| 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 |
| 60 | t_stat cpu_ffp (uint32 IR, uint32 intrq); /* Fast FORTRAN Processor */\r |
| 61 | t_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 |
| 148 | static 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 |
| 159 | static 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 |
| 170 | t_stat cpu_ffp (uint32 IR, uint32 intrq)\r |
| 171 | {\r |
| 172 | OP fpop;\r |
| 173 | OPS op, op2;\r |
| 174 | uint32 entry;\r |
| 175 | uint32 j, sa, sb, sc, da, dc, ra, MA;\r |
| 176 | int32 expon;\r |
| 177 | t_stat reason = SCPE_OK;\r |
| 178 | \r |
| 179 | #if defined (HAVE_INT64) /* int64 support available */\r |
| 180 | \r |
| 181 | int32 i;\r |
| 182 | \r |
| 183 | #endif /* end of int64 support */\r |
| 184 | \r |
| 185 | if ((cpu_unit.flags & UNIT_FFP) == 0) /* FFP option installed? */\r |
| 186 | return stop_inst;\r |
| 187 | \r |
| 188 | entry = IR & 037; /* mask to entry point */\r |
| 189 | \r |
| 190 | if (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 |
| 198 | else { /* 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 |
| 258 | switch (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 |
| 560 | return 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 |
| 633 | static 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 |
| 640 | t_stat cpu_dbi (uint32 IR, uint32 intrq)\r |
| 641 | {\r |
| 642 | OP din;\r |
| 643 | OPS op;\r |
| 644 | uint32 entry, t;\r |
| 645 | t_stat reason = SCPE_OK;\r |
| 646 | \r |
| 647 | if ((cpu_unit.flags & UNIT_DBI) == 0) /* DBI option installed? */\r |
| 648 | return stop_inst;\r |
| 649 | \r |
| 650 | entry = IR & 017; /* mask to entry point */\r |
| 651 | \r |
| 652 | if (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 |
| 656 | switch (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 |
| 814 | if (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 |
| 819 | return reason;\r |
| 820 | }\r |