/* EPC Imp to C Translation Release 4 Version Apr 95 */ #include "imptoc.h" int main (int argc, char **argv) { /* IMP15 COMPILER 30/10/78 */ /*OUTPUT STREAMS */ static const int err = 0; static const int obj = 1; static const int map = 2; /*PRIMITIVE ROUTINE TAGS */ static const int moni = 4; /* MONITOR */ static const int nst = 5; /* NEST */ static const int le = 6; /* TEST LESS-THAN OR EQUAL */ static const int ge = 7; /* TEST GREATER-THAN OR EQUAL */ static const int ar = 8; /* ARRAY REFERENCE */ static const int adec = 9; /* ARRAY DECLARATION */ static const int sh = 10; /* SHIFT */ static const int ent = 16; /* PROCEDURE ENTRY/EXIT */ static const int flt = 17; /* FAULT TRAP */ static const int bar = 20; /* BYTE ARRAY-REF */ static const int bget = 21; /* BYTE FETCH */ static const int bput = 22; /* BYTE STORE */ static const int adr = 28; /* ADDR */ static const int Int = 29; /* INTEGER */ static const int ptxt = 38; /* PRINT TEXT */ /*DECLARATION CODES */ static const int beg = 108; /* BEGIN */ static const int ext = 128; static const int own = 64; static const int body = 64; static const int ref = 32; static const int array = 8; static const int proc = 4; static int line = 1; /* LINE NUMBER */ static int lines = 0; /* LINE COUNT */ static int icount = 0; /* INSTRUCTION COUNT */ static int sym = 0; /* CURRENT INPUT SYMBOL */ static int symtype = 0; /*-2:LET, -1:DIG, 0:TERM*/ /* 1:OTHER, 2:KEYLET */ static int decl = 0; /* DECLARATOR TYPE */ static int sstype = 1; /* STATEMENT TYPE */ static int section = 0; /* 0:INSTR, 1:DATA */ static int ownc = 0; /* OWN COUNT */ static int faulty = 0; /* FAULT INDICATOR */ /*CURRENT INPUT LINE */ static int pos1 = 0; /* START-OF-ATOM POSITION */ static int pos = 0; /* CURRENT CHAR POSITION */ int Char[73 + 1]; /*NAME DICTIONARY */ static int dmax = 0; /* NAME DICT MAX */ static const int dbound = 500; /* UPPER BOUND (CHANGED FROM 350) */ int dict[dbound + 1]; /*TAG INFO */ static int global = 0; /* ZERO OR ENDOFPRIM TAG */ static int tmax = 0; /* TAG MAX */ int x; /* CURRENT TAG (WHEN RELEVANT) */ static int lmin = 253; /* COMP LAB MIN */ int *tt0, *ttx; /*==TAGTYPE(0),TAGTYPE(X)*/ int tagtype[223 + 1]; int index[223 + 1]; /* SIGNIFICANCE OF TAGTYPE VALUES: */ /* VAL256+ VAL128 VAL64 VAL32 VAL0:15 */ /* 0 0 SET 0 0 0 0 0 LABEL */ /* 0 EXT OWN REF 0 0 0 1 INTEGER (EXT+OWN=CONST) */ /* 0 0 OWN REF 0 0 1 0 BYTE */ /* GRAM AD SAFE/EXT BODY REF 0 1 0 0 PRED */ /* GRAM AD SAFE/EXT BODY REF 0 1 T T FN */ /* 0 0 0 0 0 1 1 1 STRING */ /* BOUNDS AD 0 1 0 1 0 0 0 SWITCH */ /* 0 0 OWN REF 1 0 T T ARRAY */ /* GRAM AD SAFE/EXT BODY REF 1 1 0 0 ROUTINE */ /* GRAM AD SAFE/EXT BODY REF 1 1 T T MAP */ /* 0 0 1 1 1 1 0 0 BEGIN */ /* NEVER STORED IN TAGTYPE */ /* 0 0 0 1 0 1 0 0 SPEC */ /*ANALYSIS RECORD */ int ss; /* START OF SS */ static const int nodebound = 70; int refco[nodebound + 1]; int sub[nodebound + 1]; /** GRAMMAR AND KEYDICT GENERATED BY TAKEON PROGRAM*/ static int gmax1 = 196; static int gmax = 196; static int phrase[127 - 111] = { 194, 69, 72, 77, 81, 115, 125, 147, 153, 156, 159, 168, 173, 176, 188, 0 }; static int atomic[111 - 79] = { 64, 70, 72, 77, 68, 69, 73, 67, 73, 73, 74, 77, 76, 77, 78, 78, 65, 65, 66, 66, 74, 78, 74, 12, 18, 15, 15, 65, 10, 15, 9, 42 }; static int initial[79] = { 36225, 35842, 33923, 3332, 68741, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -118767, 0, 0, 3604, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -131041, 0, 0, -117854, -117981, 3876, -117595, -117722, 0, 2088, 4009, 0, 0, 0, 0, 33838, 33071, 0, 0, 1842, 1075, 1460, 3765, 0, 66615, 99384, 33849, 33850, 98363, 0, 0, 0, 0, 35664, -118944, -118429, 0, 0, 0, 0, 0, 35794, -118058, -118044, 0, -118196, -118061, -118043, 0 }; static int gram[255 + 1] = { 0, 756, -129612, -129999, 1140, -94156, -94155, -129132, 9, -126846, 4996, 1653, -128746, 1073, -131063, 33918, -129978, 1095, -129999, 2676, -130640, 9, 10, 5134, 1137, 5329, 5745, 6129, 6526, 6517, 39367, 33913, 33909, 4465, -126452, 110, 37625, -126739, 110, 6726, 40441, 5376, -123378, 9, 38642, -127729, 9, 39027, -127601, 9, 1074, 7825, 39667, -124020, 110, -123127, 7417, -123923, 110, 2832, 8070, 1088, 7040, 8262, -122481, -123002, 1040, -122810, 8070, 9030, -122225, 0, 9358, 9594, 9610, 9850, 16, 9998, 10233, 10348, 9849, -118944, -118767, -118196, -118058, -118061, -131041, -117981, -117854, -118429, -118044, -118043, -117722, 13477, -117492, 46494, -131008, 46664, -117492, 46750, 46960, 47216, 32890, 32887, 46915, 32839, 46970, 79735, 65648, 79736, -116497, 0, 80231, 116, 112506, -115978, 15482, -82774, -82645, 0, 32768, 15862, 15222, -82774, 0, -114546, -114004, -113852, 16890, -121227, 17402, -112979, 32768, 118, 32880, 17424, -112870, -112741, -112612, -112979, 32768, 51450, 50301, 50428, 50555, -117971, 0, -111775, -113832, 17243, -78819, 0, 65658, -111774, -113818, 17247, -117608, -117607, 32839, -110439, -109800, 53629, -110438, -109669, -109796, 0, 53883, 53756, 54525, -109542, -109029, 0, 54652, 55165, -108902, 0, -131007, -131001, -131006, -113847, -113851, -113843, -113846, -113842, -121458, 23826, 24061, 104, 24299, 24332, 57338, 24681, 57594, 13162, 24974, 25210, 16, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }; static int kdict[425 - 31] = { 0, 387, 131, 403, 131, 131, 407, 131, 411, 415, 419, 431, 447, 451, 131, 475, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 487, 490, 495, 523, 539, 131, 131, 556, 628, 656, 708, 752, 904, 128, 128, 972, 1152, 128, 1188, 1232, 1248, 1256, 1284, 128, 1348, 1440, 1552, 1604, 128, 1636, 1648, 128, 128, 131, 1695, 131, 131, 131, -118367, -64814, 66268, 66204, 106541, 65947, 65550, 65552, -117462, 66331, 66522, -116949, -65448, 65628, 66013, 65551, -116051, -116162, -65384, 65692, 65553, 66077, -115665, 66459, 66395, 65546, 65545, -114500, -114627, -114754, 69677, 65818, 77869, 65818, -113987, -57332, 73773, 66142, -113347, -113474, 110637, 65882, 102445, -112188, 8782, -112349, -112470, -60760, 65578, 71336, 68265, -111039, -111676, 82, 70696, -111197, -111318, 70056, 71080, 68009, 71592, -110395, 10841, 69, 65728, 9415, 78, 65591, -108534, -109361, 8665, 8908, 65586, -108851, 10702, 84, 77827, 8909, 10830, 65547, 65536, -107711, 9946, -107862, 69864, 70888, -107325, 68, 71528, -107094, 69736, 70760, -102452, -105010, 88, -105271, 84, -105659, 9426, 10702, 8649, 73731, 10066, 9793, 73728, 84, 66847, 68, -104625, 65592, 70, -102842, 80, -103099, 82, -103351, 9167, 8402, 77, 65595, 77, 65593, 9938, 65594, 9801, 69, 65595, 8915, -65489, 65584, -100671, -101559, 10575, 65556, 9422, 9299, -101051, 65582, 10700, 69, 65583, -100148, 9813, 84, 65572, 8915, 66719, -94266, -98738, -98993, 11603, -99158, 70248, 71272, 84, 70568, 8916, 8903, 82, -95295, -96186, -97075, -97586, -65470, 65606, 9921, 69, -63422, 67654, 10305, -96557, -60603, 70470, 8912, 67, 66373, 78, -95661, -61115, 69958, 8912, 67, 65861, 10578, 11457, -94770, 66116, 9921, 69, -62910, 68166, 66356, 77, -93360, 83, -93526, 69800, 70824, -93142, 70440, 71464, -92607, 10825, 67817, -92221, 68, 71656, -91741, -91862, 69928, 70952, 67881, 10063, 10825, 10575, 65573, 10831, 65580, -90160, -90286, 10071, 69635, 65579, 82, 70632, 82, -89019, 10057, 10836, 11333, 84, 65574, 9412, 8387, 8916, -88237, -61179, 69894, 8912, 67, 65797, -86587, 10959, 9428, 8910, -86957, -60667, 70406, 8912, 67, 66309, -85296, -85933, 10964, 10066, 66591, 9813, 7892, -85443, 65571, 65570, 8389, 84, 65587, -82111, -82488, -82736, -83884, 9431, 8660, 72, 70145, -83007, -83249, 9426, 9166, 65990, 80, 66783, 10834, 65585, 8645, 67845, 10575, 84, 65536, 68, -81501, -81622, 70376, 71400, 68329, -80447, -80696, 10962, 69, 66655, 10053, 65558, 68, -79837, -79958, 70120, 71144, 68073, 78, -79028, 9428, 76, 67061, 10693, 83, 66484, 9416, 8908, 66869, -77373, 10575, -77533, -77654, 69992, 71016, 67945, 84, -77014, 70184, 71208, -76611, 65753, 106541 }; /*!END OF GENERATED SECTION */ int *app; /*== PHRASE(112)*/ int bapp; /* BASIC APP IE LB EXP RB */ int *mref; /*== MAP RESULT REF*/ void compileblock (int level, int btag, int *btype, int *gd) { /* void printss (int s); int gapp (void); void fault (int n); void analyse (void); void compile (void); */ static int ac = ~255; static int aclit = 0; int tbase, dbase, lstack, estack, pmax, atag, danger, access, extind, ibase; void printss (int s) { int k, p; assert (0 <= (s & 7)); assert ((s & 7) <= 2); selectoutput (s & 7); fprintf (out_file, "%4d", line); fprintf (out_file, "%s", " "); fprintf (out_file, "%s", " "); if (s != err) { { for (_imptempint = 1; _imptempint <= level; _imptempint++) fprintf (out_file, " "); }; pos1 = 0; } p = 1; for (;;) { if (p == pos1) fprintf (out_file, "%c", '^'); if (p == pos) break; k = Char[p]; p++; if (k == nl || (k == '%' && p == pos)) break; fprintf (out_file, "%c", k); } if (s == map) fprintf (out_file, "%6d", icount - ibase); fprintf (out_file, "%s", "\n"); selectoutput (obj); } void printident () { int i, j, k, l; i = index[x]; j = (unsigned) i >> 9; fprintf (out_file, "%c", ((unsigned) j >> 3) + 32); i &= 511; j &= 7; while (j != 0) { j--; for (l = 12; l >= 0; l += -6) { k = ((unsigned) dict[i - j] >> l) & 63; if (k != 0) fprintf (out_file, "%c", k + 32); } } } int gapp (void) { /* GRAMMAR FOR APP */ static const int comma = 15; static const int lb = 14; int i, l; int class (int k) { if ((k & (array + proc)) != 0) return (k & 15) + 80; /* PROC AND ARRAY PARAMS */ if ((k & ref) == 0) return 122; /* INTEGER->EXP(122) */ if ((k & 2) == 0) return 119; /* INTEGERNAME->REF(119) */ return 120; /* BYTEINTEGERNAME->BREF(120) */ } void setgcell (int c) { c += l << 7; /* LINK + CLASS */ while (l != gmax) { l++; if (gram[l] == c) return; } gmax++; l = gmax; gram[l] = c; } i = tmax; if (i == tbase) return 255; /* NULL APP (FOR NOW) */ l = gmax1; /* ')' CELL */ for (;;) { setgcell (class (tagtype[i])); i--; if (i == tbase) break; setgcell (comma); /* ',' CELL */ } setgcell (lb); /* '(' CELL */ return l; } void fault (int n) { int s_value; int s_line; char *s_file; if (n > 2) pos1 = 0; if (pos != 0) printss (err); selectoutput (err); fprintf (out_file, "%c", '*'); { s_value = n; s_line = __LINE__; s_file = __FILE__; goto s_despatch; } s_0: fprintf (out_file, "%s", "FORM"); goto f; s_1: fprintf (out_file, "%s", "ATOM"); goto f; s_2: fprintf (out_file, "%s", "NAME"); goto f; s_3: fprintf (out_file, "%s", "SIZE"); goto f; s_4: fprintf (out_file, "%s", "DUPLICATE"); goto f; s_5: fprintf (out_file, "%s", "%BEGIN"); goto m; s_6: fprintf (out_file, "%s", "%CYCLE"); goto m; s_7: fprintf (out_file, "%s", "%START"); goto m; s_8: fprintf (out_file, "%s", "%END"); goto m; s_9: fprintf (out_file, "%s", "%REPEAT"); goto m; s_10: fprintf (out_file, "%s", "%FINISH"); goto m; s_11: fprintf (out_file, "%s", "%RESULT"); goto m; s_12: fprintf (out_file, "%c", '\''); printident (); fprintf (out_file, "%c", '\''); m: fprintf (out_file, "%s", " MISSING"); goto f; s_13: fprintf (out_file, "%s", "BOUNDS"); goto f; s_14: fprintf (out_file, "%s", "INDEX"); goto f; s_15: fprintf (out_file, "%s", "CONTEXT"); goto e; s_16: fprintf (out_file, "%s", "ACCESS"); goto a; s_17: fprintf (out_file, "%s", "ORDER"); goto f; s_18: fprintf (out_file, "%s", "MATCH"); f: faulty = 1; a: access = -1; e: fprintf (out_file, "%s", "\n"); selectoutput (obj); if (symtype == 0) pos = 0; goto s_skip; s_despatch: switch (s_value) { case 0: goto s_0; case 1: goto s_1; case 2: goto s_2; case 3: goto s_3; case 4: goto s_4; case 5: goto s_5; case 6: goto s_6; case 7: goto s_7; case 8: goto s_8; case 9: goto s_9; case 10: goto s_10; case 11: goto s_11; case 12: goto s_12; case 13: goto s_13; case 14: goto s_14; case 15: goto s_15; case 16: goto s_16; case 17: goto s_17; case 18: goto s_18; default: BADSWITCH (s_value, s_line, s_file); } s_skip:; } void analyse (void) { static const int comma = 15; int atom1, atom2, subatom, last, head, max, dup, text, lim, index0; int k, n, s, g, class, nmin, nmax; int *z; static int quote = 0; static int key = 0; static int gg = 0; void readsym () { if (sym != nl) goto z2; pos = 0; pos1 = 0; z1: symtype = 1; z2: sym = fgetc (in_file); if (pos != 73) pos++; Char[pos] = sym; if (sym != nl) { if (quote != 0) return; if (sym == ' ') goto z1; if (sym == '%') { symtype = 2; goto z2; } /*KDICT(33:95) := LINK<9>:CODE<2> */ if (sym >= 96) sym -= 32; key = kdict[sym - 32]; if ((key & 3) != 0 || symtype != 2) symtype = (key & 3) - 2; } else { lines++; symtype = quote; /* 0,>0 */ } } /* READ SYM */ void codeatom (int target) { /*TARGET (IF SPECIFIED) IS FIRST ATOM CLASS FROM GRAMMAR */ int i, j, k; void lookup (int d) { static int i; /* OWN FOR OPTIMISATION */ int j, k, l, m; i = (index0 + tmax) + 1; l = index0 + lim; rep: i--; if (i == l) goto new; if ((index[i] & (~511)) != head) goto rep; j = index[i] & 511; k = max; while (k != dmax) { m = dict[k]; if (dict[j] != m) goto rep; j--; k--; } subatom = i - index0; ttx = &tagtype[subatom]; atom1 = (*ttx & 15) + 64; /*SET UP GRAM FOR PARAMETERS */ if ((*ttx & proc) != 0) *app = (unsigned) *ttx >> 8; else *app = bapp; /*NON-DECLARATIVE CONTEXT */ if ((d & 255) == 0) return; /*SPEC FOR PROC PARAMETER */ if (d == 36 && *app == 0) return; /*LABEL AFTER JUMP, PROC AFTER SPEC */ if (((*ttx & 255) + body) == d) { *ttx += body; return; } dup = 1; new: if (d == 0) return; tmax++; subatom = tmax; ttx = &tagtype[subatom]; *ttx = d; atom1 = (*ttx & 15) + 64; index[tmax] = head + max; dmax = max; } /* LOOKUP */ z1: pos1 = pos; atom1 = 9; atom2 = 0; subatom = 0; if (symtype == 0) return; /* NL OR SEMI-COLON */ if (symtype == -2) goto name; /* LETTER -> */ if (symtype < 0) goto number; /* DIGIT -> */ if (quote != 0) goto quoted; /* QUOTED SYMBOL -> */ if (sym == '\'') goto quotemark; if (sym == '"') goto string; /*LOCATE ATOM IN FIXED DICT */ /*KDICT(96:KMAX) := MORE<1>:0<1>:LINK<9>:SYM<7> */ /* OR MORE<1>:1<1>:SUBCLASS<10>:CLASS<6> */ i = (unsigned) key >> 2; readsym (); for (;;) { j = kdict[i - 32]; if ((j & 65536) != 0) break; if ((j & 127) != sym || symtype < 0) { if (j >= 0) goto err; i++; } else { k = ((unsigned) j >> 7) & 511; readsym (); if (j > 0) { if (k != 0) { if (k != sym || symtype < 0) goto err; readsym (); } k = i + 1; } i = k; } } atom1 = j & 63; /* ATOM CLASS */ subatom = ((unsigned) j >> 6) & 1023; if (atom1 == 0 && subatom == 0) goto z1; /* C NL, (SHORT) */ if (j < 0) atom2 = kdict[i + 1 - 32] & 63; /* VARIANT ATOM CLASS */ if (atom1 >= 8) return; /* DECLARATOR */ if (last >= 8) decl = 0; /*CUMULATE SUBATOM INFO IN DECL (FOR MULTI-WORD KEYWORDS) */ decl ^= subatom; /*ADJUST PROCEDURE-TYPE PARAMETERS */ if (last != 0 && (decl & proc) != 0) decl = (decl - body) + ref; /* PROC PAR */ if (atom1 != 0) return; /*EXTERNAL, BYTE */ if (symtype > 0) goto z1; err: atom1 = -1; return; quoted: if (last != comma) { atom1 = comma; return; } /* INFILTRATE COMMA */ quotemark: if (last == 38) goto string; /* PRINTTEXT */ quote = sym; readsym (); atom1 = 71; subatom = sym; /* SCONST */ if (sym == quote && ungetc (fgetc (in_file), in_file) == quote) readsym (); if (ungetc (fgetc (in_file), in_file) != quote) return; readsym (); goto endquote; string: quote = sym; readsym (); atom1 = 67; subatom = text; /* STRING */ j = 0; while (sym != quote || ungetc (fgetc (in_file), in_file) == quote) { if (sym == quote) readsym (); if ((j & (~127)) != 0) { dict[text] = j; text--; if (text == dmax) { /*TOO LONG */ atom1 = -3; text++; } j = 0; } j = (j << 7) + sym; readsym (); } dict[text] = j - 131072; text--; endquote: quote = 0; readsym (); return; number: if (last == 17 || (last == 0 && section == 0)) goto name; /* JUMP OR LAB */ atom1 = 71; /* SCONST */ i = 10; /* DECIMAL */ for (;;) { subatom = 0; for (;;) { if (symtype == -1) k = sym - '0'; else k = (sym - 'A') + 10; if (k >= i) goto err; subatom += k; readsym (); if (symtype >= 0) break; j = i; k = subatom; subatom = 0; /* MULTIPLY BY RADIX */ while (j != 0) { if ((j & 1) != 0) subatom += k; k = k << 1; j = (unsigned) j >> 1; } } if (sym != '_') return; i = subatom; readsym (); if (symtype >= 0) goto err; } name: head = (sym - 32) << 12; max = dmax; for (;;) { readsym (); if (symtype >= 0) goto z25; head += 512; max++; j = sym - 32; readsym (); if (symtype >= 0) break; j = ((j << 6) + sym) - 32; readsym (); if (symtype >= 0) break; j = ((j << 6) + sym) - 32; dict[max] = j; } dict[max] = j; z25: atom1 = -2; atom2 = 70; /* IDENT */ lim = tbase; /* LOCAL */ if (last == 0 && sym == ':') { lookup (64); return; } /* LABEL */ if (last == 17) { lookup (256); return; } /* JUMP */ if (target == 70 && decl != 0) { lookup (decl); return; } /* IDENT */ lim = global; if (last == 40) lookup (256); else lookup (0); /* MCODE,NORMAL */ if (atom1 != 65 || (*ttx & (~255)) == 0) return; atom1 = 71; subatom = dict[(unsigned) *ttx >> 8]; /* CONSTINTEGER */ } /* CODE ATOM */ /* GRAM LAYOUT: MORE<1> ORDER<2> LINK<8> CLASS<7> */ ss = 0; sstype = 1; decl = 0; atom1 = 0; last = 0; dup = 0; text = dbound; index0 = 0; *mref = (*mref & (~127)) + 119; if ((*btype & 2) != 0) *mref += 1; nmax = 0; nmin = nodebound + 1; n = 0; if (gg == 0 || section != 0) { if (symtype == 0) readsym (); if (symtype == 0 || sym == '!') goto skp; codeatom (0); if (atom1 == 11) goto skp; /* COMMENT */ } if (gg != 0) goto l4; if (atom1 <= 0) goto z91; gg = initial[atom1 - 1]; if (gg == 0) goto z91; sstype = (gg << 1) & 0x30000; if (gg < 0) { /*INIT ATOM FOR IMP */ nmax = 1; refco[nmax] = 0; sub[nmax] = 1; } l1: last = atom1; atom1 = 0; s = subatom; l2: class = gg & 127; if (class >= 24) { /*NOT TRANSPARENT */ nmin--; if (nmin == nmax) goto z90; sub[nmin] = s; l3: z = &n; for (;;) { /*INSERT CELL IN ORDER */ k = *z & 127; if (k == 0 || (gg & 98304) == 0) break; gg -= 32768; z = &refco[k]; } refco[nmin] = (class << 7) + k; *z = (*z ^ k) + nmin; } l4: g = ((unsigned) gg >> 7) & 255; for (;;) { gg = gram[g]; class = gg & 127; if (class == 0) break; if (class < 112) { if (class >= 80) class = atomic[class - 80]; if (atom1 == 0) codeatom (class); if (class == atom1 || class == atom2) goto l1; if (gg >= 0) goto z91; g++; } else { nmax++; if (nmax == nmin) goto z90; refco[nmax] = n; sub[nmax] = g; n = 0; g = phrase[class - 112]; } } s = 0; while (n != 0) { /*REVERSE LINKS */ z = &refco[n]; k = *z & 127; *z = (*z ^ k) + s; s = n; n = k; } if (nmax == 0) goto l5; n = refco[nmax]; g = sub[nmax]; nmax--; k = gg; /* EXIT-POINT CODE */ for (;;) { gg = gram[g]; if (k == 0) break; if (gg >= 0) goto z91; k -= 32768; g++; } if (s == 0 || (*z & 127) != 0) goto l2; /* SINGLETON */ class = (unsigned) *z >> 7; /* DON'T BOTHER WITH NEW NODE */ goto l3; l5: ss = s; if (dup != 0) fault (4); return; /*ERROR */ z90: atom1 = -3; z91: while (sym != nl) readsym (); if (atom1 < 0) fault (-atom1); else fault (0); quote = 0; symtype = 0; decl = 0; section = 0; gg = 0; return; skp: while (symtype != 0) readsym (); } /* ANALYSE */ void compile (void) { static const int lac = 68; static const int lad = 95; static const int tad = 71; static const int ada = 94; static const int dac = 65; static const int dad = 93; int i, j, k, next, link, class, refdest, bown = 0; int pend, pend1, pendopr, labcode, Else, main, ltag, lnest, final; int control, inc, end, ilit, elit; static int lit = 0; static int lit1 = 0; int c_value; int c_line; char *c_file; void pr (int x) { int i; i = abs (x); while (i != 0) { fprintf (out_file, "%c", (i & 15) + '0'); /* 'HEX' DIGIT */ i = (unsigned) i >> 4; } if (x < 0) fprintf (out_file, "%c", '-'); } void plantname (int x) { /* PROCEDURES, EXT SPECS */ int i, j; void next () { fprintf (out_file, "%s", " "); if (j != 0) { j--; pr (dict[i - j]); } } i = index[x]; j = ((unsigned) i >> 9) & 7; pr ((i & (~511)) + (tagtype[x] & 15)); /* SYM1+LENGTH+TYPE */ i &= 511; next (); next (); fprintf (out_file, "%s", " "); } void swop () { /* SWITCH SECTIONS */ static int t; if (level < 0) { if (section == 0) { fprintf (out_file, "%c", '('); t = x; } else { pr (t); fprintf (out_file, "%c", ')'); if (global !=0) { /*EXTERNAL NOT PERM */ plantname (t); pr (t); fprintf (out_file, "%c", '!'); } } } else fprintf (out_file, "%c", '/'); section ^= 1; } void def (int t) { /* DEFINE TAG */ pr (t); fprintf (out_file, "%c", '.'); if (section != 0) return; access = 1; ac = ~255; } void op (int opc) { /* OUTPUT OP-CODE */ fprintf (out_file, "%c", opc); icount++; } void plant (int v) { /* PLANT VALUE */ pr (v); op ('#'); } void print (int x) { if (pendopr >= 0) { if (next != link) final = 0; pendopr ^= final; /* INVERT SKIP IF FINAL */ if (pendopr != 0) { pr (pendopr); op (79); /* OPR */ } if (final == 0) { labcode = main; pr (lmin); op (76); /* JMP */ } if ((lnest & 1) != 0) def (ltag - 1); pendopr = -1; access = 1; } pr (x); } void nest () { print (nst); op (66); ac = ~ac; /* JMS NST (PRESERVES AC) */ } void pop () { op (84); ac = 255; /* LAC* T0 */ } void expend () { /* DISCHARGE PENDING LAC */ int c; if (pend < 0) return; if (ac >= 0) nest (); if (~ac != pend) { if (pend == 0) { /*CONSTANT */ print (lit); op (36); /* LAC #LIT (PSEUDO-OP) */ } else { c = lac; if ((pend & 256) != 0) c = lad; if (lit != 0) { print (lit); op (36); c = tad; if ((pend & 256) != 0) c = ada; } print (pend & 255); op (c); } } else { if (aclit != lit) { if (pend == 0) { print (lit); op (36); } else { print (lit - aclit); op (39); /* TAD # */ } } } ac = pend; aclit = lit; pend = -1; } void load (int t) { /* LOAD AC */ expend (); pend = t; lit = 0; } void Do (int c) { /* (ADD),TAD,AND,XOR,SAD */ if (pend >= 0) { if (pend == 0) { /*CONSTANT */ print (lit); op (c - 32); /* PSEUDO-OP */ } else { if (lit != 0) { if (c == tad) { print (lit); op (39); /* TAD #LIT (PSEUDO-OP) */ } else { expend (); goto z1; } } print (pend); op (c); } } else { z1: op (c + 16); /* * T0 */ } pend = -1; if (c != 75) ac = 255; /* SAD */ } void store (int t) { /* DEPOSIT AC */ static const int dzm = 67; static const int isz = 73; if (pend == 0 && lit == 0) { pend = -1; if (~ac == t) ac = ~255; final = 512; print (t); op (dzm); } else { if (pend == t && lit == 1 && ~ac != t) { pend = -1; final = 512; print (t); op (isz); op (79); /* NOP */ } else { expend (); if (pendopr < 0) { ac = t; aclit = 0; } ac = ~ac; /* ?? */ final = 512; print (t); op (dac); } } } void opr (int x) { /* OPERATE-GROUP */ expend (); print (x); op (79); if ((x & 4125) != 0) ac = 255; } void not () { /* COMPLEMENT AC */ if (pend != 0) opr (1); else lit = ~lit; } void neg () { /* NEGATE */ if (pend < 0) { print (-1); op (39); } else lit--; not (); } void call (int t) { /* SUBROUTINE JUMP */ expend (); print (t); op (66); ac = 255; /* JMS T */ } void jmsx (int t) { /* SPECIAL JMS */ if (pend >= 0) { /*SECOND PARAM SIMPLE */ print (2); op (dac); ac = ~ac; } else { store (1); pop (); store (2); load (1); } call (t); } void jump (int t) { /* JUMP */ print (t); op (76); } void mon (int n) { /* MONITOR */ print (moni); op (82); plant ((n & 255) + 256); /* JMS* MONI: FLTNUM */ ac = ~255; access = 0; } void aref () { /* ARRAY REF */ call (ar); print (x); op (lad); } void baref () { call (bar); print (x); op (lad); } void plantown () { ownc--; if ((ownc & bown) == 0) { if (bown != 0) lit = (lit << 9) + lit1; plant (lit); } else lit1 = lit; } void compileend () { int i, j, k; while (lstack != 3) { fault ((lstack & 1) + 9); lmin += 2; lstack = (unsigned) lstack >> 2; } x = tmax; swop (); /* SELECT DATA SECTION */ if (danger != 0) plant (0); i = -1; while (x != tbase) { ttx = &tagtype[x]; k = *ttx & 255; if (k == (own + array)) { /*SWITCH */ j = (unsigned) *ttx >> 8; if (j != 0) { swop (); def (x); plant (dict[j - 1]); j = dict[j]; plant (j); while (j > 0) { op (79); j--; } /* NOP (JMP SET BY LOAD) */ swop (); } } if ((k & (ext + own)) == 0) { if (k == 0 || (k & (proc + ref)) == proc) fault (12); else { if ((k & ((ref + array) + proc)) == 0 && danger == 0) { def (x); /* DEFINE TAG DIRECT */ } else { def (-x); /* DEFINE TAG INDIRECT */ } if ((k & ((ref + array) + proc)) == 0 && danger != 0) { plant (-1); /* POINTER SLOT */ } else { plant (0); } i--; } } x--; } if (btag != 0) { def (btag); plant (0); /* ENTRY POINT */ if (danger == 0) { if (pmax != tbase) { for (;;) { print (pmax); op (dad); pmax--; if (pmax == tbase) break; pop (); } } } else { j = pmax - tbase; if (j != 0) j--; call (ent); /* JMS ENTRY/EXIT */ plant (i); plant ((i + j) - 1); /*-SLOTS:-NEST*/ } if ((btag != danger) && (danger > 0)) *gd = btag; else *btype += ext; } swop (); /* REVERT TO INSTR SECTION */ } /*PROCESS ANALYSIS RECORD */ void save (int v) { dmax++; dict[dmax] = v; } int size (void) { int i; i = (lit - lit1) + 1; if (i <= 0 || i > 4095) { fault (13); i = 200; } return i; } void poplabel (int ind) { if (lstack == 3 || (lstack & 1) != ind) { fault (ind + 6); return; } labcode = lstack & 3; Else = estack & 1; lstack = (unsigned) lstack >> 2; estack = (unsigned) estack >> 1; lmin += 2; } void set (int *w) { if (pend != 0) { tmax++; *w = tmax; tagtype[*w] = 1; index[*w] = 0; /* DECLARE WL (INTEGER=1) */ store (*w); lit = 0; } else { *w = 0; pend = -1; } } void push (int andor) { if ((lnest & 2) != andor) { andor += 4; lnest |= 1; } if ((lnest & 1) != 0) ltag--; lnest = (lnest << 3) + andor; } void pcall () { /*PROCEDURE CALL */ call (x); if (danger != 0 && danger != btag) return; if ((*ttx & ext) == 0 && x <= pmax) danger = x; /* NOT SAFE */ } void mcall () { /*MAP CALL */ if (x == Int && pend > 0 && lit == 0 && (tagtype[pend] & (own + ref)) == own) { i = pend; pend = -1; } else { pcall (); i = 3; } } void restore () { if (pend1 >= 0) { pend = pend1; lit = lit1; ac = ~255; expend (); } else { pop (); } } /* end of restore */ void getnext () { int i; /*COMPILE DECLARATIONS */ if (next == 0) { next = refco[link] & 127; link = sub[link]; } for (;;) { x = sub[next]; ttx = &tagtype[x]; i = refco[next]; class = (unsigned) i >> 7; if (class < 112 || x == 0) break; /* ATOM OR NULL PHRASE */ if ((i & 127) != 0) { sub[next] = link; link = next; } next = x; } next = i & 127; } pend = -1; lit = 0; labcode = 0; Else = 0; pendopr = -1; if (ac >= 0) exit (0); next = ss; link = 0; if (sstype == 0 && access == 0) fault (16); z1: getnext (); z2: if (class <= 31) { c_value = x; c_line = __LINE__; c_file = __FILE__; goto c_despatch; } /* OPERATORS,SIMP */ { c_value = class; c_line = __LINE__; c_file = __FILE__; goto c_despatch; } z9: if (next != link) goto z1; z10: if (labcode == 0) return; z11: if ((labcode & 1) == 0) { jump (-(lmin + 1)); access = 0; } /* JUMP BACK FOR LOOPS */ if (labcode == 0) return; if (labcode != 3) def (lmin); if (Else != 0) def (lmin + 1); /* PICKUP POINT FOR ELSE */ return; c_70: /* IDENT */ if ((*ttx & own) == 0) { if ((*ttx & ext) != 0) goto z811; if ((*ttx & (ref + array)) != array) goto z9; /* SCALAR */ if ((*ttx & 2) != 0) { /*BYTE */ print (3); op (67); /* DZM T3 (AS INDIC) */ } if (ac >= 0) { /*FIRST IN GROUP */ if (lstack != 3) fault (17); jmsx (adec); /* JMS ADEC */ } else { /*BOUNDS ALREADY SET */ load (1); call (adec); /* LAC T1:JMS ADEC */ } atag = x; print (atag); op (dad); ac = ~255; goto z9; } ownc = 0; pend = -1; if ((*ttx & 3) == 0) { /*SWITCH */ save (-lit); save (size ()); z701: *ttx += dmax << 8; goto z9; } if ((*ttx & ext) != 0) { /*CONST */ save (lit); goto z701; } if (section == 0) swop (); if ((*ttx & ref) != 0) x = -x; def (x); if ((*ttx & (ref + array)) != array) { plant (lit); if (level < 0) swop (); goto z9; } plant (-lit); ownc = size (); plant (ownc); lit = 0; bown = 0; if ((*ttx & 2) == 0) goto z9; bown = 1; ownc += ownc & 1; goto z9; c_108: /* CONST BOUND SEP (COLON) */ lit1 = lit; pend = -1; goto z9; c_109: /* OWNSEP (COMMA) */ if (ownc > 0) plantown (); lit = 0; pend = -1; goto z9; c_110: /* OWNT (T) */ while (ownc > 0) { plantown (); lit = 0; } if (section != 0) swop (); /* REVERT TO INSTR SECTION */ return; c_81: /* PROCEDURE IDENT */ if ((*ttx & (ext + body)) == 0) { /*INTERNAL SPEC */ if (global == 0) *ttx += ext; /* PERM */ return; } z811: fprintf (out_file, "%c", '('); /* BODY OR EXT SPEC */ if ((*ttx & body) != 0) goto z9; /* BODY */ plantname (x); print (x); fprintf (out_file, "%c", ','); fprintf (out_file, "%c", ')'); goto z9; /*COMPILE BEGIN,END */ c_57: /* ENDOFPRIM */ tbase = tmax; return; c_58: /* ENDOFPERM */ global = tbase; tbase = tmax; line = 1; lines = 0; icount = 0; closeoutput (); return; c_55: /* BEGIN */ if (level < 0) { /*MAIN BEGIN */ if (global == 0) { if (tmax == 0) tmax = 1; tbase = tmax; global = tbase; } sstype = 0; access = 1; level = 0; fprintf (out_file, "%c", '!'); /* ENTRY-POINT */ } else { tmax++; x = tmax; /* TREAT AS ROUTINE */ tagtype[x] = beg; index[x] = 0; call (x); ac = ~255; fprintf (out_file, "%c", '('); } return; c_56: /* END */ if (btag == 0) { /*MAIN PROGRAM */ fault (5); sstype = 0; return; } if (access != 0) { if (access > 0 && (*btype & 15) != 12 && global !=0) fault (11); print (btag); op (92); /* JMP* BTAG */ } if (danger == 0) danger = -atag; compileend (); if (global !=0) plantname (tbase); /* NAME UNLESS PERM */ print (tbase); fprintf (out_file, "%c", ')'); if (extind == 0) return; if (level != 0) fault (15); plantname (tbase); pr (tbase); fprintf (out_file, "%c", '!'); return; c_59: /* ENDOFPROGRAM, ENDOFFILE */ if (access != 0) mon (0); danger = 0; if (level >= 0) compileend (); fprintf (out_file, "%c", ')'); /* END OF BLOCK */ if (btag == 0) return; fault (8); /* MISSING END */ assert (_IMP_MONITOR_); exit (0); /*COMPILE LOOPS AND CONDITIONS */ /*LSTACK, ESTACK AND LNEST ARE SINGLE-WORD NESTS */ /*LSTACK (2 BITS) KEEPS TRACK OF STATEMENT BRACKETS */ /*ESTACK (1 BIT) KEEPS TRACK OF ELSE JUMPS */ /*LNEST (3 BITS) DEALS WITH INTERNAL STRUCTURE OF COND STATEMENTS */ /*SIGNIFICANCE OF LSTACK VALUES: */ /* 00 CYCLE */ /* 01 IF,UNLESS */ /* 10 FOR,WHILE,UNTIL */ /* 11 ELSE */ /*SIGNIFICANCE OF LNEST VALUES: */ /* 000 AND AFTER AND,IF */ /* 001 AS ABOVE + DISCONTINUITY */ /* 010 OR AFTER OR,UNLESS */ /* 011 AS ABOVE + DISCONTINUITY */ /* 100 IF / WHILE / AND AFTER OR,UNLESS */ /* 101 AS ABOVE + DISCONTINUITY */ /* 110 UNLESS / OR AFTER AND,IF */ /* 111 UNTIL / AS ABOVE + DISCONTINUITY */ /*COMPILE FOR LOOP */ /* ORDER = (START) CONTROL (INC) CSEP1 (END) CSEP2 (CYCLE,IMP) */ c_107: /* CONTROL VARIABLE */ control = x; pend1 = pend; lit1 = lit; /* START VALUE */ pend = -1; goto z9; c_105: /* CSEP1 */ set (&inc); ilit = lit; goto z9; c_106: /* CSEP2 */ set (&end); elit = lit; /* END VALUE */ load (inc); lit = ilit; /* LAC INC */ neg (); if (pend1 < 0) { if (ac < 0) pop (); Do (tad); } else { if (pend != 0) { load (pend1); lit = lit1; Do (tad); } else { pend = pend1; lit += lit1; } } store (control); /*= START-INC*/ def (lmin + 1); /* LAB FOR JUMP BACK */ load (control); /* LAC CONTROL */ load (end); lit = elit; Do (75); /* SAD END */ jump (lmin); /* JMP (NEXT INSTR) */ load (inc); lit = ilit; Do (tad); /* TAD INC */ store (control); /* DAC CONTROL */ labcode = 2; goto z9; c_51: /* REPEAT */ poplabel (0); goto z11; /*COMPILE CONDITIONS */ /*STAT ORDER = CWORD COND IMP, CWORD COND START' */ /* CWORD COND IMP ELSE IMP, CWORD COND IMP ELSE START */ /*COND ORDER = AND C1 C2, OR C1 C2, NOT C1 */ /*SCOND ORDER = EXP1 EXP2 COP, EXP1 EXP2 COP EXP3 COP */ c_53: /* LWORD: WHILE(20), UNTIL(23) */ if ((x & 1) != 0) jump (lmin - 1); /* UNTIL - JUMP OVER TEST */ def (lmin + 1); /* LABEL FOR LOOPING */ c_52: /* CWORD: IF(12), UNLESS(14) */ labcode = 0; main = (unsigned) x >> 3; lnest = x & 7; ltag = lmin; goto z9; c_42: /* AND */ push (0); goto z9; c_43: /* OR */ push (2); goto z9; c_44: /* NOT */ lnest ^= 2; goto z9; c_45: /* COP: <(64), =(128), <=(192), >=(576), #(640), >(704) */ if (next != 0) push (0); /* DOUBLE-SIDED */ if (pend == 0 && lit == 0) { /*COMPARISON WITH ZERO */ pend = -1; if (next != 0) x += 4096; /* +CLA IF DOUBLE */ } else { k = pend; if ((x & 64) != 0) { /*<,<=,>=,> */ if (pend == 0 && lit > 0 && next == 0) { print (64); op (79); /* SMA */ neg (); Do (tad); } else { if ((x & 128) != 0) { /*<=,> */ jmsx (le); x ^= 448; /* SZL,SNL */ } else { jmsx (ge); x ^= 832; /* SZL,SNL */ } if (k >= 0) ac = k; /* ACLIT STILL SET */ } } else { /*=,#*/ Do (75); /* SAD */ if (x == 640) { /*# */ if (k >= 0 && next != 0) { pend = k; ac = ~255; } x = 0; } else x = 512; /* SKP */ } } condskip: if ((lnest & 2) != 0) x ^= 512; /* INVERT */ if ((lnest & (~7)) != 0 || main == 2) { if (x != 0) opr (x); if (next == 0) ac = ~ac; i = ltag; j = lnest; while ((j & 4) == 0) { j = (unsigned) j >> 3; i += j & 1; } jump (i); if (i == lmin) labcode = main; if ((lnest & 1) != 0) def (ltag - 1); lnest = (unsigned) lnest >> 3; ltag += lnest & 1; } else { pendopr = x; final = 0; ac = ~ac; if ((lnest & 1) != 0) ac = ~255; } goto z9; /*COMPILE START, FINISH, ELSE, EXIT */ c_49: c_50: /* START, CYCLE */ if (pendopr >= 0) print (0); /* DISCHARGE PENDING SKIP */ if (labcode == 0) def (lmin + 1); /* INDEFINITE CYCLE */ if (lstack < 0) { assert (_IMP_MONITOR_); exit (0); } lstack = (lstack << 2) + labcode; estack = (estack << 1) + Else; lmin -= 2; return; c_46: /* FINISH */ poplabel (1); goto z9; c_47: /* FINISH ELSE */ poplabel (1); if (labcode == 3) fault (15); c_48: /* ELSE */ if (access != 0) { jump (lmin + 1); Else = 1; } labcode = 3; def (lmin); goto z9; c_20: /* EXIT */ j = lmin + 2; k = 1; while ((k & lstack) != 0) { j += 2; k = k << 2; } if ((((-k) & lstack)) == 0) { fault (15); k = 0; } access = 0; final = 512; jump (j); lstack |= k << 1; goto z9; /*COMPILE LABELS AND JUMPS */ c_80: /* LAB */ if (x < atag) fault (17); def (x); return; c_64: /* L */ access = 0; final = 512; jump (x); goto z9; c_82: /* SLAB */ i = (unsigned) *ttx >> 8; if (i == 0) return; /* POINTER TO BOUNDS */ lit += dict[i - 1]; /* INDEX - UPPER */ if (lit <= 0) { lit += dict[i]; /* + NUMBER */ if (lit > 0) { print (lit + 1); fprintf (out_file, "%s", " "); def (x); return; } } fault (14); return; c_72: /* SNAME */ aref (); print (3); op (88); mon (135); /* XCT* T3:MON 7+128 */ goto z10; /*COMPILE PROCEDURE EXITS */ c_16: /* RETURN */ i = 12; /* SHOULD BE ROUTINE */ pex: if ((*btype & 15) != i) fault (15); access = 0; final = 512; print (btag); op (92); /* JMP* BTAG */ goto z9; c_17: /* TRUE */ opr (2050); /* STL */ z171: i = 4; /* SHOULD BE PRED */ goto pex; c_18: /* FALSE */ opr (2048); /* CLL */ goto z171; c_35: /* FRESULT */ i = (*btype & 3) + 4; /* SHOULD BE FN */ j = ac; k = aclit; expend (); ac = j; if (ac >= 0) ac = ~255; aclit = k; goto pex; c_34: /* MRESULT */ i = (*btype & 3) + 12; /* SHOULD BE MAP */ store (3); goto pex; /*COMPILE STOP, FAULT, MONITOR, ETC */ c_19: /* STOP */ mon (64); goto z9; c_36: /* FAULT */ if (btag != 0) fault (15); /* SHOULD BE MAIN PROG */ call (flt); plant (1); /* JMS FLT: SLOT FOR NP */ ac = ~255; getnext (); jump (x); goto z9; c_37: /* MONITOR */ pend = -1; mon (lit); goto z9; c_40: /* MCODE (OPERAND AFTER) */ lit = sub[next]; c_41: /* LMCODE (CONST BEFORE) */ print (lit); op (x); ac = ~255; return; c_67: c_87: /* STRING (PRINTTEXT) */ call (ptxt); /* PTEXT SR (TEXT FOLLOWS) */ do { i = dict[x]; plant (i); x--; } while (i >= 0); ac = ~255; getnext (); /* IGNORE CALL */ goto z9; /*COMPILE OPERANDS */ c_71: /* SCONST */ i = x; getnext (); if (pend >= 0 && class == 28 && x <= 2) { /*EXP +- LIST */ if (x != 1) i = -i; lit += i; goto z9; } load (0); lit = i; goto z2; c_103: /* ASSA: = (EXP = APP (A,M)) */ pend1 = pend; lit1 = lit; pend = -1; goto z9; c_65: /* V */ load (x); goto z9; c_73: /* ARRAY ELEMENT (VAL) */ aref (); i = 3; vg: print (i); op (84); /* LAC* */ goto z9; c_77: /* MAP ELEMENT (VAL) */ mcall (); if (i == 3) goto vg; if (ac >= 0) nest (); ac = 255; goto vg; c_66: /* BV */ load (256 + x); bg: call (bget); goto z9; c_74: /* BYTE ARRAY ELEMENT (VAL) */ baref (); goto bg; c_78: /* BYTE MAP ELEMENT (VAL) */ pcall (); goto bg; c_96: /* VDEST: V */ store (x); goto z9; c_86: /* ARRAY ELEMENT (DEST) */ aref (); i = 3; vp: restore (); vp1: print (i); op (81); /* DAC* */ ac = ~ac; goto z9; c_83: /* MAP ELEMENT (DEST) */ mcall (); if (i == 3 || ac < 0) goto vp; goto vp1; c_99: /* BVDEST: BV */ call (bput); print (x); op (lad); ac = ~255; goto z9; c_100: /* BADEST: BA */ baref (); bp: restore (); call (bput); print (3); op (lac); ac = ~255; goto z9; c_101: /* BMDEST: BM */ pcall (); goto bp; c_112: /* APP (NULL) */ expend (); if (ac >= 0) nest (); goto z9; c_84: c_85: c_89: c_90: c_92: /* PPAR,FPAR,APAR,BAPAR,RPAR */ c_93: c_94: c_97: c_98: /* MPAR,BMPAR,VREF,BVREF */ load (256 + x); /* LAD X */ goto z9; c_88: /* ARRAY ELEMENT (REF) */ aref (); goto z9; c_102: /* BYTE AREF */ baref (); goto z9; c_91: c_95: /* MAP ELEMENT (REF,BREF) */ if (x != Int) pcall (); goto z9; c_69: /* F (CALL) */ if (x != adr) pcall (); goto z9; c_68: /* P (CALL) */ pcall (); x = 256; /* FOR SNL */ goto condskip; c_76: /* R (CALL) */ expend (); final = 512; pcall (); ac = ~255; goto z9; c_111: goto z9; /* SEP */ /*COMPILE OPERATORS */ c_104: /* MOD */ opr (65); opr (513); /* SMA!CMA:SKP!CMA */ print (1); op (39); /* TAD #1 */ goto z9; c_1: /* PLUS-SIGN */ if (class != 24) Do (tad); /* TAD (UNLESS UNARY) */ goto z9; c_2: /* MINUS-SIGN */ if (class != 24) { if (pend > 0) { print (1); op (79); /* INFILTRATE CMA */ Do (tad); not (); /* TAD: CMA */ } else { neg (); Do (tad); } } else { neg (); } goto z9; c_3: /* UOP: \ NOT */ not (); goto z9; c_4: c_5: /* LEFT-SHIFT, RIGHT-SHIFT */ if (pend == 0 && (lit & (~7)) == 0) { pend = -1; while (lit != 0) { if (x != 5) opr (2056); else opr (2064); /* RCL,RCR */ lit--; } } else { if (x == 5) neg (); jmsx (sh); } goto z9; c_6: /* AND */ Do (74); goto z9; c_10: /* XOR */ Do (69); goto z9; c_11: c_12: c_13: c_14: c_15: /* OR,MULT,IDIV,DIV,EXP */ jmsx (x); goto z9; c_8: /* REFOP -- (DISP -- REF) */ neg (); c_7: /* REFOP ++ (DISP ++ REF) */ getnext (); if (pend == 0) { pend = 256 + x; /* AD OF X PLUS LIT */ } else { expend (); print (x); op (ada); ac = 255; } goto z9; c_9: /* REFASS: == */ getnext (); if ((*ttx & ref) == 0) fault (15); if ((pend - 256) == x && lit == 1) { print (x); op (89); /* ISZ* (FOR ISZ) */ if (((~ac) & 255) == x) ac = ~255; } else { if (pend > 0) { ttx = &tagtype[pend & 255]; expend (); if ((*ttx & (own + ref)) == 0) { print (-65537); op (42); /* AND #-65537 */ } } print (x); op (dad); ac = ~(x + 256); aclit = 0; } goto z9; goto c_skip; c_despatch: switch (c_value) { case 70: goto c_70; case 108: goto c_108; case 109: goto c_109; case 110: goto c_110; case 81: goto c_81; case 57: goto c_57; case 58: goto c_58; case 55: goto c_55; case 56: goto c_56; case 59: goto c_59; case 107: goto c_107; case 105: goto c_105; case 106: goto c_106; case 51: goto c_51; case 53: goto c_53; case 52: goto c_52; case 42: goto c_42; case 43: goto c_43; case 44: goto c_44; case 45: goto c_45; case 49: goto c_49; case 50: goto c_50; case 46: goto c_46; case 47: goto c_47; case 48: goto c_48; case 20: goto c_20; case 80: goto c_80; case 64: goto c_64; case 82: goto c_82; case 72: goto c_72; case 16: goto c_16; case 17: goto c_17; case 18: goto c_18; case 35: goto c_35; case 34: goto c_34; case 19: goto c_19; case 36: goto c_36; case 37: goto c_37; case 40: goto c_40; case 41: goto c_41; case 67: goto c_67; case 87: goto c_87; case 71: goto c_71; case 103: goto c_103; case 65: goto c_65; case 73: goto c_73; case 77: goto c_77; case 66: goto c_66; case 74: goto c_74; case 78: goto c_78; case 96: goto c_96; case 86: goto c_86; case 83: goto c_83; case 99: goto c_99; case 100: goto c_100; case 101: goto c_101; case 112: goto c_112; case 84: goto c_84; case 85: goto c_85; case 89: goto c_89; case 90: goto c_90; case 92: goto c_92; case 93: goto c_93; case 94: goto c_94; case 97: goto c_97; case 98: goto c_98; case 88: goto c_88; case 102: goto c_102; case 91: goto c_91; case 95: goto c_95; case 69: goto c_69; case 68: goto c_68; case 76: goto c_76; case 111: goto c_111; case 104: goto c_104; case 1: goto c_1; case 2: goto c_2; case 3: goto c_3; case 4: goto c_4; case 5: goto c_5; case 6: goto c_6; case 10: goto c_10; case 11: goto c_11; case 12: goto c_12; case 13: goto c_13; case 14: goto c_14; case 15: goto c_15; case 8: goto c_8; case 7: goto c_7; case 9: goto c_9; default: BADSWITCH (c_value, c_line, c_file); } c_skip:; } /* COMPILE SS */ tbase = tmax; dbase = dmax; lstack = 3; estack = 0; if (*btype != beg) { /*PROCEDURE (NOT BEGIN) */ analyse (); /* FORMAL PARAMETERS */ x = gapp () << 8; if ((*btype & (~255)) != 0) { if ((*btype & (~255)) != x && global !=0) fault (18); } else { *btype += x; } if ((*btype & body) == 0) goto fin; /* SPEC -> */ } if (btag != 0) printss (map + 8); access = btag; /* NON-ZERO EXCEPT AT OUTSET */ extind = *btype & ext; *btype ^= extind; atag = 0; ibase = icount; danger = 0; pmax = tmax; if ((pmax - 1) == tbase && (tagtype[pmax] & 62) == 0) { ac = ~pmax; aclit = 0; } for (;;) { line += lines; { for (_imptempint = 1; _imptempint <= lines; _imptempint++) fprintf (out_file, "\n"); } /* LINE-END CODE */ lines = 0; analyse (); if (ss != 0) compile (); if ((sstype & 0x20000) != 0) { /*START OR END OF BLOCK */ ac = ~255; if ((sstype & 0x10000) != 0) break; /* END */ compileblock (level + 3, x, &tagtype[x], &danger); } } printss (map); fin: tmax = tbase; dmax = dbase; return; } /* COMPILE BLOCK */ selectinput (1); openoutput (obj, "temp.obj"); openoutput (map, "temp.map"); selectoutput (obj); app = &phrase[112 - 112]; bapp = *app; tt0 = &tagtype[0]; *tt0 = beg; mref = &gram[((unsigned) initial[34 - 1] >> 7) & 255]; compileblock (-3, 0, tt0, tt0); fprintf (out_file, "%s", "\n"); assert (faulty == 0); exit (0); } /* end of automatic translation */