Commit | Line | Data |
---|---|---|
196ba1fc PH |
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 |