Commit | Line | Data |
---|---|---|
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 | |
37 | extern t_uint64 AC, MQ, SI, KEYS;\r | |
38 | extern uint32 PC;\r | |
39 | extern uint32 SLT, SSW;\r | |
40 | extern uint32 cpu_model, stop_illop;\r | |
41 | extern uint32 ind_ovf, ind_dvc, ind_ioc, ind_mqo;\r | |
42 | extern uint32 mode_ttrap, mode_strap, mode_ctrap, mode_ftrap;\r | |
43 | extern uint32 mode_storn, mode_multi;\r | |
44 | extern uint32 chtr_pend, chtr_inht, chtr_inhi;\r | |
45 | extern uint32 ch_flags[NUM_CHAN];\r | |
46 | \r | |
47 | typedef 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 | |
53 | uint32 op_frnd (void);\r | |
54 | t_uint64 fp_fracdiv (t_uint64 dvd, t_uint64 dvr, t_uint64 *rem);\r | |
55 | void fp_norm (UFP *op);\r | |
56 | void fp_unpack (t_uint64 h, t_uint64 l, t_bool q_ac, UFP *op);\r | |
57 | uint32 fp_pack (UFP *op, uint32 mqs, int32 mqch);\r | |
58 | \r | |
59 | extern t_bool fp_trap (uint32 spill);\r | |
60 | extern t_bool sel_trap (uint32 va);\r | |
61 | extern 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 | |
68 | void op_add (t_uint64 op)\r | |
69 | {\r | |
70 | t_uint64 mac = AC & AC_MMASK; /* get magnitudes */\r | |
71 | t_uint64 mop = op & MMASK;\r | |
72 | \r | |
73 | AC = AC & AC_S; /* isolate AC sign */\r | |
74 | if ((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 | |
78 | else {\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 | |
82 | return;\r | |
83 | }\r | |
84 | \r | |
85 | /* Multiply */\r | |
86 | \r | |
87 | void op_mpy (t_uint64 ac, t_uint64 sr, uint32 sc)\r | |
88 | {\r | |
89 | uint32 sign;\r | |
90 | \r | |
91 | if (sc == 0) return; /* sc = 0? nop */\r | |
92 | sign = ((MQ & SIGN)? 1: 0) ^ ((sr & SIGN)? 1: 0); /* result sign */\r | |
93 | ac = ac & AC_MMASK; /* clear AC sign */\r | |
94 | sr = sr & MMASK; /* mpy magnitude */\r | |
95 | MQ = MQ & MMASK; /* MQ magnitude */\r | |
96 | if (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 | |
103 | else ac = MQ = 0; /* result = 0 */\r | |
104 | if (sign) { /* negative? */\r | |
105 | ac = ac | AC_S; /* insert signs */\r | |
106 | MQ = MQ | SIGN;\r | |
107 | }\r | |
108 | AC = ac; /* update AC */\r | |
109 | return;\r | |
110 | }\r | |
111 | \r | |
112 | /* Divide */\r | |
113 | \r | |
114 | t_bool op_div (t_uint64 sr, uint32 sc)\r | |
115 | {\r | |
116 | uint32 signa, signm;\r | |
117 | \r | |
118 | if (sc == 0) return FALSE; /* sc = 0? nop */\r | |
119 | signa = (AC & AC_S)? 1: 0; /* get signs */\r | |
120 | signm = (sr & SIGN)? 1: 0;\r | |
121 | sr = sr & MMASK; /* get dvr magn */\r | |
122 | if ((AC & AC_MMASK) >= sr) return TRUE; /* |AC| >= |sr|? */\r | |
123 | AC = AC & AC_MMASK; /* AC, MQ magn */\r | |
124 | MQ = MQ & MMASK;\r | |
125 | while (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 | |
133 | if (signa ^ signm) MQ = MQ | SIGN; /* quo neg? */\r | |
134 | if (signa) AC = AC | AC_S; /* rem neg? */\r | |
135 | return FALSE; /* div ok */\r | |
136 | }\r | |
137 | \r | |
138 | /* Shifts */\r | |
139 | \r | |
140 | void op_als (uint32 addr)\r | |
141 | {\r | |
142 | uint32 sc = addr & SCMASK;\r | |
143 | \r | |
144 | if ((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 | |
148 | if (sc >= 37) AC = AC & AC_S; /* sc >= 37? result 0 */\r | |
149 | else AC = (AC & AC_S) | ((AC << sc) & AC_MMASK); /* shift, save sign */\r | |
150 | return;\r | |
151 | }\r | |
152 | \r | |
153 | void op_ars (uint32 addr)\r | |
154 | {\r | |
155 | uint32 sc = addr & SCMASK;\r | |
156 | \r | |
157 | if (sc >= 37) AC = AC & AC_S; /* sc >= 37? result 0 */\r | |
158 | else AC = (AC & AC_S) | ((AC & AC_MMASK) >> sc); /* shift, save sign */\r | |
159 | return;\r | |
160 | }\r | |
161 | \r | |
162 | void op_lls (uint32 addr)\r | |
163 | {\r | |
164 | uint32 sc; /* get sc */\r | |
165 | \r | |
166 | AC = AC & AC_MMASK; /* clear AC sign */\r | |
167 | for (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 | |
172 | if (MQ & SIGN) AC = AC | AC_S; /* set ACS from MQS */\r | |
173 | return;\r | |
174 | }\r | |
175 | \r | |
176 | void op_lrs (uint32 addr)\r | |
177 | {\r | |
178 | uint32 sc = addr & SCMASK;\r | |
179 | t_uint64 mac;\r | |
180 | \r | |
181 | MQ = MQ & MMASK; /* get MQ magnitude */\r | |
182 | if (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 | |
197 | if (AC & AC_S) MQ = MQ | SIGN; /* set MQS from ACS */\r | |
198 | return;\r | |
199 | }\r | |
200 | \r | |
201 | void op_lgl (uint32 addr)\r | |
202 | {\r | |
203 | uint32 sc; /* get sc */\r | |
204 | \r | |
205 | for (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 | |
211 | return;\r | |
212 | }\r | |
213 | \r | |
214 | void op_lgr (uint32 addr)\r | |
215 | {\r | |
216 | uint32 sc = addr & SCMASK;\r | |
217 | t_uint64 mac;\r | |
218 | \r | |
219 | if (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 | |
234 | return;\r | |
235 | }\r | |
236 | \r | |
237 | /* Plus sense - undefined operations are NOPs */\r | |
238 | \r | |
239 | t_stat op_pse (uint32 addr)\r | |
240 | {\r | |
241 | uint32 ch, spill;\r | |
242 | \r | |
243 | switch (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 | |
342 | return SCPE_OK;\r | |
343 | }\r | |
344 | \r | |
345 | /* Minus sense */\r | |
346 | \r | |
347 | t_stat op_mse (uint32 addr)\r | |
348 | {\r | |
349 | uint32 t, ch;\r | |
350 | \r | |
351 | switch (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 | |
429 | return 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 | |
442 | uint32 op_fad (t_uint64 sr, t_bool norm)\r | |
443 | {\r | |
444 | UFP op1, op2, t;\r | |
445 | int32 mqch, diff;\r | |
446 | \r | |
447 | MQ = 0; /* clear MQ */\r | |
448 | fp_unpack (AC, 0, 1, &op1); /* unpack AC */\r | |
449 | fp_unpack (sr, 0, 0, &op2); /* unpack sr */\r | |
450 | if (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 | |
457 | diff = op2.ch - op1.ch; /* exp diff */\r | |
458 | if (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 | |
462 | if (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 | |
469 | else {\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 | |
476 | if (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 | |
483 | else mqch = op2.ch - FP_N_FR;\r | |
484 | return fp_pack (&op2, op2.s, mqch); /* pack AC, MQ */\r | |
485 | }\r | |
486 | \r | |
487 | /* Floating multiply */\r | |
488 | \r | |
489 | uint32 op_fmp (t_uint64 sr, t_bool norm)\r | |
490 | {\r | |
491 | UFP op1, op2;\r | |
492 | int32 mqch;\r | |
493 | uint32 f1h, f2h;\r | |
494 | \r | |
495 | fp_unpack (MQ, 0, 0, &op1); /* unpack MQ */\r | |
496 | fp_unpack (sr, 0, 0, &op2); /* unpack sr */\r | |
497 | op1.s = op1.s ^ op2.s; /* result sign */\r | |
498 | if ((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 | |
503 | f1h = FP_HIFRAC (op1.fr); /* get hi fracs */\r | |
504 | f2h = FP_HIFRAC (op2.fr);\r | |
505 | op1.fr = ((t_uint64) f1h) * ((t_uint64) f2h); /* f1h * f2h */\r | |
506 | op1.ch = (op1.ch & FP_M_CH) + op2.ch - FP_BIAS; /* result exponent */\r | |
507 | if (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 | |
516 | else mqch = op1.ch - FP_N_FR; /* set MQ exp */\r | |
517 | return fp_pack (&op1, op1.s, mqch); /* pack AC, MQ */\r | |
518 | }\r | |
519 | \r | |
520 | /* Floating divide */\r | |
521 | \r | |
522 | uint32 op_fdv (t_uint64 sr)\r | |
523 | {\r | |
524 | UFP op1, op2;\r | |
525 | int32 mqch;\r | |
526 | uint32 spill, quos;\r | |
527 | t_uint64 rem;\r | |
528 | \r | |
529 | fp_unpack (AC, 0, 1, &op1); /* unpack AC */\r | |
530 | fp_unpack (sr, 0, 0, &op2); /* unpack sr */\r | |
531 | quos = op1.s ^ op2.s; /* quotient sign */\r | |
532 | if (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 | |
536 | if (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 | |
541 | op1.ch = op1.ch & FP_M_CH; /* remove AC<Q,P> */\r | |
542 | if (op1.fr >= op2.fr) { /* |AC| >= |sr|? */\r | |
543 | op1.fr = op1.fr >> 1; /* denorm AC */\r | |
544 | op1.ch++;\r | |
545 | }\r | |
546 | op1.fr = fp_fracdiv (op1.fr, op2.fr, &rem); /* fraction divide */\r | |
547 | op1.fr = op1.fr | (rem << FP_N_FR); /* rem'quo */\r | |
548 | mqch = op1.ch - op2.ch + FP_BIAS; /* quotient exp */\r | |
549 | op1.ch = op1.ch - FP_N_FR; /* remainder exp */\r | |
550 | spill = fp_pack (&op1, quos, mqch); /* pack up */\r | |
551 | return (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 | |
570 | uint32 op_dfad (t_uint64 sr, t_uint64 sr1, t_bool norm)\r | |
571 | {\r | |
572 | UFP op1, op2, t;\r | |
573 | int32 mqch, diff;\r | |
574 | \r | |
575 | fp_unpack (AC, MQ, 1, &op1); /* unpack AC'MQ */\r | |
576 | fp_unpack (sr, sr1, 0, &op2); /* unpack sr'sr1 */\r | |
577 | if (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 | |
586 | else { /* 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 | |
591 | diff = op2.ch - op1.ch; /* exp diff */\r | |
592 | if (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 | |
596 | if (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 | |
603 | else {\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 | |
610 | if (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 | |
617 | else mqch = op2.ch - FP_N_FR;\r | |
618 | return 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 | |
630 | uint32 op_dfmp (t_uint64 sr, t_uint64 sr1, t_bool norm)\r | |
631 | {\r | |
632 | UFP op1, op2;\r | |
633 | int32 mqch;\r | |
634 | uint32 f1h, f2h, f1l, f2l;\r | |
635 | t_uint64 tx;\r | |
636 | \r | |
637 | fp_unpack (AC, MQ, 1, &op1); /* unpack AC'MQ */\r | |
638 | fp_unpack (sr, sr1, 0, &op2); /* unpack sr'sr1 */\r | |
639 | op1.s = op1.s ^ op2.s; /* result sign */\r | |
640 | f1h = FP_HIFRAC (op1.fr); /* A */\r | |
641 | f1l = FP_LOFRAC (op1.fr); /* B */\r | |
642 | f2h = FP_HIFRAC (op2.fr); /* C */\r | |
643 | f2l = FP_LOFRAC (op2.fr); /* D */\r | |
644 | if (((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 | |
652 | op1.ch = (op1.ch & FP_M_CH) + op2.ch - FP_BIAS; /* result exponent */\r | |
653 | if (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 | |
661 | else {\r | |
662 | if (norm) SI = sr; /* early out */\r | |
663 | else SI = FP_PACK36 (op2.s, op2.ch, 0);\r | |
664 | }\r | |
665 | if (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 | |
675 | else mqch = op1.ch - FP_N_FR; /* set MQ exp */\r | |
676 | return 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 | |
710 | uint32 op_dfdv (t_uint64 sr, t_uint64 sr1)\r | |
711 | {\r | |
712 | UFP op1, op2;\r | |
713 | int32 mqch;\r | |
714 | uint32 csign, ac_s;\r | |
715 | t_uint64 f1h, f2h, tr, tq1, tq1d, trmq1d, tq2;\r | |
716 | \r | |
717 | fp_unpack (AC, MQ, 1, &op1); /* unpack AC'MQ */\r | |
718 | fp_unpack (sr, 0, 0, &op2); /* unpack sr only */\r | |
719 | ac_s = op1.s; /* save AC sign */\r | |
720 | op1.s = op1.s ^ op2.s; /* sign of result */\r | |
721 | f1h = FP_HIFRAC (op1.fr);\r | |
722 | f2h = FP_HIFRAC (op2.fr);\r | |
723 | if (f1h >= (2 * f2h)) { /* |A| >= 2*|C|? */\r | |
724 | SI = 0; /* clear SI */\r | |
725 | return TRAP_F_DVC; /* divide check */\r | |
726 | }\r | |
727 | if (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 | |
732 | op1.ch = op1.ch & FP_M_CH; /* remove AC<Q,P> */\r | |
733 | if (f1h >= f2h) { /* |A| >= |C|? */\r | |
734 | op1.fr = op1.fr >> 1; /* denorm AC */\r | |
735 | op1.ch++;\r | |
736 | }\r | |
737 | op1.ch = op1.ch - op2.ch + FP_BIAS; /* exp of quotient */\r | |
738 | tq1 = fp_fracdiv (op1.fr, op2.fr, &tr); /* |A+B| / |C| */\r | |
739 | tr = tr << FP_N_FR; /* R << 27 */\r | |
740 | tq1d = (tq1 * ((t_uint64) FP_LOFRAC (sr1))) & /* Q1 * D */\r | |
741 | ~((t_uint64) FP_FMASK); /* top 27 bits */\r | |
742 | csign = (tr < tq1d); /* correction sign */\r | |
743 | if (csign) trmq1d = tq1d - tr; /* |R|<|Q1*D|? compl */\r | |
744 | else trmq1d = tr - tq1d; /* no, subtr ok */\r | |
745 | SI = FP_PACK36 (op1.s, op1.ch, tq1); /* SI has Q1 */\r | |
746 | if (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 | |
751 | tq2 = fp_fracdiv (trmq1d, op2.fr, NULL); /* |R-Q1*D| / |C| */\r | |
752 | if (trmq1d >= op2.fr) tq2 &= ~((t_uint64) 1); /* can only gen 27b quo */\r | |
753 | op1.fr = tq1 << FP_N_FR; /* shift Q1 into place */\r | |
754 | if (csign) op1.fr = op1.fr - tq2; /* sub or add Q2 */\r | |
755 | else op1.fr = op1.fr + tq2;\r | |
756 | fp_norm (&op1); /* normalize */\r | |
757 | if (op1.fr) mqch = op1.ch - FP_N_FR; /* non-zero? */\r | |
758 | else op1.ch = mqch = 0; /* clear AC, MQ exp */\r | |
759 | return fp_pack (&op1, op1.s, mqch); /* pack AC, MQ */\r | |
760 | }\r | |
761 | \r | |
762 | /* Floating round */\r | |
763 | \r | |
764 | uint32 op_frnd (void)\r | |
765 | {\r | |
766 | UFP op;\r | |
767 | uint32 spill;\r | |
768 | \r | |
769 | spill = 0; /* no error */\r | |
770 | if (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 | |
781 | return spill;\r | |
782 | }\r | |
783 | \r | |
784 | /* Fraction divide - 54/27'0 yielding quotient and remainder */\r | |
785 | \r | |
786 | t_uint64 fp_fracdiv (t_uint64 dvd, t_uint64 dvr, t_uint64 *rem)\r | |
787 | {\r | |
788 | dvr = dvr >> FP_N_FR;\r | |
789 | if (rem) *rem = dvd % dvr;\r | |
790 | return (dvd / dvr);\r | |
791 | }\r | |
792 | \r | |
793 | /* Floating point normalize */\r | |
794 | \r | |
795 | void fp_norm (UFP *op)\r | |
796 | {\r | |
797 | op->fr = op->fr & FP_DFMASK; /* mask fraction */\r | |
798 | if (op->fr == 0) return; /* zero? */\r | |
799 | while ((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 | |
803 | return;\r | |
804 | }\r | |
805 | \r | |
806 | /* Floating point unpack */\r | |
807 | \r | |
808 | void fp_unpack (t_uint64 h, t_uint64 l, t_bool q_ac, UFP *op)\r | |
809 | {\r | |
810 | if (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 | |
814 | else {\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 | |
818 | op->fr = (((t_uint64) FP_LOFRAC (h)) << FP_N_FR) | /* get frac hi */\r | |
819 | ((t_uint64) FP_LOFRAC (l)); /* get frac lo */\r | |
820 | return;\r | |
821 | }\r | |
822 | \r | |
823 | /* Floating point pack */\r | |
824 | \r | |
825 | uint32 fp_pack (UFP *op, uint32 mqs, int32 mqch)\r | |
826 | {\r | |
827 | uint32 spill;\r | |
828 | \r | |
829 | AC = FP_PACK38 (op->s, op->ch, FP_HIFRAC (op->fr)); /* pack AC */\r | |
830 | MQ = FP_PACK36 (mqs, mqch, FP_LOFRAC (op->fr)); /* pack MQ */\r | |
831 | if (op->ch > FP_M_CH) spill = TRAP_F_OVF | TRAP_F_AC; /* check AC exp */\r | |
832 | else if (op->ch < 0) spill = TRAP_F_AC;\r | |
833 | else spill = 0;\r | |
834 | if (mqch > FP_M_CH) spill |= (TRAP_F_OVF | TRAP_F_MQ); /* check MQ exp */\r | |
835 | else if (mqch < 0) spill |= TRAP_F_MQ;\r | |
836 | return spill;\r | |
837 | }\r |