/* EPC Imp to C Translation Release 4 Version Apr 95 */ #include "imptoc.h" int main (int argc, char **argv) { /* HAL-70 */ /* INPUT/OUTPUT STREAMS*/ int event; static const int true = 0; static const int false = 1; static int main = 1; static int pre = 2; /*INPUT*/ static int bin = 1; static int lis = 2; /*OUTPUT*/ /* OPERAND TYPES*/ static int opmask = 0xF000; /* MACHINE INSTRUCTION OR MACRO */ static int macro = 0xA000; static int single = 0x5000; static int fmask = 0x800; /* FORWARD REF */ static int opfmask = 0xF800; /*=OPMASK+FMASK*/ static int umask = 0x200; /* UNDEF (FORWARD REF) */ static int bmask = 0x100; /*BYTE*/ static int reg = 0x80; /*REGISTER*/ static int memmask = 0x40; /* MEM REF */ static int relmask = 0x20; /*RELOCATABLE*/ static int xmask = 0x10; /*INDEXED*/ static int regxmask = 0x90; /*=REG+XMASK*/ static int reluxmask = 0x230; /*=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; static int qstart; static int qlim; static int 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 bincount = 0; /* OUTPUT RECORD ITEM COUNT */ static int check = 0; /* OUTPUT RECORD CHECKSUM */ static int pass = -1; /* CURRENT PASS (-1,0,1) */ static int list = -1; /* LISTING CONTROL */ int asscond, skip; /* ASSEMBLY CONDITIONS (BIT NEST) */ static int save = 1; /* REG SAVE DISPLACEMENT */ static int temps = 12; /* TEMPORARY REGISTER SET (2,3) */ int loctype, loc; /* LOCATION COUNTER */ int acc, atype, aval; /* MAIN TEMP REGISTER */ int creg, ctype, cval; /* CONDITION CODE */ int cond; /* CONDITION CODE MASK */ int dreg, duse; /* DESTINATION REGISTER */ int type, val; /* CURRENT TYPE,VALUE */ int tag1, tag2; /* TAG (CHARS 1:3, 4:6) */ int mode; /* ASSEMBLY MODE */ int pend; /* TAG ALREADY RECOGNISED */ int flag; /* JUMPS / AHM */ static int qq = '?'; static int brec[52 + 1]; /* BINARY OUTPUT RECORD */ int sbound = 32767; // selectoutput (lis); int store[sbound + 1]; static int Char (int p) { return 0; /* STORE(P) */ } static void putchar (int k) { /*AT PUTPOS WITH POST-INCREMENT*/ /*STORE(PUTPOS) = K*/ putpos++; } static void fault (int k) { /*RECORD (FIRST) FAULT*/ /*NOT NECESSARILY CULPABLE IN PASS 0*/ if (fsym == ' ') fsym = k; } static void print (int k) { (*(int *) (codepos + chars)) = k; chars++; } static void printword (int v) { static void printhit (int v) { v = (v & 15) + '0'; if (v > '9') v += 7; print (v); } static void print1 (int v) { printhit ((unsigned) v >> 4); printhit (v); } print1 ((unsigned) v >> 8); print1 (v); } static void printloc () { printword (loc); if ((loctype & relmask) != 0) print ('\''); else print (' '); print (' '); } static void donewline () { fprintf (out_file, "%s", "\n"); lines++; if (lines == 61) { fprintf (out_file, "\n\n"); lines = 0; } } static void printline () { static void printit (int sub) { static int marker = 124; /* VERTICAL BAR */ int p, q, k; if (chars == 0 && Char (printpos) == nl) return; fprintf (out_file, "%c", fsym); fprintf (out_file, "%s", " "); p = codepos; q = p + chars; while (p != q) { fprintf (out_file, "%c", (*(int *) (p))); p++; } if (printpos == 0) return; { for (_imptempint = 1; _imptempint <= 17 - chars; _imptempint++) fprintf (out_file, " "); } p = printpos; q = 0; for (;;) { if (p == faultpos) fprintf (out_file, "%c", marker); k = Char (p); if (p == pseudolim) k = sub; if ((((k ^ q) & 128)) != (0)) fprintf (out_file, "%c", '\''); if (k == nl) return; fprintf (out_file, "%c", k & 127); p++; q = k; } } if (pass == 0) return; if (list >= 0 && (printpos != 0 || fsym != ' ' || (list & 1) != 0)) { if (lines == 0) fprintf (out_file, "\n\n\n"); printit (' '); donewline (); } if (fsym != ' ') { /* %AND OUTDEV # 1 */ selectoutput (0); if (printpos == 0) printpos = startpos; if (chars == 0) printloc (); printit (nl); fprintf (out_file, "%s", "\n"); selectoutput (lis); } fsym = ' '; printpos = 0; chars = 0; } static void put (int v) { /*STORE 4-BIT ITEM IN BINARY RECORD*/ static int hold = 0; v &= 15; hold = (hold << 4) + v; bincount++; if ((bincount & 3) == 0) { brec[(unsigned) bincount >> 2] = hold; check ^= hold; hold = 0; } } static void putword (int v) { static void put1 (int v) { put ((unsigned) v >> 4); put (v); } put1 ((unsigned) v >> 8); put1 (v); } static void outputrecord () { static int seq = 0; int i; static void outputword (int w) { fprintf (out_file, "%c", ((unsigned) w >> 8) & 255); fprintf (out_file, "%c", w & 255); } while (bincount != 208) put (0); selectoutput (bin); for (i = 1; i <= 10; i++) { fprintf (out_file, "%c", 0); /*RUNOUT*/} fprintf (out_file, "%c", 0xF0); /* HEADER CODE */ seq--; outputword (seq); /* SEQUENCE NUMBER */ outputword (~(check ^ seq)); /*CHECKSUM*/ for (i = 1; i <= 52; i++) { outputword (brec[i]); } bincount = 0; check = 0; selectoutput (lis); } static void plantval () { int i, j; if (type == single) type = 0; i = 2; if ((type & opmask) != 0) i = 4; if (pass > 0) { if (((bincount + i) + i) >= 208) outputrecord (); if (i == 4) { if ((type & 0x4000) == 0) { put (11); j = type ^ opmask; type = relmask; } else { put (10); j = type; type = 0; } putword (j); if (chars != 0) printline (); printloc (); printword (j); print (' '); } else { if ((type & relmask) != 0) put (9); else put (8); if (chars != 0) print (' '); else printloc (); } putword (val); printword (val); if ((type & relmask) != 0) print ('\''); if ((type & relmask) != 0 || chars == 15) printline (); } loc += i; } static void nest (int k) { np--; /* 3 */ if (np == bp) /***IMP signals untranslateable *****/; (*(int *) (np)) = k; } static void setlab (int dest) { int d; d = dest; for (;;) { type = ((*(int *) (np)) & 0xFFF) + deflim; /* DEST SLOT */ np++; val = (*(int *) (np)); /* LOC OF JUMP */ np++; atype = -1; creg = -1; flag = 0; if (((((unsigned) (d - val) >> 1) + pass)) <= 16) flag = 2; val -= flag; if (pass == 0) { d -= flag; (*(int *) (type)) = d; if (flag != 0) { loc -= 2; dest -= 2; while (type != almax) { type++; (*(int *) (type)) = (*(int *) (type)) - 2; } } } else { if ((*(int *) (type)) != d) fault ('P'); } if (((*(int *) (np)) & 0x1000) == 0) return; if (((*(int *) (np)) & 0x2000) != 0) { /*OR*/ if (d == dest) d = val + 4; } else { d = dest; } } } static void assemble () { /* INTERDATA OP-CODES (+FORMATS)*/ static int load = 0x80F; static int lb = 0x9303; static int add = 0xA0F; static int sub = 0xB0F; static int and = 0x407; static int or = 0x607; static int xor = 0x707; static int slls = 0x7508; static int srls = 0x7408; static int slhl = 0xD04; static int srhl = 0xC04; static int comp = 0x907; static int clb = 0x9402; static int store = 0x2; static int stb = 0x9202; static int ahm = 0x2102; static int bt = 0x203; static int bf = 0x303; /* FORMAT CODES*/ static int Register = 1; static int mem = 2; static int lit = 4; static int Short = 8; static int zquery = 0; int op, k, q, litval, nq, type1, val1, free; int ass_value; int ass_line; char *ass_file; static void forminst (int code) { /* LS 4 BITS OF CODE DEFINE VALID FORMATS*/ /* INTERDATA OP-CODES FOR DIFFERENT FORMATS*/ /* ARE SYSTEMATICALLY RELATED*/ /* SHORT=REGISTER+SINC, LIT=REGISTER+LINC, MEM=REGISTER+MINC*/ static int sinc = 0x1C00; static int linc = 0xC000; static int minc = 0x4000; int op; op = code & 0xFFF0; if (type == reg) { if ((code & Register) != 0) { type = single; val += op; return; } type = xmask + val; val = 0; /* COERCE TO INDEXED IMMEDIATE */ } if (type == 0 && abs (val) <= 15 && (code & Short) != 0) { /*SHORT*/ if (val < 0) { val = -val; op ^= 0x100; } type = single; val += op + sinc; } else { if ((type & 31) == xmask) fault ('R'); /* R0 AS INDEX */ if ((type & memmask) == 0) { /*IMMEDIATE*/ if ((code & lit) == 0) fault ('I'); op += linc; } else { /*MEMORY*/ if ((code & mem) == 0) fault ('I'); op += minc; } if ((type & relmask) != 0) op ^= opmask; type = (type & 15) + op; } } static void plantjump () { int i, op; op = bf; if (cond < 0) { cond = ~cond; op = bt; } if ((type & (~umask)) == loctype) { i = ((unsigned) loc >> 1) - ((unsigned) val >> 1); if (flag != 0 && abs (i) > 15) { fault ('J'); i = 0; } if (abs (i) <= 15) { if ((type & umask) == 0 || flag != 0) { op = (op << 1) + 2; /* 0408, 0608 */ type = 0; val = i; } else { if (list >= 0 && (list & 8) != 0) fault ('S'); } } } forminst ((cond << 4) + op); plantval (); cond = 0; } static void setjump (int Case) { int thold, vhold, fhold; almax++; /* 2 */ if (almax == labmin) /***IMP signals untranslateable *****/; nest (loc); nest ((almax - deflim) + Case); thold = type; vhold = val; fhold = flag; type = loctype; val = (*(int *) (almax)); flag = 0; if (pass == 0) type += umask; cond = ~cond; plantjump (); type = thold; val = vhold; flag = fhold; } static void plantinst (int code) { forminst (code); if (cond != 0) setjump (0x1000); plantval (); } static 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 & 15) == r) && (r != 0)) atype = -1; if ((type & bmask) == 0) { op = load; if (((type ^ xmask) == r) && (r != 0)) { op = add; type = 0; } creg = r; ctype = 0; cval = 0; } else { op = lb; if (creg == r) creg = -1; } plantinst ((r << 4) + op); type = reg; val = r; } static void release () { int i; if ((type & regxmask) == 0) return; i = type & 15; if (i == 0) i = val; if (i == dreg) { duse--; } else { i = 1 << i; if ((temps & i) != 0) free |= i; } } static void loadtemp () { int i, j; release (); if (dreg >= zquery && duse == 0) { i = dreg; duse = 1; } else { j = 1 + zquery; for (i = zquery; i <= 15; i++) { if ((free & j) != 0 && i != dreg) goto ok; j = j << 1; } fault ('R'); ok: free -= j; } loadreg (i); } static void swop () { int k; k = type1; type1 = type; type = k; k = val1; val1 = val; val = k; } static void progref () { if ((type & reluxmask) == xmask && val == 0) { val = type & 15; type = reg; } if (type != reg) type |= memmask; } static int temp () { if (type1 != reg) return false; if (val1 == dreg) { if (duse != 1) return false; } else { if (((1 << val1) & temps) == 0) return false; } return true; } q = qstart; new: nq = qstart; free = temps; type = (*(int *) (q)); q++; val = (*(int *) (q)); q++; get: for (;;) { if (q == qlim) return; k = (*(int *) (q)); q++; if (k < 0) { ass_value = k; ass_line = __LINE__; ass_file = __FILE__; goto ass_despatch; } (*(int *) (nq)) = type1; (*(int *) (nq + 1)) = val1; nq += 2; type1 = type; val1 = val; type = k; val = (*(int *) (q)); q++; } 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 () != true || (type == reg && val == dreg && duse == 1 && k != 0)) { swop (); if (k == 0 || temp () != true) { loadtemp (); swop (); } } if ((type & bmask) != 0 || ((op & mem) == 0 && (type & memmask) != 0)) loadtemp (); release (); plantinst ((val1 << 4) + op); type = reg; val = val1; creg = val; ctype = 0; cval = 0; if (acc == val || ((atype & 15) == val) && (val != 0)) atype = -1; if (atype == reg && aval == val) atype = -1; } pop: nq -= 2; type1 = (*(int *) (nq)); val1 = (*(int *) (nq + 1)); goto get; ass_uminus2: op = sub; if (mode > 0 && type != 0) goto nop; if (mode <= 0 && type1 == type) { type1 = 0; type = 0; } val = -val; ass_uminus1: op = add; litval = val1 + val; if (type != 0) goto bop; if ((type1 & memmask) != 0 && mode > 0) { swop (); loadtemp (); swop (); } if (type1 == reg) { if (val1 == 0) goto bop; type1 = xmask + val1; litval = val; } type = type1; val = litval; goto pop; ass_uminus3: op = and; litval = val1 & val; goto bop; ass_uminus4: op = or; litval = val1 | val; goto bop; ass_uminus5: op = xor; litval = val1 ^ val; goto bop; ass_uminus6: op = slls; litval = val1 << val; if (type != 0) op = slhl; goto nop; ass_uminus7: op = srls; litval = (unsigned) val1 >> val; if (type != 0) op = srhl; goto nop; ass_uminus8: /* TYPE_VAL */ type = val1; if ((type & opmask) == macro) type = 0; /*SAFETY*/ if ((type & (opmask + fmask)) == fmask) type = 0; goto pop; ass_uminus11: /*COMPARE*/ k = (*(int *) (q)); q++; if (mode <= 0) { if (type1 != type) { val1 = type1; val = type; } litval = ~3; if (val1 < val) litval = 1; if (val1 > val) litval = 2; k &= litval; if (k != 0) k = ~0; } else if (creg != 16 || type1 != ctype || val1 != cval || (type != val) || (val != 0)) { if (type1 != reg) { swop (); if (type1 != reg) { loadtemp (); swop (); } else { if (k != 3 && k != ~3) k ^= 3; } } if (creg != val1 || ctype != type || cval != val) { creg = val1; ctype = type; cval = val; if ((type != val) || (val != 0)) { op = comp; if (type == atype && val == aval) { type = reg; val = acc; } if ((type & bmask) != 0) { op = clb; if (k != 3 && k != ~3) fault ('I'); } } else { op = load; type = reg; val = val1; } plantinst ((val1 << 4) + op); } }; cond = k; goto get; ass_uminus12: /* TEST CC */ cond = ~val; goto get; ass_uminus13: /* AND,WHILE */ if (mode > 0) { setjump (0x1000); } else { if (cond != 0) return; /* CONDITION FALSE */ } if (q == qlim) return; goto new; ass_uminus14: /*OR*/ if (mode > 0) { cond = ~cond; setjump (0x3000); } else { if (cond == 0) return; /* CONDITION TRUE */ } goto new; ass_uminus15: /*IF*/ setjump (0x2000); return; ass_uminus16: /*ELSE*/ cond = ~0; setjump (0x4000); return; ass_uminus17: /* IF AFTER ELSE */ setjump (0x6000); return; ass_uminus18: /* MACCALL IF */ setjump (0x8000); return; ass_uminus20: /*HASH*/ type &= umask + 63; goto get; ass_uminus21: /*INDEX*/ if ((type1 & regxmask) != 0) fault ('I'); if ((type & memmask) != 0) { if (mode > 0) { zquery = 1; loadtemp (); zquery = 0; } else fault ('A'); } if (type == reg) { type = xmask + val; val = 0; } zquery = 0; if (((type1 & type) & relmask) != 0) fault ('I'); type = (type1 | type) | memmask; val += val1; goto pop; ass_uminus22: /* MINST SEPARATOR */ if ((type1 & opmask) == 0x7000) { if ((type1 & 0x10) == 0) { /*REG-TYPE INST*/ if (type != reg) fault ('I'); } else { if (val < 0) { val = ~val; val1 ^= 0x100; } if (type != 0 || val > 15) fault ('I'); } type = type1 + 0x8000; val = (val1 & 0xFF0F) + (val << 4); } else if ((type1 & opmask) == 0xF000) { if ((val1 & 0xFC0F) == 0x3) progref (); /* BAL,BTC,BFC */ forminst (val1); } else fault ('I'); goto pop; ass_uminus23: /* MACHINE INST */ if (cond != 0) setjump (0x1000); plantval (); creg = -1; atype = -1; return; ass_uminus24: /*LOAD*/ if (type != reg) loadtemp (); q = qbase; goto get; ass_uminus25: /* STORE (TYPE1,VAL1 -> TYPE,VAL) */ if (type == reg) { if (val1 != val) { swop (); loadreg (val1); } } else { if ((atype & memmask) != 0) atype = -1; if (flag == 0) { if (val1 == acc && atype < 0) { k = type & 15; if (k == 0 || ((1 << k) & temps) == 0) { atype = type; aval = val; } } op = store; if ((type & bmask) != 0) op = stb; } else { creg = 16; ctype = type; cval = val; op = ahm; } plantinst ((val1 << 4) + op); } return; ass_uminus26: /*JUMP*/ if (((*(int *) (np)) & 0xF000) == 0x3000) setjump (0x1000); /*OR*/ if (flag < 0) { /*REPEAT*/ flag = 0; if (pass == 0) { k = np; litval = loc; while (((*(int *) (k)) & 0x1000) != 0) { k += 2; litval -= 2; } if ((litval - val) < 32) flag = 1; } } progref (); plantjump (); return; goto ass_skip; ass_despatch: switch (ass_value) { case -2: goto ass_uminus2; case -1: goto ass_uminus1; case -3: goto ass_uminus3; case -4: goto ass_uminus4; case -5: goto ass_uminus5; case -6: goto ass_uminus6; case -7: goto ass_uminus7; case -8: goto ass_uminus8; case -11: goto ass_uminus11; case -12: goto ass_uminus12; case -13: goto ass_uminus13; case -14: goto ass_uminus14; case -15: goto ass_uminus15; case -16: goto ass_uminus16; case -17: goto ass_uminus17; case -18: goto ass_uminus18; case -20: goto ass_uminus20; case -21: goto ass_uminus21; case -22: goto ass_uminus22; case -23: goto ass_uminus23; case -24: goto ass_uminus24; case -25: goto ass_uminus25; case -26: goto ass_uminus26; default: BADSWITCH (ass_value, ass_line, ass_file); } ass_skip:; } /*ASSEMBLE*/ static 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 ((*(int *) (dp)) != 0) { if ((*(int *) (dp)) == tag1 && (*(int *) (dp + 1)) == tag2) goto yes; dp += 4; } /*%OWNINTEGER P*/ /*NO:*/ if ((control & 1) == 0) return; /* NO CREATION */ new: defmin -= 4; dp = defmin; if ((dp - qlim) <= 0) /***IMP signals untranslateable *****/; /* 1 */ (*(int *) (dp)) = tag1; (*(int *) (dp + 1)) = tag2; set: (*(int *) (dp + 2)) = type; (*(int *) (dp + 3)) = val; return; yes: if ((control & 2) == 0) { /*NOT DEF CLASS*/ type = (*(int *) (dp + 2)); val = (*(int *) (dp + 3)); return; } if (control == 3) { if ((dp - (*(int *) (bp))) >= 0) goto new; /*GLOBAL*/ fault ('D'); } if (control != 7) goto set; if (((*(int *) (dp + 2)) & opfmask) == fmask) { val = (*(int *) (dp + 3)); if (pass == 0) { (*(int *) (val)) = loc; } else { if ((*(int *) (val)) != loc) { fault ('P'); loc = (*(int *) (val)); } } val = loc; } else { if ((dp - (*(int *) (bp))) >= 0) goto new; fault ('D'); } goto set; } static void tagref () { static int b = 2184; static int w = 24717; if (term == '(') { type = 0; val = 0; if (tag1 == w) return; type = bmask; if (tag1 == b) return; } type = (loctype + fmask) + umask; val = labmin - 1; lookup (1); if ((type & opfmask) == fmask) { if (val == (labmin - 1)) { labmin = val; /* 2 */ if (labmin == almax) /***IMP signals untranslateable *****/; } if (pass > 0) { val = (*(int *) (val)); if (val == 0) fault ('U'); } type -= fmask; } } static void getsym () { for (;;) { sym = Char (getpos); getpos++; if (sym != ' ') return; } } static int s (int k) { if (k != sym) return false; getsym (); return true; } static int ss (int k) { if ((k != sym) || (sym != Char (getpos))) return false; getpos++; getsym (); return true; } static int tag () { int j, k; static void codesym () { sym = Char (getpos); getpos++; 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; } static void packtriple () { 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+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+K*11+1 */ codesym (); t3: if (term > 0) return; j = (j + k) + 1; codesym (); } k = sym - 'A'; if (k < 0 || k >= 26) return false; if (sym == 'X' && (Char (getpos) & 128) != 0) return false; term = 0; packtriple (); tag1 = j; for (;;) { j = 0; if (term <= 0) packtriple (); tag2 = j; while (term <= 0) codesym (); if (term != qq) break; type = 1; lookup (0); if (type != 0) fault ('U'); tag1 = val; term = 0; codesym (); } if (term == ' ') getsym (); return true; } static int tagif () { if (sym != 'I' || Char (getpos) != 'F' || Char (getpos + 1) != ' ') return false; getpos += 2; getsym (); return true; } static void queue (int k) { (*(int *) (qlim)) = k; qlim++; /* 1 */ if (qlim == defmin) /***IMP signals untranslateable *****/; } static void getexp () { int i, nbase; nbase = np; if (pend != 0) goto e3; e1: while (s ('(') == true) nest (0); if (s ('#') == true) nest (-20); if (tag () == true) { e3: if (pend >= 0) tagref (); pend = 0; if (type == reg && term == '(') { if ((save & 1) == 0) type = 0; val = (val + val) + save; } if ((type & opmask) != 0) { fault ('I'); type = 0; } if (mode != 0) { if ((type & regxmask) != 0) { i = type & 15; if (i == 0) i = val; if (i == dreg) duse++; } } 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++; } 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++; } 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 ('.') == true) { if (tag () != true) goto err; type = 0; val = tag1; } else if (s ('*') == true) { type = loctype & 63; val = loc; if (sym == 'L') { /*FOR NOW*/ type = 0; if (tag () == true) 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 ((*(int *) (np)) < 0) { queue ((*(int *) (np))); } else { if (s (')') != true) break; } np++; } i = 1; if (s ('+') == true) { nest (-1); goto e8; } if (s ('-') == true) { nest (-2); goto e8; } if (s ('&') == true) { nest (-3); goto e9; } if (s ('!') == true) { nest (-4); goto e9; } if (s ('\\') == true) { nest (-5); goto e9; } if (ss ('<') == true) { nest (-6); goto e9; } if (ss ('>') == true) { nest (-7); goto e9; } if (s ('_') == true) { nest (-8); goto e9; } if (np == nbase) return; err: np = nbase; /***IMP signals untranslateable *****/; /* 9 */ e8: i = 0; e9: if (mode != 2 || (np + 1) != nbase) goto e1; if (flag == i) flag = qlim; else flag = -1; goto e1; } static void condit (int qval) { static int and = 1717; static int or = 16873; int j, k; transf = qstart; qstart = qlim; j = 0; for (;;) { getexp (); if (s ('=') == true) { k = 3; } else if (s ('#') == true) { k = ~3; } else if (s ('<') == true) { k = ~1; if (s ('=') == true) k = 2; } else if (s ('>') == true) { k = ~2; if (s ('=') == true) k = 1; } else { queue (-12); goto andor; } getexp (); queue (-11); queue (k); andor: if (tag () != true) break; if (tag1 == and && tag2 == 0) { if (j < 0) /***IMP signals untranslateable *****/; /* 9 */ j = 1; queue (-13); } else { if (tag1 != or || j > 0) /***IMP signals untranslateable *****/; /* 9 */ j = -1; queue (-14); } } if (qval != 0) queue (qval); assemble (); if (j < 0) { atype = -1; creg = -1; } } static void getinst () { /*%INTEGER I*/ /*OPMASK VALUES*/ /* 0100,0110,1100,1101,1110: DOUBLE WORD INSTRUCTIONS*/ /* 1011,1001,0011,0010,0001: AS ABOVE BUT RELOCATABLE*/ /* 0101: SINGLE WORD INSTRUCTION*/ /* 0111: 2 OPERANDS TO COME*/ /* 1111: 1 OPERAND TO COME*/ /* 1010: MACRO*/ queue (type); queue (val); if ((type & 0x7000) != 0x7000) return; if (term != ' ') return; /* NO OPERAND FOLLOWING => */ for (;;) { getexp (); queue (-22); if (s (',') != true) return; } } static void readline () { int q; putpos = startpos; if (mp == 0) { q = 0; pseudolim = 0; for (;;) { sym = fgetc (in_file); if (sym == '\'') { sym = fgetc (in_file); 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; sym = fgetc (in_file); } printpos = startpos; } else { getpos = (*(int *) (mp)); if (Char (getpos) == 0) { qbase = mp; getpos = (*(int *) (mp + 2)); startpos = (*(int *) (mp + 3)); mp = (*(int *) (mp + 4)); if (mp < 0) { mp -= 0x38000; while (((*(int *) (np)) & 0x8000) == 0) { fault ('C'); np += 2; } setlab (loc); } if ((list & 2) != 0) printpos = 0; getsym (); /*TERMINATOR*/ if (sym == ';') getsym (); return; } if ((list & 2) != 0) printpos = startpos; qq = 0; for (;;) { sym = Char (getpos); getpos++; if (tag () == true) { if (term == ' ') { sym = term; getpos--; } type = (*(int *) (mp)); val = getpos - 1; lookup (4); while (type != val) { putchar (Char (type)); type++; } } putchar (sym); (*(int *) (mp)) = getpos; if (sym == nl) break; } qq = '?'; } qbase = (unsigned) (putpos + 1) >> 1; getpos = startpos; getsym (); } static void scanarg () { /* SET TYPE,VAL TO START,LIM OF ARG IF NOT NULL*/ int i, 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++; if (sym == ']') { j--; if (j == 0) break; } sym = Char (getpos); getpos++; } if ((getpos - 1) != i) { type = i; val = getpos - 1; } if (sym == ']') getsym (); } static void setacc () { int i; acc = -1; atype = -1; creg = -1; i = temps; if (i == 0) return; for (;;) { acc++; if ((i & 1) != 0) return; i = (unsigned) i >> 1; } } /*MAIN PROGRAM*/ /*RADIX 36 CONSTANTS*/ static int b = 2184; static int If = 9991; static int els = 5950; static int e = 5403; static int fin = 6907; static int ish = 10490; static int jum = 11642; static int p = 17206; static int ps = 17983; static int def = 4605; static int end = 6009; int i, j, k; static void bnest () { bp += 4; /* 3 */ if ((bp - np) >= 0) /***IMP signals untranslateable *****/; (*(int *) (bp - 3)) = save; (*(int *) (bp - 2)) = temps; (*(int *) (bp - 1)) = maclim; (*(int *) (bp)) = defmin; } if (0) { /* beginning of onevent block */ if (event == 19) goto err; /* RECOGNITION ERROR */ if (event == 9) goto bend; /* INPUT ENDED */ /* end of onevent block */ } for (i = 1; i <= sbound; i++) { store[i] = 0; } codepos = (int) &store[1]; maclim = (codepos + 20) << 1; storelim = (int) &store[sbound]; np = storelim; lablim = np - 60; bp = lablim; deflim = bp - ((unsigned) sbound >> 2); defmin = deflim; (*(int *) (bp)) = deflim; openinput (pre, "hal70.def"); selectinput (pre); dopass: 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 ('$') == true) { if (sym == '/') goto newpage; if (tag () != true) 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) goto lend; if (tag () == true) { 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 ('$') == true) { 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 (); val &= 255; } } else { plantval (); } i--; } if (s (',') != true && (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 ('=') != true) goto err; queue (-25); /* 'STORE' */ if ((*(int *) (qbase)) == reg) { dreg = (*(int *) (qbase + 1)); duse = 0; } qstart = qlim; mode = 2; getexp (); if (flag != 0) { if (dreg < 0 && (flag - qstart) == ((qstart - qbase) - 1) && ((*(int *) (qbase)) & bmask) == 0) { i = qbase; j = qstart; while ((*(int *) (i)) == (*(int *) (j))) { i++; j++; } if (j == flag) { if ((*(int *) (qlim - 1)) == -2) { /*MINUS*/ qstart = j - 2; (*(int *) (qstart)) = 0; (*(int *) (qstart + 1)) = 0; } else { qstart = j; qlim--; } } else flag = 0; } else flag = 0; } queue (-24); /* 'LOAD' */ condq: if (tagif () == true) { mode += 4; dreg -= 16; /*SCARIFY*/ condit (0); 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 (0); /* (DEFPOS) */ queue (0); /*SPARE*/ queue (0); /* (CALLPOS) */ queue (startpos); queue (mp); j = val; qq = 0; for (;;) { if (Char (j) == nl) break; /* END OF MAC DEF */ i = getpos - 1; /* SAVE CALLPOS */ getpos = j; getsym (); if (tag () != true) /***IMP signals untranslateable *****/; /* 4 */ type = 0; val = 0; scanarg (); if (sym == ',') getsym (); j = getpos - 1; /* SAVE DEFPOS */ getpos = i; getsym (); /* RESTORE CALLPOS */ scanarg (); if (sym == ',') getsym (); queue (tag1); queue (tag2); queue (type); queue (val); } qq = '?'; if (sym == ' ') getsym (); if (tagif () == true) { condit (-18); qlim = qstart; (*(int *) (qbase + 4)) = mp + 0x38000; } queue (0); startpos = qlim << 1; mp = qbase; (*(int *) (mp)) = j + 1; /* START OF BODY */ (*(int *) (mp + 2)) = getpos - 1; goto lend; /*CODING OF JUMPS: 1000 (SINGLE INST), 2000 (MAIN IF)*/ /* 4000 (ELSE), 6000 (IF AFTER ELSE)*/ ifc: condit (-15); goto send; Else: if (((*(int *) (np)) & 0x2000) == 0) goto cerr; queue (0); queue (0); queue (-16); assemble (); atype = -1; creg = -1; if (tagif () == true) { condit (-17); } goto send; finish: if (((*(int *) (np)) & 0x6000) == 0) goto cerr; i = loc; while (((*(int *) (np)) & 0x4000) != 0) { if (((*(int *) (np)) & 0x2000) != 0) { /*IF AFTER ELSE*/ setlab (i); } else { setlab (loc); i = val + 4; } } setlab (i); goto send; While: i = loc; atype = -1; creg = -1; condit (-13); nest (i); nest (1); goto send; cycle: nest (loc); nest (1); atype = -1; creg = -1; goto send; repeat: if ((*(int *) (np)) != 1) goto cerr; queue (loctype); queue ((*(int *) (np + 1))); np += 2; queue (-26); /* 'JUMP' */ flag = -1; goto condq; cerr: fault ('C'); goto lend; send: if (((*(int *) (np)) & 0x1000) != 0) setlab (loc); if (sym == nl) goto lend; if (s (';') == true) 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: condit (0); 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 () == true) goto a1; } asscond++; goto lend; assfin: if (asscond == 1) goto cerr; asscond = (unsigned) asscond >> 1; if (((unsigned) skip >> 1) == asscond) skip = 0; goto lend; define: if (np != storelim) fault ('C'); i = tag1; for (;;) { if ((tag () != true || s ('=') != true)) goto err; j = tag1; k = tag2; if (tag () == true) { tagref (); 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 (',') != true) 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 |= 1 << val; if (s (',') != true) break; } } temps = i; setacc (); goto send; locc: i = tag1; getexp (); assemble (); if ((type & 0xFF80) == 0) { if (i == 13556) { /*LOC*/ if (bincount >= 203) outputrecord (); if ((((loctype ^ type) & relmask)) != (0)) put (3); put (5); putword (val); } loctype = (type & 63) + memmask; loc = val; } else fault ('I'); goto send; savc: getexp (); assemble (); save = val; goto send; macdef: if (mp != 0) goto cerr; if (tag () != true) goto err; j = tag1; k = tag2; i = getpos - 1; if (sym != nl) { for (;;) { if (tag () != true) goto err; scanarg (); if (s (',') != true) break; } } if (sym != nl) goto err; tag1 = j; tag2 = k; type = macro; val = i; lookup (3); for (;;) { printline (); if (s ('$') == true && tag () == true && tag1 == end) break; startpos = putpos; if (pseudolim != 0) startpos = pseudolim + 1; readline (); } putpos = startpos; putchar (0); startpos = putpos; maclim = startpos; goto lend; 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 = (*(int *) (bp - 3)); temps = (*(int *) (bp - 2)); maclim = (*(int *) (bp - 1)); startpos = maclim; defmin = (*(int *) (bp)); setacc (); bp -= 4; if (bp != lablim) goto lend; } closeinput (); selectinput (main); bnest (); list = 5; pass++; if (pass != 2) goto dopass; if (bincount == 208) outputrecord (); put (1); outputrecord (); fault ('$'); printloc (); printline (); exit (0); } /* end of automatic translation */