projects / simh.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
First Commit of my working state
[simh.git] / I7094 / i7094_cpu1.c
CommitLineData
196ba1fc
PH		 1/* i7094_cpu1.c: IBM 7094 CPU complex instructions\r
2\r
3 Copyright (c) 2003-2006, Robert M. Supnik\r
4\r
5 Permission is hereby granted, free of charge, to any person obtaining a\r
6 copy of this software and associated documentation files (the "Software"),\r
7 to deal in the Software without restriction, including without limitation\r
8 the rights to use, copy, modify, merge, publish, distribute, sublicense,\r
9 and/or sell copies of the Software, and to permit persons to whom the\r
10 Software is furnished to do so, subject to the following conditions:\r
11\r
12 The above copyright notice and this permission notice shall be included in\r
13 all copies or substantial portions of the Software.\r
14\r
15 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR\r
16 IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,\r
17 FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL\r
18 ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER\r
19 IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN\r
20 CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.\r
21\r
22 Except as contained in this notice, the name of Robert M Supnik shall not be\r
23 used in advertising or otherwise to promote the sale, use or other dealings\r
24 in this Software without prior written authorization from Robert M Supnik.\r
25*/\r
26\r
27#include "i7094_defs.h"\r
28\r
29#define FP_HIFRAC(x) ((uint32) ((x) >> FP_N_FR) & FP_FMASK)\r
30#define FP_LOFRAC(x) ((uint32) (x) & FP_FMASK)\r
31\r
32#define FP_PACK38(s,e,f) (((s)? AC_S: 0) | ((t_uint64) (f)) | \\r
33 (((t_uint64) ((e) & FP_M_ACCH)) << FP_V_CH))\r
34#define FP_PACK36(s,e,f) (((s)? SIGN: 0) | ((t_uint64) (f)) | \\r
35 (((t_uint64) ((e) & FP_M_CH)) << FP_V_CH))\r
36\r
37extern t_uint64 AC, MQ, SI, KEYS;\r
38extern uint32 PC;\r
39extern uint32 SLT, SSW;\r
40extern uint32 cpu_model, stop_illop;\r
41extern uint32 ind_ovf, ind_dvc, ind_ioc, ind_mqo;\r
42extern uint32 mode_ttrap, mode_strap, mode_ctrap, mode_ftrap;\r
43extern uint32 mode_storn, mode_multi;\r
44extern uint32 chtr_pend, chtr_inht, chtr_inhi;\r
45extern uint32 ch_flags[NUM_CHAN];\r
46\r
47typedef struct { /* unpacked fp */\r
48 uint32 s; /* sign: 0 +, 1 - */\r
49 int32 ch; /* exponent */\r
50 t_uint64 fr; /* fraction (54b) */\r
51 } UFP;\r
52\r
53uint32 op_frnd (void);\r
54t_uint64 fp_fracdiv (t_uint64 dvd, t_uint64 dvr, t_uint64 *rem);\r
55void fp_norm (UFP *op);\r
56void fp_unpack (t_uint64 h, t_uint64 l, t_bool q_ac, UFP *op);\r
57uint32 fp_pack (UFP *op, uint32 mqs, int32 mqch);\r
58\r
59extern t_bool fp_trap (uint32 spill);\r
60extern t_bool sel_trap (uint32 va);\r
61extern t_stat ch_op_reset (uint32 ch, t_bool ch7909);\r
62\r
63/* Integer add\r
64\r
65 Sherman: "As the result of an addition or subtraction, if the C(AC) is\r
66 zero, the sign of AC is unchanged." */\r
67\r
68void op_add (t_uint64 op)\r
69{\r
70t_uint64 mac = AC & AC_MMASK; /* get magnitudes */\r
71t_uint64 mop = op & MMASK;\r
72\r
73AC = AC & AC_S; /* isolate AC sign */\r
74if ((AC? 1: 0) ^ ((op & SIGN)? 1: 0)) { /* signs diff? sub */\r
75 if (mac >= mop) AC = AC | (mac - mop); /* AC >= MQ */\r
76 else AC = (AC ^ AC_S) | (mop - mac); /* <, sign change */\r
77 }\r
78else {\r
79 AC = AC | ((mac + mop) & AC_MMASK); /* signs same, add */\r
80 if ((AC ^ mac) & AC_P) ind_ovf = 1; /* P change? overflow */\r
81 }\r
82return;\r
83}\r
84\r
85/* Multiply */\r
86\r
87void op_mpy (t_uint64 ac, t_uint64 sr, uint32 sc)\r
88{\r
89uint32 sign;\r
90\r
91if (sc == 0) return; /* sc = 0? nop */\r
92sign = ((MQ & SIGN)? 1: 0) ^ ((sr & SIGN)? 1: 0); /* result sign */\r
93ac = ac & AC_MMASK; /* clear AC sign */\r
94sr = sr & MMASK; /* mpy magnitude */\r
95MQ = MQ & MMASK; /* MQ magnitude */\r
96if (sr && MQ) { /* mpy != 0? */\r
97 while (sc--) { /* for sc */\r
98 if (MQ & 1) ac = (ac + sr) & AC_MMASK; /* MQ35? AC += mpy */\r
99 MQ = (MQ >> 1) | ((ac & 1) << 34); /* AC'MQ >> 1 */\r
100 ac = ac >> 1;\r
101 }\r
102 }\r
103else ac = MQ = 0; /* result = 0 */\r
104if (sign) { /* negative? */\r
105 ac = ac | AC_S; /* insert signs */\r
106 MQ = MQ | SIGN;\r
107 }\r
108AC = ac; /* update AC */\r
109return;\r
110}\r
111\r
112/* Divide */\r
113\r
114t_bool op_div (t_uint64 sr, uint32 sc)\r
115{\r
116uint32 signa, signm;\r
117\r
118if (sc == 0) return FALSE; /* sc = 0? nop */\r
119signa = (AC & AC_S)? 1: 0; /* get signs */\r
120signm = (sr & SIGN)? 1: 0;\r
121sr = sr & MMASK; /* get dvr magn */\r
122if ((AC & AC_MMASK) >= sr) return TRUE; /* |AC| >= |sr|? */\r
123AC = AC & AC_MMASK; /* AC, MQ magn */\r
124MQ = MQ & MMASK;\r
125while (sc--) { /* for sc */\r
126 AC = ((AC << 1) & AC_MMASK) | (MQ >> 34); /* AC'MQ << 1 */\r
127 MQ = (MQ << 1) & MMASK;\r
128 if (AC >= sr) { /* AC >= dvr? */\r
129 AC = AC - sr; /* AC -= dvr */\r
130 MQ = MQ | 1; /* set quo bit */\r
131 }\r
132 }\r
133if (signa ^ signm) MQ = MQ | SIGN; /* quo neg? */\r
134if (signa) AC = AC | AC_S; /* rem neg? */\r
135return FALSE; /* div ok */\r
136}\r
137\r
138/* Shifts */\r
139\r
140void op_als (uint32 addr)\r
141{\r
142uint32 sc = addr & SCMASK;\r
143\r
144if ((sc >= 35)? /* shift >= 35? */\r
145 ((AC & MMASK) != 0): /* test all bits for ovf */\r
146 (((AC & MMASK) >> (35 - sc)) != 0)) /* test only 35-sc bits */\r
147 ind_ovf = 1;\r
148if (sc >= 37) AC = AC & AC_S; /* sc >= 37? result 0 */\r
149else AC = (AC & AC_S) | ((AC << sc) & AC_MMASK); /* shift, save sign */\r
150return;\r
151}\r
152\r
153void op_ars (uint32 addr)\r
154{\r
155uint32 sc = addr & SCMASK;\r
156\r
157if (sc >= 37) AC = AC & AC_S; /* sc >= 37? result 0 */\r
158else AC = (AC & AC_S) | ((AC & AC_MMASK) >> sc); /* shift, save sign */\r
159return;\r
160}\r
161\r
162void op_lls (uint32 addr)\r
163{\r
164uint32 sc; /* get sc */\r
165\r
166AC = AC & AC_MMASK; /* clear AC sign */\r
167for (sc = addr & SCMASK; sc != 0; sc--) { /* for SC */\r
168 AC = ((AC << 1) & AC_MMASK) | ((MQ >> 34) & 1); /* AC'MQ << 1 */\r
169 MQ = (MQ & SIGN) | ((MQ << 1) & MMASK); /* preserve MQ sign */\r
170 if (AC & AC_P) ind_ovf = 1; /* if P, overflow */\r
171 }\r
172if (MQ & SIGN) AC = AC | AC_S; /* set ACS from MQS */\r
173return;\r
174}\r
175\r
176void op_lrs (uint32 addr)\r
177{\r
178uint32 sc = addr & SCMASK;\r
179t_uint64 mac;\r
180\r
181MQ = MQ & MMASK; /* get MQ magnitude */\r
182if (sc != 0) {\r
183 mac = AC & AC_MMASK; /* get AC magnitude, */\r
184 AC = AC & AC_S; /* sign */\r
185 if (sc < 35) { /* sc [1,34]? */\r
186 MQ = ((MQ >> sc) | (mac << (35 - sc))) & MMASK; /* MQ has AC'MQ */\r
187 AC = AC | (mac >> sc); /* AC has AC only */\r
188 }\r
189 else if (sc < 37) { /* sc [35:36]? */\r
190 MQ = (mac >> (sc - 35)) & MMASK; /* MQ has AC only */\r
191 AC = AC | (mac >> sc); /* AC has <QP> */\r
192 }\r
193 else if (sc < 72) /* sc [37:71]? */\r
194 MQ = (mac >> (sc - 35)) & MMASK; /* MQ has AC only */\r
195 else MQ = 0; /* >72? MQ = 0 */\r
196 }\r
197if (AC & AC_S) MQ = MQ | SIGN; /* set MQS from ACS */\r
198return;\r
199}\r
200\r
201void op_lgl (uint32 addr)\r
202{\r
203uint32 sc; /* get sc */\r
204\r
205for (sc = addr & SCMASK; sc != 0; sc--) { /* for SC */\r
206 AC = (AC & AC_S) | ((AC << 1) & AC_MMASK) | /* AC'MQ << 1 */\r
207 ((MQ >> 35) & 1); /* preserve AC sign */\r
208 MQ = (MQ << 1) & DMASK;\r
209 if (AC & AC_P) ind_ovf = 1; /* if P, overflow */\r
210 }\r
211return;\r
212}\r
213\r
214void op_lgr (uint32 addr)\r
215{\r
216uint32 sc = addr & SCMASK;\r
217t_uint64 mac;\r
218\r
219if (sc != 0) {\r
220 mac = AC & AC_MMASK; /* get AC magnitude, */\r
221 AC = AC & AC_S; /* sign */\r
222 if (sc < 36) { /* sc [1,35]? */\r
223 MQ = ((MQ >> sc) | (mac << (36 - sc))) & DMASK; /* MQ has AC'MQ */\r
224 AC = AC | (mac >> sc); /* AC has AC only */\r
225 }\r
226 else if (sc == 36) { /* sc [36]? */\r
227 MQ = mac & DMASK; /* MQ = AC<P,1:35> */\r
228 AC = AC | (mac >> 36); /* AC = AC<Q> */\r
229 }\r
230 else if (sc < 73) /* sc [37, 72]? */\r
231 MQ = (mac >> (sc - 36)) & DMASK; /* MQ has AC only */\r
232 else MQ = 0; /* >72, AC,MQ = 0 */\r
233 }\r
234return;\r
235}\r
236\r
237/* Plus sense - undefined operations are NOPs */\r
238\r
239t_stat op_pse (uint32 addr)\r
240{\r
241uint32 ch, spill;\r
242\r
243switch (addr) {\r
244\r
245 case 00000: /* CLM */\r
246 if (cpu_model & I_9X) AC = AC & AC_S; /* 709X only */\r
247 break;\r
248\r
249 case 00001: /* LBT */\r
250 if ((AC & 1) != 0) PC = (PC + 1) & AMASK;\r
251 break;\r
252\r
253 case 00002: /* CHS */\r
254 AC = AC ^ AC_S;\r
255 break;\r
256\r
257 case 00003: /* SSP */\r
258 AC = AC & ~AC_S;\r
259 break;\r
260\r
261 case 00004: /* ENK */\r
262 MQ = KEYS;\r
263 break;\r
264\r
265 case 00005: /* IOT */\r
266 if (ind_ioc) ind_ioc = 0;\r
267 else PC = (PC + 1) & AMASK;\r
268 break;\r
269\r
270 case 00006: /* COM */\r
271 AC = AC ^ AC_MMASK;\r
272 break;\r
273\r
274 case 00007: /* ETM */\r
275 if (cpu_model & I_9X) mode_ttrap = 1; /* 709X only */\r
276 break;\r
277\r
278 case 00010: /* RND */\r
279 if ((cpu_model & I_9X) && (MQ & B1)) /* 709X only, MQ1 set? */\r
280 op_add ((t_uint64) 1); /* incr AC */\r
281 break;\r
282\r
283 case 00011: /* FRN */\r
284 if (cpu_model & I_9X) { /* 709X only */\r
285 spill = op_frnd ();\r
286 if (spill) fp_trap (spill);\r
287 }\r
288 break;\r
289\r
290 case 00012: /* DCT */\r
291 if (ind_dvc) ind_dvc = 0;\r
292 else PC = (PC + 1) & AMASK;\r
293 break;\r
294\r
295 case 00014: /* RCT */\r
296 chtr_inhi = 1; /* 1 cycle delay */\r
297 chtr_inht = 0; /* clr inhibit trap */\r
298 chtr_pend = 0; /* no trap now */\r
299 break;\r
300\r
301 case 00016: /* LMTM */\r
302 if (cpu_model & I_94) mode_multi = 0; /* 709X only */\r
303 break;\r
304\r
305 case 00140: /* SLF */\r
306 if (cpu_model & I_9X) SLT = 0; /* 709X only */\r
307 break;\r
308\r
309 case 00141: case 00142: case 00143: case 00144: /* SLN */\r
310 if (cpu_model & I_9X) /* 709X only */\r
311 SLT = SLT | (1u << (00144 - addr));\r
312 break;\r
313\r
314 case 00161: case 00162: case 00163: /* SWT */\r
315 case 00164: case 00165: case 00166:\r
316 if ((SSW & (1u << (00166 - addr))) != 0)\r
317 PC = (PC + 1) & AMASK;\r
318 break;\r
319\r
320 case 01000: case 02000: case 03000: case 04000: /* BTT */\r
321 case 05000: case 06000: case 07000: case 10000:\r
322 if (cpu_model & I_9X) { /* 709X only */\r
323 if (sel_trap (PC)) break; /* sel trap? */\r
324 ch = GET_U_CH (addr); /* get channel */\r
325 if (ch_flags[ch] & CHF_BOT) /* BOT? */\r
326 ch_flags[ch] &= ~CHF_BOT; /* clear */\r
327 else PC = (PC + 1) & AMASK; /* else skip */\r
328 }\r
329 break;\r
330\r
331 case 001350: case 002350: case 003350: case 004350: /* RICx */\r
332 case 005350: case 006350: case 007350: case 010350:\r
333 ch = GET_U_CH (addr); /* get channel */\r
334 return ch_op_reset (ch, 1);\r
335\r
336 case 001352: case 002352: case 003352: case 004352: /* RDCx */\r
337 case 005352: case 006352: case 007352: case 010352:\r
338 ch = GET_U_CH (addr); /* get channel */\r
339 return ch_op_reset (ch, 0);\r
340 } /* end case */\r
341\r
342return SCPE_OK;\r
343}\r
344\r
345/* Minus sense */\r
346\r
347t_stat op_mse (uint32 addr)\r
348{\r
349uint32 t, ch;\r
350\r
351switch (addr) {\r
352\r
353 case 00000: /* CLM */\r
354 if (cpu_model & I_9X) AC = AC & AC_S; /* 709X only */\r
355 break;\r
356\r
357 case 00001: /* PBT */\r
358 if ((AC & AC_P) != 0) PC = (PC + 1) & AMASK;\r
359 break;\r
360\r
361 case 00002: /* EFTM */\r
362 if (cpu_model & I_9X) { /* 709X only */\r
363 mode_ftrap = 1;\r
364 ind_mqo = 0; /* clears MQ ovf */\r
365 }\r
366 break;\r
367\r
368 case 00003: /* SSM */\r
369 if (cpu_model & I_9X) AC = AC | AC_S; /* 709X only */\r
370 break;\r
371\r
372 case 00004: /* LFTM */\r
373 if (cpu_model & I_9X) mode_ftrap = 0; /* 709X only */\r
374 break;\r
375\r
376 case 00005: /* ESTM */\r
377 if (cpu_model & I_9X) mode_strap = 1; /* 709X only */\r
378 break;\r
379\r
380 case 00006: /* ECTM */\r
381 if (cpu_model & I_9X) mode_ctrap = 1; /* 709X only */\r
382 break;\r
383\r
384 case 00007: /* LTM */\r
385 if (cpu_model & I_9X) mode_ttrap = 0; /* 709X only */\r
386 break;\r
387\r
388 case 00010: /* LSNM */\r
389 if (cpu_model & I_9X) mode_storn = 0; /* 709X only */\r
390 break;\r
391\r
392 case 00012: /* RTT (704) */\r
393 if (cpu_model & I_9X) sel_trap (PC); /* 709X only */\r
394 break;\r
395\r
396 case 00016: /* EMTM */\r
397 mode_multi = 1;\r
398 break;\r
399\r
400 case 00140: /* SLF */\r
401 if (cpu_model & I_9X) SLT = 0; /* 709X only */\r
402 break;\r
403\r
404 case 00141: case 00142: case 00143: case 00144: /* SLT */\r
405 if (cpu_model & I_9X) { /* 709X only */\r
406 t = SLT & (1u << (00144 - addr));\r
407 SLT = SLT & ~t;\r
408 if (t != 0) PC = (PC + 1) & AMASK;\r
409 }\r
410 break;\r
411\r
412 case 00161: case 00162: case 00163: /* SWT */\r
413 case 00164: case 00165: case 00166:\r
414 if ((cpu_model & I_9X) && /* 709X only */\r
415 ((SSW & (1u << (00166 - addr))) != 0))\r
416 PC = (PC + 1) & AMASK;\r
417 break;\r
418\r
419 case 001000: case 002000: case 003000: case 004000: /* ETT */\r
420 case 005000: case 006000: case 007000: case 010000:\r
421 if (sel_trap (PC)) break; /* sel trap? */\r
422 ch = GET_U_CH (addr); /* get channel */\r
423 if (ch_flags[ch] & CHF_EOT) /* EOT? */\r
424 ch_flags[ch] = ch_flags[ch] & ~CHF_EOT; /* clear */\r
425 else PC = (PC + 1) & AMASK; /* else skip */\r
426 break;\r
427 }\r
428\r
429return SCPE_OK;\r
430}\r
431\r
432/* Floating add \r
433\r
434 Notes:\r
435 - AC<Q,P> enter into the initial exponent comparison. If either is set,\r
436 the numbers are always swapped. AC<P> gets OR'd into AC<S> during the\r
437 swap, and AC<Q,P> are cleared afterwards\r
438 - The early end test is actually > 077 if AC <= SR and > 100 if\r
439 AC > SR. However, any shift >= 54 will produce a zero fraction,\r
440 so the difference can be ignored */\r
441\r
442uint32 op_fad (t_uint64 sr, t_bool norm)\r
443{\r
444UFP op1, op2, t;\r
445int32 mqch, diff;\r
446\r
447MQ = 0; /* clear MQ */\r
448fp_unpack (AC, 0, 1, &op1); /* unpack AC */\r
449fp_unpack (sr, 0, 0, &op2); /* unpack sr */\r
450if (op1.ch > op2.ch) { /* AC exp > SR exp? */\r
451 if (AC & AC_P) op1.s = 1; /* AC P or's with S */\r
452 t = op1; /* swap operands */\r
453 op1 = op2;\r
454 op2 = t;\r
455 op2.ch = op2.ch & FP_M_CH; /* clear P,Q */\r
456 }\r
457diff = op2.ch - op1.ch; /* exp diff */\r
458if (diff) { /* any shift? */\r
459 if ((diff < 0) || (diff > 077)) op1.fr = 0; /* diff > 63? */\r
460 else op1.fr = op1.fr >> diff; /* no, denormalize */\r
461 }\r
462if (op1.s ^ op2.s) { /* subtract? */\r
463 if (op1.fr >= op2.fr) { /* op1 > op2? */\r
464 op2.fr = op1.fr - op2.fr; /* op1 - op2 */\r
465 op2.s = op1.s; /* op2 sign is result */\r
466 }\r
467 else op2.fr = op2.fr - op1.fr; /* else op2 - op1 */\r
468 }\r
469else {\r
470 op2.fr = op2.fr + op1.fr; /* op2 + op1 */\r
471 if (op2.fr & FP_FCRY) { /* carry? */\r
472 op2.fr = op2.fr >> 1; /* renormalize */\r
473 op2.ch++; /* incr exp */\r
474 }\r
475 }\r
476if (norm) { /* normalize? */\r
477 if (op2.fr) { /* non-zero frac? */\r
478 fp_norm (&op2);\r
479 mqch = op2.ch - FP_N_FR;\r
480 }\r
481 else op2.ch = mqch = 0; /* else true zero */\r
482 }\r
483else mqch = op2.ch - FP_N_FR;\r
484return fp_pack (&op2, op2.s, mqch); /* pack AC, MQ */\r
485}\r
486\r
487/* Floating multiply */\r
488\r
489uint32 op_fmp (t_uint64 sr, t_bool norm)\r
490{\r
491UFP op1, op2;\r
492int32 mqch;\r
493uint32 f1h, f2h;\r
494\r
495fp_unpack (MQ, 0, 0, &op1); /* unpack MQ */\r
496fp_unpack (sr, 0, 0, &op2); /* unpack sr */\r
497op1.s = op1.s ^ op2.s; /* result sign */\r
498if ((op2.ch == 0) && (op2.fr == 0)) { /* sr a normal 0? */\r
499 AC = op1.s? AC_S: 0; /* result is 0 */\r
500 MQ = op1.s? SIGN: 0;\r
501 return 0;\r
502 }\r
503f1h = FP_HIFRAC (op1.fr); /* get hi fracs */\r
504f2h = FP_HIFRAC (op2.fr);\r
505op1.fr = ((t_uint64) f1h) * ((t_uint64) f2h); /* f1h * f2h */\r
506op1.ch = (op1.ch & FP_M_CH) + op2.ch - FP_BIAS; /* result exponent */\r
507if (norm) { /* normalize? */\r
508 if (!(op1.fr & FP_FNORM)) { /* not normalized? */\r
509 op1.fr = op1.fr << 1; /* shift frac left 1 */\r
510 op1.ch--; /* decr exp */\r
511 }\r
512 if (FP_HIFRAC (op1.fr)) /* hi result non-zero? */\r
513 mqch = op1.ch - FP_N_FR; /* set MQ exp */\r
514 else op1.ch = mqch = 0; /* clear AC, MQ exp */\r
515 }\r
516else mqch = op1.ch - FP_N_FR; /* set MQ exp */\r
517return fp_pack (&op1, op1.s, mqch); /* pack AC, MQ */\r
518}\r
519\r
520/* Floating divide */\r
521\r
522uint32 op_fdv (t_uint64 sr)\r
523{\r
524UFP op1, op2;\r
525int32 mqch;\r
526uint32 spill, quos;\r
527t_uint64 rem;\r
528\r
529fp_unpack (AC, 0, 1, &op1); /* unpack AC */\r
530fp_unpack (sr, 0, 0, &op2); /* unpack sr */\r
531quos = op1.s ^ op2.s; /* quotient sign */\r
532if (op1.fr >= (2 * op2.fr)) { /* |AC| >= 2*|sr|? */\r
533 MQ = quos? SIGN: 0; /* MQ = sign only */\r
534 return TRAP_F_DVC; /* divide check */\r
535 }\r
536if (op1.fr == 0) { /* |AC| == 0? */\r
537 MQ = quos? SIGN: 0; /* MQ = sign only */\r
538 AC = 0; /* AC = +0 */\r
539 return 0; /* done */\r
540 }\r
541op1.ch = op1.ch & FP_M_CH; /* remove AC<Q,P> */\r
542if (op1.fr >= op2.fr) { /* |AC| >= |sr|? */\r
543 op1.fr = op1.fr >> 1; /* denorm AC */\r
544 op1.ch++;\r
545 }\r
546op1.fr = fp_fracdiv (op1.fr, op2.fr, &rem); /* fraction divide */\r
547op1.fr = op1.fr | (rem << FP_N_FR); /* rem'quo */\r
548mqch = op1.ch - op2.ch + FP_BIAS; /* quotient exp */\r
549op1.ch = op1.ch - FP_N_FR; /* remainder exp */\r
550spill = fp_pack (&op1, quos, mqch); /* pack up */\r
551return (spill? (spill | TRAP_F_SGL): 0); /* if spill, set SGL */\r
552}\r
553\r
554/* Double floating add \r
555\r
556 Notes:\r
557 - AC<Q,P> enter into the initial exponent comparison. If either is set,\r
558 the numbers are always swapped. AC<P> gets OR'd into AC<S> during the\r
559 swap, and AC<Q,P> are cleared afterwards\r
560 - For most cases, SI ends up with the high order part of the larger number\r
561 - The 'early end' cases (smaller number is shifted away) must be tracked\r
562 exactly for SI impacts. The early end cases are:\r
563\r
564 (a) AC > SR, diff > 0100, and AC normalized\r
565 (b) AC <= SR, diff > 077, and SR normalized\r
566\r
567 In case (a), SI is unchanged. In case (b), SI ends up with the SR sign\r
568 and characteristic but the MQ (!) fraction */\r
569\r
570uint32 op_dfad (t_uint64 sr, t_uint64 sr1, t_bool norm)\r
571{\r
572UFP op1, op2, t;\r
573int32 mqch, diff;\r
574\r
575fp_unpack (AC, MQ, 1, &op1); /* unpack AC'MQ */\r
576fp_unpack (sr, sr1, 0, &op2); /* unpack sr'sr1 */\r
577if (op1.ch > op2.ch) { /* AC exp > SR exp? */\r
578 if (((op1.ch - op2.ch) > 0100) && (AC & B9)) ; /* early out */\r
579 else SI = FP_PACK36 (op1.s, op1.ch, FP_HIFRAC (op1.fr));\r
580 if (AC & AC_P) op1.s = 1; /* AC P or's with S */\r
581 t = op1; /* swap operands */\r
582 op1 = op2;\r
583 op2 = t;\r
584 op2.ch = op2.ch & FP_M_CH; /* clear P,Q */\r
585 }\r
586else { /* AC <= SR */\r
587 if (((op2.ch - op1.ch) > 077) && (sr & B9)) /* early out */\r
588 SI = FP_PACK36 (op2.s, op2.ch, FP_LOFRAC (MQ));\r
589 else SI = FP_PACK36 (op2.s, op2.ch, FP_HIFRAC (op2.fr));\r
590 } \r
591diff = op2.ch - op1.ch; /* exp diff */\r
592if (diff) { /* any shift? */\r
593 if ((diff < 0) || (diff > 077)) op1.fr = 0; /* diff > 63? */\r
594 else op1.fr = op1.fr >> diff; /* no, denormalize */\r
595 }\r
596if (op1.s ^ op2.s) { /* subtract? */\r
597 if (op1.fr >= op2.fr) { /* op1 > op2? */\r
598 op2.fr = op1.fr - op2.fr; /* op1 - op2 */\r
599 op2.s = op1.s; /* op2 sign is result */\r
600 }\r
601 else op2.fr = op2.fr - op1.fr; /* op2 - op1 */\r
602 }\r
603else {\r
604 op2.fr = op2.fr + op1.fr; /* op2 + op1 */\r
605 if (op2.fr & FP_FCRY) { /* carry? */\r
606 op2.fr = op2.fr >> 1; /* renormalize */\r
607 op2.ch++; /* incr exp */\r
608 }\r
609 }\r
610if (norm) { /* normalize? */\r
611 if (op2.fr) { /* non-zero frac? */\r
612 fp_norm (&op2);\r
613 mqch = op2.ch - FP_N_FR;\r
614 }\r
615 else op2.ch = mqch = 0; /* else true zero */\r
616 }\r
617else mqch = op2.ch - FP_N_FR;\r
618return fp_pack (&op2, op2.s, mqch); /* pack AC, MQ */\r
619}\r
620\r
621/* Double floating multiply\r
622\r
623 Notes (notation is A+B' * C+D', where ' denotes 2^-27):\r
624 - The instruction returns 0 if A and C are both zero, because B*D is never\r
625 done as part of the algorithm\r
626 - For most cases, SI ends up with B*C, with a zero sign and exponent\r
627 - For the A+B' both zero 'early end' case SI ends up with A or C,\r
628 depending on whether the operation is normalized or not */\r
629\r
630uint32 op_dfmp (t_uint64 sr, t_uint64 sr1, t_bool norm)\r
631{\r
632UFP op1, op2;\r
633int32 mqch;\r
634uint32 f1h, f2h, f1l, f2l;\r
635t_uint64 tx;\r
636\r
637fp_unpack (AC, MQ, 1, &op1); /* unpack AC'MQ */\r
638fp_unpack (sr, sr1, 0, &op2); /* unpack sr'sr1 */\r
639op1.s = op1.s ^ op2.s; /* result sign */\r
640f1h = FP_HIFRAC (op1.fr); /* A */\r
641f1l = FP_LOFRAC (op1.fr); /* B */\r
642f2h = FP_HIFRAC (op2.fr); /* C */\r
643f2l = FP_LOFRAC (op2.fr); /* D */\r
644if (((op1.ch == 0) && (op1.fr == 0)) || /* AC'MQ normal 0? */\r
645 ((op2.ch == 0) && (op2.fr == 0)) || /* sr'sr1 normal 0? */\r
646 ((f1h == 0) && (f2h == 0))) { /* both hi frac zero? */\r
647 AC = op1.s? AC_S: 0; /* result is 0 */\r
648 MQ = op1.s? SIGN: 0;\r
649 SI = sr; /* SI has C */\r
650 return 0;\r
651 }\r
652op1.ch = (op1.ch & FP_M_CH) + op2.ch - FP_BIAS; /* result exponent */\r
653if (op1.fr) { /* A'B != 0? */\r
654 op1.fr = ((t_uint64) f1h) * ((t_uint64) f2h); /* A * C */\r
655 tx = ((t_uint64) f1h) * ((t_uint64) f2l); /* A * D */\r
656 op1.fr = op1.fr + (tx >> FP_N_FR); /* add in hi 27b */\r
657 tx = ((t_uint64) f1l) * ((t_uint64) f2h); /* B * C */\r
658 op1.fr = op1.fr + (tx >> FP_N_FR); /* add in hi 27b */\r
659 SI = tx >> FP_N_FR; /* SI keeps B * C */\r
660 }\r
661else {\r
662 if (norm) SI = sr; /* early out */\r
663 else SI = FP_PACK36 (op2.s, op2.ch, 0);\r
664 }\r
665if (norm) { /* normalize? */\r
666 if (!(op1.fr & FP_FNORM)) { /* not normalized? */\r
667 op1.fr = op1.fr << 1; /* shift frac left 1 */\r
668 op1.ch--; /* decr exp */\r
669 }\r
670 if (FP_HIFRAC (op1.fr)) { /* non-zero? */\r
671 mqch = op1.ch - FP_N_FR; /* set MQ exp */\r
672 }\r
673 else op1.ch = mqch = 0; /* clear AC, MQ exp */\r
674 }\r
675else mqch = op1.ch - FP_N_FR; /* set MQ exp */\r
676return fp_pack (&op1, op1.s, mqch); /* pack AC, MQ */\r
677}\r
678\r
679/* Double floating divide\r
680\r
681\r
682 Notes:\r
683 - This is a Taylor series expansion (where ' denotes >> 27):\r
684\r
685 (A+B') * (C+D')^-1 = (A+B') * C^-1 - (A+B') * D'* C^-2 +...\r
686\r
687 to two terms, which can be rewritten as terms Q1, Q2:\r
688\r
689 Q1 = (A+B')/C\r
690 Q2' = (R - Q1*D)'/C\r
691\r
692 - Tracking the sign of Q2' is complicated:\r
693\r
694 Q1 has the sign of the quotient, s_AC ^ s_SR\r
695 D has the sign of the divisor, s_SR\r
696 R has the sign of the dividend, s_AC\r
697 Q1*D sign is s_AC ^ s_SR ^ s^SR = s^AC\r
698 Therefore, R and Q1*D have the same sign, s_AC\r
699 Q2' sign is s^AC ^ s_SR, which is the sign of the quotient\r
700\r
701 - For first divide check, SI is 0\r
702 - For other cases, including second divide check, SI ends up with Q1\r
703 - R-Q1*D is only calculated to the high 27b; using the full 54b\r
704 throws off the result\r
705 - The second divide must check for divd >= divr, otherwise an extra\r
706 bit of quotient would be devloped, throwing off the result\r
707 - A late ECO added full post-normalization; single precision divide\r
708 does no normalization */\r
709\r
710uint32 op_dfdv (t_uint64 sr, t_uint64 sr1)\r
711{\r
712UFP op1, op2;\r
713int32 mqch;\r
714uint32 csign, ac_s;\r
715t_uint64 f1h, f2h, tr, tq1, tq1d, trmq1d, tq2;\r
716\r
717fp_unpack (AC, MQ, 1, &op1); /* unpack AC'MQ */\r
718fp_unpack (sr, 0, 0, &op2); /* unpack sr only */\r
719ac_s = op1.s; /* save AC sign */\r
720op1.s = op1.s ^ op2.s; /* sign of result */\r
721f1h = FP_HIFRAC (op1.fr);\r
722f2h = FP_HIFRAC (op2.fr);\r
723if (f1h >= (2 * f2h)) { /* |A| >= 2*|C|? */\r
724 SI = 0; /* clear SI */\r
725 return TRAP_F_DVC; /* divide check */\r
726 }\r
727if (f1h == 0) { /* |AC| == 0? */\r
728 SI = MQ = op1.s? SIGN: 0; /* MQ, SI = sign only */\r
729 AC = op1.s? AC_S: 0; /* AC = sign only */\r
730 return 0; /* done */\r
731 }\r
732op1.ch = op1.ch & FP_M_CH; /* remove AC<Q,P> */\r
733if (f1h >= f2h) { /* |A| >= |C|? */\r
734 op1.fr = op1.fr >> 1; /* denorm AC */\r
735 op1.ch++;\r
736 }\r
737op1.ch = op1.ch - op2.ch + FP_BIAS; /* exp of quotient */\r
738tq1 = fp_fracdiv (op1.fr, op2.fr, &tr); /* |A+B| / |C| */\r
739tr = tr << FP_N_FR; /* R << 27 */\r
740tq1d = (tq1 * ((t_uint64) FP_LOFRAC (sr1))) & /* Q1 * D */\r
741 ~((t_uint64) FP_FMASK); /* top 27 bits */\r
742csign = (tr < tq1d); /* correction sign */\r
743if (csign) trmq1d = tq1d - tr; /* |R|<|Q1*D|? compl */\r
744else trmq1d = tr - tq1d; /* no, subtr ok */\r
745SI = FP_PACK36 (op1.s, op1.ch, tq1); /* SI has Q1 */\r
746if (trmq1d >= (2 * op2.fr)) { /* |R-Q1*D| >= 2*|C|? */\r
747 AC = FP_PACK38 (csign ^ ac_s, 0, FP_HIFRAC (trmq1d)); /* AC has R-Q1*D */\r
748 MQ = (csign ^ ac_s)? SIGN: 0; /* MQ = sign only */\r
749 return TRAP_F_DVC; /* divide check */\r
750 }\r
751tq2 = fp_fracdiv (trmq1d, op2.fr, NULL); /* |R-Q1*D| / |C| */\r
752if (trmq1d >= op2.fr) tq2 &= ~((t_uint64) 1); /* can only gen 27b quo */\r
753op1.fr = tq1 << FP_N_FR; /* shift Q1 into place */\r
754if (csign) op1.fr = op1.fr - tq2; /* sub or add Q2 */\r
755else op1.fr = op1.fr + tq2;\r
756fp_norm (&op1); /* normalize */\r
757if (op1.fr) mqch = op1.ch - FP_N_FR; /* non-zero? */\r
758else op1.ch = mqch = 0; /* clear AC, MQ exp */\r
759return fp_pack (&op1, op1.s, mqch); /* pack AC, MQ */\r
760}\r
761\r
762/* Floating round */\r
763\r
764uint32 op_frnd (void)\r
765{\r
766UFP op;\r
767uint32 spill;\r
768\r
769spill = 0; /* no error */\r
770if (MQ & B9) { /* MQ9 set? */\r
771 fp_unpack (AC, 0, 1, &op); /* unpack AC */\r
772 op.fr = op.fr + ((t_uint64) (1 << FP_N_FR)); /* round up */\r
773 if (op.fr & FP_FCRY) { /* carry out? */\r
774 op.fr = op.fr >> 1; /* renormalize */\r
775 op.ch++; /* incr exp */\r
776 if (op.ch == (FP_M_CH + 1)) /* ovf with QP = 0? */\r
777 spill = TRAP_F_OVF | TRAP_F_AC;\r
778 }\r
779 AC = FP_PACK38 (op.s, op.ch, FP_HIFRAC (op.fr)); /* pack AC */\r
780 }\r
781return spill;\r
782}\r
783\r
784/* Fraction divide - 54/27'0 yielding quotient and remainder */\r
785\r
786t_uint64 fp_fracdiv (t_uint64 dvd, t_uint64 dvr, t_uint64 *rem)\r
787{\r
788dvr = dvr >> FP_N_FR;\r
789if (rem) *rem = dvd % dvr;\r
790return (dvd / dvr);\r
791}\r
792 \r
793/* Floating point normalize */\r
794\r
795void fp_norm (UFP *op)\r
796{\r
797op->fr = op->fr & FP_DFMASK; /* mask fraction */\r
798if (op->fr == 0) return; /* zero? */\r
799while ((op->fr & FP_FNORM) == 0) { /* until norm */\r
800 op->fr = op->fr << 1; /* lsh 1 */\r
801 op->ch--; /* decr exp */\r
802 }\r
803return;\r
804}\r
805\r
806/* Floating point unpack */\r
807\r
808void fp_unpack (t_uint64 h, t_uint64 l, t_bool q_ac, UFP *op)\r
809{\r
810if (q_ac) { /* AC? */\r
811 op->s = (h & AC_S)? 1: 0; /* get sign */\r
812 op->ch = (uint32) ((h >> FP_V_CH) & FP_M_ACCH); /* get exp */\r
813 }\r
814else {\r
815 op->s = (h & SIGN)? 1: 0; /* no, mem */\r
816 op->ch = (uint32) ((h >> FP_V_CH) & FP_M_CH);\r
817 }\r
818op->fr = (((t_uint64) FP_LOFRAC (h)) << FP_N_FR) | /* get frac hi */\r
819 ((t_uint64) FP_LOFRAC (l)); /* get frac lo */\r
820return;\r
821}\r
822\r
823/* Floating point pack */\r
824\r
825uint32 fp_pack (UFP *op, uint32 mqs, int32 mqch)\r
826{\r
827uint32 spill;\r
828\r
829AC = FP_PACK38 (op->s, op->ch, FP_HIFRAC (op->fr)); /* pack AC */\r
830MQ = FP_PACK36 (mqs, mqch, FP_LOFRAC (op->fr)); /* pack MQ */\r
831if (op->ch > FP_M_CH) spill = TRAP_F_OVF | TRAP_F_AC; /* check AC exp */\r
832else if (op->ch < 0) spill = TRAP_F_AC;\r
833else spill = 0;\r
834if (mqch > FP_M_CH) spill |= (TRAP_F_OVF | TRAP_F_MQ); /* check MQ exp */\r
835else if (mqch < 0) spill |= TRAP_F_MQ;\r
836return spill;\r
837}\r
Magically enhanced SIMH