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