int main (int argc, char **argv) { // HAL-7502 // INPUT/OUTPUT STREAMS static int main = 1, pre = 2; // INPUT static int bin = 1, lis = 2; // OUTPUT // OPERAND TYPES static int opmask = 0xF000; // MACHINE INSTRUCTION OR MACRO static int macro = 0xA000; static int fmask = 0x0800; // FORWARD REF static int umask = 0x0200; // UNDEF (FORWARD REF) static int reg = 0x0080; // REGISTER static int memmask = 0x0040; // MEM REF static int relmask = 0x0020; // RELOCATABLE static int xmask = 0x0010; // INDEXED static int regxmask = 0x0090; // =REG+XMASK static int reluxmask = 0x0230; // =RELMASK+UMASK+XMASK // TEXT POINTERS (BYTE ADDRESSES) static int codepos; // (NOT ACTUALLY BYTE) static int startpos; // START OF CURRENT LINE static int getpos; // INPUT POINTER (NEXT) static int putpos; static int pseudolim; static int printpos; // START OF PRINT LINE static int faultpos; static int maclim; // MACRO DEF LIMIT // OTHER POINTERS (WORD ADDRESSES) static int mp; // MACRO-CALL PARAMETERS static int qbase, qstart, qlim, transf; // OPERAND QUEUE static int defmin; // TAG MIN (DOWN - RESET) static int deflim; // TAG LIM (FIXED) static int almax; // ASSEMBLER LAB MAX (UP - RESET) static int labmin; // USER LAB MIN (DOWN - RESET) static int lablim; // USER LAB LIM (FIXED) static int bp; // BLOCK POINTER (UP - DOWN) static int np; // NEST POINTER (DOWN - UP) static int storelim; // (FIXED) int sym; // CURRENT SYMBOL int term; // TAG TERMINATOR int fsym; // FAULT FLAG SYMBOL static int chars = 0; // PRINT CHAR COUNT static int lines = 0; // PRINT LINE COUNT static int pass = (-(1)); // CURRENT PASS (-1,0,1) static int list = (-(1)); // LISTING CONTROL int asscond; int skip; // ASSEMBLY CONDITIONS (BIT NEST) static int save = 1; // REG SAVE DISPLACEMENT static int temps = 12; // TEMPORARY REGISTER SET static int control = 0x40; // OBJECT CODE CONTROL FIELD static int check = 0; // BINARY CHECKSUM int loctype; int loc; // LOCATION COUNTER int acc; int atype; int aval; // MAIN TEMP REGISTER int creg; // CONDITION CODE int cond; // CONDITION CODE MASK int dreg; int duse; // DESTINATION REGISTER int type; int val; // CURRENT TYPE,VALUE int tag1; int tag2; // TAG (CHARS 1:3, 4:6) int mode; // ASSEMBLY MODE int pend; // TAG ALREADY RECOGNISED int flag; // JUMPS int sbound; sbound = freestore - 260; // ALLOW FOR INPUT BUFFER if (outdev == 2) sbound -= 256; selectoutput (lis); if (outdev == 2) sbound -= 256; int store[sbound - 1 + 1]; auto int char (int p) { // BYTE FETCH } auto void putchar (int k) { // AT PUTPOS WITH POST-INCREMENT } auto void fault (int k) { // RECORD (FIRST) FAULT // NOT NECESSARILY CULPABLE IN PASS 0 if (fsym == ' ') fsym = k; } auto void print (int k) { integer (codepos + chars) = k; chars += 1; } auto void printword (int v) { auto void printhit (int v) { v = v & 15 + '0'; if (v > '9') v += 7; print (v); } auto void print1 (int v) { printhit (v >> 4); printhit (v); } print1 (v >> 8); print1 (v); } auto void printloc (void) { printword (loc); if (loctype & relmask != 0) print ('\\'); else print (' '); print (' '); } auto void donewline (void) { newline (); lines += 1; if (lines == 61) { newlines (2); lines = 0; } } auto void printline (void) { auto void printit (int sub) { static int marker = 124; // VERTICAL BAR int p; int q; int k; if ((chars == 0 && char (printpos) == nl)) return; printsymbol (fsym); space (); p = codepos; q = p + chars; while (p != q) { printsymbol (integer (p)); p += 1; } if (printpos == 0) return; spaces (17 - chars); p = printpos; q = 0; for (;;) { if (p == faultpos) printsymbol (marker); k = char (p); if (p == pseudolim) k = sub; if ((k ^ q) & 128 != 0) printsymbol ('\\'); if (k == nl) return; printsymbol (k & 127); p += 1; q = k; } } if (pass == 0) return; if (!((list < 0 || (printpos == 0 && (fsym == ' ' && list & 1 == 0))))) { if (lines == 0) newlines (3); printit (' '); donewline (); } if ((fsym != ' ' && outdev != 1)) { selectoutput (0); if (printpos == 0) printpos = startpos; if (chars == 0) printloc (); printit (nl); newline (); selectoutput (lis); } fsym = ' '; printpos = 0; chars = 0; } auto void putword (int v) { check = check ^ v; selectoutput (bin); printch (v >> 12 & 15 + control); printch (v >> 8 & 15 + 0x40); printch (v >> 4 & 15 + 0x40); printch (v & 15 + 0x40); control = 0x50; selectoutput (lis); } auto void plantval (void) { if (pass > 0) { if (chars == 0) { if (printpos != 0) printloc (); else { print (' '); print (' '); print (' '); print (' '); print (' '); print (' '); } } if (chars == 10) print (' '); printword (val); putword (val); if (type & relmask != 0) print ('\\'); if (chars >= 15) printline (); } loc += 1; } auto void plant (int v) { int thold; int vhold; thold = type; vhold = val; type = 0; val = v; plantval (); type = thold; val = thold; } auto void nest (int k) { np -= 1; // !%MONITOR 23 %IF NP = BP integer (np) = k; } auto void setlab (int dest) { int p; int q; q = 0; for (;;) { type = integer (np); p = type & 0x3FF + deflim; // DEST SLOT np += 1; val = integer (np); // LOC OF JUMP np += 1; atype = (-(1)); creg = (-(1)); flag = 0; if (type & 0x800 == 0) { if (dest - val + pass <= 128) flag = 1; } else if (type & 0x400 != 0) { if (dest - val + pass + pass == 1) flag = 2; } if (pass == 0) { dest -= flag; integer (p) = dest; if (flag != 0) { loc -= flag; while (p != almax) { p += 1; integer (p) = integer (p) - flag; } } } else { if (integer (p) != dest) fault ('P'); } if (integer (np) & 0x1000 == 0) return; if ((integer (np) & 0x2000 != 0 && q == 0)) { // OR dest = val + 1; if (!(type & 0xC00 == 0xC00)) dest = val + 2 - flag; q = 1; } } } auto void assemble (void) { // 7502 OP-CODES static int add = 0xF400, sub = 0xF500, and = 0xF100; static int or = 0xF000, xor = 0xF700, comp = 0xF200; static int copy = 0xF300; static int loadi = 0x6000, skidi = 0x7000, addi = 0x8000; static int andi = 0x9000; static int boc = 0x5800, bocr = 0x5000, jum = 0x4000; static int skip = 0x4002, loadc = 0x20F2, rot = 0x3000; static int load = 0x2000, store = 0x2008; int q; int nq; int op; int k; int litval; int type1; int val1; int free; static void *ass[ /*bounds */ ] = { &&ass_default }; auto void combine (void) { int i; int j; int k; i = 11; k = 2048; while ((k & type1 == 0 && i != 0)) { i -= 1; k = k >> 1; } j = k; while ((j & val1 == 0 && i != 0)) { i -= 1; j = j >> 1; } val = val << i & (k << 1 - 1); type = type1 - k; val = val1 - j + val; } auto void plantjump (void) { int i; int v; i = val - loc; if (cond & 6 == 0) { if (cond == 8) { if (i == 1) return; plant (skip); } } else { if ((flag != 0 && abs (i) > 127)) { fault ('J'); i = 0; } if (abs (i) <= 127) { if ((type & umask == 0 || flag != 0)) { plant (boc + (cond ^ 1) << 8 + i & 255); return; } if ((list >= 0 && list & 8 != 0)) fault ('S'); } plant (boc + cond << 8 + 2); } plant (jum + (val - loc) & 4095); } auto void setjump (int case) { int thold; int vhold; int fhold; if (cond & 6 == 0) case +=0x0800; if (cond & 1 != 0) case +=0x0400; almax += 1; // !%MONITOR 22 %IF ALMAX = LABMIN nest (loc); nest (almax - deflim + case); thold = type; vhold = val; fhold = flag; type = loctype; val = integer (almax); flag = 0; if (pass == 0) type += umask; cond = cond ^ 1; plantjump (); cond = 0; type = thold; val = vhold; flag = fhold; } auto void plantinst (int code) { if (cond != 0) setjump (0x1000); plant (code); } auto void release (void) { int i; if (type & regxmask == 0) return; i = type & 15; if (type == reg) i = val; if (i == dreg) { duse -= 1; } else { i = 1 << i; if (temps & i != 0) free = free | i; } } auto int treg (void) { int i; int j; if ((dreg >= 0 && duse == 0)) { duse = 1; return (dreg); } j = 1; for (i = 0; i <= 15; i += 1) { if ((free & j != 0 && i != dreg)) goto ok; j = j << 1; } fault ('R'); ok: free -= j; return (i); } auto void loadconst (int r) { int i; int j; i = loadi + r << 8; if ((val & ((~(255))) == 0 && type & umask == 0)) { plantinst (i + val); } else if (((~(val & ((~(255))))) == 0 && type & umask == 0)) { plantinst (i + ((~(val)))); plantinst (comp + r << 4 + r); creg = r; } else { // PLANT INST(LOADC+R<<8) // PLANT INST(SKIP) // PLANT VAL j = val >> 8 & 255; if (val & 128 != 0) j += 1; plantinst (i + j); plantinst (rot + r << 8 + 7 << 4 + r); if (val & 255 != 0) plantinst (addi + r << 8 + val & 255); } } auto void loadreg (int r) { int op; if ((atype == type && aval == val)) { type = reg; val = acc; if (r == acc) return; } if (r == acc) { atype = type; aval = val; } if ((atype == reg && aval == r)) atype = (-(1)); if ((atype & xmask != 0 && atype & 15 == r)) atype = (-(1)); if (type == reg) { plantinst (copy + r << 4 + val); creg = r; } else if (type & xmask == 0) { loadconst (r); if (type & memmask != 0) plantinst (load + r << 8 + r << 4); } else { if ((val & ((~(3))) != 0 || type & memmask == 0)) { if (type & 15 != r) { if (abs (val) <= 127) { plantinst (copy + r << 4 + type & 15); if (val != 0) plantinst (addi + r << 8 + val & 255); } else { loadconst (r); plantinst (add + r << 4 + type & 15); } creg = r; } else { if (abs (val) <= 127) { if (val != 0) { plantinst (addi + r << 8 + val & 255); creg = r; } } else { op = treg; loadconst (op); type = reg; val = op; release (); plantinst (add + r << 4 + op); creg = r; } } type = type & memmask + xmask + r; val = 0; } if (type & memmask != 0) { plantinst (load + r << 8 + (type & 15) << 4 + val); creg = (-(1)); // %FINISH -- commenting out this line allows the program to compile } else { loadconst (r); plantinst (load + r << 8 + r << 4); } } type = reg; val = r; } auto void loadtemp (void) { release (); loadreg (treg); } auto void swop (void) { int k; k = type1; type1 = type; type = k; k = val1; val1 = val; val = k; } q = qstart; new: nq = qstart; free = temps; type = integer (q); q += 1; val = integer (q); q += 1; get: for (;;) { if (q == qlim) return; k = integer (q); q += 1; if (k < 0) goto *ass[k]; integer (nq) = type1; integer (nq + 1) = val1; nq += 2; type1 = type; val1 = val; type = k; val = integer (q); q += 1; } auto int temp (void) { if (type1 != reg) return (0 != 0); if (val1 == dreg) { if (duse != 1) return (0 != 0); } else { if (1 << val1 & temps == 0) return (0 != 0); } return (0 == 0); } nop: k = 0; // NOT SYMMETRIC bop: if ((mode <= 0 || (type == 0 && type1 == 0))) { if (type != 0) fault ('A'); type = type1; val = litval; } else { if (((!(temp)) || (type == reg && (val == dreg && (duse == 1 && k != 0))))) { swop (); if ((k == 0 || (!(temp)))) { loadtemp (); swop (); } } if ((op == and && (type == 0 && val & ((~(255))) == 0))) { plantinst (andi + val1 << 8 + val); } else { if (type != reg) loadtemp (); release (); plantinst (op + val1 << 4 + val); } type = reg; val = val1; creg = val; if (acc == val) atype = (-(1)); if ((atype & xmask != 0 && atype & 15 == val)) atype = (-(1)); if ((atype == reg && aval == val)) atype = (-(1)); } pop: nq -= 2; type1 = integer (nq); val1 = integer (nq + 1); goto get; ass_ (-(2)): /* (-(2)) */ op = sub; if ((mode > 0 && type != 0)) goto nop; if ((mode <= 0 && type1 == type)) { type1 = 0; type = 0; } val = (-(val)); ass_ (-(1)): /* (-(1)) */ op = add; litval = val1 + val; if (!(type == 0)) goto bop; if ((type1 & memmask != 0 && mode > 0)) { swop (); loadtemp (); swop (); } if ((type1 == reg && (!((type == val && val == 0))))) { type1 = xmask + val1; litval = val; } type = type1; val = litval; goto pop; ass_ (-(6)): /* (-(6)) */ litval = val1 << val; k = ((-(1))) << val; val = 16 - val; goto as7; ass_ (-(7)): /* (-(7)) */ litval = val1 >> val; k = (0xFFFF) >> val; as7: if (mode <= 0) { k = 0; goto bop; } if ((type != 0 || val & ((~(15))) != 0)) fault ('I'); if ((!(temp))) { swop (); loadtemp (); swop (); } op = rot + val1 << 8 + val1; if (val > 8) plantinst (op + 0x0070); if (val != 0) plantinst (op + (val - 1) << 4); type = 0; val = k; k = (-(3)); ass_ (-(3)): /* (-(3)) */ op = and; litval = val1 & val; goto bop; ass_ (-(4)): /* (-(4)) */ op = or; litval = val1 | val; goto bop; ass_ (-(5)): /* (-(5)) */ op = xor; litval = val1 ^ val; goto bop; ass_ (-(8)): /* (-(8)) */ // TYPE_VAL type = val1; if (type & opmask == macro) type = 0; // SAFETY if (type & (opmask + fmask) == fmask) type = 0; goto pop; ass_ (-(11)): /* (-(11)) */ // COMPARE k = integer (q); q += 1; if (mode <= 0) { litval = 2 _01011000; if (val < 0) litval = 2 _01100100; if (val1 > val) litval = 2 _10101000; k = litval >> k & 1; } else { if (! ((k & 6 == 4 && (((-(256)) < val && val < 0) && type & xmask != 0)))) { if (type != reg) loadtemp (); if (creg != val) plantinst (copy + val << 4 + val); creg = val; } else { plantinst (skidi + (type & 15) << 8 - val); k += 4; // 8,9 } } cond = k; goto get; ass_ (-(12)): /* (-(12)) */ // TEST CC cond = val ^ 1; goto get; ass_ (-(13)): /* (-(13)) */ // AND if (mode > 0) { setjump (0x1000); } else { if (cond == 0) return; } if (q == qlim) return; goto new; ass_ (-(14)): /* (-(14)) */ // OR if (mode > 0) { cond = cond ^ 1; setjump (0x3000); } else { if (cond != 0) return; } goto new; ass_ (-(15)): /* (-(15)) */ // IF setjump (0x2000); return; ass_ (-(16)): /* (-(16)) */ // ELSE cond = 1; setjump (0x4000); return; ass_ (-(17)): /* (-(17)) */ // IF AFTER ELSE setjump (0x6000); return; ass_ (-(18)): /* (-(18)) */ // MACCALL IF setjump (0x8000); return; ass_ (-(20)): /* (-(20)) */ // HASH type = type & (umask + 63); goto get; ass_ (-(21)): /* (-(21)) */ // INDEX if (type1 & regxmask != 0) fault ('I'); if (type & memmask != 0) { if (mode > 0) loadtemp (); else fault ('A'); } if (type == reg) { type = xmask + val; val = 0; } if (type1 & type & relmask != 0) fault ('I'); type = type1 | type | memmask; val = val1 + val; goto pop; ass_ (-(22)): /* (-(22)) */ // MINST SEPARATOR combine (); goto pop; ass_ (-(23)): /* (-(23)) */ // PLANT INST mode = 1; plantinst (val); creg = (-(1)); atype = (-(1)); return; ass_ (-(24)): /* (-(24)) */ // LOAD if (type != reg) loadtemp (); q = qbase; goto get; ass_ (-(25)): /* (-(25)) */ // STORE (TYPE1,VAL1 -> TYPE,VAL) if (type == reg) { if (val1 != val) { swop (); loadreg (val1); } } else { if (atype & memmask != 0) atype = (-(1)); if ((val1 == acc && atype < 0)) { k = type & 15; if ((type & xmask == 0 || 1 << k & temps == 0)) { atype = type; aval = val; } } if ((type & xmask == 0 || val & ((~(3))) != 0)) { type = type & ((~(memmask))); loadtemp (); type = memmask + xmask + val; val = 0; } plantinst (store + val1 << 8 + (type & 15) << 4 + val); } return; ass_ (-(26)): /* (-(26)) */ // JUMP if (integer (np) & 0xF000 == 0x3000) setjump (0x1000); // OR if (type != reg) type = type | memmask; if (type & ((~(umask))) == loctype) { plantjump (); } else { if (type == reg) { type = xmask + val; val = 0; } if ((type & xmask == 0 || val & ((~(15))) != 0)) fault ('I'); if (cond & 8 != 0) { if (cond == 8) plant (skip); cond = 1; } plant (bocr + cond << 8 + (type & 15) << 4 + val); } cond = 0; return; } auto void getsym (void) { for (;;) { sym = char (getpos); getpos += 1; if (sym != ' ') return; } } auto int s (int k) { if (!(k == sym)) return (0 != 0); getsym (); return (0 == 0); } auto int ss (int k) { if (!((k == sym && sym == char (getpos)))) return (0 != 0); getpos += 1; getsym (); return (0 == 0); } auto int tag (void) { int j; int k; auto void codesym (void) { sym = char (getpos); getpos += 1; k = sym - '0'; if (k >= 0) { if (k < 10) { term = (-(1)); return; } k = sym - 'A'; if ((k >= 0 && (k < 26 && term == 0))) return; } term = sym; } auto void packtriple (void) { if (term < 0) goto t1; j = ((k << 5 + k) << 1 + k) << 4 + k + 1111; // K*1073+1111 codesym (); if (term != 0) goto t2; j = (k << 3 + k) << 2 + k + 111 + j; // J+K*37+111 codesym (); if (term != 0) goto t3; j = j + k + 11; codesym (); return; t1: j = ((k << 1 + k) << 1 + k) << 4 - k + 1; // K*111+1 codesym (); t2: if (term > 0) return; j = (k << 2 + k) << 1 + k + 1 + j; // J+K*11+1 codesym (); t3: if (term > 0) return; j = j + k + 1; codesym (); } k = sym - 'A'; if (!((k >= 0 && k < 26))) return (0 != 0); if ((sym == 'X' && char (getpos) & 128 != 0)) return (0 != 0); term = 0; packtriple (); tag1 = j; j = 0; if (term <= 0) packtriple (); tag2 = j; while (term <= 0) codesym (); if (term == ' ') getsym (); return (0 == 0); } auto int tagif (void) { if (!((sym == 'I' && (char (getpos) == 'F' && char (getpos + 1) == ' ')))) return (0 != 0); getpos += 2; getsym (); return (0 == 0); } auto void lookup (int control) { // ALL DICT OPERATIONS LOCALISED HERE // CONTROL = 0 (LOOKUP ONLY), 1 (FORWARD OK), // 2 (REDEF), 3 (DEF), // 4 (MACPARM), 7 (LABEL) int dp; dp = defmin; if (control == 4) dp = mp + 5; while (integer (dp) != 0) { if ((integer (dp) == tag1 && integer (dp + 1) == tag2)) goto yes; dp += 4; } // !%OWNINTEGER P // ! DP = DP-4 // !REP:DP = DP+4 // ! %LAC* DP; %OPR 640;!SNA; %JMP NO // ! %SAD TAG1; %OPR 512; %JMP REP // ! %LAC DP; %TAD #1; %DAC P // ! %LAC* P; %SAD TAG2; %JMP YES // ! ->REP no: if (control & 1 == 0) return; // NO CREATION new: defmin -= 4; dp = defmin; // !%MONITOR 21 %IF DP-QLIM <= 0 integer (dp) = tag1; integer (dp + 1) = tag2; set: integer (dp + 2) = type; integer (dp + 3) = val; return; yes: if ((control == 3 && dp - integer (bp) >= 0)) goto new; if (control & 2 == 0) { // NOT DEF CLASS type = integer (dp + 2); val = integer (dp + 3); if (!((type & opmask == macro && control == 0))) return; if (type & 31 != 25) integer (dp + 2) = type + 1; else integer (dp + 2) = type + 7; return; } if (control == 3) fault ('D'); if (control != 7) goto set; if (integer (dp + 2) & (opmask + fmask) == fmask) { val = integer (dp + 3); if (pass == 0) { integer (val) = loc; } else { if (integer (val) != loc) { fault ('P'); loc = integer (val); } } val = loc; } else { if (dp - integer (bp) >= 0) goto new; fault ('D'); } goto set; } auto void queue (int k) { integer (qlim) = k; qlim += 1; // !%MONITOR 21 %IF QLIM = DEFMIN } auto void getexp (void) { static int w = 24717; int i; int nbase; nbase = np; if (pend != 0) goto e3; e1: while (s ('(')) nest (0); if (s ('#')) nest ((-(20))); if (tag) { e3: if (tag1 == w) { // W type = 0; val = 0; } else { if (pend >= 0) { type = loctype + fmask + umask; val = labmin - 1; lookup (1); if (type & (opmask + fmask) == fmask) { if (val == labmin - 1) { labmin = val; // !%MONITOR 22 %IF LABMIN = ALMAX } val = integer (val); if (val == 0) fault ('U'); type -= fmask; } } } pend = 0; if ((type == reg && term == '(')) { if (save & 1 == 0) type = 0; val += save; // ? } if (mode != 0) { if (type & opmask != 0) { fault ('I'); type = 0; } if (type & regxmask != 0) { i = type & 15; if (i == 0) i = val; if (i == dreg) duse += 1; } } if (term == '(') { getsym (); i = type & 31; queue (type - i); queue (val); nest ((-(21))); nest (0); if (i != 0) { queue (reg); queue (i & 15); nest ((-(1))); } goto e1; } } else if (('0' <= sym && sym <= '9')) { type = 0; val = sym - '0'; for (;;) { sym = char (getpos) - '0'; if (!((0 <= sym && sym <= 9))) break; val = (val << 2 + val) << 1 + sym; getpos += 1; } getsym (); } else if (sym == 'X') { type = 0; val = 0; for (;;) { sym = char (getpos) - 128; if (sym < 0) break; if (sym >= 96) sym -= 32; // ENSURE UPPER-CASE if ((('0' <= sym && sym <= '9') || ('A' <= sym && sym <= 'F'))) { val = val << 4 + sym - '0'; if (sym >= 'A') val -= 7; } else fault ('H'); getpos += 1; } getsym (); } else if (sym & 128 != 0) { type = 0; val = sym - 128; getsym (); if ((mode >= 0 && sym & 128 != 0)) { val = val << 8 + sym - 128; getsym (); } } else if (s ('.')) { if ((!(tag))) goto err; type = 0; val = tag1; } else if (s ('*')) { type = loctype & 63; val = loc; if (sym == 'L') { // FOR NOW type = 0; if (tag) val = list; } } else if (sym == '-') { type = 0; val = 0; } else if (sym == '\\') { type = 0; val = (~(0)); } else goto err; queue (type); queue (val); while (np != nbase) { if (integer (np) < 0) { queue (integer (np)); } else { if ((!(s (')')))) break; } np += 1; } if (s ('+')) { nest ((-(1))); goto e1; } if (s ('-')) { nest ((-(2))); goto e1; } if (s ('&')) { nest ((-(3))); goto e1; } if (s ('!')) { nest ((-(4))); goto e1; } if (s ('\\')) { nest ((-(5))); goto e1; } if (ss ('<')) { nest ((-(6))); goto e1; } if (ss ('>')) { nest ((-(7))); goto e1; } if (s ('_')) { nest ((-(8))); goto e1; } if (np == nbase) return; err: np = nbase; // !%MONITOR 19 } auto void getcond (void) { static int and = 1717, or = 16873; int j; int k; transf = qstart; qstart = qlim; j = 0; for (;;) { getexp (); if (s ('=')) { k = 5; } else if (s ('#')) { k = 4; } else if (s ('<')) { k = 3; if (s ('=')) k = 7; } else if (s ('>')) { k = 6; if (s ('=')) k = 2; } else { queue ((-(12))); return; } getexp (); queue ((-(2))); // SUBTRACT queue ((-(11))); queue (k); if ((!(tag))) return; if ((tag1 == and && tag2 == 0)) { // !%MONITOR 19 %IF J < 0 j = 1; queue ((-(13))); } else { // !%MONITOR 19 %IF TAG1 # OR %OR J > 0 j = (-(1)); queue ((-(14))); } } } auto void getinst (void) { int i; queue (type); queue (val); if (term != ' ') return; // NO OPERAND FOLLOWING => for (;;) { getexp (); queue ((-(22))); if ((!(s (',')))) return; } } auto void readline (void) { int q; putpos = startpos; if (mp == 0) { q = 0; pseudolim = 0; for (;;) { readsymbol (sym); if (sym == '\\') { readsymbol (sym); q = q ^ 128; } if (sym == nl) break; if (sym - q >= 96) sym -= 32; // LOWER-CASE -> UPPER-CASE sym += q; if ((sym == '/' && pseudolim != 0)) break; if (sym == ' ') { if (pseudolim == 0) pseudolim = putpos; } else pseudolim = 0; putchar (sym); } if (pseudolim != 0) { q = putpos; putpos = pseudolim; putchar (nl); putpos = q; } for (;;) { putchar (sym); if (sym == nl) break; readsymbol (sym); } printpos = startpos; } else { getpos = integer (mp); if (char (getpos) == 0) { qbase = mp; if (integer (mp + 1) & 0x8000 != 0) { while (integer (np) & 0x8000 == 0) { fault ('C'); np += 2; } setlab (loc); } getpos = integer (mp + 2); startpos = integer (mp + 3); mp = integer (mp + 4); if (list & 2 != 0) printpos = 0; getsym (); // TERMINATOR if (sym == ';') getsym (); return; } if (list & 2 != 0) printpos = startpos; for (;;) { sym = char (getpos); getpos += 1; if (tag) { if (term == ' ') { sym = term; getpos -= 1; } type = integer (mp); val = getpos - 1; lookup (4); while (type != val) { putchar (char (type)); type += 1; } } if (sym == '?') { putchar (integer (mp + 1) >> 5 & 31 + 'A'); sym = integer (mp + 1) & 31 + 'A'; } putchar (sym); integer (mp) = getpos; if (sym == nl) break; } } qbase = (putpos + 1) >> 1; getpos = startpos; getsym (); } auto void scanarg (void) { // SET TYPE,VAL TO START,LIM OF ARG IF NOT NULL int i; int j; if ((sym == 'I' && (char (getpos) == 'F' && char (getpos + 1) == ' '))) return; i = getpos - 1; if (sym == '[') i = getpos; j = 0; for (;;) { if (sym == nl) break; if (((sym == ' ' || (sym == ',' || sym == ';')) && j <= 0)) break; if (sym == '[') j += 1; if (sym == ']') { j -= 1; if (j == 0) break; } sym = char (getpos); getpos += 1; } if (getpos - 1 != i) { type = i; val = getpos - 1; } if (sym == ']') getsym (); } auto void setacc (void) { int i; acc = (-(1)); atype = (-(1)); creg = (-(1)); i = temps; if (i == 0) return; for (;;) { acc += 1; if (i & 1 != 0) return; i = i >> 1; } } // MAIN PROGRAM // RADIX 36 CONSTANTS static int b = 2184, if = 9991 , els = 5950, e = 5403, fin = 6907, ish = 10490; static int jum = 11642, p = 17206, ps = 17983, def = 4605, end = 6009; int i; int j; int k; // !%FAULT 19 ->ERR; !RECOGNITION ERROR // !%FAULT 9 ->BEND; !INPUT ENDED for (i = 1; i <= sbound; i += 1) { store (i) = 0; } codepos = addr (store (1)); maclim = (codepos + 20) << 1; storelim = addr (store (sbound)); np = storelim; lablim = np - 60; bp = lablim; deflim = storelim - (sbound >> 2); defmin = deflim; integer (bp) = deflim; selectinput (pre); dopass: if (pass > 0) { putword (0); control = 0x20; } startpos = maclim; mp = 0; almax = deflim; labmin = lablim; asscond = 1; skip = 0; loctype = memmask + relmask; loc = 0; setacc (); read: fsym = ' '; faultpos = 0; readline (); next: dreg = (-(1)); mode = 0; pend = 0; cond = 0; qstart = qbase; qlim = qstart; flag = 0; if (s ('$')) { if (sym == '/') goto newpage; if ((!(tag))) goto err; if (tag1 == if) goto assif; if (tag1 == els) goto asselse; if (tag1 == fin) goto assfin; if (skip != 0) goto lend; if (tag1 == def) goto define; if (tag1 == 19625) goto define; // RED if (tag1 == 13350) goto listc; // LIS if (tag1 == 21780) goto temp; // TEM if (tag1 == 13556) goto locc; // LOC if (tag1 == 1917) goto locc; // ASS if (tag1 == 20568) goto savc; // SAV if (tag1 == 14111) goto macdef; // MAC if (tag1 == 2460) goto begin; // BEG if (tag1 == end) goto bend; fault ('U'); goto lend; } if ((skip != 0 || sym == '/')) goto lend; if (sym == nl) { if (lines < 54) goto lend; while (lines != 0) donewline (); goto read; } if (tag) { if (term == ':') goto labdef; mode = 1; if ((term == '(' || sym == '=')) goto assign; if ((tag1 == jum && (tag2 == p || tag2 == ps))) goto jump; if (tag1 == if) goto ifc; if ((tag1 == els && tag2 == e)) goto else_; if ((tag1 == fin && tag2 == ish)) goto finish; if ((tag1 == 25106 && tag2 == 13173)) goto while; if ((tag1 == 4269 && tag2 == 13173)) goto cycle; if ((tag1 == 19637 && tag2 == 5544)) goto repeat; if (tag1 == b) { mode = (-(2)); goto data; } type = umask; lookup (0); if (type & opmask == macro) goto maccall; if (type & opmask != 0) goto minst; if (type & umask != 0) { fault ('U'); goto lend; } pend = (-(1)); } mode = (-(1)); data: for (;;) { getexp (); assemble (); if (type & regxmask != 0) fault ('I'); i = 1; if (s ('$')) { if (val < 1000) i = val; qlim = qstart; getexp (); assemble (); } while (i > 0) { if (mode != (-(1))) { if (val & 0xFF00 != 0) fault ('T'); if (mode == (-(2))) { j = val << 8; mode = (-(3)); } else { val += j; mode = (-(2)); plantval (); } } else { plantval (); val = val & 255; } i -= 1; } if (!((s (',') || sym & 128 != 0))) break; if (sym == nl) { if (printpos != 0) printline (); readline (); qstart = qbase; } qlim = qstart; } if (mode == (-(3))) { val = j; plantval (); } goto send; labdef: creg = (-(1)); atype = (-(1)); getsym (); if (np != storelim) { fault ('C'); np = storelim; } type = loctype; val = loc; lookup (7); goto next; assign: pend = 1; getexp (); if ((!(s ('=')))) goto err; queue ((-(25))); // 'STORE' if (integer (qbase) == reg) { dreg = integer (qbase + 1); duse = 0; } qstart = qlim; mode = 2; getexp (); queue ((-(24))); // 'LOAD' condq: if (tagif) { mode += 4; dreg -= 16; // SCARIFY getcond (); assemble (); mode -= 4; dreg += 16; // RESTORE qlim = qstart; qstart = transf; } assemble (); goto send; jump: flag = tag2 - p; // POSITIVE IF SHORT getexp (); queue ((-(26))); // 'JUMP' goto condq; minst: mode = (-(1)); getinst (); queue ((-(23))); // 'PLANT' goto condq; maccall: queue (val); // DEFPOS queue (type & 1023); // JOKER queue (0); // (CALLPOS) queue (startpos); queue (mp); for (;;) { if (char (integer (qbase)) == nl) break; // END OF MAC DEF i = getpos - 1; // SAVE CALLPOS getpos = integer (qbase); getsym (); // !%MONITOR 24 %IF %NOT TAG type = 0; val = 0; scanarg (); if (sym == ',') getsym (); integer (qbase) = getpos - 1; // UPDATE DEFPOS getpos = i; getsym (); // RESTORE CALLPOS scanarg (); if (sym == ',') getsym (); queue (tag1); queue (tag2); queue (type); queue (val); } if (sym == ' ') getsym (); if (tagif) { getcond (); queue ((-(18))); assemble (); qlim = qstart; integer (qbase + 1) = integer (qbase + 1) + 0x8000; } queue (0); mp = qbase; startpos = qlim << 1; integer (mp) = integer (mp) + 1; integer (mp + 2) = getpos - 1; if ((printpos != 0 && list & 2 != 0)) printline (); goto read; // CODING OF JUMPS: 1000 (SINGLE INST), 2000 (MAIN IF) // 4000 (ELSE), 6000 (IF AFTER ELSE) ifc: getcond (); queue ((-(15))); assemble (); goto send; else_: if (integer (np) & 0x2000 == 0) goto cerr; queue (0); queue (0); queue ((-(16))); assemble (); atype = (-(1)); creg = (-(1)); if (tagif) { getcond (); queue ((-(17))); assemble (); } goto send; finish: if (integer (np) & 0x6000 == 0) goto cerr; i = loc; while (integer (np) & 0x4000 != 0) { if (integer (np) & 0x2000 != 0) { // IF AFTER ELSE setlab (i); } else { setlab (loc); i = val + 1; } } setlab (i); goto send; while: i = loc; atype = (-(1)); creg = (-(1)); getcond (); queue ((-(13))); assemble (); nest (i); nest (1); goto send; cycle: nest (loc); nest (1); goto send; repeat: if (integer (np) != 1) goto cerr; queue (loctype); queue (integer (np + 1)); np += 2; queue ((-(26))); // 'JUMP' flag = (-(1)); goto condq; cerr: fault ('C'); goto lend; send: if (integer (np) & 0x1000 != 0) setlab (loc); if (sym == nl) goto lend; if (s (';')) goto next; err: fsym = 'F'; faultpos = getpos - 1; printpos = startpos; lend: if ((skip != 0 && list & 4 == 0)) goto read; if ((fsym == ' ' && (chars == 0 && (printpos == 0 || (mp != 0 && list & 2 == 0))))) goto read; printline (); goto read; assif: asscond = asscond << 1; if (skip != 0) goto lend; a1: getcond (); assemble (); if (cond != 0) skip = asscond; if (printpos != 0) printline (); goto lend; asselse: if (skip == 0) { if (asscond & 1 != 0) goto cerr; skip = asscond; } else { if (skip != asscond) goto lend; skip = 0; if (tagif) goto a1; } asscond += 1; goto lend; assfin: if (asscond == 1) goto cerr; asscond = asscond >> 1; if (skip >> 1 == asscond) skip = 0; goto lend; define: if (np != storelim) fault ('C'); i = tag1; for (;;) { if ((!((tag && s ('='))))) goto err; j = tag1; k = tag2; if (tag) { type = umask; lookup (0); if (type & opmask != 0) { getinst (); } else { pend = (-(1)); getexp (); } } else getexp (); assemble (); tag1 = j; tag2 = k; if (i == def) lookup (3); else lookup (2); if (!(s (','))) break; qlim = qstart; } goto send; newpage: while (lines != 0) donewline (); goto lend; listc: getexp (); assemble (); list = val; goto send; temp: i = 0; if (sym != nl) { for (;;) { getexp (); if (type != reg) fault ('I'); i = i | 1 << val; if (!(s (','))) break; } } temps = i; setacc (); goto send; locc: i = tag1; getexp (); assemble (); if (type & 0xFF9F == 0) { loctype = type & relmask + memmask; loc = val; if (pass > 0) { putword (val - 1); control = 0x30; } } else fault ('I'); goto send; savc: getexp (); assemble (); save = val; goto send; macdef: if (mp != 0) goto cerr; if ((!(tag))) goto err; j = tag1; k = tag2; i = getpos - 1; if (sym != nl) { for (;;) { if ((!(tag))) goto err; scanarg (); if ((!(s (',')))) break; } } if (sym != nl) goto err; tag1 = j; tag2 = k; type = macro; val = i; lookup (3); for (;;) { printline (); if ((s ('$') && (tag && tag1 == end))) break; startpos = putpos; if (pseudolim != 0) startpos = pseudolim + 1; readline (); } putpos = startpos; putchar (0); startpos = putpos; maclim = startpos; goto lend; auto void bnest (void) { bp += 4; // !%MONITOR 23 %IF BP-NP >= 0 integer (bp - 3) = save; integer (bp - 2) = temps; integer (bp - 1) = maclim; integer (bp) = defmin; } begin: bnest (); if (sym != nl) goto newpage; goto lend; bend: if ((np != storelim || mp != 0)) fault ('C'); mp = 0; np = storelim; if (bp != lablim) { save = integer (bp - 3); temps = integer (bp - 2); maclim = integer (bp - 1); startpos = maclim; defmin = integer (bp); setacc (); bp -= 4; if (bp != lablim) goto lend; } closeinput (); selectinput (main); bnest (); list = 5; pass += 1; if (pass != 2) goto dopass; putword (check ^ 0x0100); control = 0x30; putword (0x0100); selectoutput (bin); printch (0x60); selectoutput (lis); fault ('$'); printloc (); printline (); if (outdev == 1) lines = 60; while (lines != 0) donewline (); }