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_cpu3.c
1 /* hp2100_cpu3.c: HP 2100/1000 FFP/DBI instructions
2
3 Copyright (c) 2005-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 CPU3 Fast FORTRAN and Double Integer instructions
27
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
36
37 Primary references:
38 - HP 1000 M/E/F-Series Computers Technical Reference Handbook
39 (5955-0282, Mar-1980)
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)
43
44 Additional references are listed with the associated firmware
45 implementations, as are the HP option model numbers pertaining to the
46 applicable CPUs.
47 */
48
49 #include "hp2100_defs.h"
50 #include "hp2100_cpu.h"
51 #include "hp2100_cpu1.h"
52
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 */
58
59
60 t_stat cpu_ffp (uint32 IR, uint32 intrq); /* Fast FORTRAN Processor */
61 t_stat cpu_dbi (uint32 IR, uint32 intrq); /* Double-Integer instructions */
62
63
64 /* Fast FORTRAN Processor.
65
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.
70
71 Option implementation by CPU was as follows:
72
73 2114 2115 2116 2100 1000-M 1000-E 1000-F
74 ------ ------ ------ ------ ------ ------ ------
75 N/A N/A N/A 12907A 12977B 13306B std
76
77 The instruction codes are mapped to routines as follows:
78
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
89
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 -- -- -- --
98
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.
102
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.
110
111 Notes:
112
113 1. The "$SETP" instruction is sometimes listed as ".SETP" in the
114 documentation.
115
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.
120
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.
124
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.
128
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.
131
132 6. The .XFER implementation for the 2100 FFP returns to P+2, whereas the
133 1000 implementation returns to P+1.
134
135 7. The firmware implementations of DBLE, .BLE, and DDINT clear the overflow
136 flag. The software implementations do not change overflow.
137
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
141 on both.
142
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)
146 */
147
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 /* --- --- --- --- */
157 };
158
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 /* --- --- --- --- */
168 };
169
170 t_stat cpu_ffp (uint32 IR, uint32 intrq)
171 {
172 OP fpop;
173 OPS op, op2;
174 uint32 entry;
175 uint32 j, sa, sb, sc, da, dc, ra, MA;
176 int32 expon;
177 t_stat reason = SCPE_OK;
178
179 #if defined (HAVE_INT64) /* int64 support available */
180
181 int32 i;
182
183 #endif /* end of int64 support */
184
185 if ((cpu_unit.flags & UNIT_FFP) == 0) /* FFP option installed? */
186 return stop_inst;
187
188 entry = IR & 037; /* mask to entry point */
189
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 */
193 return reason;
194 }
195
196 #if defined (HAVE_INT64) /* int64 support available */
197
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 */
201 return reason;
202
203 switch (entry) { /* decode IR<4:0> */
204
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 */
209 BR = 0;
210 PC = (PC + 1) & VAMASK; /* P+2 return for firmware w/DBI */
211 return reason;
212
213 case 003: /* .DNG 105203 (OP_N) */
214 return cpu_dbi (0105323, intrq); /* remap to double int handler */
215
216 case 004: /* .DCO 105204 (OP_N) */
217 return cpu_dbi (0105324, intrq); /* remap to double int handler */
218
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 */
222 return reason;
223
224 case 010: /* .DIN 105210 (OP_N) */
225 return cpu_dbi (0105330, intrq); /* remap to double int handler */
226
227 case 011: /* .DDE 105211 (OP_N) */
228 return cpu_dbi (0105331, intrq); /* remap to double int handler */
229
230 case 012: /* .DIS 105212 (OP_N) */
231 return cpu_dbi (0105332, intrq); /* remap to double int handler */
232
233 case 013: /* .DDS 105213 (OP_N) */
234 return cpu_dbi (0105333, intrq); /* remap to double int handler */
235
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 */
240 return reason;
241
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 */
246 return reason;
247
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 */
252 return reason;
253 } /* fall thru if not special to F */
254 }
255
256 #endif /* end of int64 support */
257
258 switch (entry) { /* decode IR<4:0> */
259
260 /* FFP module 1 */
261
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 */
265 break;
266
267 #if defined (HAVE_INT64) /* int64 support available */
268
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 */
272 break;
273
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 */
278 break;
279
280 case 003: /* .XMPY 105203 (OP_AXX) */
281 i = 0; /* params start at op[0] */
282 goto XMPY; /* process as XMPY */
283
284 case 004: /* .XDIV 105204 (OP_AXX) */
285 i = 0; /* params start at op[0] */
286 goto XDIV; /* process as XDIV */
287
288 #endif /* end of int64 support */
289
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 */
294
295 #if defined (HAVE_INT64) /* int64 support available */
296
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 */
300
301 if (intrq) { /* interrupt pending? */
302 PC = err_PC; /* restart instruction */
303 break;
304 }
305
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 */
309 break;
310
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 */
316 break;
317 }
318
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 */
321 break;
322
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 */
328 break;
329 }
330
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 */
333 break;
334
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 */
340 break;
341 }
342
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 */
345 break;
346
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 */
352 break;
353 }
354
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 */
357 break;
358
359 case 013: /* .XADD 105213 (OP_AXX) */
360 i = 0; /* params start at op[0] */
361 goto XADD; /* process as XADD */
362
363 case 014: /* .XSUB 105214 (OP_AXX) */
364 i = 0; /* params start at op[0] */
365 goto XSUB; /* process as XSUB */
366
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 */
370
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 */
374 break;
375
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 */
379
380 if (intrq) { /* interrupt pending? */
381 PC = err_PC; /* restart instruction */
382 break;
383 }
384
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 */
388 break;
389
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 */
393
394 if (intrq) { /* interrupt pending? */
395 PC = err_PC; /* restart instruction */
396 break;
397 }
398
399 O = fp_trun (&fpop, op[2], fp_x); /* truncate operand (can't ovf) */
400 WriteOp (op[1].word, fpop, fp_x); /* write result */
401 break;
402
403 #endif /* end of int64 support */
404
405 /* FFP module 2 */
406
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 */
413
414 case 021: /* .GOTO 105221 (OP_AK) */
415 if ((int16) op[1].word < 1) /* index < 1? */
416 op[1].word = 1; /* reset min */
417
418 sa = PC + op[1].word - 1; /* point to jump target */
419 if (sa >= op[0].word) /* must be <= last target */
420 sa = op[0].word - 1;
421
422 da = ReadW (sa); /* get jump target */
423 if (reason = resolve (da, &MA, intrq)) { /* resolve indirects */
424 PC = err_PC; /* irq restarts instruction */
425 break;
426 }
427
428 mp_dms_jmp (MA); /* validate jump addr */
429 PCQ_ENTRY; /* record last PC */
430 PC = MA; /* jump */
431 BR = op[0].word; /* (for 2100 FFP compat) */
432 break;
433
434 case 022: /* ..MAP 105222 (OP_KKKK) */
435 op[1].word = op[1].word - 1; /* decrement 1st subscr */
436
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 */
443 break;
444 }
445 op[1].word = op[1].word + /* offset */
446 ((op[3].word - 1) * op2[1].word +
447 op[2].word - 1) * op2[0].word;
448 }
449
450 AR = (op[0].word + op[1].word * BR) & DMASK; /* return element address */
451 break;
452
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) */
463 sc = dc;
464
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 */
469 break;
470 }
471 WriteW (da++, MA); /* put addr into formal */
472 }
473
474 AR = ra; /* return address */
475 BR = da; /* addr of 1st unused formal */
476 break;
477
478 case 024: /* .ENTP 105224 (OP_A) */
479 MA = PC - 5; /* get addr of entry point */
480 goto ENTR;
481
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 */
485
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 */
491 break;
492
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 */
496
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 */
500 break;
501
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 */
507
508 do {
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 */
517 break;
518 }
519 }
520 while (op[0].word != 0); /* loop until count exhausted */
521 break;
522
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 */
526
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 */
531 break;
532
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 */
537
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 */
546 }
547
548 E = 0; /* routine clears E */
549
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;
553 }
554 break;
555
556 default: /* others undefined */
557 reason = stop_inst;
558 }
559
560 return reason;
561 }
562
563
564 /* Double-Integer Instructions.
565
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
573 machines.
574
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.
580
581 There was no equivalent M-Series microcode, due to the limited micromachine
582 address space on that system.
583
584 Option implementation by CPU was as follows:
585
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
589
590 The routines are mapped to instruction codes as follows:
591
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)
607
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.
611
612 Notes:
613
614 1. Opcodes 105335-105337 are NOPs in the microcode. They generate
615 unimplemented instructions stops under simulation.
616
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).
620
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.
626
627 Additional references:
628 - 93585A Microcode Source (93585-18002 Rev. 2005)
629 - 93585A Double Integer Instructions Installation and Reference Manual
630 (93585-90007)
631 */
632
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 --- --- --- */
638 };
639
640 t_stat cpu_dbi (uint32 IR, uint32 intrq)
641 {
642 OP din;
643 OPS op;
644 uint32 entry, t;
645 t_stat reason = SCPE_OK;
646
647 if ((cpu_unit.flags & UNIT_DBI) == 0) /* DBI option installed? */
648 return stop_inst;
649
650 entry = IR & 017; /* mask to entry point */
651
652 if (op_dbi[entry] != OP_N)
653 if (reason = cpu_ops (op_dbi[entry], op, intrq)) /* get instruction operands */
654 return reason;
655
656 switch (entry) { /* decode IR<3:0> */
657
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 */
664 break;
665
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);
671 break;
672
673 case 002: /* .DMP 105322 (OP_JD) */
674 {
675
676 #if defined (HAVE_INT64) /* int64 support available */
677
678 t_int64 t64;
679
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));
684 if (O)
685 t = ~SIGN32; /* if overflow, rtn max pos */
686 else
687 t = (uint32) (t64 & DMASK32); /* else lower 32 bits of result */
688
689 #else /* int64 support unavailable */
690
691 uint32 sign, xu, yu, rh, rl;
692
693 sign = ((int32) op[0].dword < 0) ^ /* save sign of result */
694 ((int32) op[1].dword < 0);
695
696 xu = (uint32) abs ((int32) op[0].dword); /* make operands pos */
697 yu = (uint32) abs ((int32) op[1].dword);
698
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 */
703 }
704
705 else if ((xu & 0xFFFF0000) != 0 && /* 32 x 32 multiply? */
706 (yu & 0xFFFF0000) != 0)
707 O = 1; /* always overflows */
708
709 else { /* 16 x 32 or 32 x 16 */
710 rl = (xu & 0xFFFF) * (yu & 0xFFFF); /* form 1st partial product */
711
712 if ((xu & 0xFFFF0000) == 0)
713 rh = xu * (yu >> 16) + (rl >> 16); /* 16 x 32 2nd partial */
714 else
715 rh = (xu >> 16) * yu + (rl >> 16); /* 32 x 16 2nd partial */
716
717 O = (rh > 0x7FFF + sign); /* check for out of range */
718 if (O == 0)
719 t = (rh << 16) | (rl & 0xFFFF); /* combine partials */
720 }
721
722 if (O)
723 t = ~SIGN32; /* if overflow, rtn max pos */
724 else if (sign)
725 t = ~t + 1; /* if result neg, 2s compl */
726
727 #endif /* end of int64 support */
728
729 }
730 break;
731
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 */
736 E = 1;
737 break;
738
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 */
746
747 case 005: /* .DDI 105325 (OP_JD) */
748 DDI:
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)));
752 if (O)
753 t = ~SIGN32; /* rtn max pos for ovf */
754 else
755 t = (uint32) (INT32 (op[0].dword) / /* else return quotient */
756 INT32 (op[1].dword));
757 break;
758
759 case 006: /* .DDIR 105326 (OP_JD) */
760 t = op[0].dword; /* swap operands */
761 op[0].dword = op[1].dword;
762 op[1].dword = t;
763 goto DDI; /* continue at .DDI */
764
765 case 007: /* .DSB 105327 (OP_JD) */
766 DSB:
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);
771 break;
772
773 case 010: /* .DIN 105330 (OP_J) */
774 t = op[0].dword + 1; /* increment value */
775 O = (t == SIGN32); /* overflow if sign flipped */
776 if (t == 0)
777 E = 1; /* carry if result zero */
778 break;
779
780 case 011: /* .DDE 105331 (OP_J) */
781 t = op[0].dword - 1; /* decrement value */
782 O = (t == ~SIGN32); /* overflow if sign flipped */
783 if ((int32) t == -1)
784 E = 1; /* borrow if result -1 */
785 break;
786
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 */
791 if (t == 0)
792 PC = (PC + 1) & VAMASK; /* skip if result zero */
793 break;
794
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 */
799 if (t == 0)
800 PC = (PC + 1) & VAMASK; /* skip if result zero */
801 break;
802
803 case 014: /* .DSBR 105334 (OP_JD) */
804 t = op[0].dword; /* swap operands */
805 op[0].dword = op[1].dword;
806 op[1].dword = t;
807 goto DSB; /* continue at .DSB */
808
809 default: /* others undefined */
810 t = (AR << 16) | BR; /* set t for NOP */
811 reason = stop_inst;
812 }
813
814 if (reason == SCPE_OK) { /* if return OK */
815 AR = (t >> 16) & DMASK; /* break result */
816 BR = t & DMASK; /* into A and B */
817 }
818
819 return reason;
820 }
Magically enhanced SIMH