First Commit of my working state
[simh.git] / HP2100 / hp2100_cpu4.c
CommitLineData
196ba1fc
PH
1/* hp2100_cpu4.c: HP 1000 FPP/SIS\r
2\r
3 Copyright (c) 2006-2008, J. David Bryan\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 THE AUTHOR 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 the author 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 the author.\r
25\r
26 CPU4 Floating Point Processor and Scientific Instruction Set\r
27\r
28 18-Mar-08 JDB Fixed B register return bug in /CMRT\r
29 01-Dec-06 JDB Substitutes FPP for firmware FP if HAVE_INT64\r
30\r
31 Primary references:\r
32 - HP 1000 M/E/F-Series Computers Technical Reference Handbook\r
33 (5955-0282, Mar-1980)\r
34 - HP 1000 M/E/F-Series Computers Engineering and Reference Documentation\r
35 (92851-90001, Mar-1981)\r
36 - Macro/1000 Reference Manual (92059-90001, Dec-1992)\r
37\r
38 Additional references are listed with the associated firmware\r
39 implementations, as are the HP option model numbers pertaining to the\r
40 applicable CPUs.\r
41*/\r
42\r
43#include "hp2100_defs.h"\r
44#include "hp2100_cpu.h"\r
45#include "hp2100_cpu1.h"\r
46\r
47#if defined (HAVE_INT64) /* int64 support available */\r
48\r
49#include "hp2100_fp1.h"\r
50\r
51\r
52t_stat cpu_fpp (uint32 IR, uint32 intrq); /* Floating Point Processor */\r
53t_stat cpu_sis (uint32 IR, uint32 intrq); /* Scientific Instruction Set */\r
54\r
55extern t_stat cpu_dbi (uint32 IR, uint32 intrq); /* Double-Integer instructions */\r
56\r
57\r
58/* Floating-Point Processor.\r
59\r
60 The 1000 F-Series replaces the six 2100/1000-M/E single-precision firmware\r
61 floating-point instructions with a hardware floating-point processor (FPP).\r
62 The FPP executes single-, extended-, and double-precision floating-point\r
63 instructions, as well as double-integer instructions. All of the\r
64 floating-point instructions, as well as the single- and double-integer fix\r
65 and float instructions, are handled here. Pure double-integer instructions\r
66 are dispatched to the double-integer handler for simulation.\r
67\r
68 Option implementation by CPU was as follows:\r
69\r
70 2114 2115 2116 2100 1000-M 1000-E 1000-F\r
71 ------ ------ ------ ------ ------ ------ ------\r
72 N/A N/A N/A N/A N/A N/A std\r
73\r
74 For the F-Series, the instruction codes are mapped to routines as follows:\r
75\r
76 Instr. 1000-F Description\r
77 ------ ------ -------------------------------------\r
78 105000 FAD Single real add\r
79 105001 .XADD Extended real add\r
80 105002 .TADD Double real add\r
81 105003 [EAD] [5-word add]\r
82 105004 [tst] [Floating Point Processor self test]\r
83 105005 [xpd] [Expand exponent]\r
84 105006 [rst] [Floating Point Processor reset]\r
85 105007 [stk] [Process stack of operands]\r
86 105010 [chk] [FPP addressing check]\r
87 105014 .DAD Double integer add\r
88 105020 FSB Single real subtract\r
89 105021 .XSUB Extended real subtract\r
90 105022 .TSUB Double real subtract\r
91 105023 [ESB] [5-word subtract]\r
92 105034 .DSB Double integer subtract\r
93 105040 FMP Single real multiply\r
94 105041 .XMPY Extended real multiply\r
95 105042 .TMPY Double real multiply\r
96 105043 [EMP] [5-word multiply]\r
97 105054 .DMP Double integer multiply\r
98 105060 FDV Single real divide\r
99 105061 .XDIV Extended real divide\r
100 105062 .TDIV Double real divide\r
101 105063 [EDV] [5-word divide]\r
102 105074 .DDI Double integer divide\r
103 105100 FIX Single real to integer fix\r
104 105101 .XFXS Extended real to integer fix (.DINT)\r
105 105102 .TXFS Double real to integer fix (.TINT)\r
106 105103 [EFS] [5-word FIXS]\r
107 105104 .FIXD Real to double integer fix\r
108 105105 .XFXD Extended real to double integer fix\r
109 105106 .TFXD Double real to double integer fix\r
110 105107 [EFD] [5-word FIXD]\r
111 105114 .DSBR Double integer subtraction (reversed)\r
112 105120 FLT Integer to single real float\r
113 105121 .XFTS Integer to extended real float (.IDBL)\r
114 105122 .TFTS Integer to double real float (.ITBL)\r
115 105123 [ELS] [5-word FLTS]\r
116 105124 .FLTD Double integer to real float\r
117 105125 .XFTD Double integer to extended real float\r
118 105126 .TFTD Double integer to double real float\r
119 105127 [ELD] [5-word FLTD]\r
120 105134 .DDIR Double integer divide (reversed)\r
121\r
122 Implementation note: rather than have two simulators that each executes the\r
123 single-precision FP instruction set, we compile conditionally, based on the\r
124 availability of 64-bit integer support in the host compiler. 64-bit integers\r
125 are required for the FPP, so if they are available, then we handle the\r
126 single-precision instructions for the 2100 and M/E-Series here, and the\r
127 firmware simulation is omitted. If support is unavailable, then the firmware\r
128 function is used instead.\r
129\r
130 Notes:\r
131\r
132 1. Single-precision arithmetic instructions (.FAD, etc.) and extended- and\r
133 double-precision F-Series FPP arithmetic instructions (.XADD, .TADD,\r
134 etc.) return positive infinity on both positive and negative overflow.\r
135 The equivalent extended-precision M/E-Series FFP instructions return\r
136 negative infinity on negative overflow and positive infinity on positive\r
137 overflow.\r
138\r
139 2. The items in brackets above are undocumented instructions that are used\r
140 by the 12740 FPP-SIS-FFP diagnostic only.\r
141\r
142 3. The five-word arithmetic instructions (e.g., 105003) use an expanded\r
143 operand format that dedicates a separate word to the exponent. See the\r
144 implementation notes in the hardware floating-point processor simulation\r
145 for details.\r
146\r
147 4. The "self test" instruction (105004) returned to P+1 for early F-Series\r
148 units without double-integer support. Units incorporating such support\r
149 returned to P+2.\r
150\r
151 5. The "expand exponent" instruction (105005) is used as a "prefix"\r
152 instruction to enable a 10-bit exponent range. It is placed immediately\r
153 before a 5-word arithmetic instruction sequence, e.g., immediately\r
154 preceding an EAD instruction sequence. The arithmetic instruction\r
155 executes normally, except that under/overflow is not indicated unless\r
156 the exponent exceeds the 10-bit range, instead of the normal 8-bit\r
157 range. If overflow is indicated, the exponent is still set to +128.\r
158\r
159 Note that as 2-, 3-, and 4-word packed numbers only have room for 8-bit\r
160 exponents, the Expand Exponent instruction serves no useful purpose in\r
161 conjunction with instructions associated with these precisions. If\r
162 used, the resulting values may be in error, as overflow from the 8-bit\r
163 exponents will not be indicated.\r
164\r
165 6. The "FPP reset" instruction (105006) is provided to reset a hung box,\r
166 e.g., in cases where an improper number of parameters is supplied. The\r
167 hardware resets its internal state machine in response to this\r
168 instruction. Under simulation, the instruction has no effect, as the\r
169 simulated FPP cannot hang.\r
170\r
171 7. The "process stack" instruction (105007) executes a series of FPP\r
172 instruction sets in sequence. Each set consists of a single FPP\r
173 instruction and associated operands that specifies the operation,\r
174 followed by a "result" instruction and operand. The result instruction\r
175 is optional and is only used to specify the result precision; the\r
176 instruction itself is not executed. If the result instruction is NOP,\r
177 then the result precision is that of the executed FPP instruction. If\r
178 the result operand is null, then the result is kept in the internal FPP\r
179 accumulator for later use.\r
180\r
181 The calling sequence is as follows:\r
182\r
183 STK Process stack instruction\r
184 DEF ERRTN Address of error return\r
185 DEF SET1 Address of first instruction set\r
186 DEF SET2 Address of second instruction set\r
187 .\r
188 .\r
189 .\r
190 ERRTN EQU * Return here if execution in error\r
191 OKRTN EQU * Return here if execution OK\r
192\r
193 Instruction sets are specified as follows (e.g.):\r
194\r
195 SET1 .TADD Operation instruction (NOP to terminate series)\r
196 DEC 4 Number of words in first operand (or 0 if accum)\r
197 DEF OP1 Address of first operand\r
198 DEC 4 Number of words in second operand (or 0 if accum)\r
199 DEF OP2 Address of second operand\r
200 .XADD Result precision conversion instruction (or NOP)\r
201 DEC 3 Number of words to store (or 0 if no store)\r
202 DEF RSLT Address of buffer to hold value\r
203\r
204 The primary use of the "process stack" instruction is to enable chained\r
205 operations employing the FPP accumulator for intermediate results and to\r
206 enable expanded exponent usage across multiple instructions.\r
207\r
208 8. The "addressing check" instruction sets bit 0 of the L register to 1,\r
209 copies the X register value to the FPP, and then reads the FPP and\r
210 stores the result in the Y register. Setting the L register bit 0 to 1\r
211 normally deselects the FPP, so that the value in Y is 177777. However,\r
212 the FPP box has a strap that inverts the selection logic, even though\r
213 the box will not work with the base-set firmware if this is done. The\r
214 "addressing check" instruction is provided to test whether the strap is\r
215 in the alternate location. Under simulation, the return value is always\r
216 177777, indicating that the strap is correctly set.\r
217\r
218 Additional references:\r
219 - DOS/RTE Relocatable Library Reference Manual (24998-90001, Oct-1981)\r
220 - FPP-SIS-FFP Diagnostic Source (12740-18001, Rev. 1926)\r
221*/\r
222\r
223static const OP_PAT op_fpp[96] = {\r
224 OP_RF, OP_AXX, OP_ATT, OP_AEE, /* FAD .XADD .TADD .EADD */\r
225 OP_N, OP_C, OP_N, OP_A, /* [tst] [xpd] [rst] [stk] */\r
226 OP_N, OP_N, OP_N, OP_N, /* [chk] --- --- --- */\r
227 OP_N, OP_N, OP_N, OP_N, /* .DAD --- --- --- */\r
228 OP_RF, OP_AXX, OP_ATT, OP_AEE, /* FSB .XSUB .TSUB .ESUB */\r
229 OP_N, OP_N, OP_N, OP_N, /* --- --- --- --- */\r
230 OP_N, OP_N, OP_N, OP_N, /* --- --- --- --- */\r
231 OP_N, OP_N, OP_N, OP_N, /* .DSB --- --- --- */\r
232 OP_RF, OP_AXX, OP_ATT, OP_AEE, /* FMP .XMPY .TMPY .EMPY */\r
233 OP_N, OP_N, OP_N, OP_N, /* --- --- --- --- */\r
234 OP_N, OP_N, OP_N, OP_N, /* --- --- --- --- */\r
235 OP_N, OP_N, OP_N, OP_N, /* .DMP --- --- --- */\r
236 OP_RF, OP_AXX, OP_ATT, OP_AEE, /* FDV .XDIV .TDIV .EDIV */\r
237 OP_N, OP_N, OP_N, OP_N, /* --- --- --- --- */\r
238 OP_N, OP_N, OP_N, OP_N, /* --- --- --- --- */\r
239 OP_N, OP_N, OP_N, OP_N, /* .DDI --- --- --- */\r
240 OP_R, OP_X, OP_T, OP_E, /* FIX .XFXS .TFXS .EFXS */\r
241 OP_R, OP_X, OP_T, OP_E, /* .FIXD .XFXD .TFXD .EFXD */\r
242 OP_N, OP_N, OP_N, OP_N, /* --- --- --- --- */\r
243 OP_N, OP_N, OP_N, OP_N, /* .DSBR --- --- --- */\r
244 OP_I, OP_IA, OP_IA, OP_IA, /* FLT .XFTS .TFTS .EFTS */\r
245 OP_J, OP_JA, OP_JA, OP_JA, /* .FLTD .XFTD .TFTD .EFTD */\r
246 OP_N, OP_N, OP_N, OP_N, /* --- --- --- --- */\r
247 OP_N, OP_N, OP_N, OP_N /* .DDIR --- --- --- */\r
248 };\r
249\r
250t_stat cpu_fpp (uint32 IR, uint32 intrq)\r
251{\r
252OP fpop;\r
253OPS op;\r
254OPSIZE op1_prec, op2_prec, rslt_prec, cvt_prec;\r
255uint16 opcode, rtn_addr, stk_ptr;\r
256uint32 entry;\r
257t_stat reason = SCPE_OK;\r
258\r
259if ((cpu_unit.flags & UNIT_FP) == 0) /* FP option installed? */\r
260 return stop_inst;\r
261\r
262if (UNIT_CPU_MODEL == UNIT_1000_F) /* F-Series? */\r
263 opcode = (uint16) (IR & 0377); /* yes, use full opcode */\r
264else\r
265 opcode = (uint16) (IR & 0160); /* no, use 6 SP FP opcodes */\r
266\r
267entry = opcode & 0177; /* map to <6:0> */\r
268\r
269if (op_fpp[entry] != OP_N)\r
270 if (reason = cpu_ops (op_fpp[entry], op, intrq)) /* get instruction operands */\r
271 return reason;\r
272\r
273switch (entry) { /* decode IR<6:0> */\r
274 case 0000: /* FAD 105000 (OP_RF) */\r
275 case 0020: /* FSB 105020 (OP_RF) */\r
276 case 0040: /* FMP 105040 (OP_RF) */\r
277 case 0060: /* FDV 105060 (OP_RF) */\r
278 O = fp_exec (opcode, &fpop, op[0], op[1]); /* execute operation */\r
279 AR = fpop.fpk[0]; /* return result to A/B */\r
280 BR = fpop.fpk[1];\r
281 break;\r
282\r
283 case 0001: /* .XADD 105001 (OP_AXX) */\r
284 case 0002: /* .TADD 105002 (OP_ATT) */\r
285 case 0003: /* .EADD 105003 (OP_AEE) */\r
286\r
287 case 0021: /* .XSUB 105021 (OP_AXX) */\r
288 case 0022: /* .TSUB 105022 (OP_ATT) */\r
289 case 0023: /* .ESUB 105023 (OP_AEE) */\r
290\r
291 case 0041: /* .XMPY 105041 (OP_AXX) */\r
292 case 0042: /* .TMPY 105042 (OP_ATT) */\r
293 case 0043: /* .EMPY 105043 (OP_AEE) */\r
294\r
295 case 0061: /* .XDIV 105061 (OP_AXX) */\r
296 case 0062: /* .TDIV 105062 (OP_ATT) */\r
297 case 0063: /* .EDIV 105063 (OP_AEE) */\r
298 O = fp_exec (opcode, &fpop, op[1], op[2]); /* execute operation */\r
299 fp_prec (opcode, NULL, NULL, &rslt_prec); /* determine result precision */\r
300 WriteOp (op[0].word, fpop, rslt_prec); /* write result */\r
301 break;\r
302\r
303 case 0004: /* [tst] 105004 (OP_N) */\r
304 XR = 3; /* firmware revision */\r
305 SR = 0102077; /* test passed code */\r
306 PC = (PC + 1) & VAMASK; /* P+2 return for firmware w/DBI */\r
307 break;\r
308\r
309 case 0005: /* [xpd] 105005 (OP_C) */\r
310 return cpu_fpp (op[0].word | 0200, intrq); /* set bit 7, execute instr */\r
311\r
312 case 0006: /* [rst] 105006 (OP_N) */\r
313 break; /* do nothing for FPP reset */\r
314\r
315 case 0007: /* [stk] 105007 (OP_A) */\r
316 O = 0; /* clear overflow */\r
317 stk_ptr = PC; /* save ptr to next buf */\r
318 rtn_addr = op[0].word; /* save return address */\r
319\r
320 while (TRUE) {\r
321 PC = ReadW (stk_ptr) & VAMASK; /* point at next instruction set */\r
322 stk_ptr = (stk_ptr + 1) & VAMASK;\r
323\r
324 reason = cpu_ops (OP_CCACACCA, op, intrq); /* get instruction set */\r
325\r
326 if (reason) {\r
327 PC = err_PC; /* irq restarts */\r
328 break;\r
329 }\r
330\r
331 if (op[0].word == 0) { /* opcode = NOP? */\r
332 PC = (rtn_addr + 1) & VAMASK; /* bump to good return */\r
333 break; /* done */\r
334 }\r
335\r
336 fp_prec ((uint16) (op[0].word & 0377), /* determine operand precisions */\r
337 &op1_prec, &op2_prec, &rslt_prec);\r
338\r
339 if (TO_COUNT(op1_prec) != op[1].word) { /* first operand precisions agree? */\r
340 PC = rtn_addr; /* no, so take error return */\r
341 break;\r
342 }\r
343\r
344 else if (op1_prec != fp_a) /* operand in accumulator? */\r
345 op[1] = ReadOp (op[2].word, op1_prec); /* no, so get operand 1 */\r
346\r
347 if (TO_COUNT(op2_prec) != op[3].word) { /* second operand precisions agree? */\r
348 PC = rtn_addr; /* no, so take error return */\r
349 break;\r
350 }\r
351\r
352 else if (op2_prec != fp_a) /* operand in accumulator? */\r
353 op[2] = ReadOp (op[4].word, op2_prec); /* no, so get operand 2 */\r
354\r
355 O = O | /* execute instruction */\r
356 fp_exec ((uint16) (op[0].word & 0377), /* and accumulate overflow */\r
357 &fpop, op[1], op[2]);\r
358\r
359 if (op[5].word) { /* precision conversion? */\r
360 fp_prec ((uint16) (op[5].word & 0377), /* determine conversion precision */\r
361 NULL, NULL, &cvt_prec);\r
362\r
363 fpop = fp_accum (NULL, cvt_prec); /* convert result */\r
364 }\r
365 else /* no conversion specified */\r
366 cvt_prec = rslt_prec; /* so use original precision */\r
367\r
368 if (op[6].word) /* store result? */\r
369 WriteOp (op[7].word, fpop, cvt_prec); /* yes, so write it */\r
370 }\r
371\r
372 break;\r
373\r
374 case 0010: /* [chk] 105010 (OP_N) */\r
375 YR = 0177777; /* -1 if selection strap OK */\r
376 break;\r
377\r
378 case 0014: /* .DAD 105014 (OP_N) */\r
379 return cpu_dbi (0105321, intrq); /* remap to double int handler */\r
380\r
381 case 0034: /* .DSB 105034 (OP_N) */\r
382 return cpu_dbi (0105327, intrq); /* remap to double int handler */\r
383\r
384 case 0054: /* .DMP 105054 (OP_N) */\r
385 return cpu_dbi (0105322, intrq); /* remap to double int handler */\r
386\r
387 case 0074: /* .DDI 105074 (OP_N) */\r
388 return cpu_dbi (0105325, intrq); /* remap to double int handler */\r
389\r
390 case 0100: /* FIX 105100 (OP_R) */\r
391 case 0101: /* .XFXS 105101 (OP_X) */\r
392 case 0102: /* .TFXS 105102 (OP_T) */\r
393 case 0103: /* .EFXS 105103 (OP_E) */\r
394 O = fp_exec (opcode, &fpop, op[0], NOP); /* fix to integer */\r
395 AR = fpop.fpk[0]; /* save result */\r
396 break;\r
397\r
398 case 0104: /* .FIXD 105104 (OP_R) */\r
399 case 0105: /* .XFXD 105105 (OP_X) */\r
400 case 0106: /* .TFXD 105106 (OP_T) */\r
401 case 0107: /* .EFXD 105107 (OP_E) */\r
402 O = fp_exec (opcode, &fpop, op[0], NOP); /* fix to integer */\r
403 AR = (fpop.dword >> 16) & DMASK; /* save result */\r
404 BR = fpop.dword & DMASK; /* in A and B */\r
405 break;\r
406\r
407 case 0114: /* .DSBR 105114 (OP_N) */\r
408 return cpu_dbi (0105334, intrq); /* remap to double int handler */\r
409\r
410 case 0120: /* FLT 105120 (OP_I) */\r
411 case 0124: /* .FLTD 105124 (OP_J) */\r
412 O = fp_exec (opcode, &fpop, op[0], NOP); /* float to single */\r
413 AR = fpop.fpk[0]; /* save result */\r
414 BR = fpop.fpk[1]; /* into A/B */\r
415 break;\r
416\r
417 case 0121: /* .XFTS 105121 (OP_IA) */\r
418 case 0122: /* .TFTS 105122 (OP_IA) */\r
419 case 0123: /* .EFTS 105123 (OP_IA) */\r
420 case 0125: /* .XFTD 105125 (OP_JA) */\r
421 case 0126: /* .TFTD 105126 (OP_JA) */\r
422 case 0127: /* .EFTD 105127 (OP_JA) */\r
423 O = fp_exec (opcode, &fpop, op[0], NOP); /* float integer */\r
424 fp_prec (opcode, NULL, NULL, &rslt_prec); /* determine result precision */\r
425 WriteOp (op[1].word, fpop, rslt_prec); /* write result */\r
426 break;\r
427\r
428 case 0134: /* .DDIR 105134 (OP_N) */\r
429 return cpu_dbi (0105326, intrq); /* remap to double int handler */\r
430\r
431 default: /* others undefined */\r
432 reason = stop_inst;\r
433 }\r
434\r
435return reason;\r
436}\r
437\r
438\r
439/* Scientific Instruction Set.\r
440\r
441 The SIS adds single-precision trigonometric and logarithmic, and\r
442 double-precision polynomial evaluation instructions to the 1000-F instruction\r
443 set. The SIS is standard on the 1000-F.\r
444\r
445 Option implementation by CPU was as follows:\r
446\r
447 2114 2115 2116 2100 1000-M 1000-E 1000-F\r
448 ------ ------ ------ ------ ------ ------ ------\r
449 N/A N/A N/A N/A N/A N/A std\r
450\r
451 The routines are mapped to instruction codes as follows:\r
452\r
453 Instr. 1000-F Description\r
454 ------ ------ ----------------------------------------------\r
455 TAN 105320 Tangent\r
456 SQRT 105321 Square root\r
457 ALOG 105322 Natural logarithm\r
458 ATAN 105323 Arc tangent\r
459 COS 105324 Cosine\r
460 SIN 105325 Sine\r
461 EXP 105326 E to the power X\r
462 ALOGT 105327 Common logarithm\r
463 TANH 105330 Hyperbolic tangent\r
464 DPOLY 105331 Double-precision polynomial evaluation\r
465 /CMRT 105332 Double-precision common range reduction\r
466 /ATLG 105333 Compute (1-x)/(1+x) for .ATAN and .LOG\r
467 .FPWR 105334 Single-precision exponentiation\r
468 .TPWR 105335 Double-precision exponentiation\r
469 [tst] 105337 [self test]\r
470\r
471 The SIS simulation follows the F-Series SIS microcode, which, in turn,\r
472 follows the algebraic approximations given in the Relocatable Library manual\r
473 descriptions of the equivalent software routines.\r
474\r
475 Notes:\r
476\r
477 1. The word following the DPOLY instruction contains up to three flag bits\r
478 to indicate one of several polynomial forms to evaluate. The comments\r
479 in the DPOLY software library routine source interchange the actions of\r
480 the bit 14 and bit 0 flags. The DPOLY description in the Technical\r
481 Reference Handbook is correct.\r
482\r
483 2. Several instructions (e.g., DPOLY) are documented as leaving undefined\r
484 values in the A, B, X, Y, E, or O registers. Simulation does not\r
485 attempt to reproduce the same values as would be obtained with the\r
486 hardware.\r
487\r
488 3. The SIS uses the hardware FPP of the F-Series. FPP malfunctions are\r
489 detected by the SIS firmware and are indicated by a memory-protect\r
490 violation and setting the overflow flag. Under simulation,\r
491 malfunctions cannot occur.\r
492\r
493 4. We use OP_IIT for the .FPWR operand pattern. The "II" is redundant, but\r
494 it aligns the operands with the OP_IAT of .TPWR, so the code may be\r
495 shared.\r
496\r
497 Additional references:\r
498 - DOS/RTE Relocatable Library Reference Manual (24998-90001, Oct-1981)\r
499 - HP 1000 E-Series and F-Series Computer Microprogramming Reference Manual\r
500 (02109-90004, Apr-1980).\r
501*/\r
502\r
503\r
504/* Common single-precision range reduction for SIN, COS, TAN, and EXP.\r
505\r
506 This routine is called by the SIN, COS, TAN, and EXP handlers to reduce the\r
507 range of the argument. Reduction is performed in extended-precision. We\r
508 calculate:\r
509\r
510 multiple = (nearest even integer to argument * multiplier)\r
511 argument = argument * multiplier - multiple\r
512*/\r
513\r
514static uint32 reduce (OP *argument, int32 *multiple, OP multiplier)\r
515{\r
516OP product, count;\r
517uint32 overflow;\r
518\r
519fp_cvt (argument, fp_f, fp_x); /* convert to extended precision */\r
520fp_exec (0041, &product, *argument, multiplier); /* product = argument * multiplier */\r
521overflow = fp_exec (0111, &count, NOP, NOP); /* count = FIX (acc) */\r
522\r
523if ((int16) count.word >= 0) /* nearest even integer */\r
524 count.word = count.word + 1;\r
525count.word = count.word & ~1;\r
526*multiple = (int16) count.word;\r
527\r
528if (overflow == 0) { /* in range? */\r
529 fp_exec (0121, ACCUM, count, NOP); /* acc = FLT (count) */\r
530 overflow = fp_exec (0025, ACCUM, product, NOP); /* acc = product - acc */\r
531 *argument = fp_accum (NULL, fp_f); /* trim to single-precision */\r
532 }\r
533return overflow;\r
534}\r
535\r
536\r
537/* SIS dispatcher. */\r
538\r
539static const OP_PAT op_sis[16] = {\r
540 OP_R, OP_R, OP_R, OP_R, /* TAN SQRT ALOG ATAN */\r
541 OP_R, OP_R, OP_R, OP_R, /* COS SIN EXP ALOGT */\r
542 OP_R, OP_CATAKK, OP_AAT, OP_A, /* TANH DPOLY /CMRT /ATLG */\r
543 OP_IIF, OP_IAT, OP_N, OP_N /* .FPWR .TPWR --- [tst] */\r
544 };\r
545\r
546t_stat cpu_sis (uint32 IR, uint32 intrq)\r
547{\r
548OPS op;\r
549OP arg, coeff, pwr, product, count, result;\r
550int16 f, p;\r
551int32 multiple, power, exponent, rsltexp;\r
552uint32 entry, i;\r
553t_bool flag, sign;\r
554t_stat reason = SCPE_OK;\r
555\r
556static const OP tan_c4 = { { 0137763, 0051006 } }; /* DEC -4.0030956 */\r
557static const OP tan_c3 = { { 0130007, 0051026 } }; /* DEC -1279.5424 */\r
558static const OP tan_c2 = { { 0040564, 0012761 } }; /* DEC 0.0019974806 */\r
559static const OP tan_c1 = { { 0045472, 0001375 } }; /* DEC 0.14692695 */\r
560\r
561static const OP alog_c3 = { { 0065010, 0063002 } }; /* DEC 1.6567626301 */\r
562static const OP alog_c2 = { { 0125606, 0044404 } }; /* DEC -2.6398577035 */\r
563static const OP alog_c1 = { { 0051260, 0037402 } }; /* DEC 1.2920070987 */\r
564\r
565static const OP atan_c4 = { { 0040257, 0154404 } }; /* DEC 2.0214656 */\r
566static const OP atan_c3 = { { 0132062, 0133406 } }; /* DEC -4.7376165 */\r
567static const OP atan_c2 = { { 0047407, 0173775 } }; /* DEC 0.154357652 */\r
568static const OP atan_c1 = { { 0053447, 0014002 } }; /* DEC 1.3617611 */\r
569\r
570static const OP sin_c4 = { { 0132233, 0040745 } }; /* DEC -0.000035950439 */\r
571static const OP sin_c3 = { { 0050627, 0122361 } }; /* DEC 0.002490001 */\r
572static const OP sin_c2 = { { 0126521, 0011373 } }; /* DEC -0.0807454325 */\r
573static const OP sin_c1 = { { 0062207, 0166400 } }; /* DEC 0.78539816 */\r
574\r
575static const OP cos_c4 = { { 0126072, 0002753 } }; /* DEC -0.00031957 */\r
576static const OP cos_c3 = { { 0040355, 0007767 } }; /* DEC 0.015851077 */\r
577static const OP cos_c2 = { { 0130413, 0011377 } }; /* DEC -0.30842483 */\r
578static const OP cos_c1 = { { 0040000, 0000002 } }; /* DEC 1.0 */\r
579\r
580static const OP sqrt_a2 = { { 0045612, 0067400 } }; /* DEC 0.5901621 */\r
581static const OP sqrt_b2 = { { 0065324, 0126377 } }; /* DEC 0.4173076 */\r
582static const OP sqrt_a1 = { { 0065324, 0126400 } }; /* DEC 0.8346152 */\r
583static const OP sqrt_b1 = { { 0045612, 0067400 } }; /* DEC 0.5901621 */\r
584\r
585static const OP exp_c2 = { { 0073000, 0070771 } }; /* DEC 0.05761803 */\r
586static const OP exp_c1 = { { 0056125, 0041406 } }; /* DEC 5.7708162 */\r
587\r
588static const OP tanh_c3 = { { 0050045, 0022004 } }; /* DEC 2.5045337 */\r
589static const OP tanh_c2 = { { 0041347, 0101404 } }; /* DEC 2.0907609 */\r
590static const OP tanh_c1 = { { 0052226, 0047375 } }; /* DEC 0.16520923 */\r
591\r
592static const OP minus_1 = { { 0100000, 0000000 } }; /* DEC -1.0 */\r
593static const OP plus_1 = { { 0040000, 0000002 } }; /* DEC +1.0 */\r
594static const OP plus_half = { { 0040000, 0000000 } }; /* DEC +0.5 */\r
595static const OP ln_2 = { { 0054271, 0006000 } }; /* DEC 0.6931471806 (ln 2.0) */\r
596static const OP log_e = { { 0067455, 0166377 } }; /* DEC 0.43429228 (log e) */\r
597static const OP pi_over_4 = { { 0062207, 0166400 } }; /* Pi / 4.0 */\r
598static const OP pi_over_2 = { { 0062207, 0166402 } }; /* Pi / 2.0 */\r
599\r
600static const OP four_over_pi = { { 0050574, 0140667, 0023402 } }; /* 4.0 / Pi */\r
601static const OP two_over_ln2 = { { 0056125, 0016624, 0127404 } }; /* 2.0 / ln(2.0) */\r
602\r
603static const OP t_one = { { 0040000, 0000000, 0000000, 0000002 } }; /* DEY 1.0 */\r
604\r
605\r
606if (UNIT_CPU_MODEL != UNIT_1000_F) /* F-Series? */\r
607 return stop_inst;\r
608\r
609entry = IR & 017; /* mask to entry point */\r
610\r
611if (op_sis[entry] != OP_N)\r
612 if (reason = cpu_ops (op_sis[entry], op, intrq)) /* get instruction operands */\r
613 return reason;\r
614\r
615switch (entry) { /* decode IR<3:0> */\r
616\r
617 case 000: /* TAN 105320 (OP_R) */\r
618 O = reduce (&op[0], &multiple, four_over_pi); /* reduce range */\r
619\r
620 if (O) { /* out of range? */\r
621 op[0].fpk[0] = '0' << 8 | '9'; /* return '09' */\r
622 op[0].fpk[1] = 'O' << 8 | 'R'; /* return 'OR' */\r
623 break; /* error return is P+1 */\r
624 }\r
625\r
626 fp_exec (0040, &op[1], op[0], op[0]); /* op1 = arg ^ 2 */\r
627 fp_exec (0010, ACCUM, NOP, tan_c4); /* acc = acc + C4 */\r
628 fp_exec (0064, ACCUM, tan_c3, NOP); /* acc = C3 / acc */\r
629 fp_exec (0010, ACCUM, NOP, op[1]); /* acc = acc + op1 */\r
630 fp_exec (0050, ACCUM, NOP, tan_c2); /* acc = acc * C2 */\r
631 fp_exec (0010, ACCUM, NOP, tan_c1); /* acc = acc + C1 */\r
632 fp_exec (0050, &op[0], NOP, op[0]); /* res = acc * arg */\r
633\r
634 if (multiple & 0002) /* multiple * 2 odd? */\r
635 fp_exec (0064, &op[0], minus_1, NOP); /* res = -1.0 / acc */\r
636\r
637 PC = (PC + 1) & VAMASK; /* normal return is P+2 */\r
638 break;\r
639\r
640\r
641 case 001: /* SQRT 105321 (OP_R) */\r
642 O = 0; /* clear overflow */\r
643\r
644 if (op[0].fpk[0] == 0) { /* arg = 0? */\r
645 PC = (PC + 1) & VAMASK; /* normal return is P+2 */\r
646 break;\r
647 }\r
648\r
649 else if ((int16) op[0].fpk[0] < 0) { /* sqrt of neg? */\r
650 op[0].fpk[0] = '0' << 8 | '3'; /* return '03' */\r
651 op[0].fpk[1] = 'U' << 8 | 'N'; /* return 'UN' */\r
652 O = 1; /* set overflow */\r
653 break; /* error return is P+1 */\r
654 }\r
655\r
656 fp_unpack (&op[1], &exponent, op[0], fp_f); /* unpack argument */\r
657\r
658 if (exponent & 1) { /* exponent odd? */\r
659 fp_exec (0040, ACCUM, op[1], sqrt_a1); /* acc = op1 * A1 */\r
660 fp_exec (0010, &op[2], NOP, sqrt_b1); /* op2 = acc + B1 */\r
661 op[1].fpk[1] = op[1].fpk[1] + 2; /* op1 = op1 * 2.0 */\r
662 }\r
663 else { /* exponent even */\r
664 fp_exec (0040, ACCUM, op[1], sqrt_a2); /* acc = op1 * A2 */\r
665 fp_exec (0010, &op[2], NOP, sqrt_b2); /* op2 = acc + B2 */\r
666 }\r
667\r
668 fp_exec (0064, ACCUM, op[1], NOP); /* acc = op1 / acc */\r
669 fp_exec (0010, &op[2], NOP, op[2]); /* op2 = acc + op2 */\r
670\r
671 op[1].fpk[1] = op[1].fpk[1] + 4; /* op1 = op1 * 4.0 */\r
672\r
673 fp_exec (0064, ACCUM, op[1], NOP); /* acc = op1 / acc */\r
674 fp_exec (0010, &op[0], NOP, op[2]); /* res = acc + op2 */\r
675\r
676 power = (exponent >> 1) - 2;\r
677\r
678 if (op[0].fpk[0]) { /* calc x * 2**n */\r
679 fp_unpack (&op[1], &exponent, op[0], fp_f); /* unpack argument */\r
680 exponent = exponent + power; /* multiply by 2**n */\r
681\r
682 if ((exponent > 0177) || /* exponent overflow? */\r
683 (exponent < -0200)) { /* or underflow? */\r
684 O = 1; /* rtn unscaled val, set ovf */\r
685 break; /* error return is P+1 */\r
686 }\r
687\r
688 else\r
689 fp_pack (&op[0], op[1], exponent, fp_f);/* repack result */\r
690 }\r
691\r
692 PC = (PC + 1) & VAMASK; /* normal return is P+2 */\r
693 break;\r
694\r
695\r
696 case 002: /* ALOG 105322 (OP_R) */\r
697 case 007: /* ALOGT 105327 (OP_R) */\r
698 O = 0; /* clear overflow */\r
699\r
700 if ((int16) op[0].fpk[0] <= 0) { /* log of neg or zero? */\r
701 op[0].fpk[0] = '0' << 8 | '2'; /* return '02' */\r
702 op[0].fpk[1] = 'U' << 8 | 'N'; /* return 'UN' */\r
703 O = 1; /* set overflow */\r
704 break; /* error return is P+1 */\r
705 }\r
706\r
707 fp_unpack (&op[1], &exponent, op[0], fp_f); /* unpack argument */\r
708\r
709 if (op[0].fpk[0] < 0055000) { /* out of range? */\r
710 exponent = exponent - 1; /* drop exponent */\r
711 op[1].fpk[1] = op[1].fpk[1] | 2; /* set "exponent" to 1 */\r
712 }\r
713\r
714 op[2].fpk[0] = exponent;\r
715 fp_exec (0120, &op[3], op[2], NOP); /* op3 = FLT(exponent) */\r
716\r
717 fp_exec (0020, &op[4], op[1], plus_1); /* op4 = op1 - 1.0 */\r
718 fp_exec (0000, ACCUM, op[1], plus_1); /* acc = op1 + 1.0 */\r
719 fp_exec (0064, &op[5], op[4], NOP); /* op5 = op4 / acc */\r
720\r
721 fp_exec (0054, ACCUM, NOP, NOP); /* acc = acc * acc */\r
722 fp_exec (0030, ACCUM, NOP, alog_c3); /* acc = acc - c3 */\r
723 fp_exec (0064, ACCUM, alog_c2, NOP); /* acc = c2 / acc */\r
724 fp_exec (0010, ACCUM, NOP, alog_c1); /* acc = acc + c1 */\r
725 fp_exec (0050, ACCUM, NOP, op[5]); /* acc = acc * op5 */\r
726 fp_exec (0010, ACCUM, NOP, op[3]); /* acc = acc + op3 */\r
727 fp_exec (0050, &op[0], NOP, ln_2); /* res = acc * ln2 */\r
728\r
729 if (entry == 007) /* ALOGT? */\r
730 fp_exec (0050, &op[0], NOP, log_e); /* res = acc * log(e) */\r
731\r
732 PC = (PC + 1) & VAMASK; /* normal return is P+2 */\r
733 break;\r
734\r
735\r
736 case 003: /* ATAN 105323 (OP_R) */\r
737 O = 0; /* clear overflow */\r
738\r
739 if (op[0].fpk[0] == 0) /* argument zero? */\r
740 break; /* result zero */\r
741\r
742 flag = (op[0].fpk[1] & 1); /* get exponent sign */\r
743 sign = ((int16) op[0].fpk[0] < 0); /* get argument sign */\r
744\r
745 if (flag == 0) { /* exp pos? (abs >= 0.5)? */\r
746 if (sign) /* argument negative? */\r
747 fp_pcom (&op[0], fp_f); /* make positive */\r
748\r
749 if (op[0].fpk[1] & 0374) { /* arg >= 2? */\r
750 fp_exec(0060, &op[0], plus_1, op[0]); /* arg = 1.0 / arg */\r
751 op[2] = pi_over_2; /* constant = pi / 2.0 */\r
752 }\r
753 else {\r
754 fp_exec (0020, &op[1], plus_1, op[0]); /* op1 = 1.0 - arg */\r
755 fp_exec (0000, ACCUM, plus_1, op[0]); /* acc = 1.0 + arg */\r
756 fp_exec (0064, &op[0], op[1], NOP); /* arg = op1 / acc */\r
757 op[2] = pi_over_4; /* constant = pi / 4.0 */\r
758 }\r
759 }\r
760\r
761 fp_exec (0040, &op[1], op[0], op[0]); /* op1 = arg * arg */\r
762 fp_exec (0010, ACCUM, NOP, atan_c4); /* acc = acc + C4 */\r
763 fp_exec (0064, ACCUM, atan_c3, NOP); /* acc = C3 / acc */\r
764 fp_exec (0010, ACCUM, NOP, op[1]); /* acc = acc + op1 */\r
765 fp_exec (0050, ACCUM, NOP, atan_c2); /* acc = acc * C2 */\r
766 fp_exec (0010, ACCUM, NOP, atan_c1); /* acc = acc + C1 */\r
767 fp_exec (0064, &op[0], op[0], NOP); /* res = arg / acc */\r
768\r
769 if (flag == 0) { /* exp pos? (abs >= 0.5)? */\r
770 fp_exec (0030, &op[0], NOP, op[2]); /* res = acc - pi / n */\r
771\r
772 if (sign == 0) /* argument positive? */\r
773 fp_pcom (&op[0], fp_f); /* make negative */\r
774 }\r
775\r
776 break;\r
777\r
778\r
779 case 004: /* COS 105324 (OP_R) */\r
780 case 005: /* SIN 105325 (OP_R) */\r
781 O = reduce (&op[0], &multiple, four_over_pi); /* reduce range */\r
782\r
783 if (O) { /* out of range? */\r
784 op[0].fpk[0] = '0' << 8 | '5'; /* return '05' */\r
785 op[0].fpk[1] = 'O' << 8 | 'R'; /* return 'OR' */\r
786 break; /* error return is P+1 */\r
787 }\r
788\r
789 multiple = multiple / 2 + (entry == 004); /* add one for cosine */\r
790 flag = (multiple & 1); /* decide on series */\r
791\r
792 fp_exec (0040, &op[1], op[0], op[0]); /* op1 = arg ^ 2 */\r
793\r
794 if (flag) {\r
795 fp_exec (0050, ACCUM, NOP, cos_c4); /* acc = acc * c4 */\r
796 fp_exec (0010, ACCUM, NOP, cos_c3); /* acc = acc + c3 */\r
797 fp_exec (0050, ACCUM, NOP, op[1]); /* acc = acc * op1 */\r
798 fp_exec (0010, ACCUM, NOP, cos_c2); /* acc = acc + c2 */\r
799 fp_exec (0050, ACCUM, NOP, op[1]); /* acc = acc * op1 */\r
800 fp_exec (0010, &op[0], NOP, cos_c1); /* res = acc + c1 */\r
801 }\r
802\r
803 else {\r
804 fp_exec (0050, ACCUM, NOP, sin_c4); /* acc = acc * c4 */\r
805 fp_exec (0010, ACCUM, NOP, sin_c3); /* acc = acc + c3 */\r
806 fp_exec (0050, ACCUM, NOP, op[1]); /* acc = acc * op1 */\r
807 fp_exec (0010, ACCUM, NOP, sin_c2); /* acc = acc + c2 */\r
808 fp_exec (0050, ACCUM, NOP, op[1]); /* acc = acc * op1 */\r
809 fp_exec (0010, ACCUM, NOP, sin_c1); /* acc = acc + c1 */\r
810 fp_exec (0050, &op[0], NOP, op[0]); /* res = acc * arg */\r
811 }\r
812\r
813 if (multiple & 0002) /* multiple * 2 odd? */\r
814 fp_pcom (&op[0], fp_f); /* make negative */\r
815\r
816 PC = (PC + 1) & VAMASK; /* normal return is P+2 */\r
817 break;\r
818\r
819\r
820 case 006: /* EXP 105326 (OP_R) */\r
821 sign = ((int16) op[0].fpk[0] < 0); /* get argument sign */\r
822\r
823 O = reduce (&op[0], &multiple, two_over_ln2); /* reduce range */\r
824 multiple = multiple / 2; /* get true multiple */\r
825\r
826 if ((sign == 0) && (O | (multiple > 128))) { /* pos and ovf or out of range? */\r
827 op[0].fpk[0] = '0' << 8 | '7'; /* return '07' */\r
828 op[0].fpk[1] = 'O' << 8 | 'F'; /* return 'OF' */\r
829 O = 1; /* set overflow */\r
830 break; /* error return is P+1 */\r
831 }\r
832\r
833 else if (sign && (multiple < -128)) { /* neg and out of range? */\r
834 op[0].fpk[0] = 0; /* result is zero */\r
835 op[0].fpk[1] = 0;\r
836 O = 0; /* clear for underflow */\r
837 PC = (PC + 1) & VAMASK; /* normal return is P+2 */\r
838 break;\r
839 }\r
840\r
841 fp_exec (0040, ACCUM, op[0], op[0]); /* acc = arg ^ 2 */\r
842 fp_exec (0050, ACCUM, NOP, exp_c2); /* acc = acc * c2 */\r
843 fp_exec (0030, ACCUM, NOP, op[0]); /* acc = acc - op0 */\r
844 fp_exec (0010, ACCUM, NOP, exp_c1); /* acc = acc + c1 */\r
845 fp_exec (0064, ACCUM, op[0], NOP); /* acc = op0 / acc */\r
846 fp_exec (0010, &op[0], NOP, plus_half); /* res = acc + 0.5 */\r
847\r
848 power = multiple + 1;\r
849\r
850 if (op[0].fpk[0]) { /* calc x * 2**n */\r
851 fp_unpack (&op[1], &exponent, op[0], fp_f); /* unpack argument */\r
852 exponent = exponent + power; /* multiply by 2**n */\r
853\r
854 if ((exponent > 0177) || /* exponent overflow? */\r
855 (exponent < -0200)) { /* or underflow? */\r
856 if (sign == 0) { /* arg positive? */\r
857 op[0].fpk[0] = '0' << 8 | '7'; /* return '07' */\r
858 op[0].fpk[1] = 'O' << 8 | 'F'; /* return 'OF' */\r
859 O = 1; /* set overflow */\r
860 }\r
861 else {\r
862 op[0].fpk[0] = 0; /* result is zero */\r
863 op[0].fpk[1] = 0;\r
864 O = 0; /* clear for underflow */\r
865 }\r
866 break; /* error return is P+1 */\r
867 }\r
868\r
869 else {\r
870 fp_pack (&op[0], op[1], exponent, fp_f);/* repack value */\r
871 O = 0;\r
872 }\r
873 }\r
874\r
875 PC = (PC + 1) & VAMASK; /* normal return is P+2 */\r
876 break;\r
877\r
878\r
879 case 010: /* TANH 105330 (OP_R) */\r
880 O = 0;\r
881 sign = ((int16) op[0].fpk[0] < 0); /* get argument sign */\r
882\r
883 if (op[0].fpk[1] & 1) { /* abs (arg) < 0.5? */\r
884 fp_exec (0040, ACCUM, op[0], op[0]); /* acc = arg ^ 2 */\r
885 fp_exec (0010, ACCUM, NOP, tanh_c3); /* acc = acc + c3 */\r
886 fp_exec (0064, ACCUM, tanh_c2, NOP); /* acc = c2 / acc */\r
887 fp_exec (0010, ACCUM, NOP, tanh_c1); /* acc = acc + c1 */\r
888 fp_exec (0050, &op[0], NOP, op[0]); /* res = acc * arg */\r
889 }\r
890\r
891 else if (op[0].fpk[1] & 0370) /* abs (arg) >= 8.0? */\r
892 if (sign) /* arg negative? */\r
893 op[0] = minus_1; /* result = -1.0 */\r
894 else /* arg positive */\r
895 op[0] = plus_1; /* result = +1.0 */\r
896\r
897 else { /* 0.5 <= abs (arg) < 8.0 */\r
898 BR = BR + 2; /* arg = arg * 2.0 */\r
899 cpu_sis (0105326, intrq); /* calc exp (arg) */\r
900 PC = (PC - 1) & VAMASK; /* correct P (always good rtn) */\r
901\r
902 op[0].fpk[0] = AR; /* save value */\r
903 op[0].fpk[1] = BR;\r
904\r
905 fp_exec (0020, &op[1], op[0], plus_1); /* op1 = op0 - 1.0 */\r
906 fp_exec (0000, ACCUM, op[0], plus_1); /* acc = op0 + 1.0 */\r
907 fp_exec (0064, &op[0], op[1], NOP); /* res = op1 / acc */\r
908 }\r
909\r
910 break;\r
911\r
912\r
913 case 011: /* DPOLY 105331 (OP_CATAKK) */\r
914 O = 0; /* clear overflow */\r
915 AR = op[0].word; /* get flag word */\r
916\r
917 if ((int16) AR >= 0) { /* flags present? */\r
918 AR = 1; /* no, so set default */\r
919 arg = op[2]; /* arg = X */\r
920 }\r
921\r
922 else /* bit 15 set */\r
923 fp_exec (0042, &arg, op[2], op[2]); /* arg = X ^ 2 */\r
924\r
925 coeff = ReadOp (op[3].word, fp_t); /* get first coefficient */\r
926 op[3].word = (op[3].word + 4) & VAMASK; /* point at next */\r
927 fp_accum (&coeff, fp_t); /* acc = coeff */\r
928\r
929 for (i = 0; i < op[4].word; i++) { /* compute numerator */\r
930 fp_exec (0052, ACCUM, NOP, arg); /* acc = P[m] * arg */\r
931 coeff = ReadOp (op[3].word, fp_t); /* get next coefficient */\r
932 op[3].word = (op[3].word + 4) & VAMASK; /* point at next */\r
933 fp_exec (0012, ACCUM, NOP, coeff); /* acc = acc + P[m-1] */\r
934 }\r
935\r
936 if (AR & 1) /* bit 0 set? */\r
937 op[6] = fp_accum (NULL, fp_t); /* save numerator */\r
938 else\r
939 fp_exec (0046, &op[6], op[2], NOP); /* acc = X * acc */\r
940\r
941\r
942 if (op[5].word) { /* n > 0 ? */\r
943 fp_accum (&t_one, fp_t); /* acc = 1.0 */\r
944\r
945 for (i = 0; i < op[5].word; i++) { /* compute denominator */\r
946 fp_exec (0052, ACCUM, NOP, arg); /* acc = P[m] * arg */\r
947 coeff = ReadOp (op[3].word, fp_t); /* get next coefficient */\r
948 op[3].word = (op[3].word + 4) & VAMASK; /* point at next */\r
949 fp_exec (0012, ACCUM, NOP, coeff); /* acc = acc + P[m-1] */\r
950 }\r
951\r
952 if (AR & 0040000) /* bit 14 set? */\r
953 fp_exec (0032, ACCUM, NOP, op[6]); /* acc = den - num */\r
954\r
955 fp_exec (0066, &op[6], op[6], NOP); /* op6 = num / den */\r
956 }\r
957\r
958 WriteOp (op[1].word, op[6], fp_t); /* write result */\r
959\r
960 if (O) /* overflow? */\r
961 op[0].fpk[0] = 0; /* microcode rtns with A = 0 */\r
962 break;\r
963\r
964\r
965 case 012: /* /CMRT 105332 (OP_AAT) */\r
966 O = 0;\r
967 f = (int16) AR; /* save flags */\r
968\r
969 coeff = ReadOp (op[1].word, fp_t); /* get coefficient (C) */\r
970\r
971 fp_unpack (NULL, &exponent, op[2], fp_t); /* unpack exponent */\r
972\r
973 if ((f == -1) || (exponent < 4)) { /* TANH or abs (arg) < 16.0? */\r
974\r
975 /* result = x * c - n */\r
976\r
977 fp_exec (0042, &product, op[2], coeff); /* product = arg * C */\r
978 O = fp_exec (0112, &count, NOP, NOP); /* count = FIX (acc) */\r
979\r
980 if ((int16) count.word >= 0) /* nearest even integer */\r
981 count.word = count.word + 1;\r
982 BR = count.word = count.word & ~1; /* save LSBs of N */\r
983\r
984 O = O | fp_exec (0122, ACCUM, count, NOP); /* acc = FLT (count) */\r
985\r
986 if (O) { /* out of range? */\r
987 op[0].fpk[0] = 0; /* microcode rtns with A = 0 */\r
988 break; /* error return is P+1 */\r
989 }\r
990\r
991 fp_exec (0026, &result, product, NOP); /* acc = product - acc */\r
992 fp_unpack (NULL, &rsltexp, result, fp_t); /* unpack exponent */\r
993\r
994 /* determine if cancellation matters */\r
995\r
996 if ((f < 0) || (f == 2) || (f == 6) || /* EXP, TANH, or COS? */\r
997 (exponent - rsltexp < 5)) { /* bits lost < 5? */\r
998 WriteOp (op[0].word, result, fp_t); /* write result */\r
999 PC = (PC + 1) & VAMASK; /* P+2 return for good result */\r
1000 op[0].fpk[1] = BR; /* return LSBs of N in B */\r
1001 break; /* all done! */\r
1002 }\r
1003 }\r
1004\r
1005 /* result = (xu * cu - n) + (x - xu) * c + xu * cl */\r
1006\r
1007 if (exponent >= (8 + 16 * (f >= 0))) { /* exp >= 8 (EXP,TANH)? */\r
1008 op[0].fpk[0] = 0; /* or 24 (SIN/COS/TAN)? */\r
1009 break; /* range error return is P+1 */\r
1010 }\r
1011\r
1012 op[3].fpk[0] = coeff.fpk[0]; /* form upper bits of C (CU) */\r
1013 op[3].fpk[1] = coeff.fpk[1] & 0177770;\r
1014 op[3].fpk[2] = 0;\r
1015 op[3].fpk[3] = coeff.fpk[3] & 0000377;\r
1016\r
1017 op[4].fpk[0] = op[2].fpk[0]; /* form upper bits of X (XU) */\r
1018 op[4].fpk[1] = op[2].fpk[1] & 0177770;\r
1019 op[4].fpk[2] = 0;\r
1020 op[4].fpk[3] = op[2].fpk[3] & 0000377;\r
1021\r
1022 fp_exec (0042, &op[5], op[3], op[4]); /* op5 = cu * xu */\r
1023\r
1024 fp_exec (0116, &op[6], NOP, NOP); /* op6 = fix (acc) (2wd) */\r
1025\r
1026 if ((int32) op[6].dword >= 0) /* nearest even integer */\r
1027 op[6].dword = op[6].dword + 1;\r
1028 op[6].dword = op[6].dword & ~1;\r
1029 BR = op[6].dword & DMASK; /* save LSBs of N */\r
1030\r
1031 O = fp_exec (0126, ACCUM, op[6], NOP); /* acc = flt (op6) */\r
1032\r
1033 if (O) { /* overflow? */\r
1034 op[0].fpk[0] = 0; /* microcode rtns with A = 0 */\r
1035 break; /* range error return is P+1 */\r
1036 }\r
1037\r
1038 fp_exec (0026, &op[7], op[5], NOP); /* op7 = cu * xu - n */\r
1039\r
1040 fp_exec (0022, ACCUM, op[2], op[4]); /* acc = x - xu */\r
1041 fp_exec (0052, ACCUM, NOP, coeff); /* acc = (x - xu) * c */\r
1042 fp_exec (0012, &op[5], NOP, op[7]); /* op5 = acc + (cu * xu - n) */\r
1043\r
1044 op[1].word = (op[1].word + 4) & VAMASK; /* point at second coefficient */\r
1045 coeff = ReadOp (op[1].word, fp_t); /* get coefficient (CL) */\r
1046\r
1047 fp_exec (0042, ACCUM, op[4], coeff); /* acc = xu * cl */\r
1048 fp_exec (0012, &result, NOP, op[5]); /* result = acc + (x - xu) * c + (cu * xu - n) */\r
1049\r
1050 WriteOp (op[0].word, result, fp_t); /* write result */\r
1051 PC = (PC + 1) & VAMASK; /* P+2 return for good result */\r
1052 op[0].fpk[1] = BR; /* return LSBs of N in B */\r
1053 break;\r
1054\r
1055\r
1056 case 013: /* /ATLG 105333 (OP_A) */\r
1057 arg = ReadOp (op[0].word, fp_t); /* get argument */\r
1058\r
1059 fp_exec (0022, &op[1], t_one, arg); /* op1 = 1.0 - arg */\r
1060 fp_exec (0002, ACCUM, t_one, arg); /* acc = 1.0 + arg */\r
1061 fp_exec (0066, &op[1], op[1], NOP); /* res = op1 / acc */\r
1062\r
1063 WriteOp (op[0].word, op[1], fp_t); /* write result */\r
1064 break;\r
1065\r
1066\r
1067 case 014: /* .FPWR 105334 (OP_IIF) */\r
1068 p = 0; /* set to single-precision */\r
1069 goto NPWR;\r
1070\r
1071 case 015: /* .TPWR 105335 (OP_IAT) */\r
1072 p = 2; /* set to double-precision */\r
1073\r
1074 NPWR:\r
1075 if (op[2].fpk[0]) { /* non-zero base? */\r
1076 fp_exec (0120, &pwr, op[0], NOP); /* float power */\r
1077\r
1078 sign = ((int16) pwr.fpk[0] < 0); /* save sign of power */\r
1079 i = (pwr.fpk[0] << 2) & DMASK; /* clear it */\r
1080\r
1081 fp_unpack (NULL, &exponent, pwr, fp_f); /* unpack exponent */\r
1082\r
1083 if (sign == 0)\r
1084 exponent = exponent - 1;\r
1085\r
1086 O = 0; /* clear overflow */\r
1087 fp_accum (&op[2], (fp_f + p)); /* acc = arg */\r
1088\r
1089 while (exponent-- > 0) {\r
1090 O = O | fp_exec ((uint16) (0054 | p), /* square acc */\r
1091 ACCUM, NOP, NOP);\r
1092\r
1093 if (i & SIGN)\r
1094 O = O | fp_exec ((uint16) (0050 | p), /* acc = acc * arg */\r
1095 ACCUM, NOP, op[2]);\r
1096 i = i << 1;\r
1097 }\r
1098\r
1099 op[2] = fp_accum (NULL, (fp_f + p)); /* get accum */\r
1100\r
1101 if (op[2].fpk[0] == 0) /* result zero? */\r
1102 O = 1; /* underflow */\r
1103 }\r
1104\r
1105 if (entry == 014) /* .FPWR ? */\r
1106 op[0] = op[2]; /* copy result */\r
1107 else /* .TPWR */\r
1108 WriteOp (op[1].word, op[2], fp_t); /* write result */\r
1109\r
1110 break;\r
1111\r
1112\r
1113 case 017: /* [tst] 105337 (OP_N) */\r
1114 XR = 4; /* firmware revision */\r
1115 SR = 0102077; /* test passed code */\r
1116 PC = (PC + 1) & VAMASK; /* P+2 return for firmware w/DPOLY */\r
1117 return reason;\r
1118\r
1119\r
1120 default: /* others undefined */\r
1121 return stop_inst;\r
1122 }\r
1123\r
1124AR = op[0].fpk[0]; /* save result */\r
1125BR = op[0].fpk[1]; /* into A/B */\r
1126return reason;\r
1127}\r
1128\r
1129#endif /* end of int64 support */\r