1 /* hp2100_cpu3.c: HP 2100/1000 FFP/DBI instructions
3 Copyright (c) 2005-2008, J. David Bryan
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:
12 The above copyright notice and this permission notice shall be included in
13 all copies or substantial portions of the Software.
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.
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.
26 CPU3 Fast FORTRAN and Double Integer instructions
28 27-Feb-08 JDB Added DBI self-test instruction
29 23-Oct-07 JDB Fixed unsigned-divide bug in .DDI
30 17-Oct-07 JDB Fixed unsigned-multiply bug in .DMP
31 16-Oct-06 JDB Calls FPP for extended-precision math
32 12-Oct-06 JDB Altered DBLE, DDINT for F-Series FFP compatibility
33 26-Sep-06 JDB Moved from hp2100_cpu1.c to simplify extensions
34 09-Aug-06 JDB Added double-integer instruction set
35 18-Feb-05 JDB Add 2100/21MX Fast FORTRAN Processor instructions
38 - HP 1000 M/E/F-Series Computers Technical Reference Handbook
40 - HP 1000 M/E/F-Series Computers Engineering and Reference Documentation
41 (92851-90001, Mar-1981)
42 - Macro/1000 Reference Manual (92059-90001, Dec-1992)
44 Additional references are listed with the associated firmware
45 implementations, as are the HP option model numbers pertaining to the
49 #include "hp2100_defs.h"
50 #include "hp2100_cpu.h"
51 #include "hp2100_cpu1.h"
53 #if defined (HAVE_INT64) /* int64 support available */
54 #include "hp2100_fp1.h"
55 #else /* int64 support unavailable */
56 #include "hp2100_fp.h"
57 #endif /* end of int64 support */
60 t_stat
cpu_ffp (uint32 IR
, uint32 intrq
); /* Fast FORTRAN Processor */
61 t_stat
cpu_dbi (uint32 IR
, uint32 intrq
); /* Double-Integer instructions */
64 /* Fast FORTRAN Processor.
66 The Fast FORTRAN Processor (FFP) is a set of FORTRAN language accelerators
67 and extended-precision (three-word) floating point routines. Although the
68 FFP is an option for the 2100 and later CPUs, each implements the FFP in a
69 slightly different form.
71 Option implementation by CPU was as follows:
73 2114 2115 2116 2100 1000-M 1000-E 1000-F
74 ------ ------ ------ ------ ------ ------ ------
75 N/A N/A N/A 12907A 12977B 13306B std
77 The instruction codes are mapped to routines as follows:
79 Instr. 2100 1000-M 1000-E 1000-F Instr. 2100 1000-M 1000-E 1000-F
80 ------ ------ ------ ------ ------ ------ ------ ------ ------ ------
81 105200 -- [nop] [nop] [test] 105220 .XFER .XFER .XFER .XFER
82 105201 DBLE DBLE DBLE DBLE 105221 .GOTO .GOTO .GOTO .GOTO
83 105202 SNGL SNGL SNGL SNGL 105222 ..MAP ..MAP ..MAP ..MAP
84 105203 .XMPY .XMPY .XMPY .DNG 105223 .ENTR .ENTR .ENTR .ENTR
85 105204 .XDIV .XDIV .XDIV .DCO 105224 .ENTP .ENTP .ENTP .ENTP
86 105205 .DFER .DFER .DFER .DFER 105225 -- .PWR2 .PWR2 .PWR2
87 105206 -- .XPAK .XPAK .XPAK 105226 -- .FLUN .FLUN .FLUN
88 105207 -- XADD XADD .BLE 105227 $SETP $SETP $SETP $SETP
90 105210 -- XSUB XSUB .DIN 105230 -- .PACK .PACK .PACK
91 105211 -- XMPY XMPY .DDE 105231 -- -- .CFER .CFER
92 105212 -- XDIV XDIV .DIS 105232 -- -- -- ..FCM
93 105213 .XADD .XADD .XADD .DDS 105233 -- -- -- ..TCM
94 105214 .XSUB .XSUB .XSUB .NGL 105234 -- -- -- --
95 105215 -- .XCOM .XCOM .XCOM 105235 -- -- -- --
96 105216 -- ..DCM ..DCM ..DCM 105236 -- -- -- --
97 105217 -- DDINT DDINT DDINT 105237 -- -- -- --
99 The F-Series maps different instructions to several of the standard FFP
100 opcodes. We first look for these and dispatch them appropriately before
101 falling into the handler for the common instructions.
103 The math functions use the F-Series FPP for implementation. The FPP requires
104 that the host compiler support 64-bit integers. Therefore, if 64-bit
105 integers are not available, the math instructions of the FFP are disabled.
106 We allow this partial implementation as an aid in running systems generated
107 for the FFP. Most system programs did not use the math instructions, but
108 almost all use .ENTR. Supporting the latter even on systems that do not
109 support the former still allows such systems to boot.
113 1. The "$SETP" instruction is sometimes listed as ".SETP" in the
116 2. Extended-precision arithmetic routines (e.g., .XMPY) exist on the
117 1000-F, but they are assigned instruction codes in the single-precision
118 floating-point module range. They are replaced by several double
119 integer instructions, which we dispatch to the double integer handler.
121 3. The software implementation of ..MAP supports 1-, 2-, or 3-dimensional
122 arrays, designated by setting A = -1, 0, and +1, respectively. The
123 firmware implementation supports only 2- and 3-dimensional access.
125 4. The documentation for ..MAP for the 2100 FFP shows A = 0 or -1 for two
126 or three dimensions, respectively, but the 1000 FFP shows A = 0 or +1.
127 The firmware actually only checks the LSB of A.
129 5. The .DFER and .XFER implementations for the 2100 FFP return X+4 and Y+4
130 in the A and B registers, whereas the 1000 FFP returns X+3 and Y+3.
132 6. The .XFER implementation for the 2100 FFP returns to P+2, whereas the
133 1000 implementation returns to P+1.
135 7. The firmware implementations of DBLE, .BLE, and DDINT clear the overflow
136 flag. The software implementations do not change overflow.
138 8. The M/E-Series FFP arithmetic instructions (.XADD, etc.) return negative
139 infinity on negative overflow and positive infinity on positive
140 overflow. The equivalent F-Series instructions return positive infinity
143 Additional references:
144 - DOS/RTE Relocatable Library Reference Manual (24998-90001, Oct-1981)
145 - Implementing the HP 2100 Fast FORTRAN Processor (12907-90010, Nov-1974)
148 static const OP_PAT op_ffp_f
[32] = { /* patterns for F-Series only */
149 OP_N
, OP_AAF
, OP_AX
, OP_N
, /* [tst] DBLE SNGL .DNG */
150 OP_N
, OP_AA
, OP_A
, OP_AAF
, /* .DCO .DFER .XPAK .BLE */
151 OP_N
, OP_N
, OP_N
, OP_N
, /* .DIN .DDE .DIS .DDS */
152 OP_AT
, OP_A
, OP_A
, OP_AAX
, /* .NGL .XCOM ..DCM DDINT */
153 OP_N
, OP_AK
, OP_KKKK
, OP_A
, /* .XFER .GOTO ..MAP .ENTR */
154 OP_A
, OP_RK
, OP_R
, OP_K
, /* .ENTP .PWR2 .FLUN $SETP */
155 OP_RC
, OP_AA
, OP_R
, OP_A
, /* .PACK .CFER ..FCM ..TCM */
156 OP_N
, OP_N
, OP_N
, OP_N
/* --- --- --- --- */
159 static const OP_PAT op_ffp_e
[32] = { /* patterns for 2100/M/E-Series */
160 OP_N
, OP_AAF
, OP_AX
, OP_AXX
, /* [nop] DBLE SNGL .XMPY */
161 OP_AXX
, OP_AA
, OP_A
, OP_AAXX
, /* .XDIV .DFER .XPAK XADD */
162 OP_AAXX
, OP_AAXX
, OP_AAXX
, OP_AXX
, /* XSUB XMPY XDIV .XADD */
163 OP_AXX
, OP_A
, OP_A
, OP_AAX
, /* .XSUB .XCOM ..DCM DDINT */
164 OP_N
, OP_AK
, OP_KKKK
, OP_A
, /* .XFER .GOTO ..MAP .ENTR */
165 OP_A
, OP_RK
, OP_R
, OP_K
, /* .ENTP .PWR2 .FLUN $SETP */
166 OP_RC
, OP_AA
, OP_N
, OP_N
, /* .PACK .CFER --- --- */
167 OP_N
, OP_N
, OP_N
, OP_N
/* --- --- --- --- */
170 t_stat
cpu_ffp (uint32 IR
, uint32 intrq
)
175 uint32 j
, sa
, sb
, sc
, da
, dc
, ra
, MA
;
177 t_stat reason
= SCPE_OK
;
179 #if defined (HAVE_INT64) /* int64 support available */
183 #endif /* end of int64 support */
185 if ((cpu_unit
.flags
& UNIT_FFP
) == 0) /* FFP option installed? */
188 entry
= IR
& 037; /* mask to entry point */
190 if (UNIT_CPU_MODEL
!= UNIT_1000_F
) { /* 2100/M/E-Series? */
191 if (op_ffp_e
[entry
] != OP_N
)
192 if (reason
= cpu_ops (op_ffp_e
[entry
], op
, intrq
)) /* get instruction operands */
196 #if defined (HAVE_INT64) /* int64 support available */
198 else { /* F-Series */
199 if (op_ffp_f
[entry
] != OP_N
)
200 if (reason
= cpu_ops (op_ffp_f
[entry
], op
, intrq
)) /* get instruction operands */
203 switch (entry
) { /* decode IR<4:0> */
205 case 000: /* [tst] 105200 (OP_N) */
206 XR
= 4; /* firmware revision */
207 SR
= 0102077; /* test passed code */
208 AR
= 0; /* test clears A/B */
210 PC
= (PC
+ 1) & VAMASK
; /* P+2 return for firmware w/DBI */
213 case 003: /* .DNG 105203 (OP_N) */
214 return cpu_dbi (0105323, intrq
); /* remap to double int handler */
216 case 004: /* .DCO 105204 (OP_N) */
217 return cpu_dbi (0105324, intrq
); /* remap to double int handler */
219 case 007: /* .BLE 105207 (OP_AAF) */
220 O
= fp_cvt (&op
[2], fp_f
, fp_t
); /* convert value and clear overflow */
221 WriteOp (op
[1].word
, op
[2], fp_t
); /* write double-precision value */
224 case 010: /* .DIN 105210 (OP_N) */
225 return cpu_dbi (0105330, intrq
); /* remap to double int handler */
227 case 011: /* .DDE 105211 (OP_N) */
228 return cpu_dbi (0105331, intrq
); /* remap to double int handler */
230 case 012: /* .DIS 105212 (OP_N) */
231 return cpu_dbi (0105332, intrq
); /* remap to double int handler */
233 case 013: /* .DDS 105213 (OP_N) */
234 return cpu_dbi (0105333, intrq
); /* remap to double int handler */
236 case 014: /* .NGL 105214 (OP_AT) */
237 O
= fp_cvt (&op
[1], fp_t
, fp_f
); /* convert value */
238 AR
= op
[1].fpk
[0]; /* move MSB to A */
239 BR
= op
[1].fpk
[1]; /* move LSB to B */
242 case 032: /* ..FCM 105232 (OP_R) */
243 O
= fp_pcom (&op
[0], fp_f
); /* complement value */
244 AR
= op
[0].fpk
[0]; /* return result */
245 BR
= op
[0].fpk
[1]; /* to A/B registers */
248 case 033: /* ..TCM 105233 (OP_A) */
249 fpop
= ReadOp (op
[0].word
, fp_t
); /* read 4-word value */
250 O
= fp_pcom (&fpop
, fp_t
); /* complement it */
251 WriteOp (op
[0].word
, fpop
, fp_t
); /* write 4-word value */
253 } /* fall thru if not special to F */
256 #endif /* end of int64 support */
258 switch (entry
) { /* decode IR<4:0> */
262 case 000: /* [nop] 105200 (OP_N) */
263 if (UNIT_CPU_TYPE
!= UNIT_TYPE_1000
) /* must be 1000 M/E-series */
264 return stop_inst
; /* trap if not */
267 #if defined (HAVE_INT64) /* int64 support available */
269 case 001: /* DBLE 105201 (OP_AAF) */
270 O
= fp_cvt (&op
[2], fp_f
, fp_x
); /* convert value and clear overflow */
271 WriteOp (op
[1].word
, op
[2], fp_x
); /* write extended-precision value */
274 case 002: /* SNGL 105202 (OP_AX) */
275 O
= fp_cvt (&op
[1], fp_x
, fp_f
); /* convert value */
276 AR
= op
[1].fpk
[0]; /* move MSB to A */
277 BR
= op
[1].fpk
[1]; /* move LSB to B */
280 case 003: /* .XMPY 105203 (OP_AXX) */
281 i
= 0; /* params start at op[0] */
282 goto XMPY
; /* process as XMPY */
284 case 004: /* .XDIV 105204 (OP_AXX) */
285 i
= 0; /* params start at op[0] */
286 goto XDIV
; /* process as XDIV */
288 #endif /* end of int64 support */
290 case 005: /* .DFER 105205 (OP_AA) */
291 BR
= op
[0].word
; /* get destination address */
292 AR
= op
[1].word
; /* get source address */
293 goto XFER
; /* do transfer */
295 #if defined (HAVE_INT64) /* int64 support available */
297 case 006: /* .XPAK 105206 (OP_A) */
298 if (UNIT_CPU_TYPE
!= UNIT_TYPE_1000
) /* must be 1000 */
299 return stop_inst
; /* trap if not */
301 if (intrq
) { /* interrupt pending? */
302 PC
= err_PC
; /* restart instruction */
306 fpop
= ReadOp (op
[0].word
, fp_x
); /* read unpacked */
307 O
= fp_nrpack (&fpop
, fpop
, (int16
) AR
, fp_x
); /* nrm/rnd/pack mantissa, exponent */
308 WriteOp (op
[0].word
, fpop
, fp_x
); /* write result */
311 case 007: /* XADD 105207 (OP_AAXX) */
312 i
= 1; /* params start at op[1] */
313 XADD
: /* enter here from .XADD */
314 if (intrq
) { /* interrupt pending? */
315 PC
= err_PC
; /* restart instruction */
319 O
= fp_exec (001, &fpop
, op
[i
+ 1], op
[i
+ 2]); /* three-word add */
320 WriteOp (op
[i
].word
, fpop
, fp_x
); /* write sum */
323 case 010: /* XSUB 105210 (OP_AAXX) */
324 i
= 1; /* params start at op[1] */
325 XSUB
: /* enter here from .XSUB */
326 if (intrq
) { /* interrupt pending? */
327 PC
= err_PC
; /* restart instruction */
331 O
= fp_exec (021, &fpop
, op
[i
+ 1], op
[i
+ 2]); /* three-word subtract */
332 WriteOp (op
[i
].word
, fpop
, fp_x
); /* write difference */
335 case 011: /* XMPY 105211 (OP_AAXX) */
336 i
= 1; /* params start at op[1] */
337 XMPY
: /* enter here from .XMPY */
338 if (intrq
) { /* interrupt pending? */
339 PC
= err_PC
; /* restart instruction */
343 O
= fp_exec (041, &fpop
, op
[i
+ 1], op
[i
+ 2]); /* three-word multiply */
344 WriteOp (op
[i
].word
, fpop
, fp_x
); /* write product */
347 case 012: /* XDIV 105212 (OP_AAXX) */
348 i
= 1; /* params start at op[1] */
349 XDIV
: /* enter here from .XDIV */
350 if (intrq
) { /* interrupt pending? */
351 PC
= err_PC
; /* restart instruction */
355 O
= fp_exec (061, &fpop
, op
[i
+ 1], op
[i
+ 2]); /* three-word divide */
356 WriteOp (op
[i
].word
, fpop
, fp_x
); /* write quotient */
359 case 013: /* .XADD 105213 (OP_AXX) */
360 i
= 0; /* params start at op[0] */
361 goto XADD
; /* process as XADD */
363 case 014: /* .XSUB 105214 (OP_AXX) */
364 i
= 0; /* params start at op[0] */
365 goto XSUB
; /* process as XSUB */
367 case 015: /* .XCOM 105215 (OP_A) */
368 if (UNIT_CPU_TYPE
!= UNIT_TYPE_1000
) /* must be 1000 */
369 return stop_inst
; /* trap if not */
371 fpop
= ReadOp (op
[0].word
, fp_x
); /* read unpacked */
372 AR
= fp_ucom (&fpop
, fp_x
); /* complement and rtn exp adj */
373 WriteOp (op
[0].word
, fpop
, fp_x
); /* write result */
376 case 016: /* ..DCM 105216 (OP_A) */
377 if (UNIT_CPU_TYPE
!= UNIT_TYPE_1000
) /* must be 1000 */
378 return stop_inst
; /* trap if not */
380 if (intrq
) { /* interrupt pending? */
381 PC
= err_PC
; /* restart instruction */
385 fpop
= ReadOp (op
[0].word
, fp_x
); /* read operand */
386 O
= fp_pcom (&fpop
, fp_x
); /* complement (can't ovf neg) */
387 WriteOp (op
[0].word
, fpop
, fp_x
); /* write result */
390 case 017: /* DDINT 105217 (OP_AAX) */
391 if (UNIT_CPU_TYPE
!= UNIT_TYPE_1000
) /* must be 1000 */
392 return stop_inst
; /* trap if not */
394 if (intrq
) { /* interrupt pending? */
395 PC
= err_PC
; /* restart instruction */
399 O
= fp_trun (&fpop
, op
[2], fp_x
); /* truncate operand (can't ovf) */
400 WriteOp (op
[1].word
, fpop
, fp_x
); /* write result */
403 #endif /* end of int64 support */
407 case 020: /* .XFER 105220 (OP_N) */
408 if (UNIT_CPU_TYPE
== UNIT_TYPE_2100
)
409 PC
= (PC
+ 1) & VAMASK
; /* 2100 .XFER returns to P+2 */
410 XFER
: /* enter here from .DFER */
411 sc
= 3; /* set count for 3-wd xfer */
412 goto CFER
; /* do transfer */
414 case 021: /* .GOTO 105221 (OP_AK) */
415 if ((int16
) op
[1].word
< 1) /* index < 1? */
416 op
[1].word
= 1; /* reset min */
418 sa
= PC
+ op
[1].word
- 1; /* point to jump target */
419 if (sa
>= op
[0].word
) /* must be <= last target */
422 da
= ReadW (sa
); /* get jump target */
423 if (reason
= resolve (da
, &MA
, intrq
)) { /* resolve indirects */
424 PC
= err_PC
; /* irq restarts instruction */
428 mp_dms_jmp (MA
); /* validate jump addr */
429 PCQ_ENTRY
; /* record last PC */
431 BR
= op
[0].word
; /* (for 2100 FFP compat) */
434 case 022: /* ..MAP 105222 (OP_KKKK) */
435 op
[1].word
= op
[1].word
- 1; /* decrement 1st subscr */
437 if ((AR
& 1) == 0) /* 2-dim access? */
438 op
[1].word
= op
[1].word
+ /* compute element offset */
439 (op
[2].word
- 1) * op
[3].word
;
440 else { /* 3-dim access */
441 if (reason
= cpu_ops (OP_KK
, op2
, intrq
)) { /* get 1st, 2nd ranges */
442 PC
= err_PC
; /* irq restarts instruction */
445 op
[1].word
= op
[1].word
+ /* offset */
446 ((op
[3].word
- 1) * op2
[1].word
+
447 op
[2].word
- 1) * op2
[0].word
;
450 AR
= (op
[0].word
+ op
[1].word
* BR
) & DMASK
; /* return element address */
453 case 023: /* .ENTR 105223 (OP_A) */
454 MA
= PC
- 3; /* get addr of entry point */
455 ENTR
: /* enter here from .ENTP */
456 da
= op
[0].word
; /* get addr of 1st formal */
457 dc
= MA
- da
; /* get count of formals */
458 sa
= ReadW (MA
); /* get addr of return point */
459 ra
= ReadW (sa
++); /* get rtn, ptr to 1st actual */
460 WriteW (MA
, ra
); /* stuff rtn into caller's ent */
461 sc
= ra
- sa
; /* get count of actuals */
462 if (sc
> dc
) /* use min (actuals, formals) */
465 for (j
= 0; j
< sc
; j
++) {
466 MA
= ReadW (sa
++); /* get addr of actual */
467 if (reason
= resolve (MA
, &MA
, intrq
)) { /* resolve indirect */
468 PC
= err_PC
; /* irq restarts instruction */
471 WriteW (da
++, MA
); /* put addr into formal */
474 AR
= ra
; /* return address */
475 BR
= da
; /* addr of 1st unused formal */
478 case 024: /* .ENTP 105224 (OP_A) */
479 MA
= PC
- 5; /* get addr of entry point */
482 case 025: /* .PWR2 105225 (OP_RK) */
483 if (UNIT_CPU_TYPE
!= UNIT_TYPE_1000
) /* must be 1000 */
484 return stop_inst
; /* trap if not */
486 fp_unpack (&fpop
, &expon
, op
[0], fp_f
); /* unpack value */
487 expon
= expon
+ (int16
) (op
[1].word
); /* multiply by 2**n */
488 fp_pack (&fpop
, fpop
, expon
, fp_f
); /* repack value */
489 AR
= fpop
.fpk
[0]; /* return result */
490 BR
= fpop
.fpk
[1]; /* to A/B registers */
493 case 026: /* .FLUN 105226 (OP_R) */
494 if (UNIT_CPU_TYPE
!= UNIT_TYPE_1000
) /* must be 1000 */
495 return stop_inst
; /* trap if not */
497 fp_unpack (&fpop
, &expon
, op
[0], fp_f
); /* unpack value */
498 AR
= (int16
) expon
; /* return expon to A */
499 BR
= fpop
.fpk
[1]; /* and low mant to B */
502 case 027: /* $SETP 105227 (OP_K) */
503 j
= sa
= AR
; /* save initial value */
504 sb
= BR
; /* save initial address */
505 AR
= 0; /* AR will return = 0 */
506 BR
= BR
& VAMASK
; /* addr must be direct */
509 WriteW (BR
, j
); /* write value to address */
510 j
= (j
+ 1) & DMASK
; /* incr value */
511 BR
= (BR
+ 1) & VAMASK
; /* incr address */
512 op
[0].word
= op
[0].word
- 1; /* decr count */
513 if (op
[0].word
&& intrq
) { /* more and intr? */
514 AR
= sa
; /* restore A */
515 BR
= sb
; /* restore B */
516 PC
= err_PC
; /* restart instruction */
520 while (op
[0].word
!= 0); /* loop until count exhausted */
523 case 030: /* .PACK 105230 (OP_RC) */
524 if (UNIT_CPU_TYPE
!= UNIT_TYPE_1000
) /* must be 1000 */
525 return stop_inst
; /* trap if not */
527 O
= fp_nrpack (&fpop
, op
[0], /* nrm/rnd/pack value */
528 (int16
) (op
[1].word
), fp_f
);
529 AR
= fpop
.fpk
[0]; /* return result */
530 BR
= fpop
.fpk
[1]; /* to A/B registers */
533 case 031: /* .CFER 105231 (OP_AA) */
534 if ((UNIT_CPU_MODEL
!= UNIT_1000_E
) && /* must be 1000 E-series */
535 (UNIT_CPU_MODEL
!= UNIT_1000_F
)) /* or 1000 F-series */
536 return stop_inst
; /* trap if not */
538 BR
= op
[0].word
; /* get destination address */
539 AR
= op
[1].word
; /* get source address */
540 sc
= 4; /* set for 4-wd xfer */
541 CFER
: /* enter here from .XFER */
542 for (j
= 0; j
< sc
; j
++) { /* xfer loop */
543 WriteW (BR
, ReadW (AR
)); /* transfer word */
544 AR
= (AR
+ 1) & VAMASK
; /* bump source addr */
545 BR
= (BR
+ 1) & VAMASK
; /* bump destination addr */
548 E
= 0; /* routine clears E */
550 if (UNIT_CPU_TYPE
== UNIT_TYPE_2100
) { /* 2100 (and .DFER/.XFER)? */
551 AR
= (AR
+ 1) & VAMASK
; /* 2100 FFP returns X+4, Y+4 */
552 BR
= (BR
+ 1) & VAMASK
;
556 default: /* others undefined */
564 /* Double-Integer Instructions.
566 The double-integer instructions were added to the HP instruction set at
567 revision 1920 of the 1000-F. They were immediately adopted in a number of HP
568 software products, most notably the RTE file management package (FMP)
569 routines. As these routines are used in nearly every RTE program, F-Series
570 programs were almost always a few hundred bytes smaller than their M- and
571 E-Series counterparts. This became significant as RTE continued to grow in
572 size, and some customer programs ran out of address space on E-Series
575 While HP never added double-integer instructions to the standard E-Series, a
576 product from the HP "specials group," HP 93585A, provided microcoded
577 replacements for the E-Series. This could provide just enough address-space
578 savings to allow programs to load in E-Series systems, in addition to
579 accelerating these common operations.
581 There was no equivalent M-Series microcode, due to the limited micromachine
582 address space on that system.
584 Option implementation by CPU was as follows:
586 2114 2115 2116 2100 1000-M 1000-E 1000-F
587 ------ ------ ------ ------ ------ ------ ------
588 N/A N/A N/A N/A N/A 93585A std
590 The routines are mapped to instruction codes as follows:
592 Instr. 1000-E 1000-F Description
593 ------ ------ ------ -----------------------------------------
594 [test] 105320 -- [self test]
595 .DAD 105321 105014 Double integer add
596 .DMP 105322 105054 Double integer multiply
597 .DNG 105323 105203 Double integer negate
598 .DCO 105324 105204 Double integer compare
599 .DDI 105325 105074 Double integer divide
600 .DDIR 105326 105134 Double integer divide (reversed)
601 .DSB 105327 105034 Double integer subtract
602 .DIN 105330 105210 Double integer increment
603 .DDE 105331 105211 Double integer decrement
604 .DIS 105332 105212 Double integer increment and skip if zero
605 .DDS 105333 105213 Double integer decrement and skip if zero
606 .DSBR 105334 105114 Double integer subtraction (reversed)
608 On the F-Series, the double-integer instruction codes are split among the
609 floating-point processor and the Fast FORTRAN Processor ranges. They are
610 dispatched from those respective simulators for processing here.
614 1. Opcodes 105335-105337 are NOPs in the microcode. They generate
615 unimplemented instructions stops under simulation.
617 2. This is an implementation of Revision 2 of the microcode, which was
618 released as ROM part numbers 93585-80003, 93585-80005, and 93585-80001
619 (Revision 1 substituted -80002 for -80005).
621 3. The F-Series firmware executes .DMP and .DDI/.DDIR by floating the
622 32-bit double integer to a 48-bit extended-precision number, calling the
623 FPP to execute the extended-precision multiply/divide, and then fixing
624 the product to a 32-bit double integer. We simulate these directly with
625 64- or 32-bit integer arithmetic.
627 Additional references:
628 - 93585A Microcode Source (93585-18002 Rev. 2005)
629 - 93585A Double Integer Instructions Installation and Reference Manual
633 static const OP_PAT op_dbi
[16] = {
634 OP_N
, OP_JD
, OP_JD
, OP_J
, /* [test] .DAD .DMP .DNG */
635 OP_JD
, OP_JD
, OP_JD
, OP_JD
, /* .DCO .DDI .DDIR .DSB */
636 OP_J
, OP_J
, OP_A
, OP_A
, /* .DIN .DDE .DIS .DDS */
637 OP_JD
, OP_N
, OP_N
, OP_N
/* .DSBR --- --- --- */
640 t_stat
cpu_dbi (uint32 IR
, uint32 intrq
)
645 t_stat reason
= SCPE_OK
;
647 if ((cpu_unit
.flags
& UNIT_DBI
) == 0) /* DBI option installed? */
650 entry
= IR
& 017; /* mask to entry point */
652 if (op_dbi
[entry
] != OP_N
)
653 if (reason
= cpu_ops (op_dbi
[entry
], op
, intrq
)) /* get instruction operands */
656 switch (entry
) { /* decode IR<3:0> */
658 case 000: /* [test] 105320 (OP_N) */
659 XR
= 2; /* set revision */
660 BR
= 0377; /* side effect of microcode */
661 SR
= 0102077; /* set "pass" code */
662 PC
= (PC
+ 1) & VAMASK
; /* return to P+1 */
663 t
= (AR
<< 16) | BR
; /* set t for return */
666 case 001: /* .DAD 105321 (OP_JD) */
667 t
= op
[0].dword
+ op
[1].dword
; /* add values */
668 E
= E
| (t
< op
[0].dword
); /* carry if result smaller */
669 O
= (((~op
[0].dword
^ op
[1].dword
) & /* overflow if sign wrong */
670 (op
[0].dword
^ t
) & SIGN32
) != 0);
673 case 002: /* .DMP 105322 (OP_JD) */
676 #if defined (HAVE_INT64) /* int64 support available */
680 t64
= (t_int64
) INT32 (op
[0].dword
) * /* multiply signed values */
681 (t_int64
) INT32 (op
[1].dword
);
682 O
= ((t64
< -(t_int64
) 0x80000000) || /* overflow if out of range */
683 (t64
> (t_int64
) 0x7FFFFFFF));
685 t
= ~SIGN32
; /* if overflow, rtn max pos */
687 t
= (uint32
) (t64
& DMASK32
); /* else lower 32 bits of result */
689 #else /* int64 support unavailable */
691 uint32 sign
, xu
, yu
, rh
, rl
;
693 sign
= ((int32
) op
[0].dword
< 0) ^ /* save sign of result */
694 ((int32
) op
[1].dword
< 0);
696 xu
= (uint32
) abs ((int32
) op
[0].dword
); /* make operands pos */
697 yu
= (uint32
) abs ((int32
) op
[1].dword
);
699 if ((xu
& 0xFFFF0000) == 0 && /* 16 x 16 multiply? */
700 (yu
& 0xFFFF0000) == 0) {
701 t
= xu
* yu
; /* do it */
702 O
= 0; /* can't overflow */
705 else if ((xu
& 0xFFFF0000) != 0 && /* 32 x 32 multiply? */
706 (yu
& 0xFFFF0000) != 0)
707 O
= 1; /* always overflows */
709 else { /* 16 x 32 or 32 x 16 */
710 rl
= (xu
& 0xFFFF) * (yu
& 0xFFFF); /* form 1st partial product */
712 if ((xu
& 0xFFFF0000) == 0)
713 rh
= xu
* (yu
>> 16) + (rl
>> 16); /* 16 x 32 2nd partial */
715 rh
= (xu
>> 16) * yu
+ (rl
>> 16); /* 32 x 16 2nd partial */
717 O
= (rh
> 0x7FFF + sign
); /* check for out of range */
719 t
= (rh
<< 16) | (rl
& 0xFFFF); /* combine partials */
723 t
= ~SIGN32
; /* if overflow, rtn max pos */
725 t
= ~t
+ 1; /* if result neg, 2s compl */
727 #endif /* end of int64 support */
732 case 003: /* .DNG 105323 (OP_J) */
733 t
= ~op
[0].dword
+ 1; /* negate value */
734 O
= (op
[0].dword
== SIGN32
); /* overflow if max neg */
735 if (op
[0].dword
== 0) /* borrow if result zero */
739 case 004: /* .DCO 105324 (OP_JD) */
740 t
= op
[0].dword
; /* copy for later store */
741 if ((int32
) op
[0].dword
< (int32
) op
[1].dword
)
742 PC
= (PC
+ 1) & VAMASK
; /* < rtns to P+2 */
743 else if ((int32
) op
[0].dword
> (int32
) op
[1].dword
)
744 PC
= (PC
+ 2) & VAMASK
; /* > rtns to P+3 */
745 break; /* = rtns to P+1 */
747 case 005: /* .DDI 105325 (OP_JD) */
749 O
= ((op
[1].dword
== 0) || /* overflow if div 0 */
750 ((op
[0].dword
== SIGN32
) && /* or max neg div -1 */
751 ((int32
) op
[1].dword
== -1)));
753 t
= ~SIGN32
; /* rtn max pos for ovf */
755 t
= (uint32
) (INT32 (op
[0].dword
) / /* else return quotient */
756 INT32 (op
[1].dword
));
759 case 006: /* .DDIR 105326 (OP_JD) */
760 t
= op
[0].dword
; /* swap operands */
761 op
[0].dword
= op
[1].dword
;
763 goto DDI
; /* continue at .DDI */
765 case 007: /* .DSB 105327 (OP_JD) */
767 t
= op
[0].dword
- op
[1].dword
; /* subtract values */
768 E
= E
| (op
[0].dword
< op
[1].dword
); /* borrow if minu < subtr */
769 O
= (((op
[0].dword
^ op
[1].dword
) & /* overflow if sign wrong */
770 (op
[0].dword
^ t
) & SIGN32
) != 0);
773 case 010: /* .DIN 105330 (OP_J) */
774 t
= op
[0].dword
+ 1; /* increment value */
775 O
= (t
== SIGN32
); /* overflow if sign flipped */
777 E
= 1; /* carry if result zero */
780 case 011: /* .DDE 105331 (OP_J) */
781 t
= op
[0].dword
- 1; /* decrement value */
782 O
= (t
== ~SIGN32
); /* overflow if sign flipped */
784 E
= 1; /* borrow if result -1 */
787 case 012: /* .DIS 105332 (OP_A) */
788 din
= ReadOp (op
[0].word
, in_d
); /* get value */
789 t
= din
.dword
= din
.dword
+ 1; /* increment value */
790 WriteOp (op
[0].word
, din
, in_d
); /* store it back */
792 PC
= (PC
+ 1) & VAMASK
; /* skip if result zero */
795 case 013: /* .DDS 105333 (OP_A) */
796 din
= ReadOp (op
[0].word
, in_d
); /* get value */
797 t
= din
.dword
= din
.dword
- 1; /* decrement value */
798 WriteOp (op
[0].word
, din
, in_d
); /* write it back */
800 PC
= (PC
+ 1) & VAMASK
; /* skip if result zero */
803 case 014: /* .DSBR 105334 (OP_JD) */
804 t
= op
[0].dword
; /* swap operands */
805 op
[0].dword
= op
[1].dword
;
807 goto DSB
; /* continue at .DSB */
809 default: /* others undefined */
810 t
= (AR
<< 16) | BR
; /* set t for NOP */
814 if (reason
== SCPE_OK
) { /* if return OK */
815 AR
= (t
>> 16) & DMASK
; /* break result */
816 BR
= t
& DMASK
; /* into A and B */