1969 lines
82 KiB
C
1969 lines
82 KiB
C
/* i1401_cpu.c: IBM 1401 CPU simulator
|
|
|
|
Copyright (c) 1993-2021, Robert M. Supnik
|
|
|
|
Permission is hereby granted, free of charge, to any person obtaining a
|
|
copy of this software and associated documentation files (the "Software"),
|
|
to deal in the Software without restriction, including without limitation
|
|
the rights to use, copy, modify, merge, publish, distribute, sublicense,
|
|
and/or sell copies of the Software, and to permit persons to whom the
|
|
Software is furnished to do so, subject to the following conditions:
|
|
|
|
The above copyright notice and this permission notice shall be included in
|
|
all copies or substantial portions of the Software.
|
|
|
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
|
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
|
|
ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
|
|
IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
|
|
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
|
|
|
Except as contained in this notice, the name of Robert M Supnik shall not be
|
|
used in advertising or otherwise to promote the sale, use or other dealings
|
|
in this Software without prior written authorization from Robert M Supnik.
|
|
|
|
08-Jun-21 RMS Added max value to address registers
|
|
13-Mar-17 RMS Fixed MTF length checking (COVERITY)
|
|
30-Jan-15 RMS Fixed treatment of overflow (Ken Shirriff)
|
|
08-Oct-12 RMS Clear storage and branch preserves B register (Van Snyder)
|
|
19-Mar-11 RMS Reverted multiple tape indicator implementation
|
|
20-Jan-11 RMS Fixed branch on EOT indicator per hardware (Van Snyder)
|
|
07-Nov-10 RMS Fixed divide not to clear word marks in quotient
|
|
24-Apr-10 RMS Revised divide algorithm (Van Snyder)
|
|
11-Jul-08 RMS Added missing A magtape modifier (Van Snyder)
|
|
Fixed tape indicator implementation (Bob Abeles)
|
|
Fixed bug in ZA and ZS (Bob Abeles)
|
|
07-Jul-07 RMS Removed restriction on load-mode binary tape
|
|
28-Jun-07 RMS Added support for SS overlap modifiers
|
|
22-May-06 RMS Fixed format error in CPU history (Peter Schorn)
|
|
06-Mar-06 RMS Fixed bug in divide (Van Snyder)
|
|
22-Sep-05 RMS Fixed declarations (Sterling Garwood)
|
|
01-Sep-05 RMS Removed error stops in MCE
|
|
16-Aug-05 RMS Fixed C++ declaration and cast problems
|
|
02-Jun-05 RMS Fixed SSB-SSG clearing on RESET (Ralph Reinke)
|
|
14-Nov-04 WVS Added column binary support, debug support
|
|
06-Nov-04 RMS Added instruction history
|
|
12-Jul-03 RMS Moved ASCII/BCD tables to included file
|
|
Revised fetch to model hardware
|
|
Removed length checking in fetch phase
|
|
16-Mar-03 RMS Fixed mnemonic, instruction lengths, and reverse
|
|
scan length check bug for MCS
|
|
Fixed MCE bug, BS off by 1 if zero suppress
|
|
Fixed chaining bug, D lost if return to SCP
|
|
Fixed H branch, branch occurs after continue
|
|
Added check for invalid 8 character MCW, LCA
|
|
03-Jun-03 RMS Added 1311 support
|
|
22-May-02 RMS Added multiply and divide
|
|
30-Dec-01 RMS Added old PC queue
|
|
30-Nov-01 RMS Added extended SET/SHOW support
|
|
10-Aug-01 RMS Removed register in declarations
|
|
07-Dec-00 RMS Fixed bugs found by Charles Owen
|
|
-- 4,7 char NOPs are legal
|
|
-- 1 char B is chained BCE
|
|
-- MCE moves whole char after first
|
|
14-Apr-99 RMS Changed t_addr to unsigned
|
|
|
|
The register state for the IBM 1401 is:
|
|
|
|
IS I storage address register (PC)
|
|
AS A storage address register (address of first operand)
|
|
BS B storage address register (address of second operand)
|
|
ind[0:63] indicators
|
|
SSA sense switch A
|
|
IOCHK I/O check
|
|
PRCHK process check
|
|
|
|
The IBM 1401 is a variable instruction length, decimal data system.
|
|
Memory consists of 4000, 8000, 12000, or 16000 BCD characters, each
|
|
containing six bits of data and a word mark. There are no general
|
|
registers; all instructions are memory to memory, using explicit
|
|
addresses or an address pointer from a prior instruction.
|
|
|
|
BCD numeric data consists of the low four bits of a character (DIGIT),
|
|
encoded as X, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, X, X, X, X, X. The high
|
|
two bits (ZONE) encode the sign of the data as +, +, -, +. Character
|
|
data uses all six bits of a character. Numeric and character fields are
|
|
delimited by a word mark. Fields are typically processed in descending
|
|
address order (low-order data to high-order data).
|
|
|
|
The 1401 encodes a decimal address, and an index register number, in
|
|
three characters:
|
|
|
|
character zone digit
|
|
addr + 0 <1:0> of thousands hundreds
|
|
addr + 1 index register # tens
|
|
addr + 2 <3:2> of thousands ones
|
|
|
|
Normally the digit values 0, 11, 12, 13, 14, 15 are illegal in addresses.
|
|
However, in indexing, digits are passed through the adder, and illegal
|
|
values are normalized to legal counterparts.
|
|
|
|
The 1401 has six instruction formats:
|
|
|
|
op A and B addresses, if any, from AS and BS
|
|
op d A and B addresses, if any, from AS and BS
|
|
op aaa B address, if any, from BS
|
|
op aaa d B address, if any, from BS
|
|
op aaa bbb
|
|
op aaa bbb d
|
|
|
|
where aaa is the A address, bbb is the B address, and d is a modifier.
|
|
The opcode has word mark set; all other characters have word mark clear.
|
|
|
|
This routine is the instruction decode routine for the IBM 1401.
|
|
It is called from the simulator control program to execute
|
|
instructions in simulated memory, starting at the simulated PC.
|
|
It runs until 'reason' is set non-zero.
|
|
|
|
General notes:
|
|
|
|
1. Reasons to stop. The simulator can be stopped by:
|
|
|
|
HALT instruction
|
|
breakpoint encountered
|
|
illegal addresses or instruction formats
|
|
I/O error in I/O simulator
|
|
|
|
2. Interrupts. The 1401 has no interrupt structure.
|
|
|
|
3. Non-existent memory. On the 1401, references to non-existent
|
|
memory halt the processor.
|
|
|
|
4. Adding I/O devices. These modules must be modified:
|
|
|
|
i1401_cpu.c add device dispatching code to iodisp
|
|
i1401_sys.c add sim_devices table entry
|
|
*/
|
|
|
|
#include "i1401_defs.h"
|
|
#include "i1401_dat.h"
|
|
|
|
#define PCQ_SIZE 64 /* must be 2**n */
|
|
#define PCQ_MASK (PCQ_SIZE - 1)
|
|
#define PCQ_ENTRY pcq[pcq_p = (pcq_p - 1) & PCQ_MASK] = saved_IS
|
|
|
|
#define HIST_MIN 64
|
|
#define HIST_MAX 65536
|
|
|
|
typedef struct {
|
|
uint16 is;
|
|
uint16 ilnt;
|
|
uint8 inst[MAX_L];
|
|
} InstHistory;
|
|
|
|
/* These macros validate addresses. If an addresses error is detected,
|
|
they return an error status to the caller. These macros should only
|
|
be used in a routine that returns a t_stat value.
|
|
*/
|
|
|
|
#define MM(x) x = x - 1; \
|
|
if (x < 0) { \
|
|
x = BA + MAXMEMSIZE - 1; \
|
|
reason = STOP_WRAP; \
|
|
break; \
|
|
}
|
|
|
|
#define PP(x) x = x + 1; \
|
|
if (ADDR_ERR (x)) { \
|
|
x = BA + (x % MAXMEMSIZE); \
|
|
reason = STOP_WRAP; \
|
|
break; \
|
|
}
|
|
|
|
#define BRANCH if (ADDR_ERR (AS)) { \
|
|
reason = STOP_INVBR; \
|
|
break; \
|
|
} \
|
|
if (cpu_unit.flags & XSA) \
|
|
BS = IS; \
|
|
else BS = BA + 0; \
|
|
PCQ_ENTRY; \
|
|
IS = AS;
|
|
|
|
#define BRANCH_CS if (ADDR_ERR (AS)) { \
|
|
reason = STOP_INVBR; \
|
|
break; \
|
|
} \
|
|
PCQ_ENTRY; \
|
|
IS = AS;
|
|
|
|
|
|
uint8 M[MAXMEMSIZE] = { 0 }; /* main memory */
|
|
int32 saved_IS = 0; /* saved IS */
|
|
int32 AS = 0; /* AS */
|
|
int32 BS = 0; /* BS */
|
|
int32 D = 0; /* modifier */
|
|
int32 as_err = 0, bs_err = 0; /* error flags */
|
|
int32 hb_pend = 0; /* halt br pending */
|
|
uint16 pcq[PCQ_SIZE] = { 0 }; /* PC queue */
|
|
int32 pcq_p = 0; /* PC queue ptr */
|
|
REG *pcq_r = NULL; /* PC queue reg ptr */
|
|
int32 ind[64] = { 0 }; /* indicators */
|
|
int32 ssa = 1; /* sense switch A */
|
|
int32 prchk = 0; /* process check stop */
|
|
int32 iochk = 0; /* I/O check stop */
|
|
int32 hst_p = 0; /* history pointer */
|
|
int32 hst_lnt = 0; /* history length */
|
|
InstHistory *hst = NULL; /* instruction history */
|
|
t_bool conv_old = 0; /* old conversions */
|
|
|
|
extern int32 sim_emax;
|
|
|
|
t_stat cpu_ex (t_value *vptr, t_addr addr, UNIT *uptr, int32 sw);
|
|
t_stat cpu_dep (t_value val, t_addr addr, UNIT *uptr, int32 sw);
|
|
t_stat cpu_reset (DEVICE *dptr);
|
|
t_stat cpu_set_size (UNIT *uptr, int32 val, CONST char *cptr, void *desc);
|
|
t_stat cpu_set_hist (UNIT *uptr, int32 val, CONST char *cptr, void *desc);
|
|
t_stat cpu_show_hist (FILE *st, UNIT *uptr, int32 val, CONST void *desc);
|
|
t_stat cpu_set_conv (UNIT *uptr, int32 val, CONST char *cptr, void *desc);
|
|
t_stat cpu_show_conv (FILE *st, UNIT *uptr, int32 val, CONST void *desc);
|
|
int32 store_addr_h (int32 addr);
|
|
int32 store_addr_t (int32 addr);
|
|
int32 store_addr_u (int32 addr);
|
|
int32 div_add (int32 ap, int32 bp);
|
|
int32 div_sub (int32 ap, int32 bp);
|
|
void div_sign (int32 dvrc, int32 dvdc, int32 qp, int32 rp);
|
|
t_stat iomod (int32 ilnt, int32 mod, const int32 *tptr);
|
|
t_stat iodisp (int32 dev, int32 unit, int32 flag, int32 mod);
|
|
|
|
extern t_stat read_card (int32 ilnt, int32 mod);
|
|
extern t_stat punch_card (int32 ilnt, int32 mod);
|
|
extern t_stat select_stack (int32 mod);
|
|
extern t_stat carriage_control (int32 mod);
|
|
extern t_stat write_line (int32 ilnt, int32 mod);
|
|
extern t_stat inq_io (int32 flag, int32 mod);
|
|
extern t_stat mt_io (int32 unit, int32 flag, int32 mod);
|
|
extern t_stat dp_io (int32 fnc, int32 flag, int32 mod);
|
|
extern t_stat mt_func (int32 unit, int32 flag, int32 mod);
|
|
|
|
/* CPU data structures
|
|
|
|
cpu_dev CPU device descriptor
|
|
cpu_unit CPU unit descriptor
|
|
cpu_reg CPU register list
|
|
cpu_mod CPU modifier list
|
|
*/
|
|
|
|
UNIT cpu_unit = {
|
|
UDATA (NULL, UNIT_FIX + UNIT_BCD + STDOPT, MAXMEMSIZE)
|
|
};
|
|
|
|
REG cpu_reg[] = {
|
|
{ DRDATA (IS, saved_IS, 14), PV_LEFT, MAXADDR },
|
|
{ DRDATA (AS, AS, 14), PV_LEFT, MAXADDR },
|
|
{ DRDATA (BS, BS, 14), PV_LEFT, MAXADDR },
|
|
{ FLDATA (ASERR, as_err, 0) },
|
|
{ FLDATA (BSERR, bs_err, 0) },
|
|
{ ORDATA (D, D, 7) },
|
|
{ FLDATA (SSA, ssa, 0) },
|
|
{ FLDATA (SSB, ind[IN_SSB], 0) },
|
|
{ FLDATA (SSC, ind[IN_SSC], 0) },
|
|
{ FLDATA (SSD, ind[IN_SSD], 0) },
|
|
{ FLDATA (SSE, ind[IN_SSE], 0) },
|
|
{ FLDATA (SSF, ind[IN_SSF], 0) },
|
|
{ FLDATA (SSG, ind[IN_SSG], 0) },
|
|
{ FLDATA (EQU, ind[IN_EQU], 0) },
|
|
{ FLDATA (UNEQ, ind[IN_UNQ], 0) },
|
|
{ FLDATA (HIGH, ind[IN_HGH], 0) },
|
|
{ FLDATA (LOW, ind[IN_LOW], 0) },
|
|
{ FLDATA (OVF, ind[IN_OVF], 0) },
|
|
{ FLDATA (IOCHK, iochk, 0) },
|
|
{ FLDATA (PRCHK, prchk, 0) },
|
|
{ FLDATA (HBPEND, hb_pend, 0) },
|
|
{ BRDATA (IND, ind, 8, 32, 64), REG_HIDDEN + PV_LEFT },
|
|
{ BRDATA (ISQ, pcq, 10, 14, PCQ_SIZE), REG_RO+REG_CIRC },
|
|
{ DRDATA (ISQP, pcq_p, 6), REG_HRO },
|
|
{ ORDATA (WRU, sim_int_char, 8) },
|
|
{ FLDATA (CONVOLD, conv_old, 0), REG_HIDDEN },
|
|
{ NULL }
|
|
};
|
|
|
|
MTAB cpu_mod[] = {
|
|
{ XSA, XSA, "XSA", "XSA", NULL },
|
|
{ XSA, 0, "no XSA", "NOXSA", NULL },
|
|
{ HLE, HLE, "HLE", "HLE", NULL },
|
|
{ HLE, 0, "no HLE", "NOHLE", NULL },
|
|
{ BBE, BBE, "BBE", "BBE", NULL },
|
|
{ BBE, 0, "no BBE", "NOBBE", NULL },
|
|
{ MA, MA, "MA", 0, NULL },
|
|
{ MA, 0, "no MA", 0, NULL },
|
|
{ MR, MR, "MR", "MR", NULL },
|
|
{ MR, 0, "no MR", "NOMR", NULL },
|
|
{ EPE, EPE, "EPE", "EPE", NULL },
|
|
{ EPE, 0, "no EPE", "NOEPE", NULL },
|
|
{ MDV, MDV, "MDV", "MDV", NULL },
|
|
{ MDV, 0, "no MDV", "NOMDV", NULL },
|
|
{ UNIT_MSIZE, 4000, NULL, "4K", &cpu_set_size },
|
|
{ UNIT_MSIZE, 8000, NULL, "8K", &cpu_set_size },
|
|
{ UNIT_MSIZE, 12000, NULL, "12K", &cpu_set_size },
|
|
{ UNIT_MSIZE, 16000, NULL, "16K", &cpu_set_size },
|
|
{ MTAB_XTD|MTAB_VDV|MTAB_NMO|MTAB_SHP, 0, "HISTORY", "HISTORY",
|
|
&cpu_set_hist, &cpu_show_hist },
|
|
{ MTAB_XTD|MTAB_VDV|MTAB_NMO, 0, "CONVERSIONS", "NEWCONVERSIONS",
|
|
&cpu_set_conv, &cpu_show_conv },
|
|
{ MTAB_XTD|MTAB_VDV|MTAB_NMO, 1, NULL, "OLDCONVERSIONS",
|
|
&cpu_set_conv, NULL },
|
|
{ 0 }
|
|
};
|
|
|
|
DEVICE cpu_dev = {
|
|
"CPU", &cpu_unit, cpu_reg, cpu_mod,
|
|
1, 10, 14, 1, 8, 7,
|
|
&cpu_ex, &cpu_dep, &cpu_reset,
|
|
NULL, NULL, NULL,
|
|
NULL, DEV_DEBUG
|
|
};
|
|
|
|
/* Tables */
|
|
|
|
/* Opcode table - length, dispatch, and option flags. This table is
|
|
used by the symbolic input routine to validate instruction lengths */
|
|
|
|
const int32 op_table[64] = {
|
|
0, /* 00: illegal */
|
|
L1 | L2 | L4 | L5, /* read */
|
|
L1 | L2 | L4 | L5, /* write */
|
|
L1 | L2 | L4 | L5, /* write and read */
|
|
L1 | L2 | L4 | L5, /* punch */
|
|
L1 | L4, /* read and punch */
|
|
L1 | L2 | L4 | L5, /* write and punch */
|
|
L1 | L2 | L4 | L5, /* write, read, punch */
|
|
L1, /* 10: read feed */
|
|
L1, /* punch feed */
|
|
0, /* illegal */
|
|
L1 | L4 | L7 | AREQ | BREQ | MA, /* modify address */
|
|
L1 | L4 | L7 | AREQ | BREQ | MDV, /* multiply */
|
|
0, /* illegal */
|
|
0, /* illegal */
|
|
0, /* illegal */
|
|
0, /* 20: illegal */
|
|
L1 | L4 | L7 | BREQ | NOWM, /* clear storage */
|
|
L1 | L4 | L7 | AREQ | BREQ, /* subtract */
|
|
0, /* illegal */
|
|
L5 | IO, /* magtape */
|
|
L1 | L8 | BREQ, /* branch wm or zone */
|
|
L1 | L8 | BREQ | BBE, /* branch if bit eq */
|
|
0, /* illegal */
|
|
L1 | L4 | L7 | AREQ | BREQ, /* 30: move zones */
|
|
L1 | L4 | L7 | AREQ | BREQ, /* move supress zero */
|
|
0, /* illegal */
|
|
L1 | L4 | L7 | AREQ | BREQ | NOWM, /* set word mark */
|
|
L1 | L4 | L7 | AREQ | BREQ | MDV, /* divide */
|
|
0, /* illegal */
|
|
0, /* illegal */
|
|
0, /* illegal */
|
|
0, /* 40: illegal */
|
|
0, /* illegal */
|
|
L2 | L5, /* select stacker */
|
|
L1 | L4 | L7 | L8 | BREQ | MLS | IO, /* load */
|
|
L1 | L4 | L7 | L8 | BREQ | MLS | IO, /* move */
|
|
HNOP | L1 | L2 | L4 | L5 | L7 | L8, /* nop */
|
|
0, /* illegal */
|
|
L1 | L4 | L7 | AREQ | BREQ | MR, /* move to record */
|
|
L1 | L4 | AREQ | MLS, /* 50: store A addr */
|
|
0, /* illegal */
|
|
L1 | L4 | L7 | AREQ | BREQ, /* zero and subtract */
|
|
0, /* illegal */
|
|
0, /* illegal */
|
|
0, /* illegal */
|
|
0, /* illegal */
|
|
0, /* illegal */
|
|
0, /* 60: illegal */
|
|
L1 | L4 | L7 | AREQ | BREQ, /* add */
|
|
L1 | L4 | L5 | L8, /* branch */
|
|
L1 | L4 | L7 | AREQ | BREQ, /* compare */
|
|
L1 | L4 | L7 | AREQ | BREQ, /* move numeric */
|
|
L1 | L4 | L7 | AREQ | BREQ, /* move char edit */
|
|
L2 | L5, /* carriage control */
|
|
0, /* illegal */
|
|
L1 | L4 | L7 | AREQ | MLS, /* 70: store B addr */
|
|
0, /* illegal */
|
|
L1 | L4 | L7 | AREQ | BREQ, /* zero and add */
|
|
HNOP | L1 | L2 | L4 | L5 | L7 | L8, /* halt */
|
|
L1 | L4 | L7 | AREQ | BREQ, /* clear word mark */
|
|
0, /* illegal */
|
|
0, /* illegal */
|
|
0 /* illegal */
|
|
};
|
|
|
|
const int32 len_table[9] = { 0, L1, L2, 0, L4, L5, 0, L7, L8 };
|
|
|
|
/* Address character conversion tables. Illegal characters are marked by
|
|
the flag BA but also contain the post-adder value for indexing */
|
|
|
|
const int32 hun_table[64] = {
|
|
BA+000, 100, 200, 300, 400, 500, 600, 700,
|
|
800, 900, 000, BA+300, BA+400, BA+500, BA+600, BA+700,
|
|
BA+1000, 1100, 1200, 1300, 1400, 1500, 1600, 1700,
|
|
1800, 1900, 1000, BA+1300, BA+1400, BA+1500, BA+1600, BA+1700,
|
|
BA+2000, 2100, 2200, 2300, 2400, 2500, 2600, 2700,
|
|
2800, 2900, 2000, BA+2300, BA+2400, BA+2500, BA+2600, BA+2700,
|
|
BA+3000, 3100, 3200, 3300, 3400, 3500, 3600, 3700,
|
|
3800, 3900, 3000, BA+3300, BA+3400, BA+3500, BA+3600, BA+3700
|
|
};
|
|
|
|
const int32 ten_table[64] = {
|
|
BA+00, 10, 20, 30, 40, 50, 60, 70,
|
|
80, 90, 00, BA+30, BA+40, BA+50, BA+60, BA+70,
|
|
X1+00, X1+10, X1+20, X1+30, X1+40, X1+50, X1+60, X1+70,
|
|
X1+80, X1+90, X1+00, X1+30, X1+40, X1+50, X1+60, X1+70,
|
|
X2+00, X2+10, X2+20, X2+30, X2+40, X2+50, X2+60, X2+70,
|
|
X2+80, X2+90, X2+00, X2+30, X2+40, X2+50, X2+60, X2+70,
|
|
X3+00, X3+10, X3+20, X3+30, X3+40, X3+50, X3+60, X3+70,
|
|
X3+80, X3+90, X3+00, X3+30, X3+40, X3+50, X3+60, X3+70
|
|
};
|
|
|
|
const int32 one_table[64] = {
|
|
BA+0, 1, 2, 3, 4, 5, 6, 7,
|
|
8, 9, 0, BA+3, BA+4, BA+5, BA+6, BA+7,
|
|
BA+4000, 4001, 4002, 4003, 4004, 4005, 4006, 4007,
|
|
4008, 4009, 4000, BA+4003, BA+4004, BA+4005, BA+4006, BA+4007,
|
|
BA+8000, 8001, 8002, 8003, 8004, 8005, 8006, 8007,
|
|
8008, 8009, 8000, BA+8003, BA+8004, BA+8005, BA+8006, BA+8007,
|
|
BA+12000, 12001, 12002, 12003, 12004, 12005, 12006, 12007,
|
|
12008, 12009, 12000, BA+12003, BA+12004, BA+12005, BA+12006, BA+12007
|
|
};
|
|
|
|
const int32 bin_to_bcd[16] = {
|
|
10, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15
|
|
};
|
|
|
|
const int32 bcd_to_bin[16] = {
|
|
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 3, 4, 5, 6, 7
|
|
};
|
|
|
|
/* Indicator resets - a 1 marks an indicator that resets when tested */
|
|
|
|
static const int32 ind_table[64] = {
|
|
0, 0, 0, 0, 0, 0, 0, 0, /* 00 - 07 */
|
|
0, 0, 0, 0, 0, 0, 0, 0, /* 10 - 17 */
|
|
0, 0, 0, 0, 0, 0, 0, 0, /* 20 - 27 */
|
|
0, 1, 1, 0, 1, 0, 0, 0, /* 30 - 37 */
|
|
0, 0, 0, 0, 0, 0, 0, 0, /* 40 - 47 */
|
|
0, 0, 1, 0, 1, 0, 0, 0, /* 50 - 57 */
|
|
0, 0, 0, 0, 0, 0, 0, 0, /* 60 - 67 */
|
|
0, 0, 1, 0, 0, 0, 0, 0 /* 70 - 77 */
|
|
};
|
|
|
|
/* Character collation table for compare with HLE option */
|
|
|
|
static const int32 col_table[64] = {
|
|
000, 067, 070, 071, 072, 073, 074, 075,
|
|
076, 077, 066, 024, 025, 026, 027, 030,
|
|
023, 015, 056, 057, 060, 061, 062, 063,
|
|
064, 065, 055, 016, 017, 020, 021, 022,
|
|
014, 044, 045, 046, 047, 050, 051, 052,
|
|
053, 054, 043, 007, 010, 011, 012, 013,
|
|
006, 032, 033, 034, 035, 036, 037, 040,
|
|
041, 042, 031, 001, 002, 003, 004, 005
|
|
};
|
|
|
|
/* Summing table for two decimal digits, converted back to BCD
|
|
Also used for multiplying two decimal digits, converted back to BCD,
|
|
with carry forward
|
|
*/
|
|
|
|
static const int32 sum_table[100] = {
|
|
BCD_ZERO, BCD_ONE, BCD_TWO, BCD_THREE, BCD_FOUR,
|
|
BCD_FIVE, BCD_SIX, BCD_SEVEN, BCD_EIGHT, BCD_NINE,
|
|
BCD_ZERO, BCD_ONE, BCD_TWO, BCD_THREE, BCD_FOUR,
|
|
BCD_FIVE, BCD_SIX, BCD_SEVEN, BCD_EIGHT, BCD_NINE,
|
|
BCD_ZERO, BCD_ONE, BCD_TWO, BCD_THREE, BCD_FOUR,
|
|
BCD_FIVE, BCD_SIX, BCD_SEVEN, BCD_EIGHT, BCD_NINE,
|
|
BCD_ZERO, BCD_ONE, BCD_TWO, BCD_THREE, BCD_FOUR,
|
|
BCD_FIVE, BCD_SIX, BCD_SEVEN, BCD_EIGHT, BCD_NINE,
|
|
BCD_ZERO, BCD_ONE, BCD_TWO, BCD_THREE, BCD_FOUR,
|
|
BCD_FIVE, BCD_SIX, BCD_SEVEN, BCD_EIGHT, BCD_NINE,
|
|
BCD_ZERO, BCD_ONE, BCD_TWO, BCD_THREE, BCD_FOUR,
|
|
BCD_FIVE, BCD_SIX, BCD_SEVEN, BCD_EIGHT, BCD_NINE,
|
|
BCD_ZERO, BCD_ONE, BCD_TWO, BCD_THREE, BCD_FOUR,
|
|
BCD_FIVE, BCD_SIX, BCD_SEVEN, BCD_EIGHT, BCD_NINE,
|
|
BCD_ZERO, BCD_ONE, BCD_TWO, BCD_THREE, BCD_FOUR,
|
|
BCD_FIVE, BCD_SIX, BCD_SEVEN, BCD_EIGHT, BCD_NINE,
|
|
BCD_ZERO, BCD_ONE, BCD_TWO, BCD_THREE, BCD_FOUR,
|
|
BCD_FIVE, BCD_SIX, BCD_SEVEN, BCD_EIGHT, BCD_NINE,
|
|
BCD_ZERO, BCD_ONE, BCD_TWO, BCD_THREE, BCD_FOUR,
|
|
BCD_FIVE, BCD_SIX, BCD_SEVEN, BCD_EIGHT, BCD_NINE
|
|
};
|
|
|
|
static const int32 cry_table[100] = {
|
|
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
|
1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
|
|
2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
|
|
3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
|
|
4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
|
|
5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
|
|
6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
|
|
7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
|
|
8, 8, 8, 8, 8, 8, 8, 8, 8, 8,
|
|
9, 9, 9, 9, 9, 9, 9, 9, 9, 9
|
|
};
|
|
|
|
/* Legal modifier tables */
|
|
|
|
static const int32 r_mod[] = {
|
|
BCD_C, -1
|
|
};
|
|
static const int32 p_mod[] = {
|
|
BCD_C, -1
|
|
};
|
|
static const int32 w_mod[] = {
|
|
BCD_S, BCD_SQUARE, -1
|
|
};
|
|
static const int32 ss_mod[] = {
|
|
BCD_ONE, BCD_TWO, BCD_FOUR, BCD_EIGHT,
|
|
BCD_DOLLAR, BCD_DECIMAL, BCD_SQUARE, -1
|
|
};
|
|
static const int32 mtf_mod[] = {
|
|
BCD_A, BCD_B, BCD_E,
|
|
BCD_M, BCD_R, BCD_U, -1
|
|
};
|
|
|
|
t_stat sim_instr (void)
|
|
{
|
|
int32 IS, ilnt, flags;
|
|
int32 op, xa, t, wm, ioind = 0, dev = 0, unit = 0;
|
|
int32 a, b, i, k, asave, bsave;
|
|
int32 carry, lowprd, sign, ps;
|
|
int32 quo, qs;
|
|
int32 qzero, qawm, qbody, qsign, qdollar, qaster, qdecimal;
|
|
t_stat reason, r1, r2;
|
|
|
|
/* Restore saved state */
|
|
|
|
IS = saved_IS;
|
|
if (as_err) /* flag bad addresses */
|
|
AS = AS | BA;
|
|
if (bs_err)
|
|
BS = BS | BA;
|
|
as_err = bs_err = 0; /* reset error flags */
|
|
reason = 0;
|
|
|
|
/* Main instruction fetch/decode loop */
|
|
|
|
while (reason == 0) { /* loop until halted */
|
|
|
|
if (hb_pend) { /* halt br pending? */
|
|
hb_pend = 0; /* clear flag */
|
|
BRANCH; /* execute branch */
|
|
}
|
|
|
|
saved_IS = IS; /* commit prev instr */
|
|
if (sim_interval <= 0) { /* check clock queue */
|
|
if ((reason = sim_process_event ()))
|
|
break;
|
|
}
|
|
|
|
if (sim_brk_summ && sim_brk_test (IS, SWMASK ('E'))) { /* breakpoint? */
|
|
reason = STOP_IBKPT; /* stop simulation */
|
|
break;
|
|
}
|
|
|
|
sim_interval = sim_interval - 1;
|
|
|
|
/* Instruction fetch - 1401 fetch works as follows:
|
|
|
|
- Each character fetched enters the B register. This register is not
|
|
visible; the variable t represents the B register.
|
|
- Except for the first and last cycles, each character fetched enters
|
|
the A register. This register is not visible; the variable D represents
|
|
the A register, because this is the instruction modifier for 2, 5, and 8
|
|
character instructions.
|
|
- At the start of the second cycle (first address character), the A-address
|
|
register and, for most instructions, the B-address register, are cleared
|
|
to blanks. The simulator represents addresses in binary and creates the
|
|
effect of blanks (address is bad) if less than three A-address characters
|
|
are found. Further, the simulator accumulates only the A-address, and
|
|
replicates it to the B-address at the appropriate point.
|
|
- At the start of the fifth cycle (fourth address character), the B-address
|
|
register is cleared to blanks. Again, the simulator creates the effect of
|
|
blanks (address is bad) if less than three B-address characters are found.
|
|
|
|
The 1401 does not explicitly check for valid instruction lengths. Most 2,
|
|
3, 5, 6 character instructions will be invalid because the A-address or
|
|
B-address (or both) are invalid.
|
|
*/
|
|
|
|
if ((M[IS] & WM) == 0) { /* I-Op: WM under op? */
|
|
reason = STOP_NOWM; /* no, error */
|
|
break;
|
|
}
|
|
op = M[IS] & CHAR; /* get opcode */
|
|
flags = op_table[op]; /* get op flags */
|
|
if ((flags == 0) || (flags & ALLOPT & ~cpu_unit.flags)) {
|
|
reason = STOP_NXI; /* illegal inst? */
|
|
break;
|
|
}
|
|
if (op == OP_SAR) /* SAR? save ASTAR */
|
|
BS = AS;
|
|
PP (IS);
|
|
|
|
if ((t = M[IS]) & WM) /* I-1: WM? 1 char inst */
|
|
goto CHECK_LENGTH;
|
|
D = ioind = t; /* could be D char, % */
|
|
AS = hun_table[t]; /* could be A addr */
|
|
PP (IS); /* if %xy, BA is set */
|
|
|
|
if ((t = M[IS]) & WM) { /* I-2: WM? 2 char inst */
|
|
AS = AS | BA; /* ASTAR bad */
|
|
if (!(flags & MLS))
|
|
BS = AS;
|
|
goto CHECK_LENGTH;
|
|
}
|
|
D = dev = t; /* could be D char, dev */
|
|
AS = AS + ten_table[t]; /* build A addr */
|
|
PP (IS);
|
|
|
|
if ((t = M[IS]) & WM) { /* I-3: WM? 3 char inst */
|
|
AS = AS | BA; /* ASTAR bad */
|
|
if (!(flags & MLS))
|
|
BS = AS;
|
|
goto CHECK_LENGTH;
|
|
}
|
|
D = unit = t; /* could be D char, unit */
|
|
if (unit == BCD_ZERO) /* convert unit to binary */
|
|
unit = 0;
|
|
AS = AS + one_table[t]; /* finish A addr */
|
|
xa = (AS >> V_INDEX) & M_INDEX; /* get index reg */
|
|
if (xa && (ioind != BCD_PERCNT) && (cpu_unit.flags & XSA)) { /* indexed? */
|
|
AS = AS + hun_table[M[xa] & CHAR] + ten_table[M[xa + 1] & CHAR] +
|
|
one_table[M[xa + 2] & CHAR];
|
|
AS = (AS & INDEXMASK) % MAXMEMSIZE;
|
|
}
|
|
if (!(flags & MLS)) /* not MLS? B = A */
|
|
BS = AS;
|
|
PP (IS);
|
|
|
|
if ((t = M[IS]) & WM) /* I-4: WM? 4 char inst */
|
|
goto CHECK_LENGTH;
|
|
if ((op == OP_B) && (t == BCD_BLANK)) /* BR + space? */
|
|
goto CHECK_LENGTH;
|
|
D = t; /* could be D char */
|
|
BS = hun_table[t]; /* could be B addr */
|
|
PP (IS);
|
|
|
|
if ((t = M[IS]) & WM) { /* I-5: WM? 5 char inst */
|
|
BS = BS | BA; /* BSTAR bad */
|
|
goto CHECK_LENGTH;
|
|
}
|
|
D = t; /* could be D char */
|
|
BS = BS + ten_table[t]; /* build B addr */
|
|
PP (IS);
|
|
|
|
if ((t = M[IS]) & WM) { /* I-6: WM? 6 char inst */
|
|
BS = BS | BA; /* BSTAR bad */
|
|
goto CHECK_LENGTH;
|
|
}
|
|
D = t; /* could be D char */
|
|
BS = BS + one_table[t]; /* finish B addr */
|
|
xa = (BS >> V_INDEX) & M_INDEX; /* get index reg */
|
|
if (xa && (cpu_unit.flags & XSA)) { /* indexed? */
|
|
BS = BS + hun_table[M[xa] & CHAR] + ten_table[M[xa + 1] & CHAR] +
|
|
one_table[M[xa + 2] & CHAR];
|
|
BS = (BS & INDEXMASK) % MAXMEMSIZE;
|
|
}
|
|
PP (IS);
|
|
|
|
if (flags & NOWM) /* I-7: SWM? done */
|
|
goto CHECK_LENGTH;
|
|
if ((t = M[IS]) & WM) /* WM? 7 char inst */
|
|
goto CHECK_LENGTH;
|
|
D = t; /* last char is D */
|
|
while (((t = M[IS]) & WM) == 0) { /* I-8: repeats until WM */
|
|
D = t; /* last char is D */
|
|
PP (IS);
|
|
}
|
|
if (reason) /* addr err on last? */
|
|
break;
|
|
|
|
CHECK_LENGTH:
|
|
if ((flags & BREQ) && ADDR_ERR (BS)) { /* valid B? */
|
|
reason = STOP_INVB;
|
|
break;
|
|
}
|
|
if ((flags & AREQ) && ADDR_ERR (AS)) { /* valid A? */
|
|
reason = STOP_INVA;
|
|
break;
|
|
}
|
|
ilnt = IS - saved_IS; /* get lnt */
|
|
if (hst_lnt) { /* history enabled? */
|
|
hst_p = (hst_p + 1); /* next entry */
|
|
if (hst_p >= hst_lnt)
|
|
hst_p = 0;
|
|
hst[hst_p].is = saved_IS; /* save IS */
|
|
hst[hst_p].ilnt = ilnt;
|
|
for (i = 0; (i < MAX_L) && (i < ilnt); i++)
|
|
hst[hst_p].inst[i] = M[saved_IS + i];
|
|
}
|
|
if (DEBUG_PRS (cpu_dev)) {
|
|
fprint_val (sim_deb, saved_IS, 10, 5, PV_RSPC);
|
|
fprintf (sim_deb, ": " );
|
|
for (i = 0; i < sim_emax; i++)
|
|
sim_eval[i] = 0;
|
|
for (i = 0, k = saved_IS; i < sim_emax; i++, k++) {
|
|
if (cpu_ex (&sim_eval[i], k, &cpu_unit, 0) != SCPE_OK)
|
|
break;
|
|
}
|
|
fprint_sym (sim_deb, saved_IS, sim_eval, &cpu_unit, SWMASK('M'));
|
|
fprintf (sim_deb, "\n" );
|
|
}
|
|
switch (op) { /* case on opcode */
|
|
|
|
/* Move/load character instructions A check B check
|
|
|
|
MCW copy A to B, preserving B WM, here fetch
|
|
until either A or B WM
|
|
LCA copy A to B, overwriting B WM, here fetch
|
|
until A WM
|
|
|
|
Instruction lengths:
|
|
|
|
1 chained A and B
|
|
2,3 invalid A-address
|
|
4 chained B address
|
|
5,6 invalid B-address - checked in fetch
|
|
7 normal
|
|
8+ normal + modifier
|
|
*/
|
|
|
|
case OP_MCW: /* move char */
|
|
if ((ilnt >= 4) && (ioind == BCD_PERCNT)) { /* I/O form? */
|
|
reason = iodisp (dev, unit, MD_NORM, D); /* dispatch I/O */
|
|
break;
|
|
}
|
|
if (ADDR_ERR (AS)) { /* check A addr */
|
|
reason = STOP_INVA;
|
|
break;
|
|
}
|
|
do {
|
|
wm = M[AS] | M[BS];
|
|
M[BS] = (M[BS] & WM) | (M[AS] & CHAR); /* move char */
|
|
MM (AS); /* decr pointers */
|
|
MM (BS);
|
|
} while ((wm & WM) == 0); /* stop on A,B WM */
|
|
break;
|
|
|
|
case OP_LCA: /* load char */
|
|
if ((ilnt >= 4) && (ioind == BCD_PERCNT)) { /* I/O form? */
|
|
reason = iodisp (dev, unit, MD_WM, D);
|
|
break;
|
|
}
|
|
if (ADDR_ERR (AS)) { /* check A addr */
|
|
reason = STOP_INVA;
|
|
break;
|
|
}
|
|
do {
|
|
wm = M[BS] = M[AS]; /* move char + wmark */
|
|
MM (AS); /* decr pointers */
|
|
MM (BS);
|
|
} while ((wm & WM) == 0); /* stop on A WM */
|
|
break;
|
|
|
|
/* Other move instructions A check B check
|
|
|
|
MCM copy A to B, preserving B WM, fetch fetch
|
|
until record or group mark
|
|
MCS copy A to B, clearing B WM, until A WM; fetch fetch
|
|
reverse scan and suppress leading zeroes
|
|
MN copy A char digit to B char digit, fetch fetch
|
|
preserving B zone and WM
|
|
MZ copy A char zone to B char zone, fetch fetch
|
|
preserving B digit and WM
|
|
|
|
Instruction lengths:
|
|
|
|
1 chained
|
|
2,3 invalid A-address - checked in fetch
|
|
4 self (B-address = A-address)
|
|
5,6 invalid B-address - checked in fetch
|
|
7 normal
|
|
8+ normal + ignored modifier
|
|
*/
|
|
|
|
case OP_MCM: /* move to rec/group */
|
|
do {
|
|
t = M[AS];
|
|
M[BS] = (M[BS] & WM) | (M[AS] & CHAR); /* move char */
|
|
PP (AS); /* incr pointers */
|
|
PP (BS);
|
|
} while (((t & CHAR) != BCD_RECMRK) && (t != (BCD_GRPMRK + WM)));
|
|
break;
|
|
|
|
case OP_MCS: /* move suppress zero */
|
|
bsave = BS; /* save B start */
|
|
qzero = 1; /* set suppress */
|
|
do {
|
|
wm = M[AS];
|
|
M[BS] = M[AS] & ((BS != bsave)? CHAR: DIGIT);/* copy char */
|
|
MM (AS); /* decr pointers */
|
|
MM (BS);
|
|
} while ((wm & WM) == 0); /* stop on A WM */
|
|
if (reason) /* addr err? stop */
|
|
break;
|
|
do {
|
|
PP (BS); /* adv B */
|
|
t = M[BS]; /* get B, cant be WM */
|
|
if ((t == BCD_ZERO) || (t == BCD_COMMA)) {
|
|
if (qzero)
|
|
M[BS] = 0;
|
|
}
|
|
else if ((t == BCD_BLANK) || (t == BCD_MINUS)) ;
|
|
else if (((t == BCD_DECIMAL) && (cpu_unit.flags & EPE)) ||
|
|
(t <= BCD_NINE))
|
|
qzero = 0;
|
|
else qzero = 1;
|
|
} while (BS < bsave);
|
|
PP (BS); /* BS end is B+1 */
|
|
break;
|
|
|
|
case OP_MN: /* move numeric */
|
|
M[BS] = (M[BS] & ~DIGIT) | (M[AS] & DIGIT); /* move digit */
|
|
MM (AS); /* decr pointers */
|
|
MM (BS);
|
|
break;
|
|
|
|
case OP_MZ: /* move zone */
|
|
M[BS] = (M[BS] & ~ZONE) | (M[AS] & ZONE); /* move high bits */
|
|
MM (AS); /* decr pointers */
|
|
MM (BS);
|
|
break;
|
|
|
|
/* Branch instruction A check B check
|
|
|
|
Instruction lengths:
|
|
|
|
1 branch if B char equals d, chained if branch here
|
|
2,3 invalid B-address if branch here
|
|
4 unconditional branch if branch
|
|
5 branch if indicator[d] is set if branch
|
|
6 invalid B-address if branch here
|
|
7 branch if B char equals d, if branch here
|
|
d is last character of B-address
|
|
8 branch if B char equals d if branch here
|
|
*/
|
|
|
|
case OP_B: /* branch */
|
|
if (ilnt == 4) { /* uncond branch? */
|
|
BRANCH;
|
|
}
|
|
else if (ilnt == 5) { /* branch on ind? */
|
|
if (ind[D]) { /* test indicator */
|
|
BRANCH;
|
|
}
|
|
if (ind_table[D]) /* reset if needed */
|
|
ind[D] = 0;
|
|
}
|
|
else { /* branch char eq */
|
|
if (ADDR_ERR (BS)) { /* validate B addr */
|
|
reason = STOP_INVB;
|
|
break;
|
|
}
|
|
if ((M[BS] & CHAR) == D) { /* char equal? */
|
|
BRANCH;
|
|
}
|
|
else {
|
|
MM (BS);
|
|
}
|
|
}
|
|
break;
|
|
|
|
/* Other branch instructions A check B check
|
|
|
|
BWZ branch if (d<0>: B char WM) if branch fetch
|
|
(d<1>: B char zone = d zone)
|
|
BBE branch if B char & d non-zero if branch fetch
|
|
|
|
Instruction lengths:
|
|
1 chained
|
|
2,3 invalid A-address and B-address
|
|
4 self (B-address = A-address, d = last character of A-address)
|
|
5,6 invalid B-address
|
|
7 normal, d = last character of B-address
|
|
8+ normal
|
|
*/
|
|
|
|
case OP_BWZ: /* branch wm or zone */
|
|
if (((D & 1) && (M[BS] & WM)) || /* d1? test wm */
|
|
((D & 2) && ((M[BS] & ZONE) == (D & ZONE)))) { /* d2? test zone */
|
|
BRANCH;
|
|
}
|
|
else { /* decr pointer */
|
|
MM (BS);
|
|
}
|
|
break;
|
|
|
|
case OP_BBE: /* branch if bit eq */
|
|
if (M[BS] & D & CHAR) { /* any bits set? */
|
|
BRANCH;
|
|
}
|
|
else { /* decr pointer */
|
|
MM (BS);
|
|
}
|
|
break;
|
|
|
|
/* Arithmetic instructions A check B check
|
|
|
|
ZA move A to B, normalizing A sign, fetch fetch
|
|
preserving B WM, until B WM
|
|
ZS move A to B, complementing A sign, fetch fetch
|
|
preserving B WM, until B WM
|
|
A add A to B fetch fetch
|
|
S subtract A from B fetch fetch
|
|
C compare A to B fetch fetch
|
|
|
|
Instruction lengths:
|
|
|
|
1 chained
|
|
2,3 invalid A-address
|
|
4 self (B-address = A-address)
|
|
5,6 invalid B-address
|
|
7 normal
|
|
8+ normal + ignored modifier
|
|
|
|
Despite their names, ZA and ZS are not arithmetic instructions, but copies
|
|
with zone stripping. The adder is not used, so BCD conversions do not occur.
|
|
*/
|
|
|
|
case OP_ZA: case OP_ZS: /* zero and add/sub */
|
|
a = i = 0; /* clear flags */
|
|
do {
|
|
if (a & WM) /* A word mark? */
|
|
wm = M[BS] = (M[BS] & WM) | BCD_ZERO;
|
|
else {
|
|
a = M[AS]; /* get A char */
|
|
t = a & DIGIT; /* zap zone bits */
|
|
wm = M[BS] = (M[BS] & WM) | t; /* store digit */
|
|
MM (AS);
|
|
}
|
|
if (i == 0)
|
|
i = M[BS] = M[BS] |
|
|
((((a & ZONE) == BBIT) ^ (op == OP_ZS))? BBIT: ZONE);
|
|
MM (BS);
|
|
} while ((wm & WM) == 0); /* stop on B WM */
|
|
break;
|
|
|
|
case OP_A: case OP_S: /* add/sub */
|
|
bsave = BS; /* save sign pos */
|
|
a = M[AS]; /* get A digit/sign */
|
|
b = M[BS]; /* get B digit/sign */
|
|
MM (AS);
|
|
qsign = ((a & ZONE) == BBIT) ^ ((b & ZONE) == BBIT) ^ (op == OP_S);
|
|
t = bcd_to_bin[a & DIGIT]; /* get A binary */
|
|
t = bcd_to_bin[b & DIGIT] + (qsign? 10 - t: t); /* sum A + B */
|
|
carry = (t >= 10); /* get carry */
|
|
b = (b & ~DIGIT) | sum_table[t]; /* get result */
|
|
if (qsign && ((b & BBIT) == 0)) /* normalize sign */
|
|
b = b | ZONE;
|
|
M[BS] = b; /* store result */
|
|
MM (BS);
|
|
if (b & WM) { /* b wm? done */
|
|
if ((qsign != 0) && (carry == 0)) /* eff sub and no carry? */
|
|
M[bsave] = WM + ((b & ZONE) ^ ABIT) + sum_table[10 - t];
|
|
if ((qsign == 0) && (carry != 0)) /* eff add and carry */
|
|
ind[IN_OVF] = 1; /* overflow */
|
|
break;
|
|
}
|
|
do {
|
|
if (a & WM) /* A WM? char = 0 */
|
|
a = WM;
|
|
else {
|
|
a = M[AS]; /* else get A */
|
|
MM (AS);
|
|
}
|
|
b = M[BS]; /* get B */
|
|
t = bcd_to_bin[a & DIGIT]; /* get A binary */
|
|
t = bcd_to_bin[b & DIGIT] + (qsign? 9 - t: t) + carry;
|
|
carry = (t >= 10); /* get carry */
|
|
if ((b & WM) && (qsign == 0)) { /* last, no recomp? */
|
|
M[BS] = WM + sum_table[t] + /* zone add */
|
|
(((a & ZONE) + b + (carry? ABIT: 0)) & ZONE);
|
|
if (carry != 0) /* carry out? */
|
|
ind[IN_OVF] = 1; /* ovflo if carry */
|
|
}
|
|
else M[BS] = (b & WM) + sum_table[t]; /* normal add */
|
|
MM (BS);
|
|
} while ((b & WM) == 0); /* stop on B WM */
|
|
if (reason) /* address err? */
|
|
break;
|
|
if (qsign && (carry == 0)) { /* recompl, no carry? */
|
|
M[bsave] = M[bsave] ^ ABIT; /* XOR sign */
|
|
for (carry = 1; bsave != BS; --bsave) { /* rescan */
|
|
t = 9 - bcd_to_bin[M[bsave] & DIGIT] + carry;
|
|
carry = (t >= 10);
|
|
M[bsave] = (M[bsave] & ~DIGIT) | sum_table[t];
|
|
}
|
|
}
|
|
break;
|
|
|
|
case OP_C: /* compare */
|
|
if (ilnt != 1) { /* if not chained */
|
|
ind[IN_EQU] = 1; /* clear indicators */
|
|
ind[IN_UNQ] = ind[IN_HGH] = ind[IN_LOW] = 0;
|
|
}
|
|
do {
|
|
a = M[AS]; /* get characters */
|
|
b = M[BS];
|
|
wm = a | b; /* get word marks */
|
|
if ((a & CHAR) != (b & CHAR)) { /* unequal? */
|
|
ind[IN_EQU] = 0; /* set indicators */
|
|
ind[IN_UNQ] = 1;
|
|
ind[IN_HGH] = col_table[b & CHAR] > col_table [a & CHAR];
|
|
ind[IN_LOW] = ind[IN_HGH] ^ 1;
|
|
}
|
|
MM (AS); /* decr pointers */
|
|
MM (BS);
|
|
} while ((wm & WM) == 0); /* stop on A, B WM */
|
|
if ((a & WM) && !(b & WM)) { /* short A field? */
|
|
ind[IN_EQU] = ind[IN_LOW] = 0;
|
|
ind[IN_UNQ] = ind[IN_HGH] = 1;
|
|
}
|
|
if (!(cpu_unit.flags & HLE)) /* no HLE? */
|
|
ind[IN_EQU] = ind[IN_LOW] = ind[IN_HGH] = 0;
|
|
break;
|
|
|
|
/* I/O instructions A check B check
|
|
|
|
R read a card if branch
|
|
W write to line printer if branch
|
|
WR write and read if branch
|
|
P punch a card if branch
|
|
RP read and punch if branch
|
|
WP write and punch if branch
|
|
WRP write read and punch if branch
|
|
RF read feed (nop)
|
|
PF punch feed (nop)
|
|
SS select stacker if branch
|
|
CC carriage control if branch
|
|
|
|
Instruction lengths:
|
|
|
|
1 normal
|
|
2,3 normal, with modifier
|
|
4 branch; modifier, if any, is last character of branch address
|
|
5 branch + modifier
|
|
6+ normal, with modifier
|
|
*/
|
|
|
|
case OP_R: /* read */
|
|
if ((reason = iomod (ilnt, D, r_mod))) /* valid modifier? */
|
|
break;
|
|
reason = read_card (ilnt, D); /* read card */
|
|
BS = CDR_BUF + CDR_WIDTH;
|
|
if ((ilnt == 4) || (ilnt == 5)) { /* check for branch */
|
|
BRANCH;
|
|
}
|
|
break;
|
|
|
|
case OP_W: /* write */
|
|
if ((reason = iomod (ilnt, D, w_mod))) /* valid modifier? */
|
|
break;
|
|
reason = write_line (ilnt, D); /* print line */
|
|
BS = LPT_BUF + LPT_WIDTH;
|
|
if ((ilnt == 4) || (ilnt == 5)) { /* check for branch */
|
|
BRANCH;
|
|
}
|
|
break;
|
|
|
|
case OP_P: /* punch */
|
|
if ((reason = iomod (ilnt, D, p_mod))) /* valid modifier? */
|
|
break;
|
|
reason = punch_card (ilnt, D); /* punch card */
|
|
BS = CDP_BUF + CDP_WIDTH;
|
|
if ((ilnt == 4) || (ilnt == 5)) { /* check for branch */
|
|
BRANCH;
|
|
}
|
|
break;
|
|
|
|
case OP_WR: /* write and read */
|
|
if ((reason = iomod (ilnt, D, w_mod))) /* valid modifier? */
|
|
break;
|
|
reason = write_line (ilnt, D); /* print line */
|
|
r1 = read_card (ilnt, D); /* read card */
|
|
BS = CDR_BUF + CDR_WIDTH;
|
|
if ((ilnt == 4) || (ilnt == 5)) { /* check for branch */
|
|
BRANCH;
|
|
}
|
|
if (reason == SCPE_OK) /* merge errors */
|
|
reason = r1;
|
|
break;
|
|
|
|
case OP_WP: /* write and punch */
|
|
if ((reason = iomod (ilnt, D, w_mod))) /* valid modifier? */
|
|
break;
|
|
reason = write_line (ilnt, D); /* print line */
|
|
r1 = punch_card (ilnt, D); /* punch card */
|
|
BS = CDP_BUF + CDP_WIDTH;
|
|
if ((ilnt == 4) || (ilnt == 5)) { /* check for branch */
|
|
BRANCH;
|
|
}
|
|
if (reason == SCPE_OK) /* merge errors */
|
|
reason = r1;
|
|
break;
|
|
|
|
case OP_RP: /* read and punch */
|
|
if ((reason = iomod (ilnt, D, NULL))) /* valid modifier? */
|
|
break;
|
|
reason = read_card (ilnt, D); /* read card */
|
|
r1 = punch_card (ilnt, D); /* punch card */
|
|
BS = CDP_BUF + CDP_WIDTH;
|
|
if ((ilnt == 4) || (ilnt == 5)) { /* check for branch */
|
|
BRANCH;
|
|
}
|
|
if (reason == SCPE_OK) /* merge errors */
|
|
reason = r1;
|
|
break;
|
|
|
|
case OP_WRP: /* write, read, punch */
|
|
if ((reason = iomod (ilnt, D, w_mod))) /* valid modifier? */
|
|
break;
|
|
reason = write_line (ilnt, D); /* print line */
|
|
r1 = read_card (ilnt, D); /* read card */
|
|
r2 = punch_card (ilnt, D); /* punch card */
|
|
BS = CDP_BUF + CDP_WIDTH;
|
|
if ((ilnt == 4) || (ilnt == 5)) { /* check for branch */
|
|
BRANCH;
|
|
}
|
|
if (reason == SCPE_OK) /* merge errors */
|
|
reason = (r1 == SCPE_OK)? r2: r1;
|
|
break;
|
|
|
|
case OP_SS: /* select stacker */
|
|
if ((reason = iomod (ilnt, D, ss_mod))) /* valid modifier? */
|
|
break;
|
|
if ((reason = select_stack (D))) /* sel stack, error? */
|
|
break;
|
|
if ((ilnt == 4) || (ilnt == 5)) { /* check for branch */
|
|
BRANCH;
|
|
}
|
|
break;
|
|
|
|
case OP_CC: /* carriage control */
|
|
if ((reason = carriage_control (D))) /* car ctrl, error? */
|
|
break;
|
|
if ((ilnt == 4) || (ilnt == 5)) { /* check for branch */
|
|
BRANCH;
|
|
}
|
|
break;
|
|
|
|
/* MTF - magtape functions - must be at least 4 characters
|
|
|
|
Instruction lengths:
|
|
|
|
1-3 invalid I/O address - checked here
|
|
4 normal, d-character is unit
|
|
5 normal, d-character is last character
|
|
6+ normal, d-character is last character
|
|
*/
|
|
|
|
case OP_MTF: /* magtape function */
|
|
if (ilnt < 4) { /* too short? */
|
|
reason = STOP_INVL;
|
|
break;
|
|
}
|
|
if (ioind != BCD_PERCNT) { /* valid dev addr? */
|
|
reason = STOP_INVA;
|
|
break;
|
|
}
|
|
if ((reason = iomod (ilnt, D, mtf_mod))) /* valid modifier? */
|
|
break;
|
|
|
|
if (dev == IO_MT) /* BCD? */
|
|
reason = mt_func (unit, 0, D);
|
|
else if (dev == IO_MTB) /* binary? */
|
|
reason = mt_func (unit, MD_BIN, D);
|
|
else reason = STOP_INVA; /* wrong device */
|
|
break; /* can't branch */
|
|
|
|
case OP_RF: case OP_PF: /* read, punch feed */
|
|
break; /* nop's */
|
|
|
|
/* Move character and edit
|
|
|
|
Control flags
|
|
qsign sign of A field (0 = +, 1 = minus)
|
|
qawm A field WM seen and processed
|
|
qzero zero suppression enabled
|
|
qbody in body (copying A field characters)
|
|
qdollar EPE only; $ seen in body
|
|
qaster EPE only; * seen in body
|
|
qdecimal EPE only; . seen on first rescan
|
|
|
|
MCE operates in one to three scans, the first of which has three phases
|
|
|
|
1 right to left qbody = 0, qawm = 0 => right status
|
|
qbody = 1, qawm = 0 => body
|
|
qbody = 0, qawm = 1 => left status
|
|
2 left to right
|
|
3 right to left, extended print end only
|
|
|
|
The first A field character is masked to its digit part, all others
|
|
are copied intact
|
|
|
|
Instruction lengths:
|
|
|
|
1 chained
|
|
2,3 invalid A-address - checked in fetch
|
|
4 self (B-address = A-address)
|
|
5,6 invalid B-address - checked in fetch
|
|
7 normal
|
|
8+ normal + ignored modifier
|
|
*/
|
|
|
|
case OP_MCE: /* edit */
|
|
a = M[AS]; /* get A char */
|
|
b = M[BS]; /* get B char */
|
|
t = a & DIGIT; /* get A digit */
|
|
MM (AS);
|
|
qsign = ((a & ZONE) == BBIT); /* get A field sign */
|
|
qawm = qzero = qbody = 0; /* clear other flags */
|
|
qdollar = qaster = qdecimal = 0; /* clear EPE flags */
|
|
|
|
/* Edit pass 1 - from right to left, under B field control
|
|
|
|
* in status or !epe, skip B; else, set qaster, repl with A
|
|
$ in status or !epe, skip B; else, set qdollar, repl with A
|
|
0 in right status or body, if !qzero, set A WM; set qzero, repl with A
|
|
else, if !qzero, skip B; else, if (!B WM) set B WM
|
|
blank in right status or body, repl with A; else, skip B
|
|
C,R,- in status, blank B; else, skip B
|
|
, in status, blank B, else, skip B
|
|
& blank B
|
|
*/
|
|
|
|
do {
|
|
b = M[BS]; /* get B char */
|
|
M[BS] = M[BS] & ~WM; /* clr WM */
|
|
switch (b & CHAR) { /* case on B char */
|
|
|
|
case BCD_ASTER: /* * */
|
|
if (!qbody || qdollar || !(cpu_unit.flags & EPE))
|
|
break;
|
|
qaster = 1; /* flag */
|
|
goto A_CYCLE; /* take A cycle */
|
|
|
|
case BCD_DOLLAR: /* $ */
|
|
if (!qbody || qaster || !(cpu_unit.flags & EPE))
|
|
break;
|
|
qdollar = 1; /* flag */
|
|
goto A_CYCLE; /* take A cycle */
|
|
|
|
case BCD_ZERO: /* 0 */
|
|
if (qawm) { /* left status? */
|
|
if (!qzero) /* first? set WM */
|
|
M[BS] = M[BS] | WM;
|
|
qzero = 1; /* flag suppress */
|
|
break;
|
|
}
|
|
if (!qzero) /* body, first? WM */
|
|
t = t | WM;
|
|
qzero = 1; /* flag suppress */
|
|
goto A_CYCLE; /* take A cycle */
|
|
|
|
case BCD_BLANK: /* blank */
|
|
if (qawm) /* left status? */
|
|
break;
|
|
A_CYCLE:
|
|
M[BS] = t; /* copy char */
|
|
if (a & WM) { /* end of A field? */
|
|
qbody = 0; /* end body */
|
|
qawm = 1; /* start left status */
|
|
}
|
|
else {
|
|
qbody = 1; /* in body */
|
|
a = M[AS]; /* next A */
|
|
MM (AS);
|
|
t = a & CHAR; /* use A char */
|
|
}
|
|
break;
|
|
|
|
case BCD_C: case BCD_R: case BCD_MINUS: /* C, R, - */
|
|
if (!qsign && !qbody) /* + & status? blank */
|
|
M[BS] = BCD_BLANK;
|
|
break;
|
|
|
|
case BCD_COMMA: /* , */
|
|
if (!qbody) /* status? blank */
|
|
M[BS] = BCD_BLANK;
|
|
break;
|
|
|
|
case BCD_AMPER: /* & */
|
|
M[BS] = BCD_BLANK; /* blank */
|
|
break;
|
|
} /* end switch */
|
|
|
|
MM (BS); /* decr B pointer */
|
|
} while ((b & WM) == 0); /* stop on B WM */
|
|
|
|
if (reason) /* address err? */
|
|
break;
|
|
if (!qzero) /* rescan? */
|
|
break;
|
|
|
|
/* Edit pass 2 - from left to right, suppressing zeroes */
|
|
|
|
do {
|
|
b = M[++BS]; /* get B char */
|
|
switch (b & CHAR) { /* case on B char */
|
|
|
|
case BCD_ONE: case BCD_TWO: case BCD_THREE:
|
|
case BCD_FOUR: case BCD_FIVE: case BCD_SIX:
|
|
case BCD_SEVEN: case BCD_EIGHT: case BCD_NINE:
|
|
qzero = 0; /* turn off supr */
|
|
break;
|
|
|
|
case BCD_ZERO: case BCD_COMMA: /* 0 or , */
|
|
if (qzero && !qdecimal) /* if supr, blank */
|
|
M[BS] = qaster? BCD_ASTER: BCD_BLANK;
|
|
break;
|
|
|
|
case BCD_BLANK: /* blank */
|
|
if (qaster) /* if EPE *, repl */
|
|
M[BS] = BCD_ASTER;
|
|
break;
|
|
|
|
case BCD_DECIMAL: /* . */
|
|
if (qzero && (cpu_unit.flags & EPE)) /* flag for EPE */
|
|
qdecimal = 1;
|
|
break;
|
|
|
|
case BCD_PERCNT: case BCD_WM: case BCD_BS:
|
|
case BCD_TS: case BCD_MINUS:
|
|
break; /* ignore */
|
|
|
|
default: /* other */
|
|
qzero = 1; /* restart supr */
|
|
break;
|
|
} /* end case */
|
|
} while ((b & WM) == 0);
|
|
|
|
M[BS] = M[BS] & ~WM; /* clear B WM */
|
|
if (!qdollar && !(qdecimal && qzero)) { /* rescan again? */
|
|
BS++; /* BS = addr WM + 1 */
|
|
break;
|
|
}
|
|
if (qdecimal && qzero) /* no digits? clr $ */
|
|
qdollar = 0;
|
|
|
|
/* Edit pass 3 (extended print only) - from right to left */
|
|
|
|
for (;; ) { /* until chars */
|
|
b = M[BS]; /* get B char */
|
|
if ((b == BCD_BLANK) && qdollar) { /* blank & flt $? */
|
|
M[BS] = BCD_DOLLAR; /* insert $ */
|
|
break; /* exit for */
|
|
}
|
|
if (b == BCD_DECIMAL) { /* decimal? */
|
|
M[BS] = qaster? BCD_ASTER: BCD_BLANK;
|
|
break; /* exit for */
|
|
}
|
|
if ((b == BCD_ZERO) && !qdollar) /* 0 & ~flt $ */
|
|
M[BS] = qaster? BCD_ASTER: BCD_BLANK;
|
|
BS--;
|
|
} /* end for */
|
|
break; /* done at last! */
|
|
|
|
/* Multiply. Comments from the PDP-10 based simulator by Len Fehskens.
|
|
|
|
Multiply, with variable length operands, is necessarily done the same
|
|
way you do it with paper and pencil, except that partial products are
|
|
added into the incomplete final product as they are computed, rather
|
|
than at the end. The 1401 multiplier format allows the product to
|
|
be developed in place, without scratch storage.
|
|
|
|
The A field contains the multiplicand, length LD. The B field must be
|
|
LD + 1 + length of multiplier. Locate the low order multiplier digit,
|
|
and at the same time zero out the product field. Then compute the sign
|
|
of the result.
|
|
|
|
Instruction lengths:
|
|
|
|
1 chained
|
|
2,3 invalid A-address - checked in fetch
|
|
4 self (B-address = A-address)
|
|
5,6 invalid B-address - checked in fetch
|
|
7 normal
|
|
8+ normal + ignored modifier
|
|
*/
|
|
|
|
case OP_MUL:
|
|
asave = AS; /* save AS, BS */
|
|
bsave = lowprd = BS;
|
|
do {
|
|
a = M[AS]; /* get mpcd char */
|
|
M[BS] = BCD_ZERO; /* zero prod */
|
|
MM (AS); /* decr pointers */
|
|
MM (BS);
|
|
} while ((a & WM) == 0); /* until A WM */
|
|
if (reason) /* address err? */
|
|
break;
|
|
M[BS] = BCD_ZERO; /* zero hi prod */
|
|
MM (BS); /* addr low mpyr */
|
|
sign = ((M[asave] & ZONE) == BBIT) ^ ((M[BS] & ZONE) == BBIT);
|
|
|
|
/* Outer loop on multiplier (BS) and product digits (ps),
|
|
inner loop on multiplicand digits (AS).
|
|
AS and ps cannot produce an address error.
|
|
*/
|
|
|
|
do {
|
|
ps = bsave; /* ptr to prod */
|
|
AS = asave; /* ptr to mpcd */
|
|
carry = 0; /* init carry */
|
|
b = M[BS]; /* get mpyr char */
|
|
do {
|
|
a = M[AS]; /* get mpcd char */
|
|
t = (bcd_to_bin[a & DIGIT] * /* mpyr * mpcd */
|
|
bcd_to_bin[b & DIGIT]) + /* + c + partial prod */
|
|
carry + bcd_to_bin[M[ps] & DIGIT];
|
|
carry = cry_table[t];
|
|
M[ps] = (M[ps] & WM) | sum_table[t];
|
|
MM (AS);
|
|
ps--;
|
|
} while ((a & WM) == 0); /* until mpcd done */
|
|
M[BS] = (M[BS] & WM) | BCD_ZERO; /* zero mpyr just used */
|
|
t = bcd_to_bin[M[ps] & DIGIT] + carry; /* add carry to prod */
|
|
M[ps] = (M[ps] & WM) | sum_table[t]; /* store */
|
|
bsave--; /* adv prod ptr */
|
|
MM (BS); /* adv mpyr ptr */
|
|
} while ((b & WM) == 0); /* until mpyr done */
|
|
M[lowprd] = M[lowprd] | ZONE; /* assume + */
|
|
if (sign) /* if minus, B only */
|
|
M[lowprd] = M[lowprd] & ~ABIT;
|
|
break;
|
|
|
|
/* Divide. Comments from the PDP-10 based simulator by Len Fehskens.
|
|
|
|
Divide is done, like multiply, pretty much the same way you do it with
|
|
pencil and paper; successive subtraction of the divisor from a substring
|
|
of the dividend while counting up the corresponding quotient digit.
|
|
|
|
Let LS be the length of the divisor, LD the length of the dividend:
|
|
- AS points to the low order divisor digit.
|
|
- BS points to the high order dividend digit.
|
|
- The low order dividend digit is identified by sign (zone) bits.
|
|
- To the left of the dividend is a (zero) field of length LS + 1.
|
|
So the quotient starts as BS - LS - 1.
|
|
The divide process starts with a subdividend that begins at BS - LS
|
|
and ends at BS. (Note that the subdividend is one digit wider than
|
|
the divisor, to allow for borrows during the divide process.) This
|
|
means that non-zero digits in the "zero" field to the left of the
|
|
dividend CAN affect the divide.
|
|
|
|
Start by computing the length of the divisor and testing for divide
|
|
by zero.
|
|
|
|
Instruction lengths:
|
|
|
|
1 chained
|
|
2,3 invalid A-address - checked in fetch
|
|
4 self (B-address = A-address)
|
|
5,6 invalid B-address - checked in fetch
|
|
7 normal
|
|
8+ normal + ignored modifier
|
|
*/
|
|
|
|
case OP_DIV:
|
|
asave = AS;
|
|
t = 0; /* assume all 0's */
|
|
do { /* scan divisor */
|
|
a = M[AS]; /* get dvr char */
|
|
if ((bcd_to_bin[a & DIGIT]) != 0) /* mark non-zero */
|
|
t = 1;
|
|
MM (AS);
|
|
}
|
|
while ((a & WM) == 0);
|
|
if (reason) /* address err? */
|
|
break;
|
|
if (t == 0) { /* div by zero? */
|
|
ind[IN_OVF] = 1; /* set ovf indic */
|
|
qs = bsave = BS; /* quo, dividend */
|
|
do {
|
|
b = M[bsave]; /* find end divd */
|
|
PP (bsave); /* marked by zone */
|
|
} while ((b & ZONE) == 0);
|
|
if (reason) /* address err? */
|
|
break;
|
|
if (ADDR_ERR (qs)) { /* address err? */
|
|
reason = STOP_WRAP; /* address wrap? */
|
|
break;
|
|
}
|
|
div_sign (M[asave], b, qs - 1, bsave - 1); /* set signs */
|
|
BS = (BS - 2) - (asave - (AS + 1)); /* final bs */
|
|
break;
|
|
}
|
|
bsave = BS; /* end subdivd */
|
|
qs = BS - (asave - AS) - 1; /* quo start */
|
|
|
|
/* Divide loop - done with subroutines to keep the code clean.
|
|
In the loop,
|
|
|
|
asave = low order divisor (constant)
|
|
bsave = low order subdividend (increments)
|
|
qs = current quotient digit (increments)
|
|
*/
|
|
|
|
do {
|
|
quo = 0; /* clear quo digit */
|
|
if (ADDR_ERR (qs) || ADDR_ERR (bsave)) {
|
|
reason = STOP_WRAP; /* address wrap? */
|
|
break;
|
|
}
|
|
b = M[bsave]; /* save low divd */
|
|
do {
|
|
t = div_sub (asave, bsave); /* subtract */
|
|
quo++; /* incr quo digit */
|
|
} while (t == 0); /* until borrow */
|
|
div_add (asave, bsave); /* restore */
|
|
quo--;
|
|
if (quo > 9) /* overflow? */
|
|
ind[IN_OVF] = 1; /* set ovf indic */
|
|
M[qs] = (M[qs] & WM) | sum_table[quo]; /* store quo digit */
|
|
bsave++; /* adv divd, quo */
|
|
qs++;
|
|
} while ((b & ZONE) == 0); /* until B sign */
|
|
if (reason) /* address err? */
|
|
break;
|
|
|
|
/* At this point,
|
|
|
|
AS = high order divisor - 1
|
|
asave = unit position of divisor
|
|
b = unit character of dividend
|
|
bsave = unit position of remainder + 1
|
|
qs = unit position of quotient + 1
|
|
*/
|
|
|
|
div_sign (M[asave], b, qs - 1, bsave - 1); /* set signs */
|
|
BS = qs - 2; /* BS = quo 10's pos */
|
|
break;
|
|
|
|
/* Word mark instructions A check B check
|
|
|
|
SWM set WM on A char and B char fetch fetch
|
|
CWM clear WM on A char and B char fetch fetch
|
|
|
|
Instruction lengths:
|
|
|
|
1 chained
|
|
2,3 invalid A-address
|
|
4 one operand (B-address = A-address)
|
|
5,6 invalid B-address
|
|
7 two operands (SWM cannot be longer than 7)
|
|
8+ two operands + ignored modifier
|
|
*/
|
|
|
|
case OP_SWM: /* set word mark */
|
|
M[BS] = M[BS] | WM; /* set A field mark */
|
|
M[AS] = M[AS] | WM; /* set B field mark */
|
|
MM (AS); /* decr pointers */
|
|
MM (BS);
|
|
break;
|
|
|
|
case OP_CWM: /* clear word mark */
|
|
M[BS] = M[BS] & ~WM; /* clear A field mark */
|
|
M[AS] = M[AS] & ~WM; /* clear B field mark */
|
|
MM (AS); /* decr pointers */
|
|
MM (BS);
|
|
break;
|
|
|
|
/* Clear storage instruction A check B check
|
|
|
|
CS clear from B down to nearest hundreds if branch fetch
|
|
address
|
|
|
|
Instruction lengths:
|
|
|
|
1 chained
|
|
2,3 invalid A-address and B-address
|
|
4 one operand (B-address = A-address)
|
|
5,6 invalid B-address
|
|
7 branch
|
|
8+ one operand, branch ignored
|
|
|
|
Note that clear storage and branch does not overwrite the B register,
|
|
unlike all other branches
|
|
*/
|
|
|
|
case OP_CS: /* clear storage */
|
|
t = (BS / 100) * 100; /* lower bound */
|
|
while (BS >= t) /* clear region */
|
|
M[BS--] = 0;
|
|
if (BS < 0) /* wrap if needed */
|
|
BS = BS + MEMSIZE;
|
|
if (ilnt == 7) { /* branch variant? */
|
|
BRANCH_CS; /* special branch */
|
|
}
|
|
break;
|
|
|
|
/* Modify address instruction A check B check
|
|
|
|
MA add A addr and B addr, store at B addr fetch fetch
|
|
|
|
Instruction lengths:
|
|
1 chained
|
|
2,3 invalid A-address and B-address
|
|
4 self (B-address = A-address)
|
|
5,6 invalid B-address
|
|
7 normal
|
|
8+ normal + ignored modifier
|
|
*/
|
|
|
|
case OP_MA: /* modify address */
|
|
a = one_table[M[AS] & CHAR]; MM (AS); /* get A address */
|
|
a = a + ten_table[M[AS] & CHAR]; MM (AS);
|
|
a = a + hun_table[M[AS] & CHAR]; MM (AS);
|
|
b = one_table[M[BS] & CHAR]; MM (BS); /* get B address */
|
|
b = b + ten_table[M[BS] & CHAR]; MM (BS);
|
|
b = b + hun_table[M[BS] & CHAR]; MM (BS);
|
|
t = ((a + b) & INDEXMASK) % MAXMEMSIZE; /* compute sum */
|
|
M[BS + 3] = (M[BS + 3] & WM) | store_addr_u (t);
|
|
M[BS + 2] = (M[BS + 2] & (WM + ZONE)) | store_addr_t (t);
|
|
M[BS + 1] = (M[BS + 1] & WM) | store_addr_h (t);
|
|
if (((a % 4000) + (b % 4000)) >= 4000) /* carry? */
|
|
BS = BS + 2;
|
|
break;
|
|
|
|
/* Store address instructions A-check B-check
|
|
|
|
SAR store A* at A addr fetch
|
|
SBR store B* at A addr fetch
|
|
|
|
Instruction lengths:
|
|
1 chained
|
|
2,3 invalid A-address
|
|
4 normal
|
|
5+ B-address overwritten from instruction;
|
|
invalid address ignored
|
|
*/
|
|
|
|
case OP_SAR: case OP_SBR: /* store A, B reg */
|
|
M[AS] = (M[AS] & WM) | store_addr_u (BS);
|
|
MM (AS);
|
|
M[AS] = (M[AS] & WM) | store_addr_t (BS);
|
|
MM (AS);
|
|
M[AS] = (M[AS] & WM) | store_addr_h (BS);
|
|
MM (AS);
|
|
break;
|
|
|
|
/* NOP - no validity checking, all instructions length ok */
|
|
|
|
case OP_NOP: /* nop */
|
|
break;
|
|
|
|
/* HALT - unless length = 4 (branch), no validity checking; all lengths ok */
|
|
|
|
case OP_H: /* halt */
|
|
if (ilnt == 4) /* set pending branch */
|
|
hb_pend = 1;
|
|
reason = STOP_HALT; /* stop simulator */
|
|
saved_IS = IS; /* commit instruction */
|
|
break;
|
|
|
|
default:
|
|
reason = STOP_NXI; /* unimplemented */
|
|
break;
|
|
} /* end switch */
|
|
} /* end while */
|
|
|
|
/* Simulation halted */
|
|
|
|
as_err = ADDR_ERR (AS); /* get addr err flags */
|
|
bs_err = ADDR_ERR (BS);
|
|
AS = AS & ADDRMASK; /* clean addresses */
|
|
BS = BS & ADDRMASK;
|
|
pcq_r->qptr = pcq_p; /* update pc q ptr */
|
|
return reason;
|
|
} /* end sim_instr */
|
|
|
|
/* store addr_x - convert address to BCD character in x position
|
|
|
|
Inputs:
|
|
addr = address to convert
|
|
Outputs:
|
|
char = converted address character
|
|
*/
|
|
|
|
int32 store_addr_h (int32 addr)
|
|
{
|
|
int32 thous;
|
|
|
|
thous = (addr / 1000) & 03;
|
|
return bin_to_bcd[(addr % 1000) / 100] | (thous << V_ZONE);
|
|
}
|
|
|
|
int32 store_addr_t (int32 addr)
|
|
{
|
|
return bin_to_bcd[(addr % 100) / 10];
|
|
}
|
|
|
|
int32 store_addr_u (int32 addr)
|
|
{
|
|
int32 thous;
|
|
|
|
thous = (addr / 1000) & 014;
|
|
return bin_to_bcd[addr % 10] | (thous << (V_ZONE - 2));
|
|
}
|
|
|
|
/* div_add - add string for divide */
|
|
|
|
int32 div_add (int32 ap, int32 bp)
|
|
{
|
|
int32 a, b, c, r;
|
|
|
|
c = 0; /* init carry */
|
|
do {
|
|
a = M[ap]; /* get operands */
|
|
b = M[bp];
|
|
r = bcd_to_bin[b & DIGIT] + /* sum digits + c */
|
|
bcd_to_bin[a & DIGIT] + c;
|
|
c = (r >= 10); /* set carry out */
|
|
M[bp] = (M[bp] & WM) | sum_table[r]; /* store result */
|
|
ap--;
|
|
bp--;
|
|
} while ((a & WM) == 0);
|
|
return c;
|
|
}
|
|
|
|
/* div_sub - substract string for divide */
|
|
|
|
int32 div_sub (int32 ap, int32 bp)
|
|
{
|
|
int32 a, b, c, r;
|
|
|
|
c = 0; /* init borrow */
|
|
do {
|
|
a = M[ap]; /* get operands */
|
|
b = M[bp];
|
|
r = bcd_to_bin[b & DIGIT] - /* a - b - borrow */
|
|
bcd_to_bin[a & DIGIT] - c;
|
|
c = (r < 0); /* set borrow out */
|
|
M[bp] = (M[bp] & WM) | sum_table[r + 10]; /* store result */
|
|
ap--;
|
|
bp--;
|
|
} while ((a & WM) == 0);
|
|
b = M[bp]; /* borrow position */
|
|
if (bcd_to_bin[b & DIGIT] != 0) { /* non-zero? */
|
|
r = bcd_to_bin[b & DIGIT] - c; /* subtract borrow */
|
|
M[bp] = (M[bp] & WM) | sum_table[r]; /* store result */
|
|
return 0; /* subtract worked */
|
|
}
|
|
return c; /* return borrow */
|
|
}
|
|
|
|
/* div_sign - set signs for divide */
|
|
|
|
void div_sign (int32 dvrc, int32 dvdc, int32 qp, int32 rp)
|
|
{
|
|
int32 sign = dvrc & ZONE; /* divisor sign */
|
|
|
|
M[rp] = M[rp] | ZONE; /* assume rem pos */
|
|
if (sign == BBIT) /* if dvr -, rem - */
|
|
M[rp] = M[rp] & ~ABIT;
|
|
M[qp] = M[qp] | ZONE; /* assume quo + */
|
|
if (((dvdc & ZONE) == BBIT) ^ (sign == BBIT)) /* dvr,dvd diff? */
|
|
M[qp] = M[qp] & ~ABIT; /* make quo - */
|
|
return;
|
|
}
|
|
|
|
/* iomod - check on I/O modifiers
|
|
|
|
Inputs:
|
|
ilnt = instruction length
|
|
mod = modifier character
|
|
tptr = pointer to table of modifiers, end is -1
|
|
Output:
|
|
status = SCPE_OK if ok, STOP_INVM if invalid
|
|
*/
|
|
|
|
t_stat iomod (int32 ilnt, int32 mod, const int32 *tptr)
|
|
{
|
|
if ((ilnt != 2) && (ilnt != 5) && (ilnt < 8))
|
|
return SCPE_OK;
|
|
if (tptr == NULL)
|
|
return STOP_INVM;
|
|
do {
|
|
if (mod == *tptr++)
|
|
return SCPE_OK;
|
|
} while (*tptr >= 0);
|
|
return STOP_INVM;
|
|
}
|
|
|
|
/* iodisp - dispatch load or move to I/O routine
|
|
|
|
Inputs:
|
|
dev = device number
|
|
unit = unit number
|
|
flag = move (MD_NORM) vs load (MD_WM)
|
|
mod = modifier
|
|
*/
|
|
|
|
t_stat iodisp (int32 dev, int32 unit, int32 flag, int32 mod)
|
|
{
|
|
if (dev == IO_INQ) /* inq terminal? */
|
|
return inq_io (flag, mod);
|
|
if (dev == IO_DP) /* disk pack? */
|
|
return dp_io (unit, flag, mod);
|
|
if (dev == IO_MT) /* magtape? */
|
|
return mt_io (unit, flag, mod);
|
|
if (dev == IO_MTB) /* binary magtape? */
|
|
return mt_io (unit, flag | MD_BIN, mod);
|
|
return STOP_NXD; /* not implemented */
|
|
}
|
|
|
|
/* Reset routine */
|
|
|
|
t_stat cpu_reset (DEVICE *dptr)
|
|
{
|
|
int32 i;
|
|
|
|
for (i = 0; i < 64; i++) { /* clr indicators */
|
|
if ((i < IN_SSB) || (i > IN_SSG)) /* except SSB-SSG */
|
|
ind[i] = 0;
|
|
}
|
|
ind[IN_UNC] = 1; /* ind[0] always on */
|
|
AS = 0; /* clear AS */
|
|
BS = 0; /* clear BS */
|
|
as_err = 1;
|
|
bs_err = 1;
|
|
D = 0; /* clear D */
|
|
hb_pend = 0; /* no halt br */
|
|
pcq_r = find_reg ("ISQ", NULL, dptr);
|
|
if (pcq_r)
|
|
pcq_r->qptr = 0;
|
|
else return SCPE_IERR;
|
|
sim_brk_types = sim_brk_dflt = SWMASK ('E');
|
|
return SCPE_OK;
|
|
}
|
|
|
|
/* Memory examine */
|
|
|
|
t_stat cpu_ex (t_value *vptr, t_addr addr, UNIT *uptr, int32 sw)
|
|
{
|
|
if (addr >= MEMSIZE)
|
|
return SCPE_NXM;
|
|
if (vptr != NULL)
|
|
*vptr = M[addr] & (WM + CHAR);
|
|
return SCPE_OK;
|
|
}
|
|
|
|
/* Memory deposit */
|
|
|
|
t_stat cpu_dep (t_value val, t_addr addr, UNIT *uptr, int32 sw)
|
|
{
|
|
if (addr >= MEMSIZE)
|
|
return SCPE_NXM;
|
|
M[addr] = val & (WM + CHAR);
|
|
return SCPE_OK;
|
|
}
|
|
|
|
/* Memory size change */
|
|
|
|
t_stat cpu_set_size (UNIT *uptr, int32 val, CONST char *cptr, void *desc)
|
|
{
|
|
int32 mc = 0;
|
|
uint32 i;
|
|
|
|
if ((val <= 0) || (val > MAXMEMSIZE) || ((val % 1000) != 0))
|
|
return SCPE_ARG;
|
|
for (i = val; i < MEMSIZE; i++)
|
|
mc = mc | M[i];
|
|
if ((mc != 0) && (!get_yn ("Really truncate memory [N]?", FALSE)))
|
|
return SCPE_OK;
|
|
MEMSIZE = val;
|
|
for (i = MEMSIZE; i < MAXMEMSIZE; i++)
|
|
M[i] = 0;
|
|
if (MEMSIZE > 4000)
|
|
cpu_unit.flags = cpu_unit.flags | MA;
|
|
else cpu_unit.flags = cpu_unit.flags & ~MA;
|
|
return SCPE_OK;
|
|
}
|
|
|
|
/* Set history */
|
|
|
|
t_stat cpu_set_hist (UNIT *uptr, int32 val, CONST char *cptr, void *desc)
|
|
{
|
|
int32 i, lnt;
|
|
t_stat r;
|
|
|
|
if (cptr == NULL) {
|
|
for (i = 0; i < hst_lnt; i++)
|
|
hst[i].ilnt = 0;
|
|
hst_p = 0;
|
|
return SCPE_OK;
|
|
}
|
|
lnt = (int32) get_uint (cptr, 10, HIST_MAX, &r);
|
|
if ((r != SCPE_OK) || (lnt && (lnt < HIST_MIN)))
|
|
return SCPE_ARG;
|
|
hst_p = 0;
|
|
if (hst_lnt) {
|
|
free (hst);
|
|
hst_lnt = 0;
|
|
hst = NULL;
|
|
}
|
|
if (lnt) {
|
|
hst = (InstHistory *) calloc (lnt, sizeof (InstHistory));
|
|
if (hst == NULL)
|
|
return SCPE_MEM;
|
|
hst_lnt = lnt;
|
|
}
|
|
return SCPE_OK;
|
|
}
|
|
|
|
/* Show history */
|
|
|
|
t_stat cpu_show_hist (FILE *st, UNIT *uptr, int32 val, CONST void *desc)
|
|
{
|
|
int32 i, k, di, lnt;
|
|
CONST char *cptr = (CONST char *) desc;
|
|
t_value sim_eval[MAX_L + 1];
|
|
t_stat r;
|
|
InstHistory *h;
|
|
|
|
if (hst_lnt == 0) /* enabled? */
|
|
return SCPE_NOFNC;
|
|
if (cptr) {
|
|
lnt = (int32) get_uint (cptr, 10, hst_lnt, &r);
|
|
if ((r != SCPE_OK) || (lnt == 0))
|
|
return SCPE_ARG;
|
|
}
|
|
else lnt = hst_lnt;
|
|
di = hst_p - lnt; /* work forward */
|
|
if (di < 0)
|
|
di = di + hst_lnt;
|
|
fprintf (st, "IS IR\n\n");
|
|
for (k = 0; k < lnt; k++) { /* print specified */
|
|
h = &hst[(++di) % hst_lnt]; /* entry pointer */
|
|
if (h->ilnt) { /* instruction? */
|
|
fprintf (st, "%05d ", h->is);
|
|
for (i = 0; i < h->ilnt; i++)
|
|
sim_eval[i] = h->inst[i];
|
|
sim_eval[h->ilnt] = WM;
|
|
if ((fprint_sym (st, h->is, sim_eval, &cpu_unit, SWMASK ('M'))) > 0) {
|
|
fprintf (st, "(undefined)");
|
|
for (i = 0; i < h->ilnt; i++)
|
|
fprintf (st, " %02o", h->inst[i]);
|
|
}
|
|
fputc ('\n', st); /* end line */
|
|
} /* end else instruction */
|
|
} /* end for */
|
|
return SCPE_OK;
|
|
}
|
|
|
|
/* Set conversions */
|
|
|
|
t_stat cpu_set_conv (UNIT *uptr, int32 val, CONST char *cptr, void *desc)
|
|
{
|
|
conv_old = val;
|
|
return SCPE_OK;
|
|
}
|
|
|
|
/* Show conversions */
|
|
|
|
t_stat cpu_show_conv (FILE *st, UNIT *uptr, int32 val, CONST void *desc)
|
|
{
|
|
if (conv_old)
|
|
fputs ("Old (pre-3.5-1) conversions\n", st);
|
|
else fputs ("New conversions\n", st);
|
|
return SCPE_OK;
|
|
}
|