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