Commit | Line | Data |
---|---|---|
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 | |
52 | t_stat cpu_fpp (uint32 IR, uint32 intrq); /* Floating Point Processor */\r | |
53 | t_stat cpu_sis (uint32 IR, uint32 intrq); /* Scientific Instruction Set */\r | |
54 | \r | |
55 | extern 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 | |
223 | static 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 | |
250 | t_stat cpu_fpp (uint32 IR, uint32 intrq)\r | |
251 | {\r | |
252 | OP fpop;\r | |
253 | OPS op;\r | |
254 | OPSIZE op1_prec, op2_prec, rslt_prec, cvt_prec;\r | |
255 | uint16 opcode, rtn_addr, stk_ptr;\r | |
256 | uint32 entry;\r | |
257 | t_stat reason = SCPE_OK;\r | |
258 | \r | |
259 | if ((cpu_unit.flags & UNIT_FP) == 0) /* FP option installed? */\r | |
260 | return stop_inst;\r | |
261 | \r | |
262 | if (UNIT_CPU_MODEL == UNIT_1000_F) /* F-Series? */\r | |
263 | opcode = (uint16) (IR & 0377); /* yes, use full opcode */\r | |
264 | else\r | |
265 | opcode = (uint16) (IR & 0160); /* no, use 6 SP FP opcodes */\r | |
266 | \r | |
267 | entry = opcode & 0177; /* map to <6:0> */\r | |
268 | \r | |
269 | if (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 | |
273 | switch (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 | |
435 | return 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 | |
514 | static uint32 reduce (OP *argument, int32 *multiple, OP multiplier)\r | |
515 | {\r | |
516 | OP product, count;\r | |
517 | uint32 overflow;\r | |
518 | \r | |
519 | fp_cvt (argument, fp_f, fp_x); /* convert to extended precision */\r | |
520 | fp_exec (0041, &product, *argument, multiplier); /* product = argument * multiplier */\r | |
521 | overflow = fp_exec (0111, &count, NOP, NOP); /* count = FIX (acc) */\r | |
522 | \r | |
523 | if ((int16) count.word >= 0) /* nearest even integer */\r | |
524 | count.word = count.word + 1;\r | |
525 | count.word = count.word & ~1;\r | |
526 | *multiple = (int16) count.word;\r | |
527 | \r | |
528 | if (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 | |
533 | return overflow;\r | |
534 | }\r | |
535 | \r | |
536 | \r | |
537 | /* SIS dispatcher. */\r | |
538 | \r | |
539 | static 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 | |
546 | t_stat cpu_sis (uint32 IR, uint32 intrq)\r | |
547 | {\r | |
548 | OPS op;\r | |
549 | OP arg, coeff, pwr, product, count, result;\r | |
550 | int16 f, p;\r | |
551 | int32 multiple, power, exponent, rsltexp;\r | |
552 | uint32 entry, i;\r | |
553 | t_bool flag, sign;\r | |
554 | t_stat reason = SCPE_OK;\r | |
555 | \r | |
556 | static const OP tan_c4 = { { 0137763, 0051006 } }; /* DEC -4.0030956 */\r | |
557 | static const OP tan_c3 = { { 0130007, 0051026 } }; /* DEC -1279.5424 */\r | |
558 | static const OP tan_c2 = { { 0040564, 0012761 } }; /* DEC 0.0019974806 */\r | |
559 | static const OP tan_c1 = { { 0045472, 0001375 } }; /* DEC 0.14692695 */\r | |
560 | \r | |
561 | static const OP alog_c3 = { { 0065010, 0063002 } }; /* DEC 1.6567626301 */\r | |
562 | static const OP alog_c2 = { { 0125606, 0044404 } }; /* DEC -2.6398577035 */\r | |
563 | static const OP alog_c1 = { { 0051260, 0037402 } }; /* DEC 1.2920070987 */\r | |
564 | \r | |
565 | static const OP atan_c4 = { { 0040257, 0154404 } }; /* DEC 2.0214656 */\r | |
566 | static const OP atan_c3 = { { 0132062, 0133406 } }; /* DEC -4.7376165 */\r | |
567 | static const OP atan_c2 = { { 0047407, 0173775 } }; /* DEC 0.154357652 */\r | |
568 | static const OP atan_c1 = { { 0053447, 0014002 } }; /* DEC 1.3617611 */\r | |
569 | \r | |
570 | static const OP sin_c4 = { { 0132233, 0040745 } }; /* DEC -0.000035950439 */\r | |
571 | static const OP sin_c3 = { { 0050627, 0122361 } }; /* DEC 0.002490001 */\r | |
572 | static const OP sin_c2 = { { 0126521, 0011373 } }; /* DEC -0.0807454325 */\r | |
573 | static const OP sin_c1 = { { 0062207, 0166400 } }; /* DEC 0.78539816 */\r | |
574 | \r | |
575 | static const OP cos_c4 = { { 0126072, 0002753 } }; /* DEC -0.00031957 */\r | |
576 | static const OP cos_c3 = { { 0040355, 0007767 } }; /* DEC 0.015851077 */\r | |
577 | static const OP cos_c2 = { { 0130413, 0011377 } }; /* DEC -0.30842483 */\r | |
578 | static const OP cos_c1 = { { 0040000, 0000002 } }; /* DEC 1.0 */\r | |
579 | \r | |
580 | static const OP sqrt_a2 = { { 0045612, 0067400 } }; /* DEC 0.5901621 */\r | |
581 | static const OP sqrt_b2 = { { 0065324, 0126377 } }; /* DEC 0.4173076 */\r | |
582 | static const OP sqrt_a1 = { { 0065324, 0126400 } }; /* DEC 0.8346152 */\r | |
583 | static const OP sqrt_b1 = { { 0045612, 0067400 } }; /* DEC 0.5901621 */\r | |
584 | \r | |
585 | static const OP exp_c2 = { { 0073000, 0070771 } }; /* DEC 0.05761803 */\r | |
586 | static const OP exp_c1 = { { 0056125, 0041406 } }; /* DEC 5.7708162 */\r | |
587 | \r | |
588 | static const OP tanh_c3 = { { 0050045, 0022004 } }; /* DEC 2.5045337 */\r | |
589 | static const OP tanh_c2 = { { 0041347, 0101404 } }; /* DEC 2.0907609 */\r | |
590 | static const OP tanh_c1 = { { 0052226, 0047375 } }; /* DEC 0.16520923 */\r | |
591 | \r | |
592 | static const OP minus_1 = { { 0100000, 0000000 } }; /* DEC -1.0 */\r | |
593 | static const OP plus_1 = { { 0040000, 0000002 } }; /* DEC +1.0 */\r | |
594 | static const OP plus_half = { { 0040000, 0000000 } }; /* DEC +0.5 */\r | |
595 | static const OP ln_2 = { { 0054271, 0006000 } }; /* DEC 0.6931471806 (ln 2.0) */\r | |
596 | static const OP log_e = { { 0067455, 0166377 } }; /* DEC 0.43429228 (log e) */\r | |
597 | static const OP pi_over_4 = { { 0062207, 0166400 } }; /* Pi / 4.0 */\r | |
598 | static const OP pi_over_2 = { { 0062207, 0166402 } }; /* Pi / 2.0 */\r | |
599 | \r | |
600 | static const OP four_over_pi = { { 0050574, 0140667, 0023402 } }; /* 4.0 / Pi */\r | |
601 | static const OP two_over_ln2 = { { 0056125, 0016624, 0127404 } }; /* 2.0 / ln(2.0) */\r | |
602 | \r | |
603 | static const OP t_one = { { 0040000, 0000000, 0000000, 0000002 } }; /* DEY 1.0 */\r | |
604 | \r | |
605 | \r | |
606 | if (UNIT_CPU_MODEL != UNIT_1000_F) /* F-Series? */\r | |
607 | return stop_inst;\r | |
608 | \r | |
609 | entry = IR & 017; /* mask to entry point */\r | |
610 | \r | |
611 | if (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 | |
615 | switch (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 | |
1124 | AR = op[0].fpk[0]; /* save result */\r | |
1125 | BR = op[0].fpk[1]; /* into A/B */\r | |
1126 | return reason;\r | |
1127 | }\r | |
1128 | \r | |
1129 | #endif /* end of int64 support */\r |