cd4c19da08879553c3e5d9a3c43962f52c064026
1 /* i1401_sys.c: IBM 1401 simulator interface
3 Copyright (c) 1993-2005, Robert M. Supnik
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:
12 The above copyright notice and this permission notice shall be included in
13 all copies or substantial portions of the Software.
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.
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.
26 20-Sep-05 RMS Revised for new code tables
27 04-Jan-05 WVS Added address argument support
28 14-Nov-04 WVS Added data printout support
29 16-Mar-03 RMS Fixed mnemonic for MCS
30 03-Jun-02 RMS Added 1311 support
31 18-May-02 RMS Added -D feature from Van Snyder
32 26-Jan-02 RMS Fixed H, NOP with no trailing wm (found by Van Snyder)
33 17-Sep-01 RMS Removed multiconsole support
34 13-Jul-01 RMS Fixed bug in symbolic output (found by Peter Schorn)
35 27-May-01 RMS Added multiconsole support
36 14-Mar-01 RMS Revised load/dump interface (again)
37 30-Oct-00 RMS Added support for examine to file
38 27-Oct-98 RMS V2.4 load interface
41 #include "i1401_defs.h"
45 extern DEVICE cpu_dev
, inq_dev
, lpt_dev
;
46 extern DEVICE cdr_dev
, cdp_dev
, stack_dev
;
47 extern DEVICE dp_dev
, mt_dev
;
51 extern char ascii_to_bcd_old
[128], ascii_to_bcd
[128];
52 extern char bcd_to_ascii_old
[64], bcd_to_ascii_a
[64], bcd_to_ascii_h
[64];
53 extern char *get_glyph (char *cptr
, char *gbuf
, char term
);
54 extern int32
store_addr_h (int32 addr
);
55 extern int32
store_addr_t (int32 addr
);
56 extern int32
store_addr_u (int32 addr
);
57 extern t_bool conv_old
;
59 /* SCP data structures and interface routines
61 sim_name simulator name string
62 sim_PC pointer to saved PC register descriptor
63 sim_emax maximum number of words for examine/deposit
64 sim_devices array of pointers to simulated devices
65 sim_stop_messages array of pointers to stop messages
66 sim_load binary loader
69 char sim_name
[] = "IBM 1401";
71 REG
*sim_PC
= &cpu_reg
[0];
73 int32 sim_emax
= LINE_LNT
;
75 DEVICE
*sim_devices
[] = {
87 const char *sim_stop_messages
[] = {
89 "Unimplemented instruction",
90 "Non-existent memory",
91 "Non-existent device",
92 "No WM at instruction start",
95 "Invalid instruction length",
97 "Invalid branch address",
100 "Invalid MT unit number",
101 "Invalid MT record length",
102 "Write to locked MT unit",
103 "Skip to unpunched CCT channel",
105 "Address register wrap",
107 "Invalid disk sector address",
108 "Invalid disk sector count",
110 "Invalid disk function",
111 "Invalid disk record length",
112 "Write track while disabled",
114 "Disk address miscompare",
115 "Direct seek cylinder exceeds maximum"
118 /* Binary loader -- load carriage control tape
120 A carriage control tape consists of entries of the form
122 (repeat count) column number,column number,column number,...
124 The CCT entries are stored in cct[0:lnt-1], cctlnt contains the
128 t_stat
sim_load (FILE *fileref
, char *cptr
, char *fnam
, int flag
)
130 int32 col
, rpt
, ptr
, mask
, cctbuf
[CCT_LNT
];
132 extern int32 cctlnt
, cctptr
, cct
[CCT_LNT
];
133 char cbuf
[CBUFSIZE
], gbuf
[CBUFSIZE
];
135 if ((*cptr
!= 0) || (flag
!= 0)) return SCPE_ARG
;
137 for ( ; (cptr
= fgets (cbuf
, CBUFSIZE
, fileref
)) != NULL
; ) { /* until eof */
139 if (*cptr
== '(') { /* repeat count? */
140 cptr
= get_glyph (cptr
+ 1, gbuf
, ')'); /* get 1st field */
141 rpt
= get_uint (gbuf
, 10, CCT_LNT
, &r
); /* repeat count */
142 if (r
!= SCPE_OK
) return SCPE_FMT
;
145 while (*cptr
!= 0) { /* get col no's */
146 cptr
= get_glyph (cptr
, gbuf
, ','); /* get next field */
147 col
= get_uint (gbuf
, 10, 12, &r
); /* column number */
148 if (r
!= SCPE_OK
) return SCPE_FMT
;
149 mask
= mask
| (1 << col
); /* set bit */
151 for ( ; rpt
> 0; rpt
--) { /* store vals */
152 if (ptr
>= CCT_LNT
) return SCPE_FMT
;
153 cctbuf
[ptr
++] = mask
;
156 if (ptr
== 0) return SCPE_FMT
;
159 for (rpt
= 0; rpt
< cctlnt
; rpt
++) cct
[rpt
] = cctbuf
[rpt
];
165 const char *opcode
[64] = {
166 NULL
, "R", "W", "WR", "P", "RP", "WP", "WRP",
167 "SRF", "SPF", NULL
, "MA", "MUL", NULL
, NULL
, NULL
,
168 NULL
, "CS", "S", NULL
, "MTF", "BWZ", "BBE", NULL
,
169 "MZ", "MCS", NULL
, "SWM", "DIV", NULL
, NULL
, NULL
,
170 NULL
, NULL
, "SS", "LCA", "MCW", "NOP", NULL
, "MCM",
171 "SAR", NULL
, "ZS", NULL
, NULL
, NULL
, NULL
, NULL
,
172 NULL
, "A", "B", "C", "MN", "MCE", "CC", NULL
,
173 "SBR", NULL
, "ZA", "H", "CWM", NULL
, NULL
, NULL
176 /* Print an address from three characters */
178 void fprint_addr (FILE *of
, t_value
*dig
)
181 extern int32 hun_table
[64], ten_table
[64], one_table
[64];
183 addr
= hun_table
[dig
[0] & CHAR
] + ten_table
[dig
[1]] + one_table
[dig
[2]];
184 xa
= (addr
>> V_INDEX
) & M_INDEX
;
185 if (xa
) fprintf (of
, " %d,%d", addr
& ADDRMASK
, ((xa
- (X1
>> V_INDEX
)) / 5) + 1);
186 else if (addr
>= MAXMEMSIZE
) fprintf (of
, " %d*", addr
& ADDRMASK
);
187 else fprintf (of
, " %d", addr
);
191 /* Print unknown opcode as data */
193 t_stat
dcw (FILE *of
, int32 op
, t_value
*val
, int32 sw
)
196 t_bool use_h
= sw
& SWMASK ('F');
198 fprintf (of
, "DCW @%c", bcd2ascii (op
, use_h
)); /* assume it's data */
199 for (i
= 1; i
< sim_emax
; i
++) {
200 if (val
[i
] & WM
) break;
201 fprintf (of
, "%c", bcd2ascii (val
[i
], use_h
));
204 return -(i
- 1); /* return # chars */
211 addr = current address
212 *val = values to decode
213 *uptr = pointer to unit
216 return = if >= 0, error code
217 if < 0, number of extra words retired
220 #define FMTASC(x) ((x) < 040)? "<%03o>": "%c", (x)
222 t_stat
fprint_sym (FILE *of
, t_addr addr
, t_value
*val
,
223 UNIT
*uptr
, int32 sw
)
225 int32 op
, flags
, ilnt
, i
, t
;
226 int32 wmch
= conv_old
? '~': '`';
227 t_bool use_h
= sw
& SWMASK ('F');
228 extern int32 op_table
[64], len_table
[9];
230 if (sw
& SWMASK ('C')) { /* character? */
232 if (uptr
->flags
& UNIT_BCD
) {
233 if (t
& WM
) fputc (wmch
, of
);
234 fputc (bcd2ascii (t
& CHAR
, use_h
), of
);
236 else fprintf (of
, FMTASC (t
& 0177));
239 if ((uptr
!= NULL
) && (uptr
!= &cpu_unit
)) /* CPU? */
241 if (sw
& SWMASK ('D')) { /* dump? */
242 for (i
= 0; i
< 50; i
++)
243 fprintf (of
, "%c", bcd2ascii (val
[i
] & CHAR
, use_h
)) ;
244 fprintf (of
, "\n\t");
245 for (i
= 0; i
< 50; i
++)
246 fprintf (of
, (val
[i
] & WM
)? "1": " ") ;
249 if (sw
& SWMASK ('S')) { /* string? */
253 if (t
& WM
) fputc (wmch
, of
);
254 fputc (bcd2ascii (t
& CHAR
, use_h
), of
);
255 } while ((i
< LINE_LNT
) && ((val
[i
] & WM
) == 0));
258 if ((sw
& SWMASK ('M')) == 0) return SCPE_ARG
;
260 if ((val
[0] & WM
) == 0) return STOP_NOWM
; /* WM under op? */
261 op
= val
[0]& CHAR
; /* isolate op */
262 if (opcode
[op
] == NULL
) return dcw (of
, op
, val
, sw
); /* invalid op */
263 flags
= op_table
[op
]; /* get flags */
264 for (ilnt
= 1; ilnt
< sim_emax
; ilnt
++) { /* find inst lnt */
265 if (val
[ilnt
] & WM
) break;
267 if ((flags
& (NOWM
| HNOP
)) && (ilnt
> 7)) ilnt
= 7; /* cs, swm, h, nop? */
268 else if ((op
== OP_B
) && (ilnt
> 4) && (val
[4] == BCD_BLANK
)) ilnt
= 4;
269 else if ((ilnt
> 8) && (op
!= OP_NOP
)) ilnt
= 8; /* cap length */
270 if (ilnt
== 3) { /* lnt = 3? */
271 fprintf (of
, "DSA"); /* assume DSA */
272 fprint_addr (of
, val
); /* print addr */
275 if ((((flags
& len_table
[ilnt
]) == 0) && /* invalid lnt, */
276 (op
!= OP_NOP
)) || /* not nop? */
277 (opcode
[op
] == NULL
)) /* or undef? */
278 return dcw (of
, op
, val
, sw
);
279 fprintf (of
, "%s",opcode
[op
]); /* print opcode */
280 if (ilnt
> 2) { /* A address? */
281 if (((flags
& IO
) || (op
== OP_NOP
)) && (val
[1] == BCD_PERCNT
))
282 fprintf (of
, " %%%c%c", bcd2ascii (val
[2], use_h
),
283 bcd2ascii (val
[3], sw
));
284 else fprint_addr (of
, &val
[1]);
286 if (ilnt
> 5) fprint_addr (of
, &val
[4]); /* B address? */
287 if ((ilnt
== 2) || (ilnt
== 5) || (ilnt
== 8)) /* d character? */
288 fprintf (of
, " '%c", bcd2ascii (val
[ilnt
- 1], use_h
));
289 return -(ilnt
- 1); /* return # chars */
292 /* get_addr - get address + index pair */
294 t_stat
get_addr (char *cptr
, t_value
*val
)
300 cptr
= get_glyph (cptr
, gbuf
, ','); /* get address */
301 addr
= get_uint (gbuf
, 10, MAXMEMSIZE
, &r
);
302 if (r
!= SCPE_OK
) return SCPE_ARG
;
303 if (*cptr
!= 0) { /* more? */
304 cptr
= get_glyph (cptr
, gbuf
, ' ');
305 index
= get_uint (gbuf
, 10, 3, &r
);
306 if ((r
!= SCPE_OK
) || (index
== 0)) return SCPE_ARG
;
309 if (*cptr
!= 0) return SCPE_ARG
;
310 val
[0] = store_addr_h (addr
);
311 val
[1] = store_addr_t (addr
) | (index
<< V_ZONE
);
312 val
[2] = store_addr_u (addr
);
316 /* get_io - get I/O address */
318 t_stat
get_io (char *cptr
, t_value
*val
)
320 if ((cptr
[0] != '%') || (cptr
[3] != 0) || !isalnum (cptr
[1]) ||
321 !isalnum (cptr
[2])) return SCPE_ARG
;
323 val
[1] = ascii2bcd (cptr
[1]);
324 val
[2] = ascii2bcd (cptr
[2]);
331 *cptr = pointer to input string
333 *uptr = pointer to unit
334 *val = pointer to output values
337 status = > 0 error code
338 <= 0 -number of extra words
341 t_stat
parse_sym (char *cptr
, t_addr addr
, UNIT
*uptr
, t_value
*val
, int32 sw
)
343 int32 i
, op
, ilnt
, t
, cflag
, wm_seen
;
344 int32 wmch
= conv_old
? '~': '`';
345 extern int32 op_table
[64], len_table
[9];
348 cflag
= (uptr
== NULL
) || (uptr
== &cpu_unit
);
349 while (isspace (*cptr
)) cptr
++; /* absorb spaces */
350 if ((sw
& SWMASK ('C')) || (sw
& SWMASK ('S')) || (*cptr
== wmch
) ||
351 ((*cptr
== '\'') && cptr
++) || ((*cptr
== '"') && cptr
++)) {
353 for (i
= 0; (i
< sim_emax
) && (*cptr
!= 0); ) {
354 t
= *cptr
++; /* get character */
355 if (cflag
&& (wm_seen
== 0) && (t
== wmch
)) wm_seen
= WM
;
356 else if (uptr
->flags
& UNIT_BCD
) {
357 if (t
< 040) return SCPE_ARG
;
358 val
[i
++] = ascii2bcd (t
) | wm_seen
;
363 if ((i
== 0) || wm_seen
) return SCPE_ARG
;
367 if (cflag
== 0) return SCPE_ARG
; /* CPU only */
368 cptr
= get_glyph (cptr
, gbuf
, 0); /* get opcode */
369 for (op
= 0; op
< 64; op
++) { /* look it up */
370 if (opcode
[op
] && strcmp (gbuf
, opcode
[op
]) == 0) break;
372 if (op
>= 64) return SCPE_ARG
; /* successful? */
373 val
[0] = op
| WM
; /* store opcode */
374 cptr
= get_glyph (cptr
, gbuf
, 0); /* get addr or d */
375 if (((op_table
[op
] && IO
) && (get_io (gbuf
, &val
[1]) == SCPE_OK
)) ||
376 (get_addr (gbuf
, &val
[1]) == SCPE_OK
)) {
377 cptr
= get_glyph (cptr
, gbuf
, 0); /* get addr or d */
378 if (get_addr (gbuf
, &val
[4]) == SCPE_OK
) {
379 cptr
= get_glyph (cptr
, gbuf
, ','); /* get d */
380 ilnt
= 7; /* a and b addresses */
382 else ilnt
= 4; /* a address */
384 else ilnt
= 1; /* no addresses */
385 if ((gbuf
[0] == '\'') || (gbuf
[0] == '"')) { /* d character? */
387 if ((gbuf
[2] != 0) || (*cptr
!= 0) || (t
< 040))
388 return SCPE_ARG
; /* end and legal? */
389 val
[ilnt
] = ascii2bcd (t
); /* save D char */
392 else if (gbuf
[0] != 0) return SCPE_ARG
; /* not done? */
393 if ((op_table
[op
] & len_table
[ilnt
]) == 0) return STOP_INVL
;
397 /* Convert BCD to ASCII */
399 int32
bcd2ascii (int32 c
, t_bool use_h
)
401 if (conv_old
) return bcd_to_ascii_old
[c
];
402 else if (use_h
) return bcd_to_ascii_h
[c
];
403 else return bcd_to_ascii_a
[c
];
406 /* Convert ASCII to BCD */
408 int32
ascii2bcd (int32 c
)
410 if (conv_old
) return ascii_to_bcd_old
[c
];
411 else return ascii_to_bcd
[c
];