projects / simh.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
First Commit of my working state
[simh.git] / VAX / vax_octa.c
1 /* vax_octa.c - VAX octaword and h_floating instructions
2
3 Copyright (c) 2004-2008, Robert M Supnik
4
5 Permission is hereby granted, free of charge, to any person obtaining a
6 copy of this software and associated documentation files (the "Software"),
7 to deal in the Software without restriction, including without limitation
8 the rights to use, copy, modify, merge, publish, distribute, sublicense,
9 and/or sell copies of the Software, and to permit persons to whom the
10 Software is furnished to do so, subject to the following conditions:
11
12 The above copyright notice and this permission notice shall be included in
13 all copies or substantial portions of the Software.
14
15 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16 IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17 FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
18 ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
19 IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
20 CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
21
22 Except as contained in this notice, the name of Robert M Supnik shall not be
23 used in advertising or otherwise to promote the sale, use or other dealings
24 in this Software without prior written authorization from Robert M Supnik.
25
26 This module simulates the VAX h_floating instruction set.
27
28 28-May-08 RMS Inlined physical memory routines
29 10-May-06 RMS Fixed bug in reported VA on faulting cross-page write
30 03-May-06 RMS Fixed MNEGH to test negated sign, clear C
31 Fixed carry propagation in qp_inc, qp_neg, qp_add
32 Fixed pack routines to test for zero via fraction
33 Fixed ACBH to set cc's on result
34 Fixed POLYH to set R3 correctly
35 Fixed POLYH to not exit prematurely if arg = 0
36 Fixed POLYH to mask mul reslt to 127b
37 Fixed fp add routine to test for zero via fraction
38 to support "denormal" argument from POLYH
39 Fixed EMODH to concatenate 15b of 16b extension
40 (all reported by Tim Stark)
41 15-Jul-04 RMS Cloned from 32b VAX floating point implementation
42 */
43
44 #include "vax_defs.h"
45
46 #if defined (FULL_VAX)
47
48 extern int32 R[16];
49 extern int32 PSL;
50 extern int32 trpirq;
51 extern int32 p1;
52 extern jmp_buf save_env;
53
54 extern int32 Test (uint32 va, int32 acc, int32 *status);
55
56 #define WORDSWAP(x) ((((x) & WMASK) << 16) | (((x) >> 16) & WMASK))
57
58 typedef struct {
59 uint32 f0; /* low */
60 uint32 f1;
61 uint32 f2;
62 uint32 f3; /* high */
63 } UQP;
64
65 typedef struct {
66 int32 sign;
67 int32 exp;
68 UQP frac;
69 } UFPH;
70
71 #define UH_NM_H 0x80000000 /* normalized */
72 #define UH_FRND 0x00000080 /* F round */
73 #define UH_DRND 0x00000080 /* D round */
74 #define UH_GRND 0x00000400 /* G round */
75 #define UH_HRND 0x00004000 /* H round */
76 #define UH_V_NM 127
77
78 int32 op_tsth (int32 val);
79 int32 op_cmph (int32 *hf1, int32 *hf2);
80 int32 op_cvtih (int32 val, int32 *hf);
81 int32 op_cvthi (int32 *hf, int32 *flg, int32 opc);
82 int32 op_cvtfdh (int32 vl, int32 vh, int32 *hf);
83 int32 op_cvtgh (int32 vl, int32 vh, int32 *hf);
84 int32 op_cvthfd (int32 *hf, int32 *vh);
85 int32 op_cvthg (int32 *hf, int32 *vh);
86 int32 op_addh (int32 *opnd, int32 *hf, t_bool sub);
87 int32 op_mulh (int32 *opnd, int32 *hf);
88 int32 op_divh (int32 *opnd, int32 *hf);
89 int32 op_emodh (int32 *opnd, int32 *hflt, int32 *intgr, int32 *flg);
90 void op_polyh (int32 *opnd, int32 acc);
91 void h_write_b (int32 spec, int32 va, int32 val, int32 acc);
92 void h_write_w (int32 spec, int32 va, int32 val, int32 acc);
93 void h_write_l (int32 spec, int32 va, int32 val, int32 acc);
94 void h_write_q (int32 spec, int32 va, int32 vl, int32 vh, int32 acc);
95 void h_write_o (int32 spec, int32 va, int32 *val, int32 acc);
96 void vax_hadd (UFPH *a, UFPH *b);
97 void vax_hmul (UFPH *a, UFPH *b, uint32 mlo);
98 void vax_hmod (UFPH *a, int32 *intgr, int32 *flg);
99 void vax_hdiv (UFPH *a, UFPH *b);
100 uint32 qp_add (UQP *a, UQP *b);
101 uint32 qp_sub (UQP *a, UQP *b);
102 void qp_inc (UQP *a);
103 void qp_lsh (UQP *a, uint32 sc);
104 void qp_rsh (UQP *a, uint32 sc);
105 void qp_rsh_s (UQP *a, uint32 sc, uint32 neg);
106 void qp_neg (UQP *a);
107 int32 qp_cmp (UQP *a, UQP *b);
108 void h_unpackfd (int32 hi, int32 lo, UFPH *a);
109 void h_unpackg (int32 hi, int32 lo, UFPH *a);
110 void h_unpackh (int32 *hflt, UFPH *a);
111 void h_normh (UFPH *a);
112 int32 h_rpackfd (UFPH *a, int32 *rl);
113 int32 h_rpackg (UFPH *a, int32 *rl);
114 int32 h_rpackh (UFPH *a, int32 *hflt);
115
116 static int32 z_octa[4] = { 0, 0, 0, 0 };
117
118 /* Octaword instructions */
119
120 int32 op_octa (int32 *opnd, int32 cc, int32 opc, int32 acc, int32 spec, int32 va)
121 {
122 int32 r, rh, temp, flg;
123 int32 r_octa[4];
124
125 switch (opc) {
126
127 /* PUSHAO
128
129 opnd[0] = src.ao
130 */
131
132 case PUSHAO:
133 Write (SP - 4, opnd[0], L_LONG, WA); /* push operand */
134 SP = SP - 4; /* decr stack ptr */
135 CC_IIZP_L (opnd[0]); /* set cc's */
136 break;
137
138 /* MOVAO
139
140 opnd[0] = src.ro
141 opnd[1:2] = dst.wl
142 spec = last specifier
143 va = address if last specifier is memory
144 */
145
146 case MOVAO:
147 h_write_l (spec, va, opnd[0], acc); /* write operand */
148 CC_IIZP_L (opnd[0]); /* set cc's */
149 break;
150
151 /* CLRO
152
153 opnd[0:1] = dst.wl
154 spec = last specifier
155 va = address if last specifier is memory
156 */
157
158 case CLRO:
159 h_write_o (spec, va, z_octa, acc); /* write 0's */
160 CC_ZZ1P; /* set cc's */
161 break;
162
163 /* TSTH
164
165 opnd[0:3] = src.rh
166 */
167
168 case TSTH:
169 r = op_tsth (opnd[0]); /* test for 0 */
170 CC_IIZZ_FP (r); /* set cc's */
171 break;
172
173 /* MOVO, MOVH, MNEGH
174
175 opnd[0:3] = src.ro
176 opnd[4:5] = dst.wo
177 spec = last specifier
178 va = address if last specifier is memory
179 */
180
181 case MOVO:
182 h_write_o (spec, va, opnd, acc); /* write src */
183 CC_IIZP_O (opnd[0], opnd[1], opnd[2], opnd[3]); /* set cc's */
184 break;
185
186 case MOVH:
187 if (r = op_tsth (opnd[0])) { /* test for 0 */
188 h_write_o (spec, va, opnd, acc); /* nz, write result */
189 CC_IIZP_FP (r); /* set cc's */
190 }
191 else { /* zero */
192 h_write_o (spec, va, z_octa, acc); /* write 0 */
193 cc = (cc & CC_C) | CC_Z; /* set cc's */
194 }
195 break;
196
197 case MNEGH:
198 if (r = op_tsth (opnd[0])) { /* test for 0 */
199 opnd[0] = opnd[0] ^ FPSIGN; /* nz, invert sign */
200 h_write_o (spec, va, opnd, acc); /* write result */
201 CC_IIZZ_FP (opnd[0]); /* set cc's */
202 }
203 else { /* zero */
204 h_write_o (spec, va, z_octa, acc); /* write 0 */
205 cc = CC_Z; /* set cc's */
206 }
207 break;
208
209 /* CMPH
210
211 opnd[0:3] = src1.rh
212 opnd[4:7] = src2.rh
213 */
214
215 case CMPH:
216 cc = op_cmph (opnd + 0, opnd + 4); /* set cc's */
217 break;
218
219 /* CVTBH, CVTWH, CVTLH
220
221 opnd[0] = src.rx
222 opnd[1:2] = dst.wh
223 spec = last specifier
224 va = address if last specifier is memory
225 */
226
227 case CVTBH:
228 r = op_cvtih (SXTB (opnd[0]), r_octa); /* convert */
229 h_write_o (spec, va, r_octa, acc); /* write reslt */
230 CC_IIZZ_FP (r); /* set cc's */
231 break;
232
233 case CVTWH:
234 r = op_cvtih (SXTW (opnd[0]), r_octa); /* convert */
235 h_write_o (spec, va, r_octa, acc); /* write result */
236 CC_IIZZ_FP (r); /* set cc's */
237 break;
238
239 case CVTLH:
240 r = op_cvtih (opnd[0], r_octa); /* convert */
241 h_write_o (spec, va, r_octa, acc); /* write result */
242 CC_IIZZ_FP (r); /* set cc's */
243 break;
244
245 /* CVTHB, CVTHW, CVTHL, CVTRHL
246
247 opnd[0:3] = src.rh
248 opnd[4:5] = dst.wx
249 spec = last specifier
250 va = address if last specifier is memory
251 */
252
253 case CVTHB:
254 r = op_cvthi (opnd, &flg, opc) & BMASK; /* convert */
255 h_write_b (spec, va, r, acc); /* write result */
256 CC_IIZZ_B (r); /* set cc's */
257 if (flg) { V_INTOV; }
258 break;
259
260 case CVTHW:
261 r = op_cvthi (opnd, &flg, opc) & WMASK; /* convert */
262 h_write_w (spec, va, r, acc); /* write result */
263 CC_IIZZ_W (r); /* set cc's */
264 if (flg) { V_INTOV; }
265 break;
266
267 case CVTHL: case CVTRHL:
268 r = op_cvthi (opnd, &flg, opc) & LMASK; /* convert */
269 h_write_l (spec, va, r, acc); /* write result */
270 CC_IIZZ_L (r); /* set cc's */
271 if (flg) { V_INTOV; }
272 break;
273
274 /* CVTFH
275
276 opnd[0] = src.rf
277 opnd[1:2] = dst.wh
278 spec = last specifier
279 va = address if last specifier is memory
280 */
281
282 case CVTFH:
283 r = op_cvtfdh (opnd[0], 0, r_octa); /* convert */
284 h_write_o (spec, va, r_octa, acc); /* write result */
285 CC_IIZZ_FP (r); /* set cc's */
286 break;
287
288 /* CVTDH, CVTGH
289
290 opnd[0:1] = src.rx
291 opnd[2:3] = dst.wh
292 spec = last specifier
293 va = address if last specifier is memory
294 */
295
296 case CVTDH:
297 r = op_cvtfdh (opnd[0], opnd[1], r_octa); /* convert */
298 h_write_o (spec, va, r_octa, acc); /* write result */
299 CC_IIZZ_FP (r); /* set cc's */
300 break;
301
302 case CVTGH:
303 r = op_cvtgh (opnd[0], opnd[1], r_octa); /* convert */
304 h_write_o (spec, va, r_octa, acc); /* write result */
305 CC_IIZZ_FP (r); /* set cc's */
306 break;
307
308 /* CVTHF, CVTHD, CVTHG
309
310 opnd[0:3] = src.rh
311 opnd[4:5] = dst.wx
312 spec = last specifier
313 va = address if last specifier is memory
314 */
315
316 case CVTHF:
317 r = op_cvthfd (opnd, NULL); /* convert */
318 h_write_l (spec, va, r, acc); /* write result */
319 CC_IIZZ_FP (r); /* set cc's */
320 break;
321
322 case CVTHD:
323 r = op_cvthfd (opnd, &rh); /* convert */
324 h_write_q (spec, va, r, rh, acc); /* write result */
325 CC_IIZZ_FP (r); /* set cc's */
326 break;
327
328 case CVTHG:
329 r = op_cvthg (opnd, &rh); /* convert */
330 h_write_q (spec, va, r, rh, acc); /* write result */
331 CC_IIZZ_FP (r); /* set cc's */
332 break;
333
334 /* ADDH2, SUBH2, MULH2, DIVH2
335
336 op[0:3] = src.rh
337 op[4:7] = dst.mh
338 spec = last specifier
339 va = address if last specifier is memory
340
341 ADDH3, SUBH3, MULH3, DIVH3
342
343 op[0:3] = src1.rh
344 op[4:7] = src2.rh
345 op[8:9] = dst.wh
346 spec = last specifier
347 va = address if last specifier is memory
348 */
349
350
351 case ADDH2: case ADDH3:
352 r = op_addh (opnd, r_octa, FALSE); /* add */
353 h_write_o (spec, va, r_octa, acc); /* write result */
354 CC_IIZZ_FP (r); /* set cc's */
355 break;
356
357 case SUBH2: case SUBH3:
358 r = op_addh (opnd, r_octa, TRUE); /* subtract */
359 h_write_o (spec, va, r_octa, acc); /* write result */
360 CC_IIZZ_FP (r); /* set cc's */
361 break;
362
363 case MULH2: case MULH3:
364 r = op_mulh (opnd, r_octa); /* multiply */
365 h_write_o (spec, va, r_octa, acc); /* write result */
366 CC_IIZZ_FP (r); /* set cc's */
367 break;
368
369 case DIVH2: case DIVH3:
370 r = op_divh (opnd, r_octa); /* divide */
371 h_write_o (spec, va, r_octa, acc); /* write result */
372 CC_IIZZ_FP (r); /* set cc's */
373 break;
374
375 /* ACBH
376
377 opnd[0:3] = limit.rh
378 opnd[4:7] = add.rh
379 opnd[8:11] = index.mh
380 spec = last specifier
381 va = last va
382 brdest = branch destination
383 */
384
385 case ACBH:
386 r = op_addh (opnd + 4, r_octa, FALSE); /* add + index */
387 CC_IIZP_FP (r); /* set cc's */
388 temp = op_cmph (r_octa, opnd); /* result : limit */
389 h_write_o (spec, va, r_octa, acc); /* write 2nd */
390 if ((temp & CC_Z) || ((opnd[4] & FPSIGN)? /* test br cond */
391 !(temp & CC_N): (temp & CC_N)))
392 cc = cc | LSIGN; /* hack for branch */
393 break;
394
395 /* POLYH
396
397 opnd[0:3] = arg.rh
398 opnd[4] = deg.rb
399 opnd[5] = table.ah
400 */
401
402 case POLYH:
403 op_polyh (opnd, acc); /* eval polynomial */
404 CC_IIZZ_FP (R[0]); /* set cc's */
405 break;
406
407 /* EMODH
408
409 opnd[0:3] = multiplier
410 opnd[4] = extension
411 opnd[5:8] = multiplicand
412 opnd[9:10] = integer destination (int.wl)
413 opnd[11:12] = floating destination (flt.wh)
414 spec = last specifier
415 va = address if last specifier is memory
416 */
417
418 case EMODH:
419 r = op_emodh (opnd, r_octa, &temp, &flg); /* extended mod */
420 if (opnd[11] < 0) { /* 2nd memory? */
421 Read (opnd[12], L_BYTE, WA); /* prove write */
422 Read ((opnd[12] + 15) & LMASK, L_BYTE, WA);
423 }
424 if (opnd[9] >= 0) R[opnd[9]] = temp; /* store 1st */
425 else Write (opnd[10], temp, L_LONG, WA);
426 h_write_o (spec, va, r_octa, acc); /* write 2nd */
427 CC_IIZZ_FP (r); /* set cc's */
428 if (flg) { V_INTOV; } /* int ovflo? */
429 break;
430
431 default:
432 RSVD_INST_FAULT;
433 }
434
435 return cc;
436 }
437
438 /* Test h_floating
439
440 Note that only the high 32b is processed.
441 If the high 32b is not zero, the rest of the fraction is unchanged. */
442
443 int32 op_tsth (int32 val)
444 {
445 if (val & H_EXP) return val; /* non-zero? */
446 if (val & FPSIGN) RSVD_OPND_FAULT; /* reserved? */
447 return 0; /* clean 0 */
448 }
449
450 /* Compare h_floating */
451
452 int32 op_cmph (int32 *hf1, int32 *hf2)
453 {
454 UFPH a, b;
455 int32 r;
456
457 h_unpackh (hf1, &a); /* unpack op1 */
458 h_unpackh (hf2, &b); /* unpack op2 */
459 if (a.sign != b.sign) return (a.sign? CC_N: 0); /* opp signs? */
460 if (a.exp != b.exp) r = a.exp - b.exp; /* cmp exp */
461 else r = qp_cmp (&a.frac, &b.frac); /* if =, cmp frac */
462 if (r < 0) return (a.sign? 0: CC_N); /* !=, maybe set N */
463 if (r > 0) return (a.sign? CC_N: 0);
464 return CC_Z; /* =, set Z */
465 }
466
467 /* Integer to h_floating convert */
468
469 int32 op_cvtih (int32 val, int32 *hf)
470 {
471 UFPH a;
472
473 if (val == 0) { /* zero? */
474 hf[0] = hf[1] = hf[2] = hf[3] = 0; /* result is 0 */
475 return 0;
476 }
477 if (val < 0) { /* negative? */
478 a.sign = FPSIGN; /* sign = - */
479 val = -val;
480 }
481 else a.sign = 0; /* else sign = + */
482 a.exp = 32 + H_BIAS; /* initial exp */
483 a.frac.f3 = val & LMASK; /* fraction hi */
484 a.frac.f2 = a.frac.f1 = a.frac.f0 = 0;
485 h_normh (&a); /* normalize */
486 return h_rpackh (&a, hf); /* round and pack */
487 }
488
489 /* H_floating to integer convert */
490
491 int32 op_cvthi (int32 *hf, int32 *flg, int32 opc)
492 {
493 UFPH a;
494 int32 lnt = opc & 03;
495 int32 ubexp;
496 static uint32 maxv[4] = { 0x7F, 0x7FFF, 0x7FFFFFFF, 0x7FFFFFFF };
497
498 *flg = 0; /* clear ovflo */
499 h_unpackh (hf, &a); /* unpack */
500 ubexp = a.exp - H_BIAS; /* unbiased exp */
501 if ((a.exp == 0) || (ubexp < 0)) return 0; /* true zero or frac? */
502 if (ubexp <= UH_V_NM) { /* exp in range? */
503 qp_rsh (&a.frac, UH_V_NM - ubexp); /* leave rnd bit */
504 if (lnt == 03) qp_inc (&a.frac); /* if CVTR, round */
505 qp_rsh (&a.frac, 1); /* now justified */
506 if (a.frac.f3 || a.frac.f2 || a.frac.f1 ||
507 (a.frac.f0 > (maxv[lnt] + (a.sign? 1: 0)))) *flg = CC_V;
508 }
509 else {
510 *flg = CC_V; /* always ovflo */
511 if (ubexp > (UH_V_NM + 32)) return 0; /* in ext range? */
512 qp_lsh (&a.frac, ubexp - UH_V_NM - 1); /* no rnd bit */
513 }
514 return (a.sign? NEG (a.frac.f0): a.frac.f0); /* return lo frac */
515 }
516
517 /* Floating to floating convert - F/D to H, G to H, H to F/D, H to G */
518
519 int32 op_cvtfdh (int32 vl, int32 vh, int32 *hflt)
520 {
521 UFPH a;
522
523 h_unpackfd (vl, vh, &a); /* unpack f/d */
524 a.exp = a.exp - FD_BIAS + H_BIAS; /* if nz, adjust exp */
525 return h_rpackh (&a, hflt); /* round and pack */
526 }
527
528 int32 op_cvtgh (int32 vl, int32 vh, int32 *hflt)
529 {
530 UFPH a;
531
532 h_unpackg (vl, vh, &a); /* unpack g */
533 a.exp = a.exp - G_BIAS + H_BIAS; /* if nz, adjust exp */
534 return h_rpackh (&a, hflt); /* round and pack */
535 }
536
537 int32 op_cvthfd (int32 *hflt, int32 *rh)
538 {
539 UFPH a;
540
541 h_unpackh (hflt, &a); /* unpack h */
542 a.exp = a.exp - H_BIAS + FD_BIAS; /* if nz, adjust exp */
543 return h_rpackfd (&a, rh); /* round and pack */
544 }
545
546 int32 op_cvthg (int32 *hflt, int32 *rh)
547 {
548 UFPH a;
549
550 h_unpackh (hflt, &a); /* unpack h */
551 a.exp = a.exp - H_BIAS + G_BIAS; /* if nz, adjust exp */
552 return h_rpackg (&a, rh); /* round and pack */
553 }
554
555 /* Floating add and subtract */
556
557 int32 op_addh (int32 *opnd, int32 *hflt, t_bool sub)
558 {
559 UFPH a, b;
560
561 h_unpackh (&opnd[0], &a); /* unpack s1, s2 */
562 h_unpackh (&opnd[4], &b);
563 if (sub) a.sign = a.sign ^ FPSIGN; /* sub? -s1 */
564 vax_hadd (&a, &b); /* do add */
565 return h_rpackh (&a, hflt); /* round and pack */
566 }
567
568 /* Floating multiply */
569
570 int32 op_mulh (int32 *opnd, int32 *hflt)
571 {
572 UFPH a, b;
573
574 h_unpackh (&opnd[0], &a); /* unpack s1, s2 */
575 h_unpackh (&opnd[4], &b);
576 vax_hmul (&a, &b, 0); /* do multiply */
577 return h_rpackh (&a, hflt); /* round and pack */
578 }
579
580 /* Floating divide */
581
582 int32 op_divh (int32 *opnd, int32 *hflt)
583 {
584 UFPH a, b;
585
586 h_unpackh (&opnd[0], &a); /* unpack s1, s2 */
587 h_unpackh (&opnd[4], &b);
588 vax_hdiv (&a, &b); /* do divide */
589 return h_rpackh (&b, hflt); /* round and pack */
590 }
591
592 /* Polynomial evaluation
593
594 The most mis-implemented instruction in the VAX (probably here too).
595 POLY requires a precise combination of masking versus normalizing
596 to achieve the desired answer. In particular, both the multiply
597 and add steps are masked prior to normalization. In addition,
598 negative small fractions must not be treated as 0 during denorm. */
599
600 void op_polyh (int32 *opnd, int32 acc)
601 {
602 UFPH r, a, c;
603 int32 deg = opnd[4];
604 int32 ptr = opnd[5];
605 int32 i, wd[4], res[4];
606
607 if (deg > 31) RSVD_OPND_FAULT; /* deg > 31? fault */
608 h_unpackh (&opnd[0], &a); /* unpack arg */
609 wd[0] = Read (ptr, L_LONG, RD); /* get C0 */
610 wd[1] = Read (ptr + 4, L_LONG, RD);
611 wd[2] = Read (ptr + 8, L_LONG, RD);
612 wd[3] = Read (ptr + 12, L_LONG, RD);
613 ptr = ptr + 16; /* adv ptr */
614 h_unpackh (wd, &r); /* unpack C0 */
615 h_rpackh (&r, res); /* first result */
616 for (i = 0; i < deg; i++) { /* loop */
617 h_unpackh (res, &r); /* unpack result */
618 vax_hmul (&r, &a, 1); /* r = r * arg */
619 wd[0] = Read (ptr, L_LONG, RD); /* get Cn */
620 wd[1] = Read (ptr + 4, L_LONG, RD);
621 wd[2] = Read (ptr + 8, L_LONG, RD);
622 wd[3] = Read (ptr + 12, L_LONG, RD);
623 ptr = ptr + 16;
624 h_unpackh (wd, &c); /* unpack Cnext */
625 vax_hadd (&r, &c); /* r = r + Cnext */
626 h_rpackh (&r, res); /* round and pack */
627 }
628 R[0] = res[0]; /* result */
629 R[1] = res[1];
630 R[2] = res[2];
631 R[3] = res[3];
632 R[4] = 0;
633 R[5] = ptr;
634 return;
635 }
636
637 /* Extended modularize
638
639 EMOD presents two sets of complications. First, it requires an extended
640 fraction multiply, with precise (and unusual) truncation conditions.
641 Second, it has two write operands, a dubious distinction it shares
642 with EDIV. */
643
644 int32 op_emodh (int32 *opnd, int32 *hflt, int32 *intgr, int32 *flg)
645 {
646 UFPH a, b;
647
648 h_unpackh (&opnd[0], &a); /* unpack operands */
649 h_unpackh (&opnd[5], &b);
650 a.frac.f0 = a.frac.f0 | (opnd[4] >> 1); /* extend src1 */
651 vax_hmul (&a, &b, 0); /* multiply */
652 vax_hmod (&a, intgr, flg); /* sep int & frac */
653 return h_rpackh (&a, hflt); /* round and pack frac */
654 }
655
656 /* Unpacked floating point routines */
657
658 /* Floating add */
659
660 void vax_hadd (UFPH *a, UFPH *b)
661 {
662 int32 ediff;
663 UFPH t;
664
665 if ((a->frac.f3 == 0) && (a->frac.f2 == 0) && /* s1 = 0? */
666 (a->frac.f1 == 0) && (a->frac.f0 == 0)) {
667 *a = *b; /* result is s2 */
668 return;
669 }
670 if ((b->frac.f3 == 0) && (b->frac.f2 == 0) && /* s2 = 0? */
671 (b->frac.f1 == 0) && (b->frac.f0 == 0))
672 return;
673 if ((a->exp < b->exp) || /* |s1| < |s2|? */
674 ((a->exp == b->exp) && (qp_cmp (&a->frac, &b->frac) < 0))) {
675 t = *a; /* swap */
676 *a = *b;
677 *b = t;
678 }
679 ediff = a->exp - b->exp; /* exp diff */
680 if (a->sign ^ b->sign) { /* eff sub? */
681 qp_neg (&b->frac); /* negate fraction */
682 if (ediff) qp_rsh_s (&b->frac, ediff, 1); /* denormalize */
683 qp_add (&a->frac, &b->frac); /* "add" frac */
684 h_normh (a); /* normalize */
685 }
686 else {
687 if (ediff) qp_rsh (&b->frac, ediff); /* add, denormalize */
688 if (qp_add (&a->frac, &b->frac)) { /* add frac, carry? */
689 qp_rsh (&a->frac, 1); /* renormalize */
690 a->frac.f3 = a->frac.f3 | UH_NM_H; /* add norm bit */
691 a->exp = a->exp + 1; /* incr exp */
692 }
693 }
694 return;
695 }
696
697 /* Floating multiply - 128b * 128b */
698
699 void vax_hmul (UFPH *a, UFPH *b, uint32 mlo)
700 {
701 int32 i, c;
702 UQP accum = { 0, 0, 0, 0 };
703
704 if ((a->exp == 0) || (b->exp == 0)) { /* zero argument? */
705 a->frac.f0 = a->frac.f1 = 0; /* result is zero */
706 a->frac.f2 = a->frac.f3 = 0;
707 a->sign = a->exp = 0;
708 return;
709 }
710 a->sign = a->sign ^ b->sign; /* sign of result */
711 a->exp = a->exp + b->exp - H_BIAS; /* add exponents */
712 for (i = 0; i < 128; i++) { /* quad precision */
713 if (a->frac.f0 & 1) c = qp_add (&accum, &b->frac); /* mplr low? add */
714 else c = 0;
715 qp_rsh (&accum, 1); /* shift result */
716 if (c) accum.f3 = accum.f3 | UH_NM_H; /* add carry out */
717 qp_rsh (&a->frac, 1); /* shift mplr */
718 }
719 a->frac = accum; /* result */
720 a->frac.f0 = a->frac.f0 & ~mlo; /* mask low frac */
721 h_normh (a); /* normalize */
722 return;
723 }
724
725 /* Floating modulus - there are three cases
726
727 exp <= bias - integer is 0, fraction is input,
728 no overflow
729 bias < exp <= bias+128 - separate integer and fraction,
730 integer overflow may occur
731 bias+128 < exp - result is integer, fraction is 0
732 integer overflow
733 */
734
735 void vax_hmod (UFPH *a, int32 *intgr, int32 *flg)
736 {
737 UQP ifr;
738
739 if (a->exp <= H_BIAS) *intgr = *flg = 0; /* 0 or <1? int = 0 */
740 else if (a->exp <= (H_BIAS + 128)) { /* in range? */
741 ifr = a->frac;
742 qp_rsh (&ifr, 128 - (a->exp - H_BIAS)); /* separate integer */
743 if ((a->exp > (H_BIAS + 32)) || /* test ovflo */
744 ((a->exp == (H_BIAS + 32)) &&
745 (ifr.f0 > (a->sign? 0x80000000: 0x7FFFFFFF))))
746 *flg = CC_V;
747 else *flg = 0;
748 *intgr = ifr.f0;
749 if (a->sign) *intgr = -*intgr; /* -? comp int */
750 qp_lsh (&a->frac, a->exp - H_BIAS); /* excise integer */
751 a->exp = H_BIAS;
752 }
753 else {
754 *intgr = 0; /* out of range */
755 a->frac.f0 = a->frac.f1 = 0; /* result 0 */
756 a->frac.f2 = a->frac.f3 = 0;
757 a->sign = a->exp = 0;
758 *flg = CC_V; /* overflow */
759 }
760 h_normh (a); /* normalize */
761 return;
762 }
763
764 /* Floating divide
765
766 Carried out to 128 bits, although fewer are required */
767
768 void vax_hdiv (UFPH *a, UFPH *b)
769 {
770 int32 i;
771 UQP quo = { 0, 0, 0, 0 };
772
773 if (a->exp == 0) FLT_DZRO_FAULT; /* divr = 0? */
774 if (b->exp == 0) return; /* divd = 0? */
775 b->sign = b->sign ^ a->sign; /* result sign */
776 b->exp = b->exp - a->exp + H_BIAS + 1; /* unbiased exp */
777 qp_rsh (&a->frac, 1); /* allow 1 bit left */
778 qp_rsh (&b->frac, 1);
779 for (i = 0; i < 128; i++) { /* divide loop */
780 qp_lsh (&quo, 1); /* shift quo */
781 if (qp_cmp (&b->frac, &a->frac) >= 0) { /* div step ok? */
782 qp_sub (&b->frac, &a->frac); /* subtract */
783 quo.f0 = quo.f0 + 1; /* quo bit = 1 */
784 }
785 qp_lsh (&b->frac, 1); /* shift divd */
786 }
787 b->frac = quo;
788 h_normh (b); /* normalize */
789 return;
790 }
791
792 /* Quad precision integer routines */
793
794 int32 qp_cmp (UQP *a, UQP *b)
795 {
796 if (a->f3 < b->f3) return -1; /* compare hi */
797 if (a->f3 > b->f3) return +1;
798 if (a->f2 < b->f2) return -1; /* hi =, compare mid1 */
799 if (a->f2 > b->f2) return +1;
800 if (a->f1 < b->f1) return -1; /* mid1 =, compare mid2 */
801 if (a->f1 > b->f1) return +1;
802 if (a->f0 < b->f0) return -1; /* mid2 =, compare lo */
803 if (a->f0 > b->f0) return +1;
804 return 0; /* all equal */
805 }
806
807 uint32 qp_add (UQP *a, UQP *b)
808 {
809 uint32 cry1, cry2, cry3, cry4;
810
811 a->f0 = (a->f0 + b->f0) & LMASK; /* add lo */
812 cry1 = (a->f0 < b->f0); /* carry? */
813 a->f1 = (a->f1 + b->f1 + cry1) & LMASK; /* add mid2 */
814 cry2 = (a->f1 < b->f1) || (cry1 && (a->f1 == b->f1)); /* carry? */
815 a->f2 = (a->f2 + b->f2 + cry2) & LMASK; /* add mid1 */
816 cry3 = (a->f2 < b->f2) || (cry2 && (a->f2 == b->f2)); /* carry? */
817 a->f3 = (a->f3 + b->f3 + cry3) & LMASK; /* add hi */
818 cry4 = (a->f3 < b->f3) || (cry3 && (a->f3 == b->f3)); /* carry? */
819 return cry4; /* return carry out */
820 }
821
822 void qp_inc (UQP *a)
823 {
824 a->f0 = (a->f0 + 1) & LMASK; /* inc lo */
825 if (a->f0 == 0) { /* propagate carry */
826 a->f1 = (a->f1 + 1) & LMASK;
827 if (a->f1 == 0) {
828 a->f2 = (a->f2 + 1) & LMASK;
829 if (a->f2 == 0) {
830 a->f3 = (a->f3 + 1) & LMASK;
831 }
832 }
833 }
834 return;
835 }
836
837 uint32 qp_sub (UQP *a, UQP *b)
838 {
839 uint32 brw1, brw2, brw3, brw4;
840
841 brw1 = (a->f0 < b->f0); /* borrow? */
842 a->f0 = (a->f0 - b->f0) & LMASK; /* sub lo */
843 brw2 = (a->f1 < b->f1) || (brw1 && (a->f1 == b->f1)); /* borrow? */
844 a->f1 = (a->f1 - b->f1 - brw1) & LMASK; /* sub mid1 */
845 brw3 = (a->f2 < b->f2) || (brw2 && (a->f2 == b->f2)); /* borrow? */
846 a->f2 = (a->f2 - b->f2 - brw2) & LMASK; /* sub mid2 */
847 brw4 = (a->f3 < b->f3) || (brw3 && (a->f3 == b->f3)); /* borrow? */
848 a->f3 = (a->f3 - b->f3 - brw3) & LMASK; /* sub high */
849 return brw4;
850 }
851
852 void qp_neg (UQP *a)
853 {
854 uint32 cryin;
855
856 cryin = 1;
857 a->f0 = (~a->f0 + cryin) & LMASK;
858 if (a->f0 != 0) cryin = 0;
859 a->f1 = (~a->f1 + cryin) & LMASK;
860 if (a->f1 != 0) cryin = 0;
861 a->f2 = (~a->f2 + cryin) & LMASK;
862 if (a->f2 != 0) cryin = 0;
863 a->f3 = (~a->f3 + cryin) & LMASK;
864 return;
865 }
866
867 void qp_lsh (UQP *r, uint32 sc)
868 {
869 if (sc >= 128) r->f3 = r->f2 = r->f1 = r->f0 = 0; /* > 127? result 0 */
870 else if (sc >= 96) { /* [96,127]? */
871 r->f3 = (r->f0 << (sc - 96)) & LMASK;
872 r->f2 = r->f1 = r->f0 = 0;
873 }
874 else if (sc > 64) { /* [65,95]? */
875 r->f3 = ((r->f1 << (sc - 64)) | (r->f0 >> (96 - sc))) & LMASK;
876 r->f2 = (r->f0 << (sc - 64)) & LMASK;
877 r->f1 = r->f0 = 0;
878 }
879 else if (sc == 64) { /* [64]? */
880 r->f3 = r->f1;
881 r->f2 = r->f0;
882 r->f1 = r->f0 = 0;
883 }
884 else if (sc > 32) { /* [33,63]? */
885 r->f3 = ((r->f2 << (sc - 32)) | (r->f1 >> (64 - sc))) & LMASK;
886 r->f2 = ((r->f1 << (sc - 32)) | (r->f0 >> (64 - sc))) & LMASK;
887 r->f1 = (r->f0 << (sc - 32)) & LMASK;
888 r->f0 = 0;
889 }
890 else if (sc == 32) { /* [32]? */
891 r->f3 = r->f2;
892 r->f2 = r->f1;
893 r->f1 = r->f0;
894 r->f0 = 0;
895 }
896 else if (sc != 0) { /* [31,1]? */
897 r->f3 = ((r->f3 << sc) | (r->f2 >> (32 - sc))) & LMASK;
898 r->f2 = ((r->f2 << sc) | (r->f1 >> (32 - sc))) & LMASK;
899 r->f1 = ((r->f1 << sc) | (r->f0 >> (32 - sc))) & LMASK;
900 r->f0 = (r->f0 << sc) & LMASK;
901 }
902 return;
903 }
904
905 void qp_rsh (UQP *r, uint32 sc)
906 {
907 if (sc >= 128) r->f3 = r->f2 = r->f1 = r->f0 = 0; /* > 127? result 0 */
908 else if (sc >= 96) { /* [96,127]? */
909 r->f0 = (r->f3 >> (sc - 96)) & LMASK;
910 r->f1 = r->f2 = r->f3 = 0;
911 }
912 else if (sc > 64) { /* [65,95]? */
913 r->f0 = ((r->f2 >> (sc - 64)) | (r->f3 << (96 - sc))) & LMASK;
914 r->f1 = (r->f3 >> (sc - 64)) & LMASK;
915 r->f2 = r->f3 = 0;
916 }
917 else if (sc == 64) { /* [64]? */
918 r->f0 = r->f2;
919 r->f1 = r->f3;
920 r->f2 = r->f3 = 0;
921 }
922 else if (sc > 32) { /* [33,63]? */
923 r->f0 = ((r->f1 >> (sc - 32)) | (r->f2 << (64 - sc))) & LMASK;
924 r->f1 = ((r->f2 >> (sc - 32)) | (r->f3 << (64 - sc))) & LMASK;
925 r->f2 = (r->f3 >> (sc - 32)) & LMASK;
926 r->f3 = 0;
927 }
928 else if (sc == 32) { /* [32]? */
929 r->f0 = r->f1;
930 r->f1 = r->f2;
931 r->f2 = r->f3;
932 r->f3 = 0;
933 }
934 else if (sc != 0) { /* [31,1]? */
935 r->f0 = ((r->f0 >> sc) | (r->f1 << (32 - sc))) & LMASK;
936 r->f1 = ((r->f1 >> sc) | (r->f2 << (32 - sc))) & LMASK;
937 r->f2 = ((r->f2 >> sc) | (r->f3 << (32 - sc))) & LMASK;
938 r->f3 = (r->f3 >> sc) & LMASK;
939 }
940 return;
941 }
942
943 void qp_rsh_s (UQP *r, uint32 sc, uint32 neg)
944 {
945 qp_rsh (r, sc); /* do unsigned right */
946 if (neg && sc) { /* negative? */
947 if (sc >= 128)
948 r->f0 = r->f1 = r->f2 = r->f3 = LMASK; /* > 127? result -1 */
949 else {
950 UQP ones = { LMASK, LMASK, LMASK, LMASK };
951 qp_lsh (&ones, 128 - sc); /* shift ones */
952 r->f0 = r->f0 | ones.f0; /* or into result */
953 r->f1 = r->f1 | ones.f1;
954 r->f2 = r->f2 | ones.f2;
955 r->f3 = r->f3 | ones.f3;
956 }
957 }
958 return;
959 }
960
961 /* Support routines */
962
963 void h_unpackfd (int32 hi, int32 lo, UFPH *r)
964 {
965 r->sign = hi & FPSIGN; /* get sign */
966 r->exp = FD_GETEXP (hi); /* get exponent */
967 r->frac.f0 = r->frac.f1 = 0; /* low bits 0 */
968 if (r->exp == 0) { /* exp = 0? */
969 if (r->sign) RSVD_OPND_FAULT; /* if -, rsvd op */
970 r->frac.f2 = r->frac.f3 = 0; /* else 0 */
971 return;
972 }
973 r->frac.f3 = WORDSWAP ((hi & ~(FPSIGN | FD_EXP)) | FD_HB);
974 r->frac.f2 = WORDSWAP (lo);
975 qp_lsh (&r->frac, FD_GUARD);
976 return;
977 }
978
979 void h_unpackg (int32 hi, int32 lo, UFPH *r)
980 {
981 r->sign = hi & FPSIGN; /* get sign */
982 r->exp = G_GETEXP (hi); /* get exponent */
983 r->frac.f0 = r->frac.f1 = 0; /* low bits 0 */
984 if (r->exp == 0) { /* exp = 0? */
985 if (r->sign) RSVD_OPND_FAULT; /* if -, rsvd op */
986 r->frac.f2 = r->frac.f3 = 0; /* else 0 */
987 return;
988 }
989 r->frac.f3 = WORDSWAP ((hi & ~(FPSIGN | G_EXP)) | G_HB);
990 r->frac.f2 = WORDSWAP (lo);
991 qp_lsh (&r->frac, G_GUARD);
992 return;
993 }
994
995 void h_unpackh (int32 *hflt, UFPH *r)
996 {
997 r->sign = hflt[0] & FPSIGN; /* get sign */
998 r->exp = H_GETEXP (hflt[0]); /* get exponent */
999 if (r->exp == 0) { /* exp = 0? */
1000 if (r->sign) RSVD_OPND_FAULT; /* if -, rsvd op */
1001 r->frac.f0 = r->frac.f1 = 0; /* else 0 */
1002 r->frac.f2 = r->frac.f3 = 0;
1003 return;
1004 }
1005 r->frac.f3 = WORDSWAP ((hflt[0] & ~(FPSIGN | H_EXP)) | H_HB);
1006 r->frac.f2 = WORDSWAP (hflt[1]);
1007 r->frac.f1 = WORDSWAP (hflt[2]);
1008 r->frac.f0 = WORDSWAP (hflt[3]);
1009 qp_lsh (&r->frac, H_GUARD);
1010 return;
1011 }
1012
1013 void h_normh (UFPH *r)
1014 {
1015 int32 i;
1016 static uint32 normmask[5] = {
1017 0xc0000000, 0xf0000000, 0xff000000, 0xffff0000, 0xffffffff };
1018 static int32 normtab[6] = { 1, 2, 4, 8, 16, 32};
1019
1020 if ((r->frac.f0 == 0) && (r->frac.f1 == 0) &&
1021 (r->frac.f2 == 0) && (r->frac.f3 == 0)) { /* if fraction = 0 */
1022 r->sign = r->exp = 0; /* result is 0 */
1023 return;
1024 }
1025 while ((r->frac.f3 & UH_NM_H) == 0) { /* normalized? */
1026 for (i = 0; i < 5; i++) { /* find first 1 */
1027 if (r->frac.f3 & normmask[i]) break;
1028 }
1029 qp_lsh (&r->frac, normtab[i]); /* shift frac */
1030 r->exp = r->exp - normtab[i]; /* decr exp */
1031 }
1032 return;
1033 }
1034
1035 int32 h_rpackfd (UFPH *r, int32 *rh)
1036 {
1037 static UQP f_round = { 0, 0, 0, UH_FRND };
1038 static UQP d_round = { 0, 0, UH_DRND, 0 };
1039
1040 if (rh) *rh = 0; /* assume 0 */
1041 if ((r->frac.f3 == 0) && (r->frac.f2 == 0)) return 0; /* frac = 0? done */
1042 qp_add (&r->frac, rh? &d_round: &f_round);
1043 if ((r->frac.f3 & UH_NM_H) == 0) { /* carry out? */
1044 qp_rsh (&r->frac, 1); /* renormalize */
1045 r->exp = r->exp + 1;
1046 }
1047 if (r->exp > (int32) FD_M_EXP) FLT_OVFL_FAULT; /* ovflo? fault */
1048 if (r->exp <= 0) { /* underflow? */
1049 if (PSL & PSW_FU) FLT_UNFL_FAULT; /* fault if fu */
1050 return 0; /* else 0 */
1051 }
1052 qp_rsh (&r->frac, FD_GUARD); /* remove guard */
1053 if (rh) *rh = WORDSWAP (r->frac.f2);
1054 return r->sign | (r->exp << FD_V_EXP) |
1055 (WORDSWAP (r->frac.f3) & ~(FD_HB | FPSIGN | FD_EXP));
1056 }
1057
1058 int32 h_rpackg (UFPH *r, int32 *rh)
1059 {
1060 static UQP g_round = { 0, 0, UH_GRND, 0 };
1061
1062 *rh = 0; /* assume 0 */
1063 if ((r->frac.f3 == 0) && (r->frac.f2 == 0)) return 0; /* frac = 0? done */
1064 qp_add (&r->frac, &g_round); /* round */
1065 if ((r->frac.f3 & UH_NM_H) == 0) { /* carry out? */
1066 qp_rsh (&r->frac, 1); /* renormalize */
1067 r->exp = r->exp + 1;
1068 }
1069 if (r->exp > (int32) G_M_EXP) FLT_OVFL_FAULT; /* ovflo? fault */
1070 if (r->exp <= 0) { /* underflow? */
1071 if (PSL & PSW_FU) FLT_UNFL_FAULT; /* fault if fu */
1072 return 0; /* else 0 */
1073 }
1074 qp_rsh (&r->frac, G_GUARD); /* remove guard */
1075 *rh = WORDSWAP (r->frac.f2); /* get low */
1076 return r->sign | (r->exp << G_V_EXP) |
1077 (WORDSWAP (r->frac.f3) & ~(G_HB | FPSIGN | G_EXP));
1078 }
1079
1080 int32 h_rpackh (UFPH *r, int32 *hflt)
1081 {
1082 static UQP h_round = { UH_HRND, 0, 0, 0 };
1083
1084 hflt[0] = hflt[1] = hflt[2] = hflt[3] = 0; /* assume 0 */
1085 if ((r->frac.f3 == 0) && (r->frac.f2 == 0) && /* frac = 0? done */
1086 (r->frac.f1 == 0) && (r->frac.f0 == 0)) return 0;
1087 if (qp_add (&r->frac, &h_round)) { /* round, carry out? */
1088 qp_rsh (&r->frac, 1); /* renormalize */
1089 r->exp = r->exp + 1;
1090 }
1091 if (r->exp > (int32) H_M_EXP) FLT_OVFL_FAULT; /* ovflo? fault */
1092 if (r->exp <= 0) { /* underflow? */
1093 if (PSL & PSW_FU) FLT_UNFL_FAULT; /* fault if fu */
1094 return 0; /* else 0 */
1095 }
1096 qp_rsh (&r->frac, H_GUARD); /* remove guard */
1097 hflt[0] = r->sign | (r->exp << H_V_EXP) |
1098 (WORDSWAP (r->frac.f3) & ~(H_HB | FPSIGN | H_EXP));
1099 hflt[1] = WORDSWAP (r->frac.f2);
1100 hflt[2] = WORDSWAP (r->frac.f1);
1101 hflt[3] = WORDSWAP (r->frac.f0);
1102 return hflt[0];
1103 }
1104
1105 void h_write_b (int32 spec, int32 va, int32 val, int32 acc)
1106 {
1107 int32 rn;
1108
1109 if (spec > (GRN | nPC)) Write (va, val, L_BYTE, WA);
1110 else {
1111 rn = spec & 0xF;
1112 R[rn] = (R[rn] & ~BMASK) | val;
1113 }
1114 return;
1115 }
1116
1117 void h_write_w (int32 spec, int32 va, int32 val, int32 acc)
1118 {
1119 int32 rn;
1120
1121 if (spec > (GRN | nPC)) Write (va, val, L_WORD, WA);
1122 else {
1123 rn = spec & 0xF;
1124 R[rn] = (R[rn] & ~WMASK) | val;
1125 }
1126 return;
1127 }
1128
1129 void h_write_l (int32 spec, int32 va, int32 val, int32 acc)
1130 {
1131 if (spec > (GRN | nPC)) Write (va, val, L_LONG, WA);
1132 else R[spec & 0xF] = val;
1133 return;
1134 }
1135
1136 void h_write_q (int32 spec, int32 va, int32 vl, int32 vh, int32 acc)
1137 {
1138 int32 rn, mstat;
1139
1140 if (spec > (GRN | nPC)) {
1141 if ((Test (va + 7, WA, &mstat) >= 0) ||
1142 (Test (va, WA, &mstat) < 0))
1143 Write (va, vl, L_LONG, WA);
1144 Write (va + 4, vh, L_LONG, WA);
1145 }
1146 else {
1147 rn = spec & 0xF;
1148 if (rn >= nSP) RSVD_ADDR_FAULT;
1149 R[rn] = vl;
1150 R[rn + 1] = vh;
1151 }
1152 return;
1153 }
1154
1155 void h_write_o (int32 spec, int32 va, int32 *val, int32 acc)
1156 {
1157 int32 rn, mstat;
1158
1159 if (spec > (GRN | nPC)) {
1160 if ((Test (va + 15, WA, &mstat) >= 0) ||
1161 (Test (va, WA, &mstat) < 0))
1162 Write (va, val[0], L_LONG, WA);
1163 Write (va + 4, val[1], L_LONG, WA);
1164 Write (va + 8, val[2], L_LONG, WA);
1165 Write (va + 12, val[3], L_LONG, WA);
1166 }
1167 else {
1168 rn = spec & 0xF;
1169 if (rn >= nAP) RSVD_ADDR_FAULT;
1170 R[rn] = val[0];
1171 R[rn + 1] = val[1];
1172 R[rn + 2] = val[2];
1173 R[rn + 3] = val[3];
1174 }
1175 return;
1176 }
1177
1178 #else
1179
1180 extern jmp_buf save_env;
1181
1182 int32 op_octa (int32 *opnd, int32 cc, int32 opc, int32 acc, int32 spec, int32 va)
1183 {
1184 RSVD_INST_FAULT;
1185 return cc;
1186 }
1187
1188 #endif
Magically enhanced SIMH