| 1 | /* i1401_cpu.c: IBM 1401 CPU simulator\r |
| 2 | \r |
| 3 | Copyright (c) 1993-2007, Robert M. Supnik\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 | ROBERT M SUPNIK 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 Robert M Supnik 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 Robert M Supnik.\r |
| 25 | \r |
| 26 | 07-Jul-07 RMS Removed restriction on load-mode binary tape\r |
| 27 | 28-Jun-07 RMS Added support for SS overlap modifiers\r |
| 28 | 22-May-06 RMS Fixed format error in CPU history (found by Peter Schorn)\r |
| 29 | 06-Mar-06 RMS Fixed bug in divide (found by Van Snyder)\r |
| 30 | 22-Sep-05 RMS Fixed declarations (from Sterling Garwood)\r |
| 31 | 01-Sep-05 RMS Removed error stops in MCE\r |
| 32 | 16-Aug-05 RMS Fixed C++ declaration and cast problems\r |
| 33 | 02-Jun-05 RMS Fixed SSB-SSG clearing on RESET\r |
| 34 | (reported by Ralph Reinke)\r |
| 35 | 14-Nov-04 WVS Added column binary support, debug support\r |
| 36 | 06-Nov-04 RMS Added instruction history\r |
| 37 | 12-Jul-03 RMS Moved ASCII/BCD tables to included file\r |
| 38 | Revised fetch to model hardware\r |
| 39 | Removed length checking in fetch phase\r |
| 40 | 16-Mar-03 RMS Fixed mnemonic, instruction lengths, and reverse\r |
| 41 | scan length check bug for MCS\r |
| 42 | Fixed MCE bug, BS off by 1 if zero suppress\r |
| 43 | Fixed chaining bug, D lost if return to SCP\r |
| 44 | Fixed H branch, branch occurs after continue\r |
| 45 | Added check for invalid 8 character MCW, LCA\r |
| 46 | 03-Jun-03 RMS Added 1311 support\r |
| 47 | 22-May-02 RMS Added multiply and divide\r |
| 48 | 30-Dec-01 RMS Added old PC queue\r |
| 49 | 30-Nov-01 RMS Added extended SET/SHOW support\r |
| 50 | 10-Aug-01 RMS Removed register in declarations\r |
| 51 | 07-Dec-00 RMS Fixed bugs found by Charles Owen\r |
| 52 | -- 4,7 char NOPs are legal\r |
| 53 | -- 1 char B is chained BCE\r |
| 54 | -- MCE moves whole char after first\r |
| 55 | 14-Apr-99 RMS Changed t_addr to unsigned\r |
| 56 | \r |
| 57 | The register state for the IBM 1401 is:\r |
| 58 | \r |
| 59 | IS I storage address register (PC)\r |
| 60 | AS A storage address register (address of first operand)\r |
| 61 | BS B storage address register (address of second operand)\r |
| 62 | ind[0:63] indicators\r |
| 63 | SSA sense switch A\r |
| 64 | IOCHK I/O check\r |
| 65 | PRCHK process check\r |
| 66 | \r |
| 67 | The IBM 1401 is a variable instruction length, decimal data system.\r |
| 68 | Memory consists of 4000, 8000, 12000, or 16000 BCD characters, each\r |
| 69 | containing six bits of data and a word mark. There are no general\r |
| 70 | registers; all instructions are memory to memory, using explicit\r |
| 71 | addresses or an address pointer from a prior instruction.\r |
| 72 | \r |
| 73 | BCD numeric data consists of the low four bits of a character (DIGIT),\r |
| 74 | encoded as X, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, X, X, X, X, X. The high\r |
| 75 | two bits (ZONE) encode the sign of the data as +, +, -, +. Character\r |
| 76 | data uses all six bits of a character. Numeric and character fields are\r |
| 77 | delimited by a word mark. Fields are typically processed in descending\r |
| 78 | address order (low-order data to high-order data).\r |
| 79 | \r |
| 80 | The 1401 encodes a decimal address, and an index register number, in\r |
| 81 | three characters:\r |
| 82 | \r |
| 83 | character zone digit\r |
| 84 | addr + 0 <1:0> of thousands hundreds\r |
| 85 | addr + 1 index register # tens\r |
| 86 | addr + 2 <3:2> of thousands ones\r |
| 87 | \r |
| 88 | Normally the digit values 0, 11, 12, 13, 14, 15 are illegal in addresses.\r |
| 89 | However, in indexing, digits are passed through the adder, and illegal\r |
| 90 | values are normalized to legal counterparts.\r |
| 91 | \r |
| 92 | The 1401 has six instruction formats:\r |
| 93 | \r |
| 94 | op A and B addresses, if any, from AS and BS\r |
| 95 | op d A and B addresses, if any, from AS and BS\r |
| 96 | op aaa B address, if any, from BS\r |
| 97 | op aaa d B address, if any, from BS\r |
| 98 | op aaa bbb\r |
| 99 | op aaa bbb d\r |
| 100 | \r |
| 101 | where aaa is the A address, bbb is the B address, and d is a modifier.\r |
| 102 | The opcode has word mark set; all other characters have word mark clear.\r |
| 103 | \r |
| 104 | This routine is the instruction decode routine for the IBM 1401.\r |
| 105 | It is called from the simulator control program to execute\r |
| 106 | instructions in simulated memory, starting at the simulated PC.\r |
| 107 | It runs until 'reason' is set non-zero.\r |
| 108 | \r |
| 109 | General notes:\r |
| 110 | \r |
| 111 | 1. Reasons to stop. The simulator can be stopped by:\r |
| 112 | \r |
| 113 | HALT instruction\r |
| 114 | breakpoint encountered\r |
| 115 | illegal addresses or instruction formats\r |
| 116 | I/O error in I/O simulator\r |
| 117 | \r |
| 118 | 2. Interrupts. The 1401 has no interrupt structure.\r |
| 119 | \r |
| 120 | 3. Non-existent memory. On the 1401, references to non-existent\r |
| 121 | memory halt the processor.\r |
| 122 | \r |
| 123 | 4. Adding I/O devices. These modules must be modified:\r |
| 124 | \r |
| 125 | i1401_cpu.c add device dispatching code to iodisp\r |
| 126 | i1401_sys.c add sim_devices table entry\r |
| 127 | */\r |
| 128 | \r |
| 129 | #include "i1401_defs.h"\r |
| 130 | #include "i1401_dat.h"\r |
| 131 | \r |
| 132 | #define PCQ_SIZE 64 /* must be 2**n */\r |
| 133 | #define PCQ_MASK (PCQ_SIZE - 1)\r |
| 134 | #define PCQ_ENTRY pcq[pcq_p = (pcq_p - 1) & PCQ_MASK] = saved_IS\r |
| 135 | \r |
| 136 | #define HIST_MIN 64\r |
| 137 | #define HIST_MAX 65536\r |
| 138 | \r |
| 139 | typedef struct {\r |
| 140 | uint16 is;\r |
| 141 | uint16 ilnt;\r |
| 142 | uint8 inst[MAX_L];\r |
| 143 | } InstHistory;\r |
| 144 | \r |
| 145 | /* These macros validate addresses. If an addresses error is detected,\r |
| 146 | they return an error status to the caller. These macros should only\r |
| 147 | be used in a routine that returns a t_stat value.\r |
| 148 | */\r |
| 149 | \r |
| 150 | #define MM(x) x = x - 1; \\r |
| 151 | if (x < 0) { \\r |
| 152 | x = BA + MAXMEMSIZE - 1; \\r |
| 153 | reason = STOP_WRAP; \\r |
| 154 | break; \\r |
| 155 | }\r |
| 156 | \r |
| 157 | #define PP(x) x = x + 1; \\r |
| 158 | if (ADDR_ERR (x)) { \\r |
| 159 | x = BA + (x % MAXMEMSIZE); \\r |
| 160 | reason = STOP_WRAP; \\r |
| 161 | break; \\r |
| 162 | }\r |
| 163 | \r |
| 164 | #define BRANCH if (ADDR_ERR (AS)) { \\r |
| 165 | reason = STOP_INVBR; \\r |
| 166 | break; \\r |
| 167 | } \\r |
| 168 | if (cpu_unit.flags & XSA) BS = IS; \\r |
| 169 | else BS = BA + 0; \\r |
| 170 | PCQ_ENTRY; \\r |
| 171 | IS = AS;\r |
| 172 | \r |
| 173 | uint8 M[MAXMEMSIZE] = { 0 }; /* main memory */\r |
| 174 | int32 saved_IS = 0; /* saved IS */\r |
| 175 | int32 AS = 0; /* AS */\r |
| 176 | int32 BS = 0; /* BS */\r |
| 177 | int32 D = 0; /* modifier */\r |
| 178 | int32 as_err = 0, bs_err = 0; /* error flags */\r |
| 179 | int32 hb_pend = 0; /* halt br pending */\r |
| 180 | uint16 pcq[PCQ_SIZE] = { 0 }; /* PC queue */\r |
| 181 | int32 pcq_p = 0; /* PC queue ptr */\r |
| 182 | REG *pcq_r = NULL; /* PC queue reg ptr */\r |
| 183 | int32 ind[64] = { 0 }; /* indicators */\r |
| 184 | int32 ssa = 1; /* sense switch A */\r |
| 185 | int32 prchk = 0; /* process check stop */\r |
| 186 | int32 iochk = 0; /* I/O check stop */\r |
| 187 | int32 hst_p = 0; /* history pointer */\r |
| 188 | int32 hst_lnt = 0; /* history length */\r |
| 189 | InstHistory *hst = NULL; /* instruction history */\r |
| 190 | t_bool conv_old = 0; /* old conversions */\r |
| 191 | \r |
| 192 | extern int32 sim_int_char;\r |
| 193 | extern int32 sim_emax;\r |
| 194 | extern t_value *sim_eval;\r |
| 195 | extern FILE *sim_deb;\r |
| 196 | extern uint32 sim_brk_types, sim_brk_dflt, sim_brk_summ; /* breakpoint info */\r |
| 197 | \r |
| 198 | t_stat cpu_ex (t_value *vptr, t_addr addr, UNIT *uptr, int32 sw);\r |
| 199 | t_stat cpu_dep (t_value val, t_addr addr, UNIT *uptr, int32 sw);\r |
| 200 | t_stat cpu_reset (DEVICE *dptr);\r |
| 201 | t_stat cpu_set_size (UNIT *uptr, int32 val, char *cptr, void *desc);\r |
| 202 | t_stat cpu_set_hist (UNIT *uptr, int32 val, char *cptr, void *desc);\r |
| 203 | t_stat cpu_show_hist (FILE *st, UNIT *uptr, int32 val, void *desc);\r |
| 204 | t_stat cpu_set_conv (UNIT *uptr, int32 val, char *cptr, void *desc);\r |
| 205 | t_stat cpu_show_conv (FILE *st, UNIT *uptr, int32 val, void *desc);\r |
| 206 | int32 store_addr_h (int32 addr);\r |
| 207 | int32 store_addr_t (int32 addr);\r |
| 208 | int32 store_addr_u (int32 addr);\r |
| 209 | int32 div_add (int32 ap, int32 bp, int32 aend);\r |
| 210 | int32 div_sub (int32 ap, int32 bp, int32 aend);\r |
| 211 | void div_sign (int32 dvrc, int32 dvdc, int32 qp, int32 rp);\r |
| 212 | t_stat iomod (int32 ilnt, int32 mod, const int32 *tptr);\r |
| 213 | t_stat iodisp (int32 dev, int32 unit, int32 flag, int32 mod);\r |
| 214 | \r |
| 215 | extern t_stat read_card (int32 ilnt, int32 mod);\r |
| 216 | extern t_stat punch_card (int32 ilnt, int32 mod);\r |
| 217 | extern t_stat select_stack (int32 mod);\r |
| 218 | extern t_stat carriage_control (int32 mod);\r |
| 219 | extern t_stat write_line (int32 ilnt, int32 mod);\r |
| 220 | extern t_stat inq_io (int32 flag, int32 mod);\r |
| 221 | extern t_stat mt_io (int32 unit, int32 flag, int32 mod);\r |
| 222 | extern t_stat dp_io (int32 fnc, int32 flag, int32 mod);\r |
| 223 | extern t_stat mt_func (int32 unit, int32 mod);\r |
| 224 | extern t_stat sim_activate (UNIT *uptr, int32 delay);\r |
| 225 | extern t_stat fprint_sym (FILE *of, t_addr addr, t_value *val, UNIT *uptr, int32 sw);\r |
| 226 | \r |
| 227 | /* CPU data structures\r |
| 228 | \r |
| 229 | cpu_dev CPU device descriptor\r |
| 230 | cpu_unit CPU unit descriptor\r |
| 231 | cpu_reg CPU register list\r |
| 232 | cpu_mod CPU modifier list\r |
| 233 | */\r |
| 234 | \r |
| 235 | UNIT cpu_unit = {\r |
| 236 | UDATA (NULL, UNIT_FIX + UNIT_BCD + STDOPT, MAXMEMSIZE)\r |
| 237 | };\r |
| 238 | \r |
| 239 | REG cpu_reg[] = {\r |
| 240 | { DRDATA (IS, saved_IS, 14), PV_LEFT },\r |
| 241 | { DRDATA (AS, AS, 14), PV_LEFT },\r |
| 242 | { DRDATA (BS, BS, 14), PV_LEFT },\r |
| 243 | { FLDATA (ASERR, as_err, 0) },\r |
| 244 | { FLDATA (BSERR, bs_err, 0) },\r |
| 245 | { ORDATA (D, D, 7) },\r |
| 246 | { FLDATA (SSA, ssa, 0) },\r |
| 247 | { FLDATA (SSB, ind[IN_SSB], 0) },\r |
| 248 | { FLDATA (SSC, ind[IN_SSC], 0) },\r |
| 249 | { FLDATA (SSD, ind[IN_SSD], 0) },\r |
| 250 | { FLDATA (SSE, ind[IN_SSE], 0) },\r |
| 251 | { FLDATA (SSF, ind[IN_SSF], 0) },\r |
| 252 | { FLDATA (SSG, ind[IN_SSG], 0) },\r |
| 253 | { FLDATA (EQU, ind[IN_EQU], 0) },\r |
| 254 | { FLDATA (UNEQ, ind[IN_UNQ], 0) },\r |
| 255 | { FLDATA (HIGH, ind[IN_HGH], 0) },\r |
| 256 | { FLDATA (LOW, ind[IN_LOW], 0) },\r |
| 257 | { FLDATA (OVF, ind[IN_OVF], 0) },\r |
| 258 | { FLDATA (IOCHK, iochk, 0) },\r |
| 259 | { FLDATA (PRCHK, prchk, 0) },\r |
| 260 | { FLDATA (HBPEND, hb_pend, 0) },\r |
| 261 | { BRDATA (ISQ, pcq, 10, 14, PCQ_SIZE), REG_RO+REG_CIRC },\r |
| 262 | { DRDATA (ISQP, pcq_p, 6), REG_HRO },\r |
| 263 | { ORDATA (WRU, sim_int_char, 8) },\r |
| 264 | { FLDATA (CONVOLD, conv_old, 0), REG_HIDDEN },\r |
| 265 | { NULL }\r |
| 266 | };\r |
| 267 | \r |
| 268 | MTAB cpu_mod[] = {\r |
| 269 | { XSA, XSA, "XSA", "XSA", NULL },\r |
| 270 | { XSA, 0, "no XSA", "NOXSA", NULL },\r |
| 271 | { HLE, HLE, "HLE", "HLE", NULL },\r |
| 272 | { HLE, 0, "no HLE", "NOHLE", NULL },\r |
| 273 | { BBE, BBE, "BBE", "BBE", NULL },\r |
| 274 | { BBE, 0, "no BBE", "NOBBE", NULL },\r |
| 275 | { MA, MA, "MA", 0, NULL },\r |
| 276 | { MA, 0, "no MA", 0, NULL },\r |
| 277 | { MR, MR, "MR", "MR", NULL },\r |
| 278 | { MR, 0, "no MR", "NOMR", NULL },\r |
| 279 | { EPE, EPE, "EPE", "EPE", NULL },\r |
| 280 | { EPE, 0, "no EPE", "NOEPE", NULL },\r |
| 281 | { MDV, MDV, "MDV", "MDV", NULL },\r |
| 282 | { MDV, 0, "no MDV", "NOMDV", NULL },\r |
| 283 | { UNIT_MSIZE, 4000, NULL, "4K", &cpu_set_size },\r |
| 284 | { UNIT_MSIZE, 8000, NULL, "8K", &cpu_set_size },\r |
| 285 | { UNIT_MSIZE, 12000, NULL, "12K", &cpu_set_size },\r |
| 286 | { UNIT_MSIZE, 16000, NULL, "16K", &cpu_set_size },\r |
| 287 | { MTAB_XTD|MTAB_VDV|MTAB_NMO|MTAB_SHP, 0, "HISTORY", "HISTORY",\r |
| 288 | &cpu_set_hist, &cpu_show_hist },\r |
| 289 | { MTAB_XTD|MTAB_VDV|MTAB_NMO, 0, "CONVERSIONS", "NEWCONVERSIONS",\r |
| 290 | &cpu_set_conv, &cpu_show_conv },\r |
| 291 | { MTAB_XTD|MTAB_VDV|MTAB_NMO, 1, NULL, "OLDCONVERSIONS",\r |
| 292 | &cpu_set_conv, NULL },\r |
| 293 | { 0 }\r |
| 294 | };\r |
| 295 | \r |
| 296 | DEVICE cpu_dev = {\r |
| 297 | "CPU", &cpu_unit, cpu_reg, cpu_mod,\r |
| 298 | 1, 10, 14, 1, 8, 7,\r |
| 299 | &cpu_ex, &cpu_dep, &cpu_reset,\r |
| 300 | NULL, NULL, NULL,\r |
| 301 | NULL, DEV_DEBUG\r |
| 302 | };\r |
| 303 | \r |
| 304 | /* Tables */\r |
| 305 | \r |
| 306 | /* Opcode table - length, dispatch, and option flags. This table is\r |
| 307 | used by the symbolic input routine to validate instruction lengths */\r |
| 308 | \r |
| 309 | const int32 op_table[64] = {\r |
| 310 | 0, /* 00: illegal */\r |
| 311 | L1 | L2 | L4 | L5, /* read */\r |
| 312 | L1 | L2 | L4 | L5, /* write */\r |
| 313 | L1 | L2 | L4 | L5, /* write and read */\r |
| 314 | L1 | L2 | L4 | L5, /* punch */\r |
| 315 | L1 | L4, /* read and punch */\r |
| 316 | L1 | L2 | L4 | L5, /* write and read */\r |
| 317 | L1 | L2 | L4 | L5, /* write, read, punch */\r |
| 318 | L1, /* 10: read feed */\r |
| 319 | L1, /* punch feed */\r |
| 320 | 0, /* illegal */\r |
| 321 | L1 | L4 | L7 | AREQ | BREQ | MA, /* modify address */\r |
| 322 | L1 | L4 | L7 | AREQ | BREQ | MDV, /* multiply */\r |
| 323 | 0, /* illegal */\r |
| 324 | 0, /* illegal */\r |
| 325 | 0, /* illegal */\r |
| 326 | 0, /* 20: illegal */\r |
| 327 | L1 | L4 | L7 | BREQ | NOWM, /* clear storage */\r |
| 328 | L1 | L4 | L7 | AREQ | BREQ, /* subtract */\r |
| 329 | 0, /* illegal */\r |
| 330 | L5 | IO, /* magtape */\r |
| 331 | L1 | L8 | BREQ, /* branch wm or zone */\r |
| 332 | L1 | L8 | BREQ | BBE, /* branch if bit eq */\r |
| 333 | 0, /* illegal */\r |
| 334 | L1 | L4 | L7 | AREQ | BREQ, /* 30: move zones */\r |
| 335 | L1 | L4 | L7 | AREQ | BREQ, /* move supress zero */\r |
| 336 | 0, /* illegal */\r |
| 337 | L1 | L4 | L7 | AREQ | BREQ | NOWM, /* set word mark */\r |
| 338 | L1 | L4 | L7 | AREQ | BREQ | MDV, /* divide */\r |
| 339 | 0, /* illegal */\r |
| 340 | 0, /* illegal */\r |
| 341 | 0, /* illegal */\r |
| 342 | 0, /* 40: illegal */\r |
| 343 | 0, /* illegal */\r |
| 344 | L2 | L5, /* select stacker */\r |
| 345 | L1 | L4 | L7 | L8 | BREQ | MLS | IO, /* load */\r |
| 346 | L1 | L4 | L7 | L8 | BREQ | MLS | IO, /* move */\r |
| 347 | HNOP | L1 | L2 | L4 | L5 | L7 | L8, /* nop */\r |
| 348 | 0, /* illegal */\r |
| 349 | L1 | L4 | L7 | AREQ | BREQ | MR, /* move to record */\r |
| 350 | L1 | L4 | AREQ | MLS, /* 50: store A addr */\r |
| 351 | 0, /* illegal */\r |
| 352 | L1 | L4 | L7 | AREQ | BREQ, /* zero and subtract */\r |
| 353 | 0, /* illegal */\r |
| 354 | 0, /* illegal */\r |
| 355 | 0, /* illegal */\r |
| 356 | 0, /* illegal */\r |
| 357 | 0, /* illegal */\r |
| 358 | 0, /* 60: illegal */\r |
| 359 | L1 | L4 | L7 | AREQ | BREQ, /* add */\r |
| 360 | L1 | L4 | L5 | L8, /* branch */\r |
| 361 | L1 | L4 | L7 | AREQ | BREQ, /* compare */\r |
| 362 | L1 | L4 | L7 | AREQ | BREQ, /* move numeric */\r |
| 363 | L1 | L4 | L7 | AREQ | BREQ, /* move char edit */\r |
| 364 | L2 | L5, /* carriage control */\r |
| 365 | 0, /* illegal */\r |
| 366 | L1 | L4 | L7 | AREQ | MLS, /* 70: store B addr */\r |
| 367 | 0, /* illegal */\r |
| 368 | L1 | L4 | L7 | AREQ | BREQ, /* zero and add */\r |
| 369 | HNOP | L1 | L2 | L4 | L5 | L7 | L8, /* halt */\r |
| 370 | L1 | L4 | L7 | AREQ | BREQ, /* clear word mark */\r |
| 371 | 0, /* illegal */\r |
| 372 | 0, /* illegal */\r |
| 373 | 0 /* illegal */\r |
| 374 | };\r |
| 375 | \r |
| 376 | const int32 len_table[9] = { 0, L1, L2, 0, L4, L5, 0, L7, L8 };\r |
| 377 | \r |
| 378 | /* Address character conversion tables. Illegal characters are marked by\r |
| 379 | the flag BA but also contain the post-adder value for indexing */\r |
| 380 | \r |
| 381 | const int32 hun_table[64] = {\r |
| 382 | BA+000, 100, 200, 300, 400, 500, 600, 700,\r |
| 383 | 800, 900, 000, BA+300, BA+400, BA+500, BA+600, BA+700,\r |
| 384 | BA+1000, 1100, 1200, 1300, 1400, 1500, 1600, 1700,\r |
| 385 | 1800, 1900, 1000, BA+1300, BA+1400, BA+1500, BA+1600, BA+1700,\r |
| 386 | BA+2000, 2100, 2200, 2300, 2400, 2500, 2600, 2700,\r |
| 387 | 2800, 2900, 2000, BA+2300, BA+2400, BA+2500, BA+2600, BA+2700,\r |
| 388 | BA+3000, 3100, 3200, 3300, 3400, 3500, 3600, 3700,\r |
| 389 | 3800, 3900, 3000, BA+3300, BA+3400, BA+3500, BA+3600, BA+3700\r |
| 390 | };\r |
| 391 | \r |
| 392 | const int32 ten_table[64] = {\r |
| 393 | BA+00, 10, 20, 30, 40, 50, 60, 70,\r |
| 394 | 80, 90, 00, BA+30, BA+40, BA+50, BA+60, BA+70,\r |
| 395 | X1+00, X1+10, X1+20, X1+30, X1+40, X1+50, X1+60, X1+70,\r |
| 396 | X1+80, X1+90, X1+00, X1+30, X1+40, X1+50, X1+60, X1+70,\r |
| 397 | X2+00, X2+10, X2+20, X2+30, X2+40, X2+50, X2+60, X2+70,\r |
| 398 | X2+80, X2+90, X2+00, X2+30, X2+40, X2+50, X2+60, X2+70,\r |
| 399 | X3+00, X3+10, X3+20, X3+30, X3+40, X3+50, X3+60, X3+70,\r |
| 400 | X3+80, X3+90, X3+00, X3+30, X3+40, X3+50, X3+60, X3+70\r |
| 401 | };\r |
| 402 | \r |
| 403 | const int32 one_table[64] = {\r |
| 404 | BA+0, 1, 2, 3, 4, 5, 6, 7,\r |
| 405 | 8, 9, 0, BA+3, BA+4, BA+5, BA+6, BA+7,\r |
| 406 | BA+4000, 4001, 4002, 4003, 4004, 4005, 4006, 4007,\r |
| 407 | 4008, 4009, 4000, BA+4003, BA+4004, BA+4005, BA+4006, BA+4007,\r |
| 408 | BA+8000, 8001, 8002, 8003, 8004, 8005, 8006, 8007,\r |
| 409 | 8008, 8009, 8000, BA+8003, BA+8004, BA+8005, BA+8006, BA+8007,\r |
| 410 | BA+12000, 12001, 12002, 12003, 12004, 12005, 12006, 12007,\r |
| 411 | 12008, 12009, 12000, BA+12003, BA+12004, BA+12005, BA+12006, BA+12007\r |
| 412 | };\r |
| 413 | \r |
| 414 | const int32 bin_to_bcd[16] = {\r |
| 415 | 10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15\r |
| 416 | };\r |
| 417 | \r |
| 418 | const int32 bcd_to_bin[16] = {\r |
| 419 | 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 3, 4, 5, 6, 7\r |
| 420 | };\r |
| 421 | \r |
| 422 | /* Indicator resets - a 1 marks an indicator that resets when tested */\r |
| 423 | \r |
| 424 | static const int32 ind_table[64] = {\r |
| 425 | 0, 0, 0, 0, 0, 0, 0, 0, /* 00 - 07 */\r |
| 426 | 0, 0, 0, 0, 0, 0, 0, 0, /* 10 - 17 */\r |
| 427 | 0, 0, 0, 0, 0, 0, 0, 0, /* 20 - 27 */\r |
| 428 | 0, 1, 1, 0, 1, 0, 0, 0, /* 30 - 37 */\r |
| 429 | 0, 0, 1, 0, 0, 0, 0, 0, /* 40 - 47 */\r |
| 430 | 0, 0, 1, 0, 1, 0, 0, 0, /* 50 - 57 */\r |
| 431 | 0, 0, 0, 0, 0, 0, 0, 0, /* 60 - 67 */\r |
| 432 | 0, 0, 1, 0, 0, 0, 0, 0 /* 70 - 77 */\r |
| 433 | };\r |
| 434 | \r |
| 435 | /* Character collation table for compare with HLE option */\r |
| 436 | \r |
| 437 | static const int32 col_table[64] = {\r |
| 438 | 000, 067, 070, 071, 072, 073, 074, 075,\r |
| 439 | 076, 077, 066, 024, 025, 026, 027, 030,\r |
| 440 | 023, 015, 056, 057, 060, 061, 062, 063,\r |
| 441 | 064, 065, 055, 016, 017, 020, 021, 022,\r |
| 442 | 014, 044, 045, 046, 047, 050, 051, 052,\r |
| 443 | 053, 054, 043, 007, 010, 011, 012, 013,\r |
| 444 | 006, 032, 033, 034, 035, 036, 037, 040,\r |
| 445 | 041, 042, 031, 001, 002, 003, 004, 005\r |
| 446 | };\r |
| 447 | \r |
| 448 | /* Summing table for two decimal digits, converted back to BCD\r |
| 449 | Also used for multiplying two decimal digits, converted back to BCD,\r |
| 450 | with carry forward\r |
| 451 | */\r |
| 452 | \r |
| 453 | static const int32 sum_table[100] = {\r |
| 454 | BCD_ZERO, BCD_ONE, BCD_TWO, BCD_THREE, BCD_FOUR,\r |
| 455 | BCD_FIVE, BCD_SIX, BCD_SEVEN, BCD_EIGHT, BCD_NINE,\r |
| 456 | BCD_ZERO, BCD_ONE, BCD_TWO, BCD_THREE, BCD_FOUR,\r |
| 457 | BCD_FIVE, BCD_SIX, BCD_SEVEN, BCD_EIGHT, BCD_NINE,\r |
| 458 | BCD_ZERO, BCD_ONE, BCD_TWO, BCD_THREE, BCD_FOUR,\r |
| 459 | BCD_FIVE, BCD_SIX, BCD_SEVEN, BCD_EIGHT, BCD_NINE,\r |
| 460 | BCD_ZERO, BCD_ONE, BCD_TWO, BCD_THREE, BCD_FOUR,\r |
| 461 | BCD_FIVE, BCD_SIX, BCD_SEVEN, BCD_EIGHT, BCD_NINE,\r |
| 462 | BCD_ZERO, BCD_ONE, BCD_TWO, BCD_THREE, BCD_FOUR,\r |
| 463 | BCD_FIVE, BCD_SIX, BCD_SEVEN, BCD_EIGHT, BCD_NINE,\r |
| 464 | BCD_ZERO, BCD_ONE, BCD_TWO, BCD_THREE, BCD_FOUR,\r |
| 465 | BCD_FIVE, BCD_SIX, BCD_SEVEN, BCD_EIGHT, BCD_NINE,\r |
| 466 | BCD_ZERO, BCD_ONE, BCD_TWO, BCD_THREE, BCD_FOUR,\r |
| 467 | BCD_FIVE, BCD_SIX, BCD_SEVEN, BCD_EIGHT, BCD_NINE,\r |
| 468 | BCD_ZERO, BCD_ONE, BCD_TWO, BCD_THREE, BCD_FOUR,\r |
| 469 | BCD_FIVE, BCD_SIX, BCD_SEVEN, BCD_EIGHT, BCD_NINE,\r |
| 470 | BCD_ZERO, BCD_ONE, BCD_TWO, BCD_THREE, BCD_FOUR,\r |
| 471 | BCD_FIVE, BCD_SIX, BCD_SEVEN, BCD_EIGHT, BCD_NINE,\r |
| 472 | BCD_ZERO, BCD_ONE, BCD_TWO, BCD_THREE, BCD_FOUR,\r |
| 473 | BCD_FIVE, BCD_SIX, BCD_SEVEN, BCD_EIGHT, BCD_NINE\r |
| 474 | };\r |
| 475 | \r |
| 476 | static const int32 cry_table[100] = {\r |
| 477 | 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\r |
| 478 | 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\r |
| 479 | 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,\r |
| 480 | 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,\r |
| 481 | 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,\r |
| 482 | 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,\r |
| 483 | 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,\r |
| 484 | 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,\r |
| 485 | 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,\r |
| 486 | 9, 9, 9, 9, 9, 9, 9, 9, 9, 9\r |
| 487 | };\r |
| 488 | \r |
| 489 | /* Legal modifier tables */\r |
| 490 | \r |
| 491 | static const int32 r_mod[] = { BCD_C, -1 };\r |
| 492 | static const int32 p_mod[] = { BCD_C, -1 };\r |
| 493 | static const int32 w_mod[] = { BCD_S, BCD_SQUARE, -1 };\r |
| 494 | static const int32 ss_mod[] = { BCD_ONE, BCD_TWO, BCD_FOUR, BCD_EIGHT,\r |
| 495 | BCD_DOLLAR, BCD_DECIMAL, BCD_SQUARE, -1 };\r |
| 496 | static const int32 mtf_mod[] = { BCD_B, BCD_E, BCD_M, BCD_R, BCD_U, -1 };\r |
| 497 | \r |
| 498 | t_stat sim_instr (void)\r |
| 499 | {\r |
| 500 | extern int32 sim_interval;\r |
| 501 | int32 IS, ilnt, flags;\r |
| 502 | int32 op, xa, t, wm, ioind, dev, unit;\r |
| 503 | int32 a, b, i, k, asave, bsave;\r |
| 504 | int32 carry, lowprd, sign, ps;\r |
| 505 | int32 quo, ahigh, qs;\r |
| 506 | int32 qzero, qawm, qbody, qsign, qdollar, qaster, qdecimal;\r |
| 507 | t_stat reason, r1, r2;\r |
| 508 | \r |
| 509 | /* Restore saved state */\r |
| 510 | \r |
| 511 | IS = saved_IS;\r |
| 512 | if (as_err) AS = AS | BA; /* flag bad addresses */\r |
| 513 | if (bs_err) BS = BS | BA;\r |
| 514 | as_err = bs_err = 0; /* reset error flags */\r |
| 515 | reason = 0;\r |
| 516 | \r |
| 517 | /* Main instruction fetch/decode loop */\r |
| 518 | \r |
| 519 | while (reason == 0) { /* loop until halted */\r |
| 520 | \r |
| 521 | if (hb_pend) { /* halt br pending? */\r |
| 522 | hb_pend = 0; /* clear flag */\r |
| 523 | BRANCH; /* execute branch */\r |
| 524 | }\r |
| 525 | \r |
| 526 | saved_IS = IS; /* commit prev instr */\r |
| 527 | if (sim_interval <= 0) { /* check clock queue */\r |
| 528 | if (reason = sim_process_event ()) break;\r |
| 529 | }\r |
| 530 | \r |
| 531 | if (sim_brk_summ && sim_brk_test (IS, SWMASK ('E'))) { /* breakpoint? */\r |
| 532 | reason = STOP_IBKPT; /* stop simulation */\r |
| 533 | break;\r |
| 534 | }\r |
| 535 | \r |
| 536 | sim_interval = sim_interval - 1;\r |
| 537 | \r |
| 538 | /* Instruction fetch - 1401 fetch works as follows:\r |
| 539 | \r |
| 540 | - Each character fetched enters the B register. This register is not\r |
| 541 | visible; the variable t represents the B register.\r |
| 542 | - Except for the first and last cycles, each character fetched enters\r |
| 543 | the A register. This register is not visible; the variable D represents\r |
| 544 | the A register, because this is the instruction modifier for 2, 5, and 8\r |
| 545 | character instructions.\r |
| 546 | - At the start of the second cycle (first address character), the A-address\r |
| 547 | register and, for most instructions, the B-address register, are cleared\r |
| 548 | to blanks. The simulator represents addresses in binary and creates the\r |
| 549 | effect of blanks (address is bad) if less than three A-address characters\r |
| 550 | are found. Further, the simulator accumulates only the A-address, and\r |
| 551 | replicates it to the B-address at the appropriate point.\r |
| 552 | - At the start of the fifth cycle (fourth address character), the B-address\r |
| 553 | register is cleared to blanks. Again, the simulator creates the effect of\r |
| 554 | blanks (address is bad) if less than three B-address characters are found.\r |
| 555 | \r |
| 556 | The 1401 does not explicitly check for valid instruction lengths. Most 2,\r |
| 557 | 3, 5, 6 character instructions will be invalid because the A-address or\r |
| 558 | B-address (or both) are invalid.\r |
| 559 | */\r |
| 560 | \r |
| 561 | if ((M[IS] & WM) == 0) { /* I-Op: WM under op? */\r |
| 562 | reason = STOP_NOWM; /* no, error */\r |
| 563 | break;\r |
| 564 | }\r |
| 565 | op = M[IS] & CHAR; /* get opcode */\r |
| 566 | flags = op_table[op]; /* get op flags */\r |
| 567 | if ((flags == 0) || (flags & ALLOPT & ~cpu_unit.flags)) {\r |
| 568 | reason = STOP_NXI; /* illegal inst? */\r |
| 569 | break;\r |
| 570 | }\r |
| 571 | if (op == OP_SAR) BS = AS; /* SAR? save ASTAR */\r |
| 572 | PP (IS);\r |
| 573 | \r |
| 574 | if ((t = M[IS]) & WM) goto CHECK_LENGTH; /* I-1: WM? 1 char inst */\r |
| 575 | D = ioind = t; /* could be D char, % */\r |
| 576 | AS = hun_table[t]; /* could be A addr */\r |
| 577 | PP (IS); /* if %xy, BA is set */\r |
| 578 | \r |
| 579 | if ((t = M[IS]) & WM) { /* I-2: WM? 2 char inst */\r |
| 580 | AS = AS | BA; /* ASTAR bad */\r |
| 581 | if (!(flags & MLS)) BS = AS;\r |
| 582 | goto CHECK_LENGTH;\r |
| 583 | }\r |
| 584 | D = dev = t; /* could be D char, dev */\r |
| 585 | AS = AS + ten_table[t]; /* build A addr */\r |
| 586 | PP (IS);\r |
| 587 | \r |
| 588 | if ((t = M[IS]) & WM) { /* I-3: WM? 3 char inst */\r |
| 589 | AS = AS | BA; /* ASTAR bad */\r |
| 590 | if (!(flags & MLS)) BS = AS;\r |
| 591 | goto CHECK_LENGTH;\r |
| 592 | }\r |
| 593 | D = unit = t; /* could be D char, unit */\r |
| 594 | if (unit == BCD_ZERO) unit = 0; /* convert unit to binary */\r |
| 595 | AS = AS + one_table[t]; /* finish A addr */\r |
| 596 | xa = (AS >> V_INDEX) & M_INDEX; /* get index reg */\r |
| 597 | if (xa && (ioind != BCD_PERCNT) && (cpu_unit.flags & XSA)) { /* indexed? */\r |
| 598 | AS = AS + hun_table[M[xa] & CHAR] + ten_table[M[xa + 1] & CHAR] +\r |
| 599 | one_table[M[xa + 2] & CHAR];\r |
| 600 | AS = (AS & INDEXMASK) % MAXMEMSIZE;\r |
| 601 | }\r |
| 602 | if (!(flags & MLS)) BS = AS; /* not MLS? B = A */\r |
| 603 | PP (IS);\r |
| 604 | \r |
| 605 | if ((t = M[IS]) & WM) goto CHECK_LENGTH; /* I-4: WM? 4 char inst */\r |
| 606 | if ((op == OP_B) && (t == BCD_BLANK)) /* BR + space? */\r |
| 607 | goto CHECK_LENGTH;\r |
| 608 | D = t; /* could be D char */\r |
| 609 | BS = hun_table[t]; /* could be B addr */\r |
| 610 | PP (IS);\r |
| 611 | \r |
| 612 | if ((t = M[IS]) & WM) { /* I-5: WM? 5 char inst */\r |
| 613 | BS = BS | BA; /* BSTAR bad */\r |
| 614 | goto CHECK_LENGTH;\r |
| 615 | }\r |
| 616 | D = t; /* could be D char */\r |
| 617 | BS = BS + ten_table[t]; /* build B addr */\r |
| 618 | PP (IS);\r |
| 619 | \r |
| 620 | if ((t = M[IS]) & WM) { /* I-6: WM? 6 char inst */\r |
| 621 | BS = BS | BA; /* BSTAR bad */\r |
| 622 | goto CHECK_LENGTH;\r |
| 623 | }\r |
| 624 | D = t; /* could be D char */\r |
| 625 | BS = BS + one_table[t]; /* finish B addr */\r |
| 626 | xa = (BS >> V_INDEX) & M_INDEX; /* get index reg */\r |
| 627 | if (xa && (cpu_unit.flags & XSA)) { /* indexed? */\r |
| 628 | BS = BS + hun_table[M[xa] & CHAR] + ten_table[M[xa + 1] & CHAR] +\r |
| 629 | one_table[M[xa + 2] & CHAR];\r |
| 630 | BS = (BS & INDEXMASK) % MAXMEMSIZE;\r |
| 631 | }\r |
| 632 | PP (IS);\r |
| 633 | \r |
| 634 | if (flags & NOWM) goto CHECK_LENGTH; /* I-7: SWM? done */\r |
| 635 | if ((t = M[IS]) & WM) goto CHECK_LENGTH; /* WM? 7 char inst */\r |
| 636 | D = t; /* last char is D */\r |
| 637 | while (((t = M[IS]) & WM) == 0) { /* I-8: repeats until WM */\r |
| 638 | D = t; /* last char is D */\r |
| 639 | PP (IS);\r |
| 640 | }\r |
| 641 | if (reason) break; /* addr err on last? */\r |
| 642 | \r |
| 643 | CHECK_LENGTH:\r |
| 644 | if ((flags & BREQ) && ADDR_ERR (BS)) { /* valid B? */\r |
| 645 | reason = STOP_INVB;\r |
| 646 | break;\r |
| 647 | }\r |
| 648 | if ((flags & AREQ) && ADDR_ERR (AS)) { /* valid A? */\r |
| 649 | reason = STOP_INVA;\r |
| 650 | break;\r |
| 651 | }\r |
| 652 | ilnt = IS - saved_IS; /* get lnt */\r |
| 653 | if (hst_lnt) { /* history enabled? */\r |
| 654 | hst_p = (hst_p + 1); /* next entry */\r |
| 655 | if (hst_p >= hst_lnt) hst_p = 0;\r |
| 656 | hst[hst_p].is = saved_IS; /* save IS */\r |
| 657 | hst[hst_p].ilnt = ilnt;\r |
| 658 | for (i = 0; (i < MAX_L) && (i < ilnt); i++)\r |
| 659 | hst[hst_p].inst[i] = M[saved_IS + i];\r |
| 660 | }\r |
| 661 | if (DEBUG_PRS (cpu_dev)) {\r |
| 662 | fprint_val (sim_deb, saved_IS, 10, 5, PV_RSPC);\r |
| 663 | fprintf (sim_deb, ": " );\r |
| 664 | for (i = 0; i < sim_emax; i++) sim_eval[i] = 0;\r |
| 665 | for (i = 0, k = saved_IS; i < sim_emax; i++, k++) {\r |
| 666 | if (cpu_ex (&sim_eval[i], k, &cpu_unit, 0) != SCPE_OK) break;\r |
| 667 | }\r |
| 668 | fprint_sym (sim_deb, saved_IS, sim_eval, &cpu_unit, SWMASK('M'));\r |
| 669 | fprintf (sim_deb, "\n" );\r |
| 670 | }\r |
| 671 | switch (op) { /* case on opcode */ \r |
| 672 | \r |
| 673 | /* Move/load character instructions A check B check\r |
| 674 | \r |
| 675 | MCW copy A to B, preserving B WM, here fetch\r |
| 676 | until either A or B WM\r |
| 677 | LCA copy A to B, overwriting B WM, here fetch\r |
| 678 | until A WM\r |
| 679 | \r |
| 680 | Instruction lengths:\r |
| 681 | \r |
| 682 | 1 chained A and B\r |
| 683 | 2,3 invalid A-address\r |
| 684 | 4 chained B address\r |
| 685 | 5,6 invalid B-address\r |
| 686 | 7 normal\r |
| 687 | 8+ normal + modifier\r |
| 688 | */\r |
| 689 | \r |
| 690 | case OP_MCW: /* move char */\r |
| 691 | if ((ilnt >= 4) && (ioind == BCD_PERCNT)) { /* I/O form? */\r |
| 692 | reason = iodisp (dev, unit, MD_NORM, D); /* dispatch I/O */\r |
| 693 | break;\r |
| 694 | }\r |
| 695 | if (ADDR_ERR (AS)) { /* check A addr */\r |
| 696 | reason = STOP_INVA;\r |
| 697 | break;\r |
| 698 | }\r |
| 699 | do {\r |
| 700 | wm = M[AS] | M[BS];\r |
| 701 | M[BS] = (M[BS] & WM) | (M[AS] & CHAR); /* move char */\r |
| 702 | MM (AS); /* decr pointers */\r |
| 703 | MM (BS);\r |
| 704 | } while ((wm & WM) == 0); /* stop on A,B WM */\r |
| 705 | break;\r |
| 706 | \r |
| 707 | case OP_LCA: /* load char */\r |
| 708 | if ((ilnt >= 4) && (ioind == BCD_PERCNT)) { /* I/O form? */\r |
| 709 | reason = iodisp (dev, unit, MD_WM, D);\r |
| 710 | break;\r |
| 711 | }\r |
| 712 | if (ADDR_ERR (AS)) { /* check A addr */\r |
| 713 | reason = STOP_INVA;\r |
| 714 | break;\r |
| 715 | }\r |
| 716 | do {\r |
| 717 | wm = M[BS] = M[AS]; /* move char + wmark */\r |
| 718 | MM (AS); /* decr pointers */\r |
| 719 | MM (BS);\r |
| 720 | } while ((wm & WM) == 0); /* stop on A WM */\r |
| 721 | break;\r |
| 722 | \r |
| 723 | /* Other move instructions A check B check\r |
| 724 | \r |
| 725 | MCM copy A to B, preserving B WM, fetch fetch\r |
| 726 | until record or group mark\r |
| 727 | MCS copy A to B, clearing B WM, until A WM; fetch fetch\r |
| 728 | reverse scan and suppress leading zeroes\r |
| 729 | MN copy A char digit to B char digit, fetch fetch\r |
| 730 | preserving B zone and WM\r |
| 731 | MZ copy A char zone to B char zone, fetch fetch\r |
| 732 | preserving B digit and WM\r |
| 733 | \r |
| 734 | Instruction lengths:\r |
| 735 | \r |
| 736 | 1 chained\r |
| 737 | 2,3 invalid A-address\r |
| 738 | 4 self (B-address = A-address)\r |
| 739 | 5,6 invalid B-address\r |
| 740 | 7 normal\r |
| 741 | 8+ normal + ignored modifier\r |
| 742 | */\r |
| 743 | \r |
| 744 | case OP_MCM: /* move to rec/group */\r |
| 745 | do {\r |
| 746 | t = M[AS];\r |
| 747 | M[BS] = (M[BS] & WM) | (M[AS] & CHAR); /* move char */\r |
| 748 | PP (AS); /* incr pointers */\r |
| 749 | PP (BS);\r |
| 750 | } while (((t & CHAR) != BCD_RECMRK) && (t != (BCD_GRPMRK + WM)));\r |
| 751 | break;\r |
| 752 | \r |
| 753 | case OP_MCS: /* move suppress zero */\r |
| 754 | bsave = BS; /* save B start */\r |
| 755 | qzero = 1; /* set suppress */\r |
| 756 | do {\r |
| 757 | wm = M[AS];\r |
| 758 | M[BS] = M[AS] & ((BS != bsave)? CHAR: DIGIT);/* copy char */\r |
| 759 | MM (AS); MM (BS); /* decr pointers */\r |
| 760 | } while ((wm & WM) == 0); /* stop on A WM */\r |
| 761 | if (reason) break; /* addr err? stop */\r |
| 762 | do {\r |
| 763 | PP (BS); /* adv B */\r |
| 764 | t = M[BS]; /* get B, cant be WM */\r |
| 765 | if ((t == BCD_ZERO) || (t == BCD_COMMA)) {\r |
| 766 | if (qzero) M[BS] = 0;\r |
| 767 | }\r |
| 768 | else if ((t == BCD_BLANK) || (t == BCD_MINUS)) ;\r |
| 769 | else if (((t == BCD_DECIMAL) && (cpu_unit.flags & EPE)) ||\r |
| 770 | (t <= BCD_NINE)) qzero = 0;\r |
| 771 | else qzero = 1;\r |
| 772 | } while (BS < bsave);\r |
| 773 | PP (BS); /* BS end is B+1 */\r |
| 774 | break; \r |
| 775 | \r |
| 776 | case OP_MN: /* move numeric */\r |
| 777 | M[BS] = (M[BS] & ~DIGIT) | (M[AS] & DIGIT); /* move digit */\r |
| 778 | MM (AS); /* decr pointers */\r |
| 779 | MM (BS);\r |
| 780 | break;\r |
| 781 | \r |
| 782 | case OP_MZ: /* move zone */\r |
| 783 | M[BS] = (M[BS] & ~ZONE) | (M[AS] & ZONE); /* move high bits */\r |
| 784 | MM (AS); /* decr pointers */\r |
| 785 | MM (BS);\r |
| 786 | break;\r |
| 787 | \r |
| 788 | /* Branch instruction A check B check\r |
| 789 | \r |
| 790 | Instruction lengths:\r |
| 791 | \r |
| 792 | 1 branch if B char equals d, chained if branch here\r |
| 793 | 2,3 invalid B-address if branch here\r |
| 794 | 4 unconditional branch if branch\r |
| 795 | 5 branch if indicator[d] is set if branch\r |
| 796 | 6 invalid B-address if branch here\r |
| 797 | 7 branch if B char equals d, if branch here\r |
| 798 | d is last character of B-address\r |
| 799 | 8 branch if B char equals d if branch here\r |
| 800 | */\r |
| 801 | \r |
| 802 | case OP_B: /* branch */\r |
| 803 | if (ilnt == 4) { BRANCH; } /* uncond branch? */\r |
| 804 | else if (ilnt == 5) { /* branch on ind? */\r |
| 805 | if (ind[D]) { BRANCH; } /* test indicator */\r |
| 806 | if (ind_table[D]) ind[D] = 0; /* reset if needed */\r |
| 807 | }\r |
| 808 | else { /* branch char eq */\r |
| 809 | if (ADDR_ERR (BS)) { /* validate B addr */\r |
| 810 | reason = STOP_INVB;\r |
| 811 | break;\r |
| 812 | }\r |
| 813 | if ((M[BS] & CHAR) == D) { BRANCH; } /* char equal? */\r |
| 814 | else { MM (BS); }\r |
| 815 | }\r |
| 816 | break;\r |
| 817 | \r |
| 818 | /* Other branch instructions A check B check\r |
| 819 | \r |
| 820 | BWZ branch if (d<0>: B char WM) if branch fetch\r |
| 821 | (d<1>: B char zone = d zone)\r |
| 822 | BBE branch if B char & d non-zero if branch fetch\r |
| 823 | \r |
| 824 | Instruction lengths:\r |
| 825 | 1 chained\r |
| 826 | 2,3 invalid A-address and B-address\r |
| 827 | 4 self (B-address = A-address, d = last character of A-address)\r |
| 828 | 5,6 invalid B-address\r |
| 829 | 7 normal, d = last character of B-address\r |
| 830 | 8+ normal\r |
| 831 | */\r |
| 832 | \r |
| 833 | case OP_BWZ: /* branch wm or zone */\r |
| 834 | if (((D & 1) && (M[BS] & WM)) || /* d1? test wm */\r |
| 835 | ((D & 2) && ((M[BS] & ZONE) == (D & ZONE)))) /* d2? test zone */\r |
| 836 | { BRANCH; }\r |
| 837 | else { MM (BS); } /* decr pointer */\r |
| 838 | break;\r |
| 839 | \r |
| 840 | case OP_BBE: /* branch if bit eq */\r |
| 841 | if (M[BS] & D & CHAR) { BRANCH; } /* any bits set? */\r |
| 842 | else { MM (BS); } /* decr pointer */\r |
| 843 | break;\r |
| 844 | \r |
| 845 | /* Arithmetic instructions A check B check\r |
| 846 | \r |
| 847 | ZA move A to B, normalizing A sign, fetch fetch\r |
| 848 | preserving B WM, until B WM\r |
| 849 | ZS move A to B, complementing A sign, fetch fetch\r |
| 850 | preserving B WM, until B WM\r |
| 851 | A add A to B fetch fetch\r |
| 852 | S subtract A from B fetch fetch\r |
| 853 | C compare A to B fetch fetch\r |
| 854 | \r |
| 855 | Instruction lengths:\r |
| 856 | \r |
| 857 | 1 chained\r |
| 858 | 2,3 invalid A-address\r |
| 859 | 4 self (B-address = A-address)\r |
| 860 | 5,6 invalid B-address\r |
| 861 | 7 normal\r |
| 862 | 8+ normal + ignored modifier\r |
| 863 | */\r |
| 864 | \r |
| 865 | case OP_ZA: case OP_ZS: /* zero and add/sub */\r |
| 866 | a = i = 0; /* clear flags */\r |
| 867 | do {\r |
| 868 | if (a & WM) wm = M[BS] = (M[BS] & WM) | BCD_ZERO;\r |
| 869 | else {\r |
| 870 | a = M[AS]; /* get A char */\r |
| 871 | t = (a & CHAR)? bin_to_bcd[a & DIGIT]: 0;\r |
| 872 | wm = M[BS] = (M[BS] & WM) | t; /* move digit */\r |
| 873 | MM (AS);\r |
| 874 | }\r |
| 875 | if (i == 0) i = M[BS] = M[BS] |\r |
| 876 | ((((a & ZONE) == BBIT) ^ (op == OP_ZS))? BBIT: ZONE);\r |
| 877 | MM (BS);\r |
| 878 | } while ((wm & WM) == 0); /* stop on B WM */\r |
| 879 | break;\r |
| 880 | \r |
| 881 | case OP_A: case OP_S: /* add/sub */\r |
| 882 | bsave = BS; /* save sign pos */\r |
| 883 | a = M[AS]; /* get A digit/sign */\r |
| 884 | b = M[BS]; /* get B digit/sign */\r |
| 885 | MM (AS);\r |
| 886 | qsign = ((a & ZONE) == BBIT) ^ ((b & ZONE) == BBIT) ^ (op == OP_S);\r |
| 887 | t = bcd_to_bin[a & DIGIT]; /* get A binary */\r |
| 888 | t = bcd_to_bin[b & DIGIT] + (qsign? 10 - t: t); /* sum A + B */\r |
| 889 | carry = (t >= 10); /* get carry */\r |
| 890 | b = (b & ~DIGIT) | sum_table[t]; /* get result */\r |
| 891 | if (qsign && ((b & BBIT) == 0)) b = b | ZONE; /* normalize sign */\r |
| 892 | M[BS] = b; /* store result */\r |
| 893 | MM (BS);\r |
| 894 | if (b & WM) { /* b wm? done */\r |
| 895 | if (qsign && (carry == 0)) M[bsave] = /* compl, no carry? */\r |
| 896 | WM + ((b & ZONE) ^ ABIT) + sum_table[10 - t];\r |
| 897 | break;\r |
| 898 | }\r |
| 899 | do {\r |
| 900 | if (a & WM) a = WM; /* A WM? char = 0 */\r |
| 901 | else {\r |
| 902 | a = M[AS]; /* else get A */\r |
| 903 | MM (AS);\r |
| 904 | }\r |
| 905 | b = M[BS]; /* get B */\r |
| 906 | t = bcd_to_bin[a & DIGIT]; /* get A binary */\r |
| 907 | t = bcd_to_bin[b & DIGIT] + (qsign? 9 - t: t) + carry;\r |
| 908 | carry = (t >= 10); /* get carry */\r |
| 909 | if ((b & WM) && (qsign == 0)) { /* last, no recomp? */\r |
| 910 | M[BS] = WM + sum_table[t] + /* zone add */\r |
| 911 | (((a & ZONE) + b + (carry? ABIT: 0)) & ZONE);\r |
| 912 | ind[IN_OVF] = carry; /* ovflo if carry */\r |
| 913 | }\r |
| 914 | else M[BS] = (b & WM) + sum_table[t]; /* normal add */\r |
| 915 | MM (BS);\r |
| 916 | } while ((b & WM) == 0); /* stop on B WM */\r |
| 917 | if (reason) break; /* address err? */\r |
| 918 | if (qsign && (carry == 0)) { /* recompl, no carry? */\r |
| 919 | M[bsave] = M[bsave] ^ ABIT; /* XOR sign */\r |
| 920 | for (carry = 1; bsave != BS; --bsave) { /* rescan */\r |
| 921 | t = 9 - bcd_to_bin[M[bsave] & DIGIT] + carry;\r |
| 922 | carry = (t >= 10);\r |
| 923 | M[bsave] = (M[bsave] & ~DIGIT) | sum_table[t];\r |
| 924 | }\r |
| 925 | }\r |
| 926 | break;\r |
| 927 | \r |
| 928 | case OP_C: /* compare */\r |
| 929 | if (ilnt != 1) { /* if not chained */\r |
| 930 | ind[IN_EQU] = 1; /* clear indicators */\r |
| 931 | ind[IN_UNQ] = ind[IN_HGH] = ind[IN_LOW] = 0;\r |
| 932 | }\r |
| 933 | do {\r |
| 934 | a = M[AS]; /* get characters */\r |
| 935 | b = M[BS];\r |
| 936 | wm = a | b; /* get word marks */\r |
| 937 | if ((a & CHAR) != (b & CHAR)) { /* unequal? */\r |
| 938 | ind[IN_EQU] = 0; /* set indicators */\r |
| 939 | ind[IN_UNQ] = 1;\r |
| 940 | ind[IN_HGH] = col_table[b & CHAR] > col_table [a & CHAR];\r |
| 941 | ind[IN_LOW] = ind[IN_HGH] ^ 1;\r |
| 942 | }\r |
| 943 | MM (AS); MM (BS); /* decr pointers */\r |
| 944 | } while ((wm & WM) == 0); /* stop on A, B WM */\r |
| 945 | if ((a & WM) && !(b & WM)) { /* short A field? */\r |
| 946 | ind[IN_EQU] = ind[IN_LOW] = 0;\r |
| 947 | ind[IN_UNQ] = ind[IN_HGH] = 1;\r |
| 948 | }\r |
| 949 | if (!(cpu_unit.flags & HLE)) /* no HLE? */\r |
| 950 | ind[IN_EQU] = ind[IN_LOW] = ind[IN_HGH] = 0;\r |
| 951 | break;\r |
| 952 | \r |
| 953 | /* I/O instructions A check B check\r |
| 954 | \r |
| 955 | R read a card if branch\r |
| 956 | W write to line printer if branch\r |
| 957 | WR write and read if branch\r |
| 958 | P punch a card if branch\r |
| 959 | RP read and punch if branch\r |
| 960 | WP : write and punch if branch\r |
| 961 | WRP write read and punch if branch\r |
| 962 | RF read feed (nop)\r |
| 963 | PF punch feed (nop)\r |
| 964 | SS select stacker if branch\r |
| 965 | CC carriage control if branch\r |
| 966 | \r |
| 967 | Instruction lengths:\r |
| 968 | \r |
| 969 | 1 normal\r |
| 970 | 2,3 normal, with modifier\r |
| 971 | 4 branch; modifier, if any, is last character of branch address\r |
| 972 | 5 branch + modifier\r |
| 973 | 6+ normal, with modifier\r |
| 974 | */\r |
| 975 | \r |
| 976 | case OP_R: /* read */\r |
| 977 | if (reason = iomod (ilnt, D, r_mod)) break; /* valid modifier? */\r |
| 978 | reason = read_card (ilnt, D); /* read card */\r |
| 979 | BS = CDR_BUF + CDR_WIDTH;\r |
| 980 | if ((ilnt == 4) || (ilnt == 5)) { BRANCH; } /* check for branch */\r |
| 981 | break;\r |
| 982 | \r |
| 983 | case OP_W: /* write */\r |
| 984 | if (reason = iomod (ilnt, D, w_mod)) break; /* valid modifier? */\r |
| 985 | reason = write_line (ilnt, D); /* print line */\r |
| 986 | BS = LPT_BUF + LPT_WIDTH;\r |
| 987 | if ((ilnt == 4) || (ilnt == 5)) { BRANCH; } /* check for branch */\r |
| 988 | break;\r |
| 989 | \r |
| 990 | case OP_P: /* punch */\r |
| 991 | if (reason = iomod (ilnt, D, p_mod)) break; /* valid modifier? */\r |
| 992 | reason = punch_card (ilnt, D); /* punch card */\r |
| 993 | BS = CDP_BUF + CDP_WIDTH;\r |
| 994 | if ((ilnt == 4) || (ilnt == 5)) { BRANCH; } /* check for branch */\r |
| 995 | break;\r |
| 996 | \r |
| 997 | case OP_WR: /* write and read */\r |
| 998 | if (reason = iomod (ilnt, D, w_mod)) break; /* valid modifier? */\r |
| 999 | reason = write_line (ilnt, D); /* print line */\r |
| 1000 | r1 = read_card (ilnt, D); /* read card */\r |
| 1001 | BS = CDR_BUF + CDR_WIDTH;\r |
| 1002 | if ((ilnt == 4) || (ilnt == 5)) { BRANCH; } /* check for branch */\r |
| 1003 | if (reason == SCPE_OK) reason = r1; /* merge errors */\r |
| 1004 | break;\r |
| 1005 | \r |
| 1006 | case OP_WP: /* write and punch */\r |
| 1007 | if (reason = iomod (ilnt, D, w_mod)) break; /* valid modifier? */\r |
| 1008 | reason = write_line (ilnt, D); /* print line */\r |
| 1009 | r1 = punch_card (ilnt, D); /* punch card */\r |
| 1010 | BS = CDP_BUF + CDP_WIDTH;\r |
| 1011 | if ((ilnt == 4) || (ilnt == 5)) { BRANCH; } /* check for branch */\r |
| 1012 | if (reason == SCPE_OK) reason = r1; /* merge errors */\r |
| 1013 | break;\r |
| 1014 | \r |
| 1015 | case OP_RP: /* read and punch */\r |
| 1016 | if (reason = iomod (ilnt, D, NULL)) break; /* valid modifier? */\r |
| 1017 | reason = read_card (ilnt, D); /* read card */\r |
| 1018 | r1 = punch_card (ilnt, D); /* punch card */\r |
| 1019 | BS = CDP_BUF + CDP_WIDTH; \r |
| 1020 | if ((ilnt == 4) || (ilnt == 5)) { BRANCH; } /* check for branch */\r |
| 1021 | if (reason == SCPE_OK) reason = r1; /* merge errors */\r |
| 1022 | break;\r |
| 1023 | \r |
| 1024 | case OP_WRP: /* write, read, punch */\r |
| 1025 | if (reason = iomod (ilnt, D, w_mod)) break; /* valid modifier? */\r |
| 1026 | reason = write_line (ilnt, D); /* print line */\r |
| 1027 | r1 = read_card (ilnt, D); /* read card */\r |
| 1028 | r2 = punch_card (ilnt, D); /* punch card */\r |
| 1029 | BS = CDP_BUF + CDP_WIDTH;\r |
| 1030 | if ((ilnt == 4) || (ilnt == 5)) { BRANCH; } /* check for branch */\r |
| 1031 | if (reason == SCPE_OK) reason = (r1 == SCPE_OK)? r2: r1;\r |
| 1032 | break;\r |
| 1033 | \r |
| 1034 | case OP_SS: /* select stacker */\r |
| 1035 | if (reason = iomod (ilnt, D, ss_mod)) break; /* valid modifier? */\r |
| 1036 | if (reason = select_stack (D)) break; /* sel stack, error? */\r |
| 1037 | if ((ilnt == 4) || (ilnt == 5)) { BRANCH; } /* check for branch */\r |
| 1038 | break;\r |
| 1039 | \r |
| 1040 | case OP_CC: /* carriage control */\r |
| 1041 | if (reason = carriage_control (D)) break; /* car ctrl, error? */\r |
| 1042 | if ((ilnt == 4) || (ilnt == 5)) { BRANCH; } /* check for branch */\r |
| 1043 | break;\r |
| 1044 | \r |
| 1045 | /* MTF - magtape functions - must be at least 4 characters\r |
| 1046 | \r |
| 1047 | Instruction lengths:\r |
| 1048 | \r |
| 1049 | 1-3 invalid I/O address\r |
| 1050 | 4 normal, d-character is unit\r |
| 1051 | 5 normal\r |
| 1052 | 6+ normal, d-character is last character\r |
| 1053 | */\r |
| 1054 | \r |
| 1055 | case OP_MTF: /* magtape function */\r |
| 1056 | if (ilnt < 4) reason = STOP_INVL; /* too short? */\r |
| 1057 | else if (ioind != BCD_PERCNT) reason = STOP_INVA;\r |
| 1058 | else if (reason = iomod (ilnt, D, mtf_mod)) break; /* valid modifier? */\r |
| 1059 | reason = mt_func (unit, D); /* mt func, error? */\r |
| 1060 | break; /* can't branch */\r |
| 1061 | \r |
| 1062 | case OP_RF: case OP_PF: /* read, punch feed */\r |
| 1063 | break; /* nop's */\r |
| 1064 | \r |
| 1065 | /* Move character and edit\r |
| 1066 | \r |
| 1067 | Control flags\r |
| 1068 | qsign sign of A field (0 = +, 1 = minus)\r |
| 1069 | qawm A field WM seen and processed\r |
| 1070 | qzero zero suppression enabled\r |
| 1071 | qbody in body (copying A field characters)\r |
| 1072 | qdollar EPE only; $ seen in body\r |
| 1073 | qaster EPE only; * seen in body\r |
| 1074 | qdecimal EPE only; . seen on first rescan\r |
| 1075 | \r |
| 1076 | MCE operates in one to three scans, the first of which has three phases\r |
| 1077 | \r |
| 1078 | 1 right to left qbody = 0, qawm = 0 => right status\r |
| 1079 | qbody = 1, qawm = 0 => body\r |
| 1080 | qbody = 0, qawm = 1 => left status\r |
| 1081 | 2 left to right\r |
| 1082 | 3 right to left, extended print end only\r |
| 1083 | \r |
| 1084 | The first A field character is masked to its digit part, all others\r |
| 1085 | are copied intact \r |
| 1086 | \r |
| 1087 | Instruction lengths:\r |
| 1088 | \r |
| 1089 | 1 chained\r |
| 1090 | 2,3 invalid A-address\r |
| 1091 | 4 self (B-address = A-address)\r |
| 1092 | 5,6 invalid B-address\r |
| 1093 | 7 normal\r |
| 1094 | 8+ normal + ignored modifier\r |
| 1095 | */\r |
| 1096 | \r |
| 1097 | case OP_MCE: /* edit */\r |
| 1098 | a = M[AS]; /* get A char */\r |
| 1099 | b = M[BS]; /* get B char */\r |
| 1100 | t = a & DIGIT; /* get A digit */\r |
| 1101 | MM (AS);\r |
| 1102 | qsign = ((a & ZONE) == BBIT); /* get A field sign */\r |
| 1103 | qawm = qzero = qbody = 0; /* clear other flags */\r |
| 1104 | qdollar = qaster = qdecimal = 0; /* clear EPE flags */\r |
| 1105 | \r |
| 1106 | /* Edit pass 1 - from right to left, under B field control\r |
| 1107 | \r |
| 1108 | * in status or !epe, skip B; else, set qaster, repl with A\r |
| 1109 | $ in status or !epe, skip B; else, set qdollar, repl with A\r |
| 1110 | 0 in right status or body, if !qzero, set A WM; set qzero, repl with A\r |
| 1111 | else, if !qzero, skip B; else, if (!B WM) set B WM \r |
| 1112 | blank in right status or body, repl with A; else, skip B\r |
| 1113 | C,R,- in status, blank B; else, skip B\r |
| 1114 | , in status, blank B, else, skip B\r |
| 1115 | & blank B\r |
| 1116 | */\r |
| 1117 | \r |
| 1118 | do {\r |
| 1119 | b = M[BS]; /* get B char */\r |
| 1120 | M[BS] = M[BS] & ~WM; /* clr WM */\r |
| 1121 | switch (b & CHAR) { /* case on B char */\r |
| 1122 | \r |
| 1123 | case BCD_ASTER: /* * */\r |
| 1124 | if (!qbody || qdollar || !(cpu_unit.flags & EPE)) break;\r |
| 1125 | qaster = 1; /* flag */\r |
| 1126 | goto A_CYCLE; /* take A cycle */\r |
| 1127 | \r |
| 1128 | case BCD_DOLLAR: /* $ */\r |
| 1129 | if (!qbody || qaster || !(cpu_unit.flags & EPE)) break;\r |
| 1130 | qdollar = 1; /* flag */\r |
| 1131 | goto A_CYCLE; /* take A cycle */\r |
| 1132 | \r |
| 1133 | case BCD_ZERO: /* 0 */\r |
| 1134 | if (qawm) { /* left status? */\r |
| 1135 | if (!qzero) M[BS] = M[BS] | WM; /* first? set WM */\r |
| 1136 | qzero = 1; /* flag suppress */\r |
| 1137 | break;\r |
| 1138 | }\r |
| 1139 | if (!qzero) t = t | WM; /* body, first? WM */\r |
| 1140 | qzero = 1; /* flag suppress */\r |
| 1141 | goto A_CYCLE; /* take A cycle */\r |
| 1142 | \r |
| 1143 | case BCD_BLANK: /* blank */\r |
| 1144 | if (qawm) break; /* left status? */\r |
| 1145 | A_CYCLE:\r |
| 1146 | M[BS] = t; /* copy char */\r |
| 1147 | if (a & WM) { /* end of A field? */\r |
| 1148 | qbody = 0; /* end body */\r |
| 1149 | qawm = 1; /* start left status */\r |
| 1150 | }\r |
| 1151 | else {\r |
| 1152 | qbody = 1; /* in body */\r |
| 1153 | a = M[AS]; /* next A */\r |
| 1154 | MM (AS);\r |
| 1155 | t = a & CHAR; /* use A char */\r |
| 1156 | }\r |
| 1157 | break;\r |
| 1158 | \r |
| 1159 | case BCD_C: case BCD_R: case BCD_MINUS: /* C, R, - */\r |
| 1160 | if (!qsign && !qbody) M[BS] = BCD_BLANK; /* + & status? blank */\r |
| 1161 | break;\r |
| 1162 | \r |
| 1163 | case BCD_COMMA: /* , */\r |
| 1164 | if (!qbody) M[BS] = BCD_BLANK; /* status? blank */\r |
| 1165 | break;\r |
| 1166 | \r |
| 1167 | case BCD_AMPER: /* & */\r |
| 1168 | M[BS] = BCD_BLANK; /* blank */\r |
| 1169 | break;\r |
| 1170 | } /* end switch */\r |
| 1171 | \r |
| 1172 | MM (BS); /* decr B pointer */\r |
| 1173 | } while ((b & WM) == 0); /* stop on B WM */\r |
| 1174 | \r |
| 1175 | if (reason) break; /* address err? */\r |
| 1176 | if (!qzero) break; /* rescan? */\r |
| 1177 | \r |
| 1178 | /* Edit pass 2 - from left to right, suppressing zeroes */\r |
| 1179 | \r |
| 1180 | do {\r |
| 1181 | b = M[++BS]; /* get B char */\r |
| 1182 | switch (b & CHAR) { /* case on B char */\r |
| 1183 | \r |
| 1184 | case BCD_ONE: case BCD_TWO: case BCD_THREE:\r |
| 1185 | case BCD_FOUR: case BCD_FIVE: case BCD_SIX:\r |
| 1186 | case BCD_SEVEN: case BCD_EIGHT: case BCD_NINE:\r |
| 1187 | qzero = 0; /* turn off supr */\r |
| 1188 | break;\r |
| 1189 | \r |
| 1190 | case BCD_ZERO: case BCD_COMMA: /* 0 or , */\r |
| 1191 | if (qzero && !qdecimal) /* if supr, blank */\r |
| 1192 | M[BS] = qaster? BCD_ASTER: BCD_BLANK;\r |
| 1193 | break;\r |
| 1194 | \r |
| 1195 | case BCD_BLANK: /* blank */\r |
| 1196 | if (qaster) M[BS] = BCD_ASTER; /* if EPE *, repl */\r |
| 1197 | break;\r |
| 1198 | \r |
| 1199 | case BCD_DECIMAL: /* . */\r |
| 1200 | if (qzero && (cpu_unit.flags & EPE)) /* flag for EPE */\r |
| 1201 | qdecimal = 1;\r |
| 1202 | break;\r |
| 1203 | \r |
| 1204 | case BCD_PERCNT: case BCD_WM: case BCD_BS:\r |
| 1205 | case BCD_TS: case BCD_MINUS:\r |
| 1206 | break; /* ignore */\r |
| 1207 | \r |
| 1208 | default: /* other */\r |
| 1209 | qzero = 1; /* restart supr */\r |
| 1210 | break;\r |
| 1211 | } /* end case */\r |
| 1212 | } while ((b & WM) == 0);\r |
| 1213 | \r |
| 1214 | M[BS] = M[BS] & ~WM; /* clear B WM */\r |
| 1215 | if (!qdollar && !(qdecimal && qzero)) { /* rescan again? */\r |
| 1216 | BS++; /* BS = addr WM + 1 */\r |
| 1217 | break;\r |
| 1218 | }\r |
| 1219 | if (qdecimal && qzero) qdollar = 0; /* no digits? clr $ */\r |
| 1220 | \r |
| 1221 | /* Edit pass 3 (extended print only) - from right to left */\r |
| 1222 | \r |
| 1223 | for (;; ) { /* until chars */\r |
| 1224 | b = M[BS]; /* get B char */\r |
| 1225 | if ((b == BCD_BLANK) && qdollar) { /* blank & flt $? */\r |
| 1226 | M[BS] = BCD_DOLLAR; /* insert $ */\r |
| 1227 | break; /* exit for */\r |
| 1228 | }\r |
| 1229 | if (b == BCD_DECIMAL) { /* decimal? */\r |
| 1230 | M[BS] = qaster? BCD_ASTER: BCD_BLANK;\r |
| 1231 | break; /* exit for */\r |
| 1232 | }\r |
| 1233 | if ((b == BCD_ZERO) && !qdollar) /* 0 & ~flt $ */\r |
| 1234 | M[BS] = qaster? BCD_ASTER: BCD_BLANK;\r |
| 1235 | BS--;\r |
| 1236 | } /* end for */\r |
| 1237 | break; /* done at last! */ \r |
| 1238 | \r |
| 1239 | /* Multiply. Comments from the PDP-10 based simulator by Len Fehskens.\r |
| 1240 | \r |
| 1241 | Multiply, with variable length operands, is necessarily done the same\r |
| 1242 | way you do it with paper and pencil, except that partial products are\r |
| 1243 | added into the incomplete final product as they are computed, rather\r |
| 1244 | than at the end. The 1401 multiplier format allows the product to\r |
| 1245 | be developed in place, without scratch storage.\r |
| 1246 | \r |
| 1247 | The A field contains the multiplicand, length LD. The B field must be\r |
| 1248 | LD + 1 + length of multiplier. Locate the low order multiplier digit,\r |
| 1249 | and at the same time zero out the product field. Then compute the sign\r |
| 1250 | of the result.\r |
| 1251 | \r |
| 1252 | Instruction lengths:\r |
| 1253 | \r |
| 1254 | 1 chained\r |
| 1255 | 2,3 invalid A-address\r |
| 1256 | 4 self (B-address = A-address)\r |
| 1257 | 5,6 invalid B-address\r |
| 1258 | 7 normal\r |
| 1259 | 8+ normal + ignored modifier\r |
| 1260 | */\r |
| 1261 | \r |
| 1262 | case OP_MUL:\r |
| 1263 | asave = AS; /* save AS, BS */\r |
| 1264 | bsave = lowprd = BS;\r |
| 1265 | do {\r |
| 1266 | a = M[AS]; /* get mpcd char */\r |
| 1267 | M[BS] = BCD_ZERO; /* zero prod */\r |
| 1268 | MM (AS); /* decr pointers */\r |
| 1269 | MM (BS);\r |
| 1270 | } while ((a & WM) == 0); /* until A WM */\r |
| 1271 | if (reason) break; /* address err? */\r |
| 1272 | M[BS] = BCD_ZERO; /* zero hi prod */\r |
| 1273 | MM (BS); /* addr low mpyr */\r |
| 1274 | sign = ((M[asave] & ZONE) == BBIT) ^ ((M[BS] & ZONE) == BBIT);\r |
| 1275 | \r |
| 1276 | /* Outer loop on multiplier (BS) and product digits (ps),\r |
| 1277 | inner loop on multiplicand digits (AS).\r |
| 1278 | AS and ps cannot produce an address error.\r |
| 1279 | */\r |
| 1280 | \r |
| 1281 | do {\r |
| 1282 | ps = bsave; /* ptr to prod */\r |
| 1283 | AS = asave; /* ptr to mpcd */\r |
| 1284 | carry = 0; /* init carry */\r |
| 1285 | b = M[BS]; /* get mpyr char */\r |
| 1286 | do {\r |
| 1287 | a = M[AS]; /* get mpcd char */\r |
| 1288 | t = (bcd_to_bin[a & DIGIT] * /* mpyr * mpcd */\r |
| 1289 | bcd_to_bin[b & DIGIT]) + /* + c + partial prod */\r |
| 1290 | carry + bcd_to_bin[M[ps] & DIGIT];\r |
| 1291 | carry = cry_table[t];\r |
| 1292 | M[ps] = (M[ps] & WM) | sum_table[t];\r |
| 1293 | MM (AS);\r |
| 1294 | ps--;\r |
| 1295 | } while ((a & WM) == 0); /* until mpcd done */\r |
| 1296 | M[BS] = (M[BS] & WM) | BCD_ZERO; /* zero mpyr just used */\r |
| 1297 | t = bcd_to_bin[M[ps] & DIGIT] + carry; /* add carry to prod */\r |
| 1298 | M[ps] = (M[ps] & WM) | sum_table[t]; /* store */\r |
| 1299 | bsave--; /* adv prod ptr */\r |
| 1300 | MM (BS); /* adv mpyr ptr */\r |
| 1301 | } while ((b & WM) == 0); /* until mpyr done */\r |
| 1302 | M[lowprd] = M[lowprd] | ZONE; /* assume + */\r |
| 1303 | if (sign) M[lowprd] = M[lowprd] & ~ABIT; /* if minus, B only */\r |
| 1304 | break; \r |
| 1305 | \r |
| 1306 | /* Divide. Comments from the PDP-10 based simulator by Len Fehskens.\r |
| 1307 | \r |
| 1308 | Divide is done, like multiply, pretty much the same way you do it with\r |
| 1309 | pencil and paper; successive subtraction of the divisor from a substring\r |
| 1310 | of the dividend while counting up the corresponding quotient digit.\r |
| 1311 | \r |
| 1312 | Let LS be the length of the divisor, LD the length of the dividend:\r |
| 1313 | - AS points to the low order divisor digit.\r |
| 1314 | - BS points to the high order dividend digit.\r |
| 1315 | - The low order dividend digit is identified by sign (zone) bits.\r |
| 1316 | - To the left of the dividend is a zero field of length LS + 1.\r |
| 1317 | The low quotient is at low dividend - LS - 1. As BS points to the\r |
| 1318 | high dividend, the low dividend is at BS + LD - 1, so the low\r |
| 1319 | quotient is at BS + LD - LS - 2. The longest possible quotient is\r |
| 1320 | LD - LS + 1, so the first possible non-zero quotient bit will be\r |
| 1321 | found as BS - 2.\r |
| 1322 | \r |
| 1323 | This pointer calculation assumes that the divisor has no leading zeroes.\r |
| 1324 | For each leading zero, the start of the quotient will be one position\r |
| 1325 | further left.\r |
| 1326 | \r |
| 1327 | Start by locating the high order non-zero digit of the divisor. This\r |
| 1328 | also tests for a divide by zero.\r |
| 1329 | \r |
| 1330 | Instruction lengths:\r |
| 1331 | \r |
| 1332 | 1 chained\r |
| 1333 | 2,3 invalid A-address\r |
| 1334 | 4 self (B-address = A-address)\r |
| 1335 | 5,6 invalid B-address\r |
| 1336 | 7 normal\r |
| 1337 | 8+ normal + ignored modifier\r |
| 1338 | */\r |
| 1339 | \r |
| 1340 | case OP_DIV:\r |
| 1341 | asave = AS;\r |
| 1342 | ahigh = -1;\r |
| 1343 | do {\r |
| 1344 | a = M[AS]; /* get dvr char */\r |
| 1345 | if ((a & CHAR) != BCD_ZERO) ahigh = AS; /* mark non-zero */\r |
| 1346 | MM (AS);\r |
| 1347 | }\r |
| 1348 | while ((a & WM) == 0);\r |
| 1349 | if (reason) break; /* address err? */\r |
| 1350 | if (ahigh < 0) { /* div by zero? */\r |
| 1351 | ind[IN_OVF] = 1; /* set ovf indic */\r |
| 1352 | qs = bsave = BS; /* quo, dividend */\r |
| 1353 | do {\r |
| 1354 | b = M[bsave]; /* find end divd */\r |
| 1355 | PP (bsave); /* marked by zone */\r |
| 1356 | } while ((b & ZONE) == 0);\r |
| 1357 | if (reason) break; /* address err? */\r |
| 1358 | if (ADDR_ERR (qs)) { /* address err? */\r |
| 1359 | reason = STOP_WRAP; /* address wrap? */\r |
| 1360 | break;\r |
| 1361 | }\r |
| 1362 | div_sign (M[asave], b, qs - 1, bsave - 1); /* set signs */\r |
| 1363 | BS = (BS - 2) - (asave - (AS + 1)); /* final bs */\r |
| 1364 | break;\r |
| 1365 | }\r |
| 1366 | bsave = BS + (asave - ahigh); /* end subdivd */\r |
| 1367 | qs = (BS - 2) - (ahigh - (AS + 1)); /* quo start */\r |
| 1368 | \r |
| 1369 | /* Divide loop - done with subroutines to keep the code clean.\r |
| 1370 | In the loop,\r |
| 1371 | \r |
| 1372 | asave = low order divisor\r |
| 1373 | bsave = low order subdividend\r |
| 1374 | qs = current quotient digit\r |
| 1375 | */\r |
| 1376 | \r |
| 1377 | do {\r |
| 1378 | quo = 0; /* clear quo digit */\r |
| 1379 | if (ADDR_ERR (qs) || ADDR_ERR (bsave)) {\r |
| 1380 | reason = STOP_WRAP; /* address wrap? */\r |
| 1381 | break;\r |
| 1382 | }\r |
| 1383 | b = M[bsave]; /* save low divd */\r |
| 1384 | do {\r |
| 1385 | t = div_sub (asave, bsave, ahigh); /* subtract */\r |
| 1386 | quo++; /* incr quo digit */\r |
| 1387 | } while (t == 0); /* until borrow */\r |
| 1388 | div_add (asave, bsave, ahigh); /* restore */\r |
| 1389 | quo--;\r |
| 1390 | M[qs] = (M[qs] & WM) | sum_table[quo]; /* store quo digit */\r |
| 1391 | bsave++; /* adv divd, quo */\r |
| 1392 | qs++;\r |
| 1393 | } while ((b & ZONE) == 0); /* until B sign */\r |
| 1394 | if (reason) break; /* address err? */\r |
| 1395 | \r |
| 1396 | /* At this point,\r |
| 1397 | \r |
| 1398 | AS = high order divisor - 1\r |
| 1399 | asave = unit position of divisor\r |
| 1400 | b = unit character of dividend\r |
| 1401 | bsave = unit position of remainder + 1\r |
| 1402 | qs = unit position of quotient + 1\r |
| 1403 | */\r |
| 1404 | \r |
| 1405 | div_sign (M[asave], b, qs - 1, bsave - 1); /* set signs */\r |
| 1406 | BS = qs - 2; /* BS = quo 10's pos */\r |
| 1407 | break;\r |
| 1408 | \r |
| 1409 | /* Word mark instructions A check B check\r |
| 1410 | \r |
| 1411 | SWM set WM on A char and B char fetch fetch\r |
| 1412 | CWM clear WM on A char and B char fetch fetch\r |
| 1413 | \r |
| 1414 | Instruction lengths:\r |
| 1415 | \r |
| 1416 | 1 chained\r |
| 1417 | 2,3 invalid A-address\r |
| 1418 | 4 one operand (B-address = A-address)\r |
| 1419 | 5,6 invalid B-address\r |
| 1420 | 7 two operands (SWM cannot be longer than 7)\r |
| 1421 | 8+ two operands + ignored modifier\r |
| 1422 | */\r |
| 1423 | \r |
| 1424 | case OP_SWM: /* set word mark */\r |
| 1425 | M[BS] = M[BS] | WM; /* set A field mark */\r |
| 1426 | M[AS] = M[AS] | WM; /* set B field mark */\r |
| 1427 | MM (AS); /* decr pointers */\r |
| 1428 | MM (BS);\r |
| 1429 | break;\r |
| 1430 | \r |
| 1431 | case OP_CWM: /* clear word mark */\r |
| 1432 | M[BS] = M[BS] & ~WM; /* clear A field mark */\r |
| 1433 | M[AS] = M[AS] & ~WM; /* clear B field mark */\r |
| 1434 | MM (AS); /* decr pointers */\r |
| 1435 | MM (BS);\r |
| 1436 | break;\r |
| 1437 | \r |
| 1438 | /* Clear storage instruction A check B check\r |
| 1439 | \r |
| 1440 | CS clear from B down to nearest hundreds if branch fetch\r |
| 1441 | address\r |
| 1442 | \r |
| 1443 | Instruction lengths:\r |
| 1444 | \r |
| 1445 | 1 chained\r |
| 1446 | 2,3 invalid A-address and B-address\r |
| 1447 | 4 one operand (B-address = A-address)\r |
| 1448 | 5,6 invalid B-address\r |
| 1449 | 7 branch\r |
| 1450 | 8+ one operand, branch ignored\r |
| 1451 | */\r |
| 1452 | \r |
| 1453 | case OP_CS: /* clear storage */\r |
| 1454 | t = (BS / 100) * 100; /* lower bound */\r |
| 1455 | while (BS >= t) M[BS--] = 0; /* clear region */\r |
| 1456 | if (BS < 0) BS = BS + MEMSIZE; /* wrap if needed */\r |
| 1457 | if (ilnt == 7) { BRANCH; } /* branch variant? */\r |
| 1458 | break;\r |
| 1459 | \r |
| 1460 | /* Modify address instruction A check B check\r |
| 1461 | \r |
| 1462 | MA add A addr and B addr, store at B addr fetch fetch\r |
| 1463 | \r |
| 1464 | Instruction lengths:\r |
| 1465 | 1 chained\r |
| 1466 | 2,3 invalid A-address and B-address\r |
| 1467 | 4 self (B-address = A-address)\r |
| 1468 | 5,6 invalid B-address\r |
| 1469 | 7 normal\r |
| 1470 | 8+ normal + ignored modifier\r |
| 1471 | */\r |
| 1472 | \r |
| 1473 | case OP_MA: /* modify address */\r |
| 1474 | a = one_table[M[AS] & CHAR]; MM (AS); /* get A address */\r |
| 1475 | a = a + ten_table[M[AS] & CHAR]; MM (AS);\r |
| 1476 | a = a + hun_table[M[AS] & CHAR]; MM (AS);\r |
| 1477 | b = one_table[M[BS] & CHAR]; MM (BS); /* get B address */\r |
| 1478 | b = b + ten_table[M[BS] & CHAR]; MM (BS);\r |
| 1479 | b = b + hun_table[M[BS] & CHAR]; MM (BS);\r |
| 1480 | t = ((a + b) & INDEXMASK) % MAXMEMSIZE; /* compute sum */\r |
| 1481 | M[BS + 3] = (M[BS + 3] & WM) | store_addr_u (t);\r |
| 1482 | M[BS + 2] = (M[BS + 2] & (WM + ZONE)) | store_addr_t (t);\r |
| 1483 | M[BS + 1] = (M[BS + 1] & WM) | store_addr_h (t);\r |
| 1484 | if (((a % 4000) + (b % 4000)) >= 4000) BS = BS + 2; /* carry? */\r |
| 1485 | break;\r |
| 1486 | \r |
| 1487 | /* Store address instructions A-check B-check\r |
| 1488 | \r |
| 1489 | SAR store A* at A addr fetch\r |
| 1490 | SBR store B* at A addr fetch\r |
| 1491 | \r |
| 1492 | Instruction lengths:\r |
| 1493 | 1 chained\r |
| 1494 | 2,3 invalid A-address\r |
| 1495 | 4 normal\r |
| 1496 | 5+ B-address overwritten from instruction;\r |
| 1497 | invalid address ignored\r |
| 1498 | */\r |
| 1499 | \r |
| 1500 | case OP_SAR: case OP_SBR: /* store A, B reg */\r |
| 1501 | M[AS] = (M[AS] & WM) | store_addr_u (BS);\r |
| 1502 | MM (AS);\r |
| 1503 | M[AS] = (M[AS] & WM) | store_addr_t (BS);\r |
| 1504 | MM (AS);\r |
| 1505 | M[AS] = (M[AS] & WM) | store_addr_h (BS);\r |
| 1506 | MM (AS);\r |
| 1507 | break;\r |
| 1508 | \r |
| 1509 | /* NOP - no validity checking, all instructions length ok */\r |
| 1510 | \r |
| 1511 | case OP_NOP: /* nop */\r |
| 1512 | break;\r |
| 1513 | \r |
| 1514 | /* HALT - unless length = 4 (branch), no validity checking; all lengths ok */\r |
| 1515 | \r |
| 1516 | case OP_H: /* halt */\r |
| 1517 | if (ilnt == 4) hb_pend = 1; /* set pending branch */\r |
| 1518 | reason = STOP_HALT; /* stop simulator */\r |
| 1519 | saved_IS = IS; /* commit instruction */\r |
| 1520 | break;\r |
| 1521 | \r |
| 1522 | default:\r |
| 1523 | reason = STOP_NXI; /* unimplemented */\r |
| 1524 | break;\r |
| 1525 | } /* end switch */\r |
| 1526 | } /* end while */\r |
| 1527 | \r |
| 1528 | /* Simulation halted */\r |
| 1529 | \r |
| 1530 | as_err = ADDR_ERR (AS); /* get addr err flags */\r |
| 1531 | bs_err = ADDR_ERR (BS);\r |
| 1532 | AS = AS & ADDRMASK; /* clean addresses */\r |
| 1533 | BS = BS & ADDRMASK;\r |
| 1534 | pcq_r->qptr = pcq_p; /* update pc q ptr */\r |
| 1535 | return reason;\r |
| 1536 | } /* end sim_instr */\r |
| 1537 | \r |
| 1538 | /* store addr_x - convert address to BCD character in x position\r |
| 1539 | \r |
| 1540 | Inputs:\r |
| 1541 | addr = address to convert\r |
| 1542 | Outputs:\r |
| 1543 | char = converted address character\r |
| 1544 | */\r |
| 1545 | \r |
| 1546 | int32 store_addr_h (int32 addr)\r |
| 1547 | {\r |
| 1548 | int32 thous;\r |
| 1549 | \r |
| 1550 | thous = (addr / 1000) & 03;\r |
| 1551 | return bin_to_bcd[(addr % 1000) / 100] | (thous << V_ZONE);\r |
| 1552 | }\r |
| 1553 | \r |
| 1554 | int32 store_addr_t (int32 addr)\r |
| 1555 | {\r |
| 1556 | return bin_to_bcd[(addr % 100) / 10];\r |
| 1557 | }\r |
| 1558 | \r |
| 1559 | int32 store_addr_u (int32 addr)\r |
| 1560 | {\r |
| 1561 | int32 thous;\r |
| 1562 | \r |
| 1563 | thous = (addr / 1000) & 014;\r |
| 1564 | return bin_to_bcd[addr % 10] | (thous << (V_ZONE - 2));\r |
| 1565 | }\r |
| 1566 | \r |
| 1567 | /* div_add - add string for divide */\r |
| 1568 | \r |
| 1569 | int32 div_add (int32 ap, int32 bp, int32 aend)\r |
| 1570 | {\r |
| 1571 | int32 a, b, c, r;\r |
| 1572 | \r |
| 1573 | c = 0; /* init carry */\r |
| 1574 | do {\r |
| 1575 | a = M[ap]; /* get operands */\r |
| 1576 | b = M[bp];\r |
| 1577 | r = bcd_to_bin[b & DIGIT] + /* sum digits + c */\r |
| 1578 | bcd_to_bin[a & DIGIT] + c;\r |
| 1579 | c = (r >= 10); /* set carry out */\r |
| 1580 | M[bp] = sum_table[r]; /* store result */\r |
| 1581 | ap--;\r |
| 1582 | bp--;\r |
| 1583 | } while (ap >= aend);\r |
| 1584 | return c;\r |
| 1585 | }\r |
| 1586 | \r |
| 1587 | /* div_sub - substract string for divide */\r |
| 1588 | \r |
| 1589 | int32 div_sub (int32 ap, int32 bp, int32 aend)\r |
| 1590 | {\r |
| 1591 | int32 a, b, c, r;\r |
| 1592 | \r |
| 1593 | c = 0; /* init borrow */\r |
| 1594 | do {\r |
| 1595 | a = M[ap]; /* get operands */\r |
| 1596 | b = M[bp];\r |
| 1597 | r = bcd_to_bin[b & DIGIT] - /* a - b - borrow */\r |
| 1598 | bcd_to_bin[a & DIGIT] - c;\r |
| 1599 | c = (r < 0); /* set borrow out */\r |
| 1600 | M[bp] = sum_table[r + 10]; /* store result */\r |
| 1601 | ap--;\r |
| 1602 | bp--;\r |
| 1603 | } while (ap >= aend);\r |
| 1604 | b = M[bp] & CHAR; /* borrow position */\r |
| 1605 | if (b && (b != BCD_ZERO)) { /* non-zero? */\r |
| 1606 | r = bcd_to_bin[b & DIGIT] - c; /* subtract borrow */\r |
| 1607 | M[bp] = sum_table[r]; /* store result */\r |
| 1608 | return 0; /* subtract worked */\r |
| 1609 | }\r |
| 1610 | return c; /* return borrow */\r |
| 1611 | }\r |
| 1612 | \r |
| 1613 | /* div_sign - set signs for divide */\r |
| 1614 | \r |
| 1615 | void div_sign (int32 dvrc, int32 dvdc, int32 qp, int32 rp)\r |
| 1616 | {\r |
| 1617 | int32 sign = dvrc & ZONE; /* divisor sign */\r |
| 1618 | \r |
| 1619 | M[rp] = M[rp] | ZONE; /* assume rem pos */\r |
| 1620 | if (sign == BBIT) M[rp] = M[rp] & ~ABIT; /* if dvr -, rem - */\r |
| 1621 | M[qp] = M[qp] | ZONE; /* assume quo + */\r |
| 1622 | if (((dvdc & ZONE) == BBIT) ^ (sign == BBIT)) /* dvr,dvd diff? */\r |
| 1623 | M[qp] = M[qp] & ~ABIT; /* make quo - */\r |
| 1624 | return;\r |
| 1625 | }\r |
| 1626 | \r |
| 1627 | /* iomod - check on I/O modifiers\r |
| 1628 | \r |
| 1629 | Inputs:\r |
| 1630 | ilnt = instruction length\r |
| 1631 | mod = modifier character\r |
| 1632 | tptr = pointer to table of modifiers, end is -1\r |
| 1633 | Output:\r |
| 1634 | status = SCPE_OK if ok, STOP_INVM if invalid\r |
| 1635 | */\r |
| 1636 | \r |
| 1637 | t_stat iomod (int32 ilnt, int32 mod, const int32 *tptr)\r |
| 1638 | {\r |
| 1639 | if ((ilnt != 2) && (ilnt != 5) && (ilnt < 8)) return SCPE_OK;\r |
| 1640 | if (tptr == NULL) return STOP_INVM;\r |
| 1641 | do {\r |
| 1642 | if (mod == *tptr++) return SCPE_OK;\r |
| 1643 | } while (*tptr >= 0);\r |
| 1644 | return STOP_INVM;\r |
| 1645 | }\r |
| 1646 | \r |
| 1647 | /* iodisp - dispatch load or move to I/O routine\r |
| 1648 | \r |
| 1649 | Inputs:\r |
| 1650 | dev = device number\r |
| 1651 | unit = unit number\r |
| 1652 | flag = move (MD_NORM) vs load (MD_WM)\r |
| 1653 | mod = modifier\r |
| 1654 | */\r |
| 1655 | \r |
| 1656 | t_stat iodisp (int32 dev, int32 unit, int32 flag, int32 mod)\r |
| 1657 | {\r |
| 1658 | if (dev == IO_INQ) return inq_io (flag, mod); /* inq terminal? */\r |
| 1659 | if (dev == IO_DP) return dp_io (unit, flag, mod); /* disk pack? */\r |
| 1660 | if (dev == IO_MT) return mt_io (unit, flag, mod); /* magtape? */\r |
| 1661 | if (dev == IO_MTB) /* binary magtape? */\r |
| 1662 | return mt_io (unit, flag | MD_BIN, mod);\r |
| 1663 | return STOP_NXD; /* not implemented */\r |
| 1664 | }\r |
| 1665 | \r |
| 1666 | /* Reset routine */\r |
| 1667 | \r |
| 1668 | t_stat cpu_reset (DEVICE *dptr)\r |
| 1669 | {\r |
| 1670 | int32 i;\r |
| 1671 | \r |
| 1672 | for (i = 0; i < 64; i++) { /* clr indicators */\r |
| 1673 | if ((i < IN_SSB) || (i > IN_SSG)) ind[i] = 0; /* except SSB-SSG */\r |
| 1674 | }\r |
| 1675 | ind[IN_UNC] = 1; /* ind[0] always on */\r |
| 1676 | AS = 0; /* clear AS */\r |
| 1677 | BS = 0; /* clear BS *\r |
| 1678 | as_err = 1;\r |
| 1679 | bs_err = 1;/\r |
| 1680 | D = 0; /* clear D */\r |
| 1681 | hb_pend = 0; /* no halt br */\r |
| 1682 | pcq_r = find_reg ("ISQ", NULL, dptr);\r |
| 1683 | if (pcq_r) pcq_r->qptr = 0;\r |
| 1684 | else return SCPE_IERR;\r |
| 1685 | sim_brk_types = sim_brk_dflt = SWMASK ('E');\r |
| 1686 | return SCPE_OK;\r |
| 1687 | }\r |
| 1688 | \r |
| 1689 | /* Memory examine */\r |
| 1690 | \r |
| 1691 | t_stat cpu_ex (t_value *vptr, t_addr addr, UNIT *uptr, int32 sw)\r |
| 1692 | {\r |
| 1693 | if (addr >= MEMSIZE) return SCPE_NXM;\r |
| 1694 | if (vptr != NULL) *vptr = M[addr] & (WM + CHAR);\r |
| 1695 | return SCPE_OK;\r |
| 1696 | }\r |
| 1697 | \r |
| 1698 | /* Memory deposit */\r |
| 1699 | \r |
| 1700 | t_stat cpu_dep (t_value val, t_addr addr, UNIT *uptr, int32 sw)\r |
| 1701 | {\r |
| 1702 | if (addr >= MEMSIZE) return SCPE_NXM;\r |
| 1703 | M[addr] = val & (WM + CHAR);\r |
| 1704 | return SCPE_OK;\r |
| 1705 | }\r |
| 1706 | \r |
| 1707 | /* Memory size change */\r |
| 1708 | \r |
| 1709 | t_stat cpu_set_size (UNIT *uptr, int32 val, char *cptr, void *desc)\r |
| 1710 | {\r |
| 1711 | int32 mc = 0;\r |
| 1712 | uint32 i;\r |
| 1713 | \r |
| 1714 | if ((val <= 0) || (val > MAXMEMSIZE) || ((val % 1000) != 0))\r |
| 1715 | return SCPE_ARG;\r |
| 1716 | for (i = val; i < MEMSIZE; i++) mc = mc | M[i];\r |
| 1717 | if ((mc != 0) && (!get_yn ("Really truncate memory [N]?", FALSE)))\r |
| 1718 | return SCPE_OK;\r |
| 1719 | MEMSIZE = val;\r |
| 1720 | for (i = MEMSIZE; i < MAXMEMSIZE; i++) M[i] = 0;\r |
| 1721 | if (MEMSIZE > 4000) cpu_unit.flags = cpu_unit.flags | MA;\r |
| 1722 | else cpu_unit.flags = cpu_unit.flags & ~MA;\r |
| 1723 | return SCPE_OK;\r |
| 1724 | }\r |
| 1725 | \r |
| 1726 | /* Set history */\r |
| 1727 | \r |
| 1728 | t_stat cpu_set_hist (UNIT *uptr, int32 val, char *cptr, void *desc)\r |
| 1729 | {\r |
| 1730 | int32 i, lnt;\r |
| 1731 | t_stat r;\r |
| 1732 | \r |
| 1733 | if (cptr == NULL) {\r |
| 1734 | for (i = 0; i < hst_lnt; i++) hst[i].ilnt = 0;\r |
| 1735 | hst_p = 0;\r |
| 1736 | return SCPE_OK;\r |
| 1737 | }\r |
| 1738 | lnt = (int32) get_uint (cptr, 10, HIST_MAX, &r);\r |
| 1739 | if ((r != SCPE_OK) || (lnt && (lnt < HIST_MIN))) return SCPE_ARG;\r |
| 1740 | hst_p = 0;\r |
| 1741 | if (hst_lnt) {\r |
| 1742 | free (hst);\r |
| 1743 | hst_lnt = 0;\r |
| 1744 | hst = NULL;\r |
| 1745 | }\r |
| 1746 | if (lnt) {\r |
| 1747 | hst = (InstHistory *) calloc (lnt, sizeof (InstHistory));\r |
| 1748 | if (hst == NULL) return SCPE_MEM;\r |
| 1749 | hst_lnt = lnt;\r |
| 1750 | }\r |
| 1751 | return SCPE_OK;\r |
| 1752 | }\r |
| 1753 | \r |
| 1754 | /* Show history */\r |
| 1755 | \r |
| 1756 | t_stat cpu_show_hist (FILE *st, UNIT *uptr, int32 val, void *desc)\r |
| 1757 | {\r |
| 1758 | int32 i, k, di, lnt;\r |
| 1759 | char *cptr = (char *) desc;\r |
| 1760 | t_value sim_eval[MAX_L + 1];\r |
| 1761 | t_stat r;\r |
| 1762 | InstHistory *h;\r |
| 1763 | extern t_stat fprint_sym (FILE *ofile, t_addr addr, t_value *val,\r |
| 1764 | UNIT *uptr, int32 sw);\r |
| 1765 | \r |
| 1766 | if (hst_lnt == 0) return SCPE_NOFNC; /* enabled? */\r |
| 1767 | if (cptr) {\r |
| 1768 | lnt = (int32) get_uint (cptr, 10, hst_lnt, &r);\r |
| 1769 | if ((r != SCPE_OK) || (lnt == 0)) return SCPE_ARG;\r |
| 1770 | }\r |
| 1771 | else lnt = hst_lnt;\r |
| 1772 | di = hst_p - lnt; /* work forward */\r |
| 1773 | if (di < 0) di = di + hst_lnt;\r |
| 1774 | fprintf (st, "IS IR\n\n");\r |
| 1775 | for (k = 0; k < lnt; k++) { /* print specified */\r |
| 1776 | h = &hst[(++di) % hst_lnt]; /* entry pointer */\r |
| 1777 | if (h->ilnt) { /* instruction? */\r |
| 1778 | fprintf (st, "%05d ", h->is);\r |
| 1779 | for (i = 0; i < h->ilnt; i++)\r |
| 1780 | sim_eval[i] = h->inst[i];\r |
| 1781 | sim_eval[h->ilnt] = WM;\r |
| 1782 | if ((fprint_sym (st, h->is, sim_eval, &cpu_unit, SWMASK ('M'))) > 0) {\r |
| 1783 | fprintf (st, "(undefined)");\r |
| 1784 | for (i = 0; i < h->ilnt; i++)\r |
| 1785 | fprintf (st, " %02o", h->inst[i]);\r |
| 1786 | }\r |
| 1787 | fputc ('\n', st); /* end line */\r |
| 1788 | } /* end else instruction */\r |
| 1789 | } /* end for */\r |
| 1790 | return SCPE_OK;\r |
| 1791 | }\r |
| 1792 | \r |
| 1793 | /* Set conversions */\r |
| 1794 | \r |
| 1795 | t_stat cpu_set_conv (UNIT *uptr, int32 val, char *cptr, void *desc)\r |
| 1796 | {\r |
| 1797 | conv_old = val;\r |
| 1798 | return SCPE_OK;\r |
| 1799 | }\r |
| 1800 | \r |
| 1801 | /* Show conversions */\r |
| 1802 | \r |
| 1803 | t_stat cpu_show_conv (FILE *st, UNIT *uptr, int32 val, void *desc)\r |
| 1804 | {\r |
| 1805 | if (conv_old) fputs ("Old (pre-3.5-1) conversions\n", st);\r |
| 1806 | else fputs ("New conversions\n", st);\r |
| 1807 | return SCPE_OK;\r |
| 1808 | }\r |