projects / simh.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
First Commit of my working state
[simh.git] / HP2100 / hp2100_cpu3.c
CommitLineData
196ba1fc
PH		 1/* hp2100_cpu3.c: HP 2100/1000 FFP/DBI instructions\r
2\r
3 Copyright (c) 2005-2008, J. David Bryan\r
4\r
5 Permission is hereby granted, free of charge, to any person obtaining a\r
6 copy of this software and associated documentation files (the "Software"),\r
7 to deal in the Software without restriction, including without limitation\r
8 the rights to use, copy, modify, merge, publish, distribute, sublicense,\r
9 and/or sell copies of the Software, and to permit persons to whom the\r
10 Software is furnished to do so, subject to the following conditions:\r
11\r
12 The above copyright notice and this permission notice shall be included in\r
13 all copies or substantial portions of the Software.\r
14\r
15 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR\r
16 IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,\r
17 FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL\r
18 THE AUTHOR BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER\r
19 IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN\r
20 CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.\r
21\r
22 Except as contained in this notice, the name of the author shall not be\r
23 used in advertising or otherwise to promote the sale, use or other dealings\r
24 in this Software without prior written authorization from the author.\r
25\r
26 CPU3 Fast FORTRAN and Double Integer instructions\r
27\r
28 27-Feb-08 JDB Added DBI self-test instruction\r
29 23-Oct-07 JDB Fixed unsigned-divide bug in .DDI\r
30 17-Oct-07 JDB Fixed unsigned-multiply bug in .DMP\r
31 16-Oct-06 JDB Calls FPP for extended-precision math\r
32 12-Oct-06 JDB Altered DBLE, DDINT for F-Series FFP compatibility\r
33 26-Sep-06 JDB Moved from hp2100_cpu1.c to simplify extensions\r
34 09-Aug-06 JDB Added double-integer instruction set\r
35 18-Feb-05 JDB Add 2100/21MX Fast FORTRAN Processor instructions\r
36\r
37 Primary references:\r
38 - HP 1000 M/E/F-Series Computers Technical Reference Handbook\r
39 (5955-0282, Mar-1980)\r
40 - HP 1000 M/E/F-Series Computers Engineering and Reference Documentation\r
41 (92851-90001, Mar-1981)\r
42 - Macro/1000 Reference Manual (92059-90001, Dec-1992)\r
43\r
44 Additional references are listed with the associated firmware\r
45 implementations, as are the HP option model numbers pertaining to the\r
46 applicable CPUs.\r
47*/\r
48\r
49#include "hp2100_defs.h"\r
50#include "hp2100_cpu.h"\r
51#include "hp2100_cpu1.h"\r
52\r
53#if defined (HAVE_INT64) /* int64 support available */\r
54#include "hp2100_fp1.h"\r
55#else /* int64 support unavailable */\r
56#include "hp2100_fp.h"\r
57#endif /* end of int64 support */\r
58\r
59\r
60t_stat cpu_ffp (uint32 IR, uint32 intrq); /* Fast FORTRAN Processor */\r
61t_stat cpu_dbi (uint32 IR, uint32 intrq); /* Double-Integer instructions */\r
62\r
63\r
64/* Fast FORTRAN Processor.\r
65\r
66 The Fast FORTRAN Processor (FFP) is a set of FORTRAN language accelerators\r
67 and extended-precision (three-word) floating point routines. Although the\r
68 FFP is an option for the 2100 and later CPUs, each implements the FFP in a\r
69 slightly different form.\r
70\r
71 Option implementation by CPU was as follows:\r
72\r
73 2114 2115 2116 2100 1000-M 1000-E 1000-F\r
74 ------ ------ ------ ------ ------ ------ ------\r
75 N/A N/A N/A 12907A 12977B 13306B std\r
76\r
77 The instruction codes are mapped to routines as follows:\r
78\r
79 Instr. 2100 1000-M 1000-E 1000-F Instr. 2100 1000-M 1000-E 1000-F\r
80 ------ ------ ------ ------ ------ ------ ------ ------ ------ ------\r
81 105200 -- [nop] [nop] [test] 105220 .XFER .XFER .XFER .XFER\r
82 105201 DBLE DBLE DBLE DBLE 105221 .GOTO .GOTO .GOTO .GOTO\r
83 105202 SNGL SNGL SNGL SNGL 105222 ..MAP ..MAP ..MAP ..MAP\r
84 105203 .XMPY .XMPY .XMPY .DNG 105223 .ENTR .ENTR .ENTR .ENTR\r
85 105204 .XDIV .XDIV .XDIV .DCO 105224 .ENTP .ENTP .ENTP .ENTP\r
86 105205 .DFER .DFER .DFER .DFER 105225 -- .PWR2 .PWR2 .PWR2\r
87 105206 -- .XPAK .XPAK .XPAK 105226 -- .FLUN .FLUN .FLUN\r
88 105207 -- XADD XADD .BLE 105227 $SETP $SETP $SETP $SETP\r
89\r
90 105210 -- XSUB XSUB .DIN 105230 -- .PACK .PACK .PACK\r
91 105211 -- XMPY XMPY .DDE 105231 -- -- .CFER .CFER\r
92 105212 -- XDIV XDIV .DIS 105232 -- -- -- ..FCM\r
93 105213 .XADD .XADD .XADD .DDS 105233 -- -- -- ..TCM\r
94 105214 .XSUB .XSUB .XSUB .NGL 105234 -- -- -- --\r
95 105215 -- .XCOM .XCOM .XCOM 105235 -- -- -- --\r
96 105216 -- ..DCM ..DCM ..DCM 105236 -- -- -- --\r
97 105217 -- DDINT DDINT DDINT 105237 -- -- -- --\r
98\r
99 The F-Series maps different instructions to several of the standard FFP\r
100 opcodes. We first look for these and dispatch them appropriately before\r
101 falling into the handler for the common instructions.\r
102\r
103 The math functions use the F-Series FPP for implementation. The FPP requires\r
104 that the host compiler support 64-bit integers. Therefore, if 64-bit\r
105 integers are not available, the math instructions of the FFP are disabled.\r
106 We allow this partial implementation as an aid in running systems generated\r
107 for the FFP. Most system programs did not use the math instructions, but\r
108 almost all use .ENTR. Supporting the latter even on systems that do not\r
109 support the former still allows such systems to boot.\r
110\r
111 Notes:\r
112\r
113 1. The "$SETP" instruction is sometimes listed as ".SETP" in the\r
114 documentation.\r
115\r
116 2. Extended-precision arithmetic routines (e.g., .XMPY) exist on the\r
117 1000-F, but they are assigned instruction codes in the single-precision\r
118 floating-point module range. They are replaced by several double\r
119 integer instructions, which we dispatch to the double integer handler.\r
120\r
121 3. The software implementation of ..MAP supports 1-, 2-, or 3-dimensional\r
122 arrays, designated by setting A = -1, 0, and +1, respectively. The\r
123 firmware implementation supports only 2- and 3-dimensional access.\r
124\r
125 4. The documentation for ..MAP for the 2100 FFP shows A = 0 or -1 for two\r
126 or three dimensions, respectively, but the 1000 FFP shows A = 0 or +1.\r
127 The firmware actually only checks the LSB of A.\r
128\r
129 5. The .DFER and .XFER implementations for the 2100 FFP return X+4 and Y+4\r
130 in the A and B registers, whereas the 1000 FFP returns X+3 and Y+3.\r
131\r
132 6. The .XFER implementation for the 2100 FFP returns to P+2, whereas the\r
133 1000 implementation returns to P+1.\r
134\r
135 7. The firmware implementations of DBLE, .BLE, and DDINT clear the overflow\r
136 flag. The software implementations do not change overflow.\r
137\r
138 8. The M/E-Series FFP arithmetic instructions (.XADD, etc.) return negative\r
139 infinity on negative overflow and positive infinity on positive\r
140 overflow. The equivalent F-Series instructions return positive infinity\r
141 on both.\r
142\r
143 Additional references:\r
144 - DOS/RTE Relocatable Library Reference Manual (24998-90001, Oct-1981)\r
145 - Implementing the HP 2100 Fast FORTRAN Processor (12907-90010, Nov-1974)\r
146*/\r
147\r
148static const OP_PAT op_ffp_f[32] = { /* patterns for F-Series only */\r
149 OP_N, OP_AAF, OP_AX, OP_N, /* [tst] DBLE SNGL .DNG */\r
150 OP_N, OP_AA, OP_A, OP_AAF, /* .DCO .DFER .XPAK .BLE */\r
151 OP_N, OP_N, OP_N, OP_N, /* .DIN .DDE .DIS .DDS */\r
152 OP_AT, OP_A, OP_A, OP_AAX, /* .NGL .XCOM ..DCM DDINT */\r
153 OP_N, OP_AK, OP_KKKK, OP_A, /* .XFER .GOTO ..MAP .ENTR */\r
154 OP_A, OP_RK, OP_R, OP_K, /* .ENTP .PWR2 .FLUN $SETP */\r
155 OP_RC, OP_AA, OP_R, OP_A, /* .PACK .CFER ..FCM ..TCM */\r
156 OP_N, OP_N, OP_N, OP_N /* --- --- --- --- */\r
157 };\r
158\r
159static const OP_PAT op_ffp_e[32] = { /* patterns for 2100/M/E-Series */\r
160 OP_N, OP_AAF, OP_AX, OP_AXX, /* [nop] DBLE SNGL .XMPY */\r
161 OP_AXX, OP_AA, OP_A, OP_AAXX, /* .XDIV .DFER .XPAK XADD */\r
162 OP_AAXX, OP_AAXX, OP_AAXX, OP_AXX, /* XSUB XMPY XDIV .XADD */\r
163 OP_AXX, OP_A, OP_A, OP_AAX, /* .XSUB .XCOM ..DCM DDINT */\r
164 OP_N, OP_AK, OP_KKKK, OP_A, /* .XFER .GOTO ..MAP .ENTR */\r
165 OP_A, OP_RK, OP_R, OP_K, /* .ENTP .PWR2 .FLUN $SETP */\r
166 OP_RC, OP_AA, OP_N, OP_N, /* .PACK .CFER --- --- */\r
167 OP_N, OP_N, OP_N, OP_N /* --- --- --- --- */\r
168 };\r
169\r
170t_stat cpu_ffp (uint32 IR, uint32 intrq)\r
171{\r
172OP fpop;\r
173OPS op, op2;\r
174uint32 entry;\r
175uint32 j, sa, sb, sc, da, dc, ra, MA;\r
176int32 expon;\r
177t_stat reason = SCPE_OK;\r
178\r
179#if defined (HAVE_INT64) /* int64 support available */\r
180\r
181int32 i;\r
182\r
183#endif /* end of int64 support */\r
184\r
185if ((cpu_unit.flags & UNIT_FFP) == 0) /* FFP option installed? */\r
186 return stop_inst;\r
187\r
188entry = IR & 037; /* mask to entry point */\r
189\r
190if (UNIT_CPU_MODEL != UNIT_1000_F) { /* 2100/M/E-Series? */\r
191 if (op_ffp_e[entry] != OP_N)\r
192 if (reason = cpu_ops (op_ffp_e[entry], op, intrq)) /* get instruction operands */\r
193 return reason;\r
194 }\r
195\r
196#if defined (HAVE_INT64) /* int64 support available */\r
197\r
198else { /* F-Series */\r
199 if (op_ffp_f[entry] != OP_N)\r
200 if (reason = cpu_ops (op_ffp_f[entry], op, intrq)) /* get instruction operands */\r
201 return reason;\r
202\r
203 switch (entry) { /* decode IR<4:0> */\r
204\r
205 case 000: /* [tst] 105200 (OP_N) */\r
206 XR = 4; /* firmware revision */\r
207 SR = 0102077; /* test passed code */\r
208 AR = 0; /* test clears A/B */\r
209 BR = 0;\r
210 PC = (PC + 1) & VAMASK; /* P+2 return for firmware w/DBI */\r
211 return reason;\r
212\r
213 case 003: /* .DNG 105203 (OP_N) */\r
214 return cpu_dbi (0105323, intrq); /* remap to double int handler */\r
215\r
216 case 004: /* .DCO 105204 (OP_N) */\r
217 return cpu_dbi (0105324, intrq); /* remap to double int handler */\r
218\r
219 case 007: /* .BLE 105207 (OP_AAF) */\r
220 O = fp_cvt (&op[2], fp_f, fp_t); /* convert value and clear overflow */\r
221 WriteOp (op[1].word, op[2], fp_t); /* write double-precision value */\r
222 return reason;\r
223\r
224 case 010: /* .DIN 105210 (OP_N) */\r
225 return cpu_dbi (0105330, intrq); /* remap to double int handler */\r
226\r
227 case 011: /* .DDE 105211 (OP_N) */\r
228 return cpu_dbi (0105331, intrq); /* remap to double int handler */\r
229\r
230 case 012: /* .DIS 105212 (OP_N) */\r
231 return cpu_dbi (0105332, intrq); /* remap to double int handler */\r
232\r
233 case 013: /* .DDS 105213 (OP_N) */\r
234 return cpu_dbi (0105333, intrq); /* remap to double int handler */\r
235\r
236 case 014: /* .NGL 105214 (OP_AT) */\r
237 O = fp_cvt (&op[1], fp_t, fp_f); /* convert value */\r
238 AR = op[1].fpk[0]; /* move MSB to A */\r
239 BR = op[1].fpk[1]; /* move LSB to B */\r
240 return reason;\r
241\r
242 case 032: /* ..FCM 105232 (OP_R) */\r
243 O = fp_pcom (&op[0], fp_f); /* complement value */\r
244 AR = op[0].fpk[0]; /* return result */\r
245 BR = op[0].fpk[1]; /* to A/B registers */\r
246 return reason;\r
247\r
248 case 033: /* ..TCM 105233 (OP_A) */\r
249 fpop = ReadOp (op[0].word, fp_t); /* read 4-word value */\r
250 O = fp_pcom (&fpop, fp_t); /* complement it */\r
251 WriteOp (op[0].word, fpop, fp_t); /* write 4-word value */\r
252 return reason;\r
253 } /* fall thru if not special to F */\r
254 }\r
255\r
256#endif /* end of int64 support */\r
257\r
258switch (entry) { /* decode IR<4:0> */\r
259\r
260/* FFP module 1 */\r
261\r
262 case 000: /* [nop] 105200 (OP_N) */\r
263 if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 M/E-series */\r
264 return stop_inst; /* trap if not */\r
265 break;\r
266\r
267#if defined (HAVE_INT64) /* int64 support available */\r
268\r
269 case 001: /* DBLE 105201 (OP_AAF) */\r
270 O = fp_cvt (&op[2], fp_f, fp_x); /* convert value and clear overflow */\r
271 WriteOp (op[1].word, op[2], fp_x); /* write extended-precision value */\r
272 break;\r
273\r
274 case 002: /* SNGL 105202 (OP_AX) */\r
275 O = fp_cvt (&op[1], fp_x, fp_f); /* convert value */\r
276 AR = op[1].fpk[0]; /* move MSB to A */\r
277 BR = op[1].fpk[1]; /* move LSB to B */\r
278 break;\r
279\r
280 case 003: /* .XMPY 105203 (OP_AXX) */\r
281 i = 0; /* params start at op[0] */\r
282 goto XMPY; /* process as XMPY */\r
283\r
284 case 004: /* .XDIV 105204 (OP_AXX) */\r
285 i = 0; /* params start at op[0] */\r
286 goto XDIV; /* process as XDIV */\r
287\r
288#endif /* end of int64 support */\r
289\r
290 case 005: /* .DFER 105205 (OP_AA) */\r
291 BR = op[0].word; /* get destination address */\r
292 AR = op[1].word; /* get source address */\r
293 goto XFER; /* do transfer */\r
294\r
295#if defined (HAVE_INT64) /* int64 support available */\r
296\r
297 case 006: /* .XPAK 105206 (OP_A) */\r
298 if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 */\r
299 return stop_inst; /* trap if not */\r
300\r
301 if (intrq) { /* interrupt pending? */\r
302 PC = err_PC; /* restart instruction */\r
303 break;\r
304 }\r
305\r
306 fpop = ReadOp (op[0].word, fp_x); /* read unpacked */\r
307 O = fp_nrpack (&fpop, fpop, (int16) AR, fp_x); /* nrm/rnd/pack mantissa, exponent */\r
308 WriteOp (op[0].word, fpop, fp_x); /* write result */\r
309 break;\r
310\r
311 case 007: /* XADD 105207 (OP_AAXX) */\r
312 i = 1; /* params start at op[1] */\r
313 XADD: /* enter here from .XADD */\r
314 if (intrq) { /* interrupt pending? */\r
315 PC = err_PC; /* restart instruction */\r
316 break;\r
317 }\r
318\r
319 O = fp_exec (001, &fpop, op[i + 1], op[i + 2]); /* three-word add */\r
320 WriteOp (op[i].word, fpop, fp_x); /* write sum */\r
321 break;\r
322\r
323 case 010: /* XSUB 105210 (OP_AAXX) */\r
324 i = 1; /* params start at op[1] */\r
325 XSUB: /* enter here from .XSUB */\r
326 if (intrq) { /* interrupt pending? */\r
327 PC = err_PC; /* restart instruction */\r
328 break;\r
329 }\r
330\r
331 O = fp_exec (021, &fpop, op[i + 1], op[i + 2]); /* three-word subtract */\r
332 WriteOp (op[i].word, fpop, fp_x); /* write difference */\r
333 break;\r
334\r
335 case 011: /* XMPY 105211 (OP_AAXX) */\r
336 i = 1; /* params start at op[1] */\r
337 XMPY: /* enter here from .XMPY */\r
338 if (intrq) { /* interrupt pending? */\r
339 PC = err_PC; /* restart instruction */\r
340 break;\r
341 }\r
342\r
343 O = fp_exec (041, &fpop, op[i + 1], op[i + 2]); /* three-word multiply */\r
344 WriteOp (op[i].word, fpop, fp_x); /* write product */\r
345 break;\r
346\r
347 case 012: /* XDIV 105212 (OP_AAXX) */\r
348 i = 1; /* params start at op[1] */\r
349 XDIV: /* enter here from .XDIV */\r
350 if (intrq) { /* interrupt pending? */\r
351 PC = err_PC; /* restart instruction */\r
352 break;\r
353 }\r
354\r
355 O = fp_exec (061, &fpop, op[i + 1], op[i + 2]); /* three-word divide */\r
356 WriteOp (op[i].word, fpop, fp_x); /* write quotient */\r
357 break;\r
358\r
359 case 013: /* .XADD 105213 (OP_AXX) */\r
360 i = 0; /* params start at op[0] */\r
361 goto XADD; /* process as XADD */\r
362\r
363 case 014: /* .XSUB 105214 (OP_AXX) */\r
364 i = 0; /* params start at op[0] */\r
365 goto XSUB; /* process as XSUB */\r
366\r
367 case 015: /* .XCOM 105215 (OP_A) */\r
368 if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 */\r
369 return stop_inst; /* trap if not */\r
370\r
371 fpop = ReadOp (op[0].word, fp_x); /* read unpacked */\r
372 AR = fp_ucom (&fpop, fp_x); /* complement and rtn exp adj */\r
373 WriteOp (op[0].word, fpop, fp_x); /* write result */\r
374 break;\r
375\r
376 case 016: /* ..DCM 105216 (OP_A) */\r
377 if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 */\r
378 return stop_inst; /* trap if not */\r
379\r
380 if (intrq) { /* interrupt pending? */\r
381 PC = err_PC; /* restart instruction */\r
382 break;\r
383 }\r
384\r
385 fpop = ReadOp (op[0].word, fp_x); /* read operand */\r
386 O = fp_pcom (&fpop, fp_x); /* complement (can't ovf neg) */\r
387 WriteOp (op[0].word, fpop, fp_x); /* write result */\r
388 break;\r
389\r
390 case 017: /* DDINT 105217 (OP_AAX) */\r
391 if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 */\r
392 return stop_inst; /* trap if not */\r
393\r
394 if (intrq) { /* interrupt pending? */\r
395 PC = err_PC; /* restart instruction */\r
396 break;\r
397 }\r
398\r
399 O = fp_trun (&fpop, op[2], fp_x); /* truncate operand (can't ovf) */\r
400 WriteOp (op[1].word, fpop, fp_x); /* write result */\r
401 break;\r
402\r
403#endif /* end of int64 support */\r
404\r
405/* FFP module 2 */\r
406\r
407 case 020: /* .XFER 105220 (OP_N) */\r
408 if (UNIT_CPU_TYPE == UNIT_TYPE_2100)\r
409 PC = (PC + 1) & VAMASK; /* 2100 .XFER returns to P+2 */\r
410 XFER: /* enter here from .DFER */\r
411 sc = 3; /* set count for 3-wd xfer */\r
412 goto CFER; /* do transfer */\r
413\r
414 case 021: /* .GOTO 105221 (OP_AK) */\r
415 if ((int16) op[1].word < 1) /* index < 1? */\r
416 op[1].word = 1; /* reset min */\r
417\r
418 sa = PC + op[1].word - 1; /* point to jump target */\r
419 if (sa >= op[0].word) /* must be <= last target */\r
420 sa = op[0].word - 1;\r
421\r
422 da = ReadW (sa); /* get jump target */\r
423 if (reason = resolve (da, &MA, intrq)) { /* resolve indirects */\r
424 PC = err_PC; /* irq restarts instruction */\r
425 break;\r
426 }\r
427\r
428 mp_dms_jmp (MA); /* validate jump addr */\r
429 PCQ_ENTRY; /* record last PC */\r
430 PC = MA; /* jump */\r
431 BR = op[0].word; /* (for 2100 FFP compat) */\r
432 break;\r
433\r
434 case 022: /* ..MAP 105222 (OP_KKKK) */\r
435 op[1].word = op[1].word - 1; /* decrement 1st subscr */\r
436\r
437 if ((AR & 1) == 0) /* 2-dim access? */\r
438 op[1].word = op[1].word + /* compute element offset */\r
439 (op[2].word - 1) * op[3].word;\r
440 else { /* 3-dim access */\r
441 if (reason = cpu_ops (OP_KK, op2, intrq)) { /* get 1st, 2nd ranges */\r
442 PC = err_PC; /* irq restarts instruction */\r
443 break;\r
444 }\r
445 op[1].word = op[1].word + /* offset */\r
446 ((op[3].word - 1) * op2[1].word +\r
447 op[2].word - 1) * op2[0].word;\r
448 }\r
449\r
450 AR = (op[0].word + op[1].word * BR) & DMASK; /* return element address */\r
451 break;\r
452\r
453 case 023: /* .ENTR 105223 (OP_A) */\r
454 MA = PC - 3; /* get addr of entry point */\r
455 ENTR: /* enter here from .ENTP */\r
456 da = op[0].word; /* get addr of 1st formal */\r
457 dc = MA - da; /* get count of formals */\r
458 sa = ReadW (MA); /* get addr of return point */\r
459 ra = ReadW (sa++); /* get rtn, ptr to 1st actual */\r
460 WriteW (MA, ra); /* stuff rtn into caller's ent */\r
461 sc = ra - sa; /* get count of actuals */\r
462 if (sc > dc) /* use min (actuals, formals) */\r
463 sc = dc;\r
464\r
465 for (j = 0; j < sc; j++) {\r
466 MA = ReadW (sa++); /* get addr of actual */\r
467 if (reason = resolve (MA, &MA, intrq)) { /* resolve indirect */\r
468 PC = err_PC; /* irq restarts instruction */\r
469 break;\r
470 }\r
471 WriteW (da++, MA); /* put addr into formal */\r
472 }\r
473\r
474 AR = ra; /* return address */\r
475 BR = da; /* addr of 1st unused formal */\r
476 break;\r
477\r
478 case 024: /* .ENTP 105224 (OP_A) */\r
479 MA = PC - 5; /* get addr of entry point */\r
480 goto ENTR;\r
481\r
482 case 025: /* .PWR2 105225 (OP_RK) */\r
483 if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 */\r
484 return stop_inst; /* trap if not */\r
485\r
486 fp_unpack (&fpop, &expon, op[0], fp_f); /* unpack value */\r
487 expon = expon + (int16) (op[1].word); /* multiply by 2**n */\r
488 fp_pack (&fpop, fpop, expon, fp_f); /* repack value */\r
489 AR = fpop.fpk[0]; /* return result */\r
490 BR = fpop.fpk[1]; /* to A/B registers */\r
491 break;\r
492\r
493 case 026: /* .FLUN 105226 (OP_R) */\r
494 if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 */\r
495 return stop_inst; /* trap if not */\r
496\r
497 fp_unpack (&fpop, &expon, op[0], fp_f); /* unpack value */\r
498 AR = (int16) expon; /* return expon to A */\r
499 BR = fpop.fpk[1]; /* and low mant to B */\r
500 break;\r
501\r
502 case 027: /* $SETP 105227 (OP_K) */\r
503 j = sa = AR; /* save initial value */\r
504 sb = BR; /* save initial address */\r
505 AR = 0; /* AR will return = 0 */\r
506 BR = BR & VAMASK; /* addr must be direct */\r
507\r
508 do {\r
509 WriteW (BR, j); /* write value to address */\r
510 j = (j + 1) & DMASK; /* incr value */\r
511 BR = (BR + 1) & VAMASK; /* incr address */\r
512 op[0].word = op[0].word - 1; /* decr count */\r
513 if (op[0].word && intrq) { /* more and intr? */\r
514 AR = sa; /* restore A */\r
515 BR = sb; /* restore B */\r
516 PC = err_PC; /* restart instruction */\r
517 break;\r
518 }\r
519 }\r
520 while (op[0].word != 0); /* loop until count exhausted */\r
521 break;\r
522\r
523 case 030: /* .PACK 105230 (OP_RC) */\r
524 if (UNIT_CPU_TYPE != UNIT_TYPE_1000) /* must be 1000 */\r
525 return stop_inst; /* trap if not */\r
526\r
527 O = fp_nrpack (&fpop, op[0], /* nrm/rnd/pack value */\r
528 (int16) (op[1].word), fp_f);\r
529 AR = fpop.fpk[0]; /* return result */\r
530 BR = fpop.fpk[1]; /* to A/B registers */\r
531 break;\r
532\r
533 case 031: /* .CFER 105231 (OP_AA) */\r
534 if ((UNIT_CPU_MODEL != UNIT_1000_E) && /* must be 1000 E-series */\r
535 (UNIT_CPU_MODEL != UNIT_1000_F)) /* or 1000 F-series */\r
536 return stop_inst; /* trap if not */\r
537\r
538 BR = op[0].word; /* get destination address */\r
539 AR = op[1].word; /* get source address */\r
540 sc = 4; /* set for 4-wd xfer */\r
541 CFER: /* enter here from .XFER */\r
542 for (j = 0; j < sc; j++) { /* xfer loop */\r
543 WriteW (BR, ReadW (AR)); /* transfer word */\r
544 AR = (AR + 1) & VAMASK; /* bump source addr */\r
545 BR = (BR + 1) & VAMASK; /* bump destination addr */\r
546 }\r
547\r
548 E = 0; /* routine clears E */\r
549\r
550 if (UNIT_CPU_TYPE == UNIT_TYPE_2100) { /* 2100 (and .DFER/.XFER)? */\r
551 AR = (AR + 1) & VAMASK; /* 2100 FFP returns X+4, Y+4 */\r
552 BR = (BR + 1) & VAMASK;\r
553 }\r
554 break;\r
555\r
556 default: /* others undefined */\r
557 reason = stop_inst;\r
558 }\r
559\r
560return reason;\r
561}\r
562\r
563\r
564/* Double-Integer Instructions.\r
565\r
566 The double-integer instructions were added to the HP instruction set at\r
567 revision 1920 of the 1000-F. They were immediately adopted in a number of HP\r
568 software products, most notably the RTE file management package (FMP)\r
569 routines. As these routines are used in nearly every RTE program, F-Series\r
570 programs were almost always a few hundred bytes smaller than their M- and\r
571 E-Series counterparts. This became significant as RTE continued to grow in\r
572 size, and some customer programs ran out of address space on E-Series\r
573 machines.\r
574\r
575 While HP never added double-integer instructions to the standard E-Series, a\r
576 product from the HP "specials group," HP 93585A, provided microcoded\r
577 replacements for the E-Series. This could provide just enough address-space\r
578 savings to allow programs to load in E-Series systems, in addition to\r
579 accelerating these common operations.\r
580\r
581 There was no equivalent M-Series microcode, due to the limited micromachine\r
582 address space on that system.\r
583\r
584 Option implementation by CPU was as follows:\r
585\r
586 2114 2115 2116 2100 1000-M 1000-E 1000-F\r
587 ------ ------ ------ ------ ------ ------ ------\r
588 N/A N/A N/A N/A N/A 93585A std\r
589\r
590 The routines are mapped to instruction codes as follows:\r
591\r
592 Instr. 1000-E 1000-F Description\r
593 ------ ------ ------ -----------------------------------------\r
594 [test] 105320 -- [self test]\r
595 .DAD 105321 105014 Double integer add\r
596 .DMP 105322 105054 Double integer multiply\r
597 .DNG 105323 105203 Double integer negate\r
598 .DCO 105324 105204 Double integer compare\r
599 .DDI 105325 105074 Double integer divide\r
600 .DDIR 105326 105134 Double integer divide (reversed)\r
601 .DSB 105327 105034 Double integer subtract\r
602 .DIN 105330 105210 Double integer increment\r
603 .DDE 105331 105211 Double integer decrement\r
604 .DIS 105332 105212 Double integer increment and skip if zero\r
605 .DDS 105333 105213 Double integer decrement and skip if zero\r
606 .DSBR 105334 105114 Double integer subtraction (reversed)\r
607\r
608 On the F-Series, the double-integer instruction codes are split among the\r
609 floating-point processor and the Fast FORTRAN Processor ranges. They are\r
610 dispatched from those respective simulators for processing here.\r
611\r
612 Notes:\r
613\r
614 1. Opcodes 105335-105337 are NOPs in the microcode. They generate\r
615 unimplemented instructions stops under simulation.\r
616\r
617 2. This is an implementation of Revision 2 of the microcode, which was\r
618 released as ROM part numbers 93585-80003, 93585-80005, and 93585-80001\r
619 (Revision 1 substituted -80002 for -80005).\r
620\r
621 3. The F-Series firmware executes .DMP and .DDI/.DDIR by floating the\r
622 32-bit double integer to a 48-bit extended-precision number, calling the\r
623 FPP to execute the extended-precision multiply/divide, and then fixing\r
624 the product to a 32-bit double integer. We simulate these directly with\r
625 64- or 32-bit integer arithmetic.\r
626\r
627 Additional references:\r
628 - 93585A Microcode Source (93585-18002 Rev. 2005)\r
629 - 93585A Double Integer Instructions Installation and Reference Manual\r
630 (93585-90007)\r
631*/\r
632\r
633static const OP_PAT op_dbi[16] = {\r
634 OP_N, OP_JD, OP_JD, OP_J, /* [test] .DAD .DMP .DNG */\r
635 OP_JD, OP_JD, OP_JD, OP_JD, /* .DCO .DDI .DDIR .DSB */\r
636 OP_J, OP_J, OP_A, OP_A, /* .DIN .DDE .DIS .DDS */\r
637 OP_JD, OP_N, OP_N, OP_N /* .DSBR --- --- --- */\r
638 };\r
639\r
640t_stat cpu_dbi (uint32 IR, uint32 intrq)\r
641{\r
642OP din;\r
643OPS op;\r
644uint32 entry, t;\r
645t_stat reason = SCPE_OK;\r
646\r
647if ((cpu_unit.flags & UNIT_DBI) == 0) /* DBI option installed? */\r
648 return stop_inst;\r
649\r
650entry = IR & 017; /* mask to entry point */\r
651\r
652if (op_dbi[entry] != OP_N)\r
653 if (reason = cpu_ops (op_dbi[entry], op, intrq)) /* get instruction operands */\r
654 return reason;\r
655\r
656switch (entry) { /* decode IR<3:0> */\r
657\r
658 case 000: /* [test] 105320 (OP_N) */\r
659 XR = 2; /* set revision */\r
660 BR = 0377; /* side effect of microcode */\r
661 SR = 0102077; /* set "pass" code */\r
662 PC = (PC + 1) & VAMASK; /* return to P+1 */\r
663 t = (AR << 16) | BR; /* set t for return */\r
664 break;\r
665\r
666 case 001: /* .DAD 105321 (OP_JD) */\r
667 t = op[0].dword + op[1].dword; /* add values */\r
668 E = E | (t < op[0].dword); /* carry if result smaller */\r
669 O = (((~op[0].dword ^ op[1].dword) & /* overflow if sign wrong */\r
670 (op[0].dword ^ t) & SIGN32) != 0);\r
671 break;\r
672\r
673 case 002: /* .DMP 105322 (OP_JD) */\r
674 {\r
675\r
676#if defined (HAVE_INT64) /* int64 support available */\r
677\r
678 t_int64 t64;\r
679\r
680 t64 = (t_int64) INT32 (op[0].dword) * /* multiply signed values */\r
681 (t_int64) INT32 (op[1].dword);\r
682 O = ((t64 < -(t_int64) 0x80000000) || /* overflow if out of range */\r
683 (t64 > (t_int64) 0x7FFFFFFF));\r
684 if (O)\r
685 t = ~SIGN32; /* if overflow, rtn max pos */\r
686 else\r
687 t = (uint32) (t64 & DMASK32); /* else lower 32 bits of result */\r
688\r
689#else /* int64 support unavailable */\r
690\r
691 uint32 sign, xu, yu, rh, rl;\r
692\r
693 sign = ((int32) op[0].dword < 0) ^ /* save sign of result */\r
694 ((int32) op[1].dword < 0);\r
695\r
696 xu = (uint32) abs ((int32) op[0].dword); /* make operands pos */\r
697 yu = (uint32) abs ((int32) op[1].dword);\r
698\r
699 if ((xu & 0xFFFF0000) == 0 && /* 16 x 16 multiply? */\r
700 (yu & 0xFFFF0000) == 0) {\r
701 t = xu * yu; /* do it */\r
702 O = 0; /* can't overflow */\r
703 }\r
704\r
705 else if ((xu & 0xFFFF0000) != 0 && /* 32 x 32 multiply? */\r
706 (yu & 0xFFFF0000) != 0)\r
707 O = 1; /* always overflows */\r
708\r
709 else { /* 16 x 32 or 32 x 16 */\r
710 rl = (xu & 0xFFFF) * (yu & 0xFFFF); /* form 1st partial product */\r
711\r
712 if ((xu & 0xFFFF0000) == 0)\r
713 rh = xu * (yu >> 16) + (rl >> 16); /* 16 x 32 2nd partial */\r
714 else\r
715 rh = (xu >> 16) * yu + (rl >> 16); /* 32 x 16 2nd partial */\r
716\r
717 O = (rh > 0x7FFF + sign); /* check for out of range */\r
718 if (O == 0)\r
719 t = (rh << 16) | (rl & 0xFFFF); /* combine partials */\r
720 }\r
721\r
722 if (O)\r
723 t = ~SIGN32; /* if overflow, rtn max pos */\r
724 else if (sign)\r
725 t = ~t + 1; /* if result neg, 2s compl */\r
726\r
727#endif /* end of int64 support */\r
728\r
729 }\r
730 break;\r
731\r
732 case 003: /* .DNG 105323 (OP_J) */\r
733 t = ~op[0].dword + 1; /* negate value */\r
734 O = (op[0].dword == SIGN32); /* overflow if max neg */\r
735 if (op[0].dword == 0) /* borrow if result zero */\r
736 E = 1;\r
737 break;\r
738\r
739 case 004: /* .DCO 105324 (OP_JD) */\r
740 t = op[0].dword; /* copy for later store */\r
741 if ((int32) op[0].dword < (int32) op[1].dword)\r
742 PC = (PC + 1) & VAMASK; /* < rtns to P+2 */\r
743 else if ((int32) op[0].dword > (int32) op[1].dword)\r
744 PC = (PC + 2) & VAMASK; /* > rtns to P+3 */\r
745 break; /* = rtns to P+1 */\r
746\r
747 case 005: /* .DDI 105325 (OP_JD) */\r
748 DDI:\r
749 O = ((op[1].dword == 0) || /* overflow if div 0 */\r
750 ((op[0].dword == SIGN32) && /* or max neg div -1 */\r
751 ((int32) op[1].dword == -1)));\r
752 if (O)\r
753 t = ~SIGN32; /* rtn max pos for ovf */\r
754 else\r
755 t = (uint32) (INT32 (op[0].dword) / /* else return quotient */\r
756 INT32 (op[1].dword));\r
757 break;\r
758\r
759 case 006: /* .DDIR 105326 (OP_JD) */\r
760 t = op[0].dword; /* swap operands */\r
761 op[0].dword = op[1].dword;\r
762 op[1].dword = t;\r
763 goto DDI; /* continue at .DDI */\r
764\r
765 case 007: /* .DSB 105327 (OP_JD) */\r
766 DSB:\r
767 t = op[0].dword - op[1].dword; /* subtract values */\r
768 E = E | (op[0].dword < op[1].dword); /* borrow if minu < subtr */\r
769 O = (((op[0].dword ^ op[1].dword) & /* overflow if sign wrong */\r
770 (op[0].dword ^ t) & SIGN32) != 0);\r
771 break;\r
772\r
773 case 010: /* .DIN 105330 (OP_J) */\r
774 t = op[0].dword + 1; /* increment value */\r
775 O = (t == SIGN32); /* overflow if sign flipped */\r
776 if (t == 0)\r
777 E = 1; /* carry if result zero */\r
778 break;\r
779\r
780 case 011: /* .DDE 105331 (OP_J) */\r
781 t = op[0].dword - 1; /* decrement value */\r
782 O = (t == ~SIGN32); /* overflow if sign flipped */\r
783 if ((int32) t == -1)\r
784 E = 1; /* borrow if result -1 */\r
785 break;\r
786\r
787 case 012: /* .DIS 105332 (OP_A) */\r
788 din = ReadOp (op[0].word, in_d); /* get value */\r
789 t = din.dword = din.dword + 1; /* increment value */\r
790 WriteOp (op[0].word, din, in_d); /* store it back */\r
791 if (t == 0)\r
792 PC = (PC + 1) & VAMASK; /* skip if result zero */\r
793 break;\r
794\r
795 case 013: /* .DDS 105333 (OP_A) */\r
796 din = ReadOp (op[0].word, in_d); /* get value */\r
797 t = din.dword = din.dword - 1; /* decrement value */\r
798 WriteOp (op[0].word, din, in_d); /* write it back */\r
799 if (t == 0)\r
800 PC = (PC + 1) & VAMASK; /* skip if result zero */\r
801 break;\r
802\r
803 case 014: /* .DSBR 105334 (OP_JD) */\r
804 t = op[0].dword; /* swap operands */\r
805 op[0].dword = op[1].dword;\r
806 op[1].dword = t;\r
807 goto DSB; /* continue at .DSB */\r
808\r
809 default: /* others undefined */\r
810 t = (AR << 16) | BR; /* set t for NOP */\r
811 reason = stop_inst;\r
812 }\r
813\r
814if (reason == SCPE_OK) { /* if return OK */\r
815 AR = (t >> 16) & DMASK; /* break result */\r
816 BR = t & DMASK; /* into A and B */\r
817 }\r
818\r
819return reason;\r
820}\r
Magically enhanced SIMH