#include #include #include int echo = (0==0); static void readsymbol (int *i) { int c; *i = c = getchar (); if (c == EOF) {fprintf(stderr, "EM CHAR IN STMNT - DISASTER\n");exit(0);} if (echo) putchar(*i); } static int nextsymbol (void) { int c = getchar (); ungetc (c, stdin); return c; } static void printsymbol (int i) { putchar (i); } static void read (int *i) { scanf ("%d", i); if (echo) printf("%d", *i); } static void write (int i, int j) { char fmt[16]; sprintf(fmt, "%%%0dd", j); printf (fmt, i); } static void space (void) { putchar (' '); } static void spaces (int i) { while (--i > 0) space (); } static void newline (void) { putchar ('\n'); } static void newlines (int i) { while (--i > 0) newline (); } int main (int argc, char **argv) { auto void readps (void); auto void readline (void); auto int compare (void); auto void ss (void); auto void fault (int a, int b, int c, int d); auto int chnext (void); auto int newcell (void); auto int returncell (int i); auto void printname (int i); int ap; int app; int tp; int psp; int asl; int btn; int ctn; int chp; int faults; int level; int ca; int comp; int scf; int ps[(-(600)) - (-(1000)) + 1]; #define ps(n) ps[(n)+1000] // REDUCED PHRASE STRUCTURE int tag[1023 + 1], link[1023 + 1]; #define tag(n) tag[n] #define link(n) link[n] // TAGS LISTS int a[200]; #define a(n) a[(n)-1] // ANALYSIS RECORD int t[300]; #define t(n) t[(n)-1] // SOURCE TEXT int bat[1023 + 1], cot[1023 + 1]; #define bat(n) bat[n] #define cot(n) cot[n] // BRANCH, CONST TABLES int ch[512]; #define ch(n) ch[(n)-1] // NAME CHAR TABLE int jump[15 + 1], star[15 + 1], brt[15 + 1], name[15 + 1], rtp[15 + 1], br[15 + 1], chpp[15 + 1], start[15 + 1], rad[15 + 1]; #define jump(n) jump[n] #define star(n) star[n] #define brt(n) brt[n] #define name(n) name[n] #define rtp(n) rtp[n] #define br(n) br[n] #define chpp(n) chpp[n] #define start(n) start[n] #define rad(n) rad[n] // LEVEL INFORMATION int true[6], false[6]; #define true(n) true[(n)-1] #define false(n) false[(n)-1] // CONDITIONAL BRANCH INSTRUCTIONS int prec[12], ucn[12]; #define prec(n) prec[(n)-1] #define ucn(n) ucn[(n)-1] // OPERATOR PRECEDENCES, TYPES int opr[12 + 1]; #define opr(n) opr[n] // MACHINE OPERATIONS int pt[15], pn[15], ptc[15]; #define pt(n) pt[(n)-1] #define pn(n) pn[(n)-1] #define ptc(n) ptc[(n)-1] // FOR RT SPECS, HEADINGS readps (); // READ IN AND REDUCE PHRASE STRUCTURE asl = 0; // CLEAR HASHING AREA & L_10: tag (asl) = 0; // CREATE AVAILABLE SPACE LIST link (asl) = 0; // IN REMAINDER if ((asl >= 256 && asl < 1023)) link (asl) = asl + 1; asl += 1; if (asl <= 1023) goto L_10; asl = 256; // AVAILABLE SPACE LIST POINTER br (0) = 'BR0'; // BASE REGISTER MNEMONICS br (1) = 'BR1'; br (2) = 'BR2'; br (3) = 'BR3'; br (4) = 'BR4'; br (5) = 'BR5'; br (6) = 'BR6'; br (7) = 'BR7'; br (8) = 'BR8'; br (9) = 'BR9'; br (10) = 'BR10'; br (11) = 'BR11'; br (12) = 'BR12'; br (13) = 'BR13'; br (14) = 'BR14'; br (15) = 'BR15'; true (1) = 'BZ'; // CONDITIONAL BRANCH MNEMONICS false (1) = 'BNZ'; true (2) = 'BNZ'; false (2) = 'BZ'; true (3) = 'BNG'; false (3) = 'BG'; true (4) = 'BL'; false (4) = 'BNL'; true (5) = 'BNL'; false (5) = 'BL'; true (6) = 'BG'; false (6) = 'BNG'; prec (1) = 3; // OPERATOR PRECEDENCES prec (2) = 3; // 4 : HIGHEST prec (3) = 2; // 1 : LOWEST prec (4) = 1; prec (5) = 1; prec (6) = 3; prec (7) = 2; prec (8) = 2; prec (9) = 1; prec (10) = 1; prec (11) = 1; prec (12) = 4; opr (0) = 'LOAD'; // MACHINE INSTRUCTION MNEMONICS opr (1) = 'SHL'; opr (2) = 'SHR'; opr (3) = 'AND'; opr (4) = 'XOR'; opr (5) = 'OR'; opr (6) = 'EXP'; opr (7) = 'DIV'; opr (8) = 'MLT'; opr (9) = 'ADD'; opr (10) = 'SUB'; opr (11) = 'NEG'; opr (12) = 'NOT'; ucn (1) = 3; // OPERATOR TYPES ucn (2) = 3; // 1 : UNARY ucn (3) = 2; // 2 : BINARY COMMUTATIVE ucn (3) = 2; // 3 : BINARY NON-COMMUTATIVE ucn (4) = 2; ucn (5) = 2; ucn (6) = 3; ucn (7) = 3; ucn (8) = 2; ucn (9) = 2; ucn (10) = 3; ucn (11) = 1; ucn (12) = 1; btn = 0; // BRANCH TABLE POINTER ctn = 0; // CONSTANT TABLE POINTER chp = 1; // NAME CHARACTER TABLE POINTER faults = 0; // FAULT COUNT level = 0; // TEXTUAL LEVEL scf = 0; // CONDITION FLAG jump (0) = 0; // JUMP LIST POINTER star (0) = 0; // STORAGE ALLOCATION POSITION IN COT name (0) = 0; // NAME LIST POINTER rtp (0) = (-(1)); // ROUTINE TYPE chpp (0) = 0; // NAME CHARACTER TABLE POSITION start (0) = 0; // START/FINISH LIST rad (0) = 10; // NEXT RELATIVE ADDRESS TO BE ALLOCATED ca = 0; echo = (0!=0); // CURRENT CODE DUMPING ADDRESS printsymbol ('P'); printsymbol ('R'); printsymbol ('G'); printsymbol (':'); // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! L_1: readline (); tp = 1; // TEXT POINTER L_2: if (t (tp) == '!') goto L_3; // COMMENT - SKIP TO END psp = (-(1000)); // START OF IN PHRASE STRUCTURE TABLES ap = 1; if (compare () == 1) { // SUCCESSFUL ANALYSIS ap = 1; // ANALYSIS RECORD POINTER ss (); // PROCESS SOURCE STATEMENT if (t (tp - 1) == ';') goto L_2; // FURTHER STATEMENT ON THIS LINE goto L_1; } // GO TO READ NEXT LINE fault ('SYNT', 'AX ?', ' ', ' '); // UNSUCCESSFUL ANALYSIS L_5: if (t (tp) == 10) goto L_1; // NEWLINE - READ NEXT LINE if (t (tp) == ';') { // END OF STATEMENT tp += 1; // TP TO START OF NEXT STATEMENT goto L_2; } // GO TO EXAMINE NEXT STATEMENT L_3: tp += 1; // SKIP TO NEXT CHARACTER OF STATEMENT goto L_5; // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto void readps (void) { // READ IN AND REDUCE PHRASE STRUCTURE int pnp; int alt; int p; int i; int j; int k; int pn[300 - 256 + 1], psp[300 - 256 + 1]; #undef pn #define pn(n) pn[(n)-256] #define psp(n) psp[(n)-256] // PHRASE NAME CHARS & POINTERS TO START OF PHRASES IN PS auto void insertlit (void); auto int getpn (void); pnp = 256; // PN POINTER p = (-(1000)); // PS POINTER L_1: readsymbol (&i); if (i == 'B') { // BUILT-IN PHRASE L_2: readsymbol (&i); // SKIP TO < if (i != '<') goto L_2; j = getpn (); // READ PHRASE NAME & GET POSITION IN PSP L_3: readsymbol (&i); // SKIP TO = if (i != '=') goto L_3; read (&k); // READ PHRASE NUMBER psp (j) = k; // FILL IN PHRASE NUMBER goto L_1; } // GO TO DEAL WITH NEXT PHRASE if (i == 'P') { // PHRASE L_4: readsymbol (&i); // SKIP TO < if (i != '<') goto L_4; psp (getpn ()) = p; // READ PHRASE NAME & FILL IN PS POSITION L_7: alt = p; // REMEMBER START POSITION IN PS OF THIS ALTERNATIVE L_6: p += 1; // NEXT PS POSITION L_5: readsymbol (&i); // START OF NEXT ITEM IN THIS ALTERNATIVE if (i == '\'') { // LITERAL TEXT insertlit (); // READ LITERAL & INSERT IN PS goto L_5; } // GO FOR NEXT ITEM if (i == '<') { // ITEM IS A PHRASE NAME ps (p) = getpn (); // READ PHRASE NAME & FILL IN PS WITH PSP POSITION goto L_6; } // GO FOR NEXT ITEM if (i == ',') { // END OF THIS ALTERNATIVE ps (alt) = p; // FILL IN POINTER TO END OF ALTERNATIVE goto L_7; } // GO FOR START OF NEXT ALTERNATIVE if (i == ';') { // END OF PHRASE DEFINITION ps (alt) = p; // FILL IN POINTER TO END OF ALTERNATIVE ps (p) = 0; // FILL IN END OF PHRASE MARKER p += 1; // NEXT PS POSITION FOR START OF NEXT PHRASE DEFINITION goto L_1; } // GO FOR NEXT PHRASE goto L_5; } // SKIP TO SOMETHING SIGNIFICANT if (i == 'E') { // END OF PHRASE STRUCTURE DEFINITIONS i = (-(1000)); // REPLACE ALL POINTERS TO PSP WITH CORRECT PS POINTERS L_8: if (ps (i) >= 256) ps (i) = psp (ps (i)); i += 1; if (i != p) goto L_8; return; } goto L_1; // SKIP TO SOMETHING SIGNIFICANT // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! auto void insertlit (void) { // INSERT LITERAL TEXT INTO 'PS' int sh; int i; sh = 0; // % SHIFT VALUE TO 0 L_1: readsymbol (&i); if (i == '\'') { if (nextsymbol () != '\'') return; // END OF LITERAL readsymbol (&i); // QUOTE INSIDE LITERAL - IGNORE ONE } if (i == '%') sh = 128; else { // SHIFT VALUE TO 128 FOR % if ((i < 'A' || i > 'Z')) sh = 0; // END OF KEYWORD - SHIFT VALUE TO 0 ps (p) = i + sh; // STORE SHIFTED (POSSIBLY) CHAR IN PS p += 1; // MOVE TO NEXT POSITION IN PS } goto L_1; } // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! auto int getpn (void) { // READ IN PHRASE NAME AND GET INDEX IN 'PSP' int np; int s; int i; np = 0; // TO ACCUMULATE PHRASE NAME CHARS s = 24; // INITIAL SHIFT VALUE TO PACK CHARS L_1: readsymbol (&i); if (i != '>') { // NOT END OF NAME YET np = np | i << s; // PACK NEXT CHAR OF PHRASE NAME s -= 8; // REDUCE SHIFT VALUE FOR NEXT CHAR goto L_1; } if (pnp != 256) { // NOT FIRST PHRASE NAME i = 256; // SCAN NAMES TO FIND IF ALREADY IN L_2: if (np == pn (i)) return (i); i += 1; if (i != pnp) goto L_2; } pn (pnp) = np; // INSERT NEW NAME IN DICTIONARY psp (pnp) = 99999; // UNDEFINED PHRASE MARKER pnp += 1; // MOVE TO NEXT DICTIONARY POSITION return (pnp - 1); } } #undef pn #define pn(n) pn[(n)-1] // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto void readline (void) { // LEXICAL PHASE - READ & CLEAN UP NEXT LINE OF TEXT auto void store (int i); int sh; int i; newlines (2); printsymbol (';'); sh = 0; // % & LITERAL SHIFT VALUE TO 0 tp = 1; // POINTER TO TEXT ARRAY T L_1: readsymbol (&i); if ((i == 10 && tp == 1)) goto L_1; printsymbol (i); if (i == '\'') { sh = 128; // SHIFT VALUE FOR LITERAL L_2: store (i); // STORE SHIFTED CHAR IN TEXT ARRAY readsymbol (&i); printsymbol (i); if (i == 10) printsymbol (';'); if (i != '\'') goto L_2; // NOT END OF LITERAL YET readsymbol (&i); printsymbol (i); if (i == '\'') goto L_2; // QUOTE IN LITERAL - IGNORE ONE sh = 0; // SHIFT VALUE TO 0 FOR END OF LITERAL store ('\''); // STORE UNSHIFTED VALUE TO MARK END } if (i == '%') sh = 128; else { // SHIFT VALUE TO 128 FOR KEYWORD if ((i < 'A' || i > 'Z')) sh = 0; // SHIFT VALUE TO 0 FOR END OF KEYWORD if (i != ' ') { // IGNORE SPACES store (i); if (i == 10) { // NEWLINE CHAR if (t (tp - 2) == 'C' + 128) { tp -= 2; printsymbol (';'); } else return; } } } goto L_1; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! auto void store (int i) { // STORE (POSSIBLY) SHIFTED CHARACTER IN TEXT ARRAY & CHECK LINE NOT TOO LONG if (tp > 300) { fault ('STAT', 'MNT ', 'TOO ', 'LONG'); tp = 1; } t (tp) = i + sh; // STORE CHAR IN TEXT ARRAY tp += 1; // MOVE TO NEXT POSITION } } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto int compare (void) { // ANALYSE PHRASE #undef name auto int name (void); // BUILT-IN PHRASE NAME auto int cnst (void); // BUILT-IN PHRASE int app; int tpp; int pspp; int ae; int n; tpp = tp; // PRESERVE INITIAL TEXT POINTER app = ap; // PRESERVE INITIAL ANALYSIS RECORD a (ap) = 1; // ALTERNATIVE 1 FIRST L_11: ae = ps (psp); // POINTER TO END OF ALTERNATIVE psp += 1; // FIRST ITEM OF ALTERNATIVE DEFN L_12: if (psp == ae) return (1); // END OF ALT REACHED - SUCCESS n = ps (psp); // NEXT ITEM OF ALT DEFN psp += 1; // FOR FOLLOWING ITEM if (n < 0) { // SUB-PHRASE pspp = psp; // PRESERVE PS POINTER psp = n; // POINTER TO DEFN OF SUB-PHRASE ap += 1; // NEXT ANALYSIS RECORD POSITION n = compare (); // RECURSIVE COMPARISON FOR SUB-PHRASE psp = pspp; // RESTORE PS POINTER if (n == 1) goto L_12; // SUCCESSFUL COMPARISON - GO FOR NEXT ITEM goto L_13; } // UNSUCCESSFUL - GO FOR NEXT ALTERNATIVE if (n == 1) { // BUILT-IN PHRASE if (name () == 1) goto L_12; // SUCCESS goto L_13; } // FAILURE if (n == 2) { // BUILT-IN PHRASE CNST if (cnst () == 1) goto L_12; // SUCCESS goto L_13; } // FAILURE if (n == t (tp)) { // LITERAL - MATCHES SOURCE CHAR tp += 1; // MOVE TO NEXT SOURCE CHAR goto L_12; } // GO FOR NEXT ITEM L_13: if (ps (ae) == 0) return (0); // END OF PHRASE psp = ae; // START OF DEFN OF NEXT ALTERNATIVE tp = tpp; // BACKTRACK SOURCE TEXT ap = app; // AND ANALYSIS RECORD POINTERS a (ap) = a (ap) + 1; // COUNT ALTERNATIVE NUMBER ON ONE goto L_11; // GO TO ANALYSE NEW ALTERNATIVE // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! auto int name (void) { // RECOGNISE AND INSERT NAME IN HASHING AREA OF TAG/LINK ARRAYS int i; int j; int k; int l; int m; int n; i = t (tp); // FIRST SOURCE CHAR if ((i < 'A' || (i > 'Z' || (i == 'M' && t (tp + 1) == '\'' + 128)))) return (0); // FAILURE-NOTALETTERORANM-TYPECONSTANT j = chp; // NEXT POSITION IN CHARACTER ARRAY k = i << 16; // LEAVE HOLE FOR LENGTH & PACK FIRST CHAR l = 1; // NO OF CHARS m = 8; // NEXT SHIFT VALUE FOR PACKING n = i; // SUM VALUE OF CHARS FOR HASHING L_1: tp += 1; i = t (tp); // NEXT CHAR FROM TEXT ARRAY if ((('0' <= i && i <= '9') || ('A' <= i && i <= 'Z'))) { // ADIGITORALETTER k = k | i << m; // PACK NEXT LETTER l += 1; // CHARACTER COUNT m -= 8; // NEXT SHIFT n += i; // SUM OF LETTERS if (m < 0) { // PACKED WORD OF CHARS FULL ch (chnext ()) = k; // STORE WORD IN CHAR ARRAY k = 0; // PACKING WORD TO ZERO m = 24; // NEW SHIFT VALUE } goto L_1; } // GO FOR NEXT CHAR if (k != 0) ch (chnext ()) = k; // STORE ANY REMAINING CHARS IN CHAR ARRAY ch (j) = ch (j) | l << 24; // FILL IN LENGTH IN HOLE LEFT IN FIRST WORD i = ((n & 15) << 4) | ((n >> 4) & 15); // HASH VALUE k = i; // SCAN DICTIONARY FOR NAME L_2: if (tag (k) != 0) { // A NAME IN THIS POSITION l = tag (k); // CHAR ARRAY POSITION m = j; // CHAR ARRAY POSITION OF NEW NAME L_4: if (ch (l) == ch (m)) { // PACKED WORDS MATCH m += 1; // NEXT WORD OF NEW NAME if (m == chp) { // NAMES MATCH chp = j; // MOVE CHP BACK SINCE NAME ALREADY IN goto L_3; } l += 1; // NEXT WORD OF OLD NAME goto L_4; } // GO FOR NEXT WORD k = (k + 1) & 255; // NO MATCH SO TRY NEXT DICTIONARY POSITION if (k == i) { // STARTING POSITION REACHED AGAIN fault ('DICT', 'IONA', 'RY F', 'ULL '); exit (0); } goto L_2; } tag (k) = j; // STORE CHAR ARRAY POSITION OF NAME L_3: ap += 1; // NEXT ANALYSIS RECORD POSITION a (ap) = k; // STORE IDENTIFICATION NO OF NAME return (1); // SUCCESS } // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! auto int cnst (void) { // RECOGNISE INTEGER AND LITERAL TEXT CONSTANTS int i; int j; int k; i = t (tp); // FIRST CHAR if ((i == 'M' && t (tp + 1) == '\'' + 128)) { // M-TYPE CONSTANT tp += 1; // IGNORE THE M i = t (tp); } if (i == '\'' + 128) { // START OF A LITERAL j = 0; // TO ACCUMULATE LITERAL VALUE k = 0; // CHARACTER COUNT L_1: tp += 1; i = t (tp); // NEXT CHAR if (i != '\'') { // NOT END OF LITERAL j = (j << 8) | (i & 127); // PACK CHAR k += 1; // COUNT CHAR goto L_1; } tp += 1; // POINTER AFTER QUOTE if (k > 4) fault ('STRI', 'NG T', 'OO L', 'ONG '); goto L_2; } if ((i < '0' || i > '9')) return (0); // NOT A CONSTANT j = 0; L_3: j = 10 * j + i - '0'; // ACCUMULATE DECIMAL VALUE tp += 1; i = t (tp); // NEXT CHAR if (('0' <= i && i <= '9')) goto L_3; // A DIGIT - STILL PART OF CONSTANT L_2: ap += 1; // NEXT ANALYSIS RECORD POSITION a (ap) = j; // FILL IN VALUE OF CONSTANT return (1); // SUCCESS } } #define name(n) name[n] // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto void ss (void) { // COMPILE SOURCE STATEMENT auto void ui (void); auto void sccond (int *label); auto void sexpr (void); auto int findlabel (void); auto void check (void); auto void unset (void); auto void pushstart (int flag, int label); auto int btnext (void); auto int ctnext (void); auto int wsnext (void); auto void storetag (int name, int form, int type, int dim, int lev, int ad); auto void dump (int op, int reg, int base, int disp); auto void skipsexpr (void); auto void skipapp (void); auto void rt (void); auto void arrad (void); auto void enter (int type, int alloc); auto void return_ (void); int i; int j; int k; int l; int m; int n; int p; int q; int r; int ws; int label; i = a (ap); // ANALYSIS RECORD ENTRY ap += 1; // FOR FOLLOWING ENTRY ws = 2; // SET WORKSPACE POINTER if (i == 1) goto L_10; // UNCONDITIONAL INSTRUCTION if (i == 2) goto L_20; // CONDITIONAL STATEMENT if (i == 3) goto L_30; // LABEL if (i == 4) goto L_40; // %FINISH if (i == 5) goto L_50; // DECLARATIONS if (i == 6) goto L_60; // ROUTINE/FN SPEC if (i == 7) goto L_70; // %END if (i == 8) goto L_80; // %BEGIN if (i == 9) goto L_90; // %ENDOFPROGRAM return; // // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! // UI L_10: ui (); // COMPILE UNCONDITIONAL INSTRUCTION return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! // %IF . . . %THEN . . . %ELSE L_20: sccond (&i); // COMPILE CONDITION if (a (ap) == 2) { // AP ON - JUMP INSTRUCTION ap += 2; // AP ON j = (-(1)); // MARKER FOR 'JUMP' } else { // NOT A JUMP if (a (ap) == 3) { // %START if (a (ap + 1) == 1) fault ('%STA', 'RT %', 'ELSE', ' ? '); pushstart (0, i); return; } ui (); // COMPILE REMAINING UNCOND. INSTNS. j = 0; // 'NOT JUMP' MARKER } if (a (ap) == 1) { // -CLAUSE PRESENT if (j == 0) { // WAS NOT A JUMP j = btnext (); // JUMP ROUND -CLAUSE dump ('B', 0, 'BT', j); } if (i >= 0) bat (i) = ca; // FILL IN LABEL ON -CLAUSE ap += 1; // AP ON if (a (ap) == 3) { // %START pushstart (1, j); return; } ui (); // COMPILE REMAINING S i = j; // JUMP AROUND LABEL } if (i >= 0) bat (i) = ca; // TO BRANCH ROUND THE UI return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! // CONST: . . . L_30: i = findlabel (); // LOCATE/INSERT LABEL IN JUMP LIST if (i >= 0) { // VALID LABEL if (bat (i) >= 0) { write (label, 1); spaces (2); fault ('LABE', 'L SE', 'T TW', 'ICE '); } bat (i) = ca; // FILL IN LABEL ADDRESS } ss (); // COMPILE STATEMENT AFTER LABEL return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! // %FINISH . . . L_40: i = start (level); // LINK TO FIRST CELL IN START LIST if (i == 0) { // NO CELLS IN LIST fault ('SPUR', 'IOUS', ' %FI', 'NISH'); return; } j = tag (i) & 65535; // JUMP AROUND LABEL k = tag (i) >> 16; // BEFORE OR AFTER %ELSE MARKER start (level) = returncell (i); // POP UP CELL if (a (ap) == 1) { // %ELSE PRESENT if (k == 1) fault ('TWO ', '%ELS', 'ES !', ' '); k = btnext (); // JUMP AROUND dump ('B', 0, 'BT', k); if (j != 65535) bat (j) = ca; // FILL IN LABEL ON IF NECESSARY ap += 1; // AP ON if (a (ap) == 3) { // %START pushstart (1, k); return; } ui (); // COMPILE REMAINING S j = k; // JUMP AROUND LABEL } if (j != 65535) bat (j) = ca; // FILL IN JUMP AROUND LABEL IF NECESSARY return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! // DECLARATIONS L_50: if (a (ap) == 1) { // = %ARRAY app = ap; // SAVE AP L_51: ap += 2; // AP ON if (a (ap) == 1) goto L_51; // SKIP DOWN TO END OF LIST OF NAMES ap += 1; // AP ON <+-\> sexpr (); // COMPILE EXPRESSION - LOWER BOUND dump ('STR', 'ACC', br (level), wsnext ()); // STORE VALUE IN WORKSPACE sexpr (); // COMPILE EXPRESSION - UPPER BOUND dump ('LDA', 'ACC', 'ACC', 1); // INCREMENT VALUE BY 1 if (a (ap) == 1) { // 2-DIM ARRAYS dump ('SUB', 'ACC', br (level), ws - 1); // PERFORM 2-DIM ARRAY DECLARATION CALCULATIONS dump ('STR', 'ACC', br (level), wsnext ()); ap += 1; sexpr (); // LOWER BOUND EXPR FOR 2ND DIM dump ('MLT', 'ACC', br (level), ws - 1); dump ('STR', 'ACC', br (level), wsnext ()); sexpr (); // UPPER BOUND EXPR FOR 2ND DIM dump ('LDA', 'ACC', 'ACC', 1); dump ('MLT', 'ACC', br (level), ws - 2); dump ('STR', 'ACC', br (level), wsnext ()); ws -= 4; // RESTORE WORKSPACE POINTER i = 2; // NO OF DIMS } else { // 1-DIM ARRAYS dump ('STR', 'ACC', br (level), wsnext ()); ws -= 2; // RESTORE WORKSPACE POINTER i = 1; // NO OF DIMS } j = 2; // TAG FOR 'ARRAY' ap = app; // RESTORE AP TO BEFORE LIST OF NAMES } else { // SCALAR DECLARATIONS i = 0; // DIMS=0 FOR SCALARS j = 0; // TAG FOR SCALAR } L_52: storetag (a (ap + 1), j, 1, i, level, rad (level)); // PUSHDOWN TAG FOR THIS NAME if (i == 0) rad (level) = rad (level) + 1; else { // ONE RELATIVE LOCATION FOR SCALARS if (i == 1) { // 1-DIM ARRAYS dump ('SUB', 'STP', br (level), ws); dump ('STR', 'STP', br (level), rad (level)); dump ('ADD', 'STP', br (level), ws + 1); } else { // 2-DIM ARRAYS dump ('LOAD', 'ACC', br (level), ws + 1); dump ('STR', 'ACC', br (level), rad (level)); dump ('SUB', 'STP', br (level), ws + 2); dump ('LDA', 'ACC', 'STP', 0); dump ('SUB', 'ACC', br (level), ws); dump ('STR', 'ACC', br (level), rad (level) + 1); dump ('ADD', 'STP', br (level), ws + 3); } rad (level) = rad (level) + 2; // 2 RELATIVE LOCATIONS FOR ARRAYS } ap += 2; // AP ON if (a (ap) == 1) goto L_52; // MORE NAMES IN LIST OF NAMES return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! // RT SPEC? . . . L_60: i = a (ap) - 1; // ROUTINE/FN j = a (ap + 1); // SPEC ? k = a (ap + 2); // NAME OF ROUTIINE OR FN ap += 3; // AP ON l = 0; // PARAMETER COUNT m = 10; // FIRST RELATIVE ADDRESS TO BE ALLOCATED L_63: if (a (ap) == 1) { // PARAMETERS PRESENT ap += 1; // AP ON if (a (ap) == 1) n = 3; else n = 3 - a (ap); // SET TAG FOR PARAMETER FORM p = n << 28 | 1 << 24 | (level + 1) << 16; // SET UP PATTERN FOR WHOLE TAG L_62: l += 1; // PARAMETER COUNT if (l > 15) { fault ('TOO ', 'MANY', ' PAR', 'AMS '); goto L_61; } // IGNORE SUPERFLUOUS PARAMS pt (l) = p | m; // STORE TAG FOR THIS PARAM pn (l) = a (ap + 1); // STORE THE NAMES IDENT. NO if (n == 3) m += 2; else m += 1; // NEXT RELATIVE ADDRESS ap += 2; // AP ON if (a (ap) == 1) goto L_62; // MORE NAMES IN LIST ap += 1; // AP ON goto L_63; } L_61: n = link (k); // LINK TO TAG FOR NAME OF ROUTINE OR FN if ((n == 0 || ((tag (n) >> 16) & 15) < level)) { // NAME NOT SET OR SET AT LOWER LEVEL if (l > 0) { // PARAMETERS PRESENT p = 1; // PARAMETER COUNT q = k; // 'INSERT AFTER' POINTER L_64: r = newcell (); // PUSHDOWN TAG FOR PARAMETER tag (r) = pt (p); link (r) = link (q); ptc (p) = r; // SAVE POINTER TO TAG CELL link (q) = r; q = r; // NEW VALUE FOR 'INSERT AFTER' POINTER p += 1; // PARAMETER COUNT if (p <= l) goto L_64; // MORE PARAMETERS YET } storetag (k, 4, i, l, level, btnext ()); // PUSHDOWN TAG FOR NAME OF ROUTINE OR FN if (level == 0) bat (btn - 1) = k + 65536; // FLAG FOR EXTERNAL SPECS } else { // NAME ALREADY SET AT THIS LEVEL if ((j == 2 && tag (n) >> 28 == 4)) { // STATEMENT NOT A SPEC & FORM OF NAME IS RT if (((tag (n) >> 24) & 15) != i) { printname (k); fault ('RT N', 'OT A', 'S SP', 'EC '); } if (bat (tag (n) & 65535) >= 0) { printname (k); fault ('RT A', 'PPEA', 'RS T', 'WICE'); } p = tag (n) >> 20 & 15; // NO OF PARAMS IN SPEC if (l != p) { fault ('PARS', ' NOT', ' AS ', 'SPEC'); if (l > p) l = p; // IGNORE SUPERFLUOUS PARAMS } if (l > 0) { // PARAMS PRESENT p = 1; // PARAM COUNT q = link (n); // LINK TO TAG OF FIRST PARAM L_67: if ((pt (p) | ((tag (q) & 15) << 20)) != tag (q)) { printname (pn (p)); fault ('PAR ', 'NOT ', 'AS S', 'PEC '); } ptc (p) = q; // SAVE POINTER TO TAG CELL p += 1; // PARAM COUNT q = link (q); // NEXT TAG CELL if (p <= l) goto L_67; // MORE PARAMS } } else { printname (k); fault ('NAME', ' SET', ' TWI', 'CE '); } } L_68: if (j == 2) { // STATEMENT NOT A SPEC brt (level) = btnext (); // BRANCH ROUND ROUTINE OR FN dump ('B', 0, 'BT', brt (level)); bat (tag (link (k)) & 65535) = ca; // FILL IN ADDRESS OF THIS ROUTINE OR FN if (level == 15) fault ('TOO ', 'MANY', ' LEV', 'ELS '); else level += 1; // NEXT TEXTUAL LEVEL enter (i, m); if (l > 0) { // PARAMS PRESENT p = 1; // PARAM COUNT L_69: i = pt (p); // PUSHDOWN TAGS FOR PARAMS if (i >> 28 == 3) storetag (pn (p), 3, 1, 0, level, ptc (p)); else storetag (pn (p), i >> 28, 1, 0, level, i & 65535); // TREAT ARRAYNAMES SPECIALLY p += 1; if (p <= l) goto L_69; // MORE PARAMS YET } } return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! // %END L_70: check (); // CHECK LABELS & START/FINISH BLOCKS cot (star (level)) = rad (level); // STORE STATIC ALLOCATION FOR THIS LEVEL unset (); // UNSET NAMES DECLARED AT THIS LEVEL chp = chpp (level); if (rtp (level) != 0) dump ('STOP', 0, 0, 0); // %STOP FOR FNS return_ (); // DUMP %RETURN CODE level -= 1; // DECREMENT TEXTUAL LEVEL COUNT if (level < 1) { // NOT BACK AT OUTER LEVEL YET fault ('EXCE', 'SS %', 'END ', ' '); goto L_71; } // TREAT AS %ENDOFPROGRAM bat (brt (level)) = ca; // FILL ADDR FOR BRANCH ROUND ROUTINE/FN return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! // %BEGIN L_80: if (level != 0) { fault ('%BEG', 'IN E', 'XTRA', ' '); // NO INTERNAL BLOCKS ALLOWED return; } if ((ca != 0 || rad (0) != 10)) { fault ('%BEG', 'IN N', 'OT F', 'IRST'); return; } level = 1; // TEXTUAL LEVEL COUNT TO 1 enter ((-(1)), 10); return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! // %ENDOFPROGRAM L_90: check (); // CHECK LABELS & START/FINISHES cot (star (level)) = rad (level); // FILL IN STATIC ALLOCATION FOR OUTER BLOCK unset (); // UNSET NAMES DECLARED AT THIS LEVEL if (level != 1) fault ('TOO ', 'FEW ', '%END', 'S '); L_71: dump ('STOP', 0, 0, 0); // %STOP printsymbol ('B'); // PRINT OUT BRANCH TABLE printsymbol ('T'); printsymbol (':'); newline (); ca = 0; L_93: if (ca != btn) { dump ('B', 0, 'PRG', bat (ca)); // BRANCH RELATIVE TO START OF PROGRAM goto L_93; } printsymbol ('C'); // PRINT OUT CONSTANT TABLE printsymbol ('T'); printsymbol (':'); newline (); i = 0; L_91: if (i != ctn) { write (cot (i), 10); newline (); i += 1; goto L_91; } printsymbol (';'); write (faults, 1); // NUMBER OF PROGRAM FAULTS fault (' FAU', 'LTS ', 'IN P', 'ROGM'); exit (0); // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto void ui (void) { // COMPILE UNCONDITIONAL INSTRUCTION int i; int j; int k; int l; i = a (ap); // NEXT ANALYSIS RECORD ENTRY ap += 1; if (i == 1) goto L_10; // ROUTINE CALL OR ASSIGNMENT STATEMENT if (i == 2) goto L_20; // JUMP INSTRUCTION if (i == 3) goto L_30; // %START if (i == 4) goto L_40; // %RETURN if (i == 5) goto L_50; // %RESULT= dump ('STOP', 0, 0, 0); // %STOP return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! // NAME APP ASS L_10: i = link (a (ap)); // POINTER TO NAME TAGS if (i == 0) { printname (a (ap)); fault ('NAME', ' NOT', ' SET', 0); } else i = tag (i); // NAME TAGS OR ZERO TO AVOID DIAGNOSTICS j = ap; // PRESERVE ANALYSIS RECORD POINTER ap += 1; // AP ON skipapp (); // SKIP TO if (a (ap) == 2) { // ROUTINE CALL if (i >> 24 == 64) { // 'FORM/TYPE' IS ROUTINE ap = j; // RESTORE AP TO rt (); // CALL ROUTINE } else { if (i != 0) { printname (a (j)); fault ('NOT ', 'ROUT', 'INE ', 'NAME'); } } ap += 1; // AP AFTER return; } k = i >> 28; // 'FORM' OF NAME if (k == 4) { printname (a (j)); fault ('NAME', ' NOT', ' A D', 'ESTN'); // ROUTINE/FN FORM i = 0; // CLEAR TAGS TO AVOID FURTHER DIAGNOSTIC } ap += 1; // AP ON <+-\> sexpr (); if (i == 0) return; // LHS NAME NOT SET if (k >= 2) { // LHS AN ARRAY TYPE dump ('STR', 'ACC', br (level), wsnext ()); // PRESERVE ACCUMMULATOR k = ap; // PRESERVE AP ap = j; // RESTORE INITIALANAL REC POINTER arrad (); // CALCULATE ARRAY ELEMENT ADDRESS ws -= 1; // RESTORE WORKSPACE POINTER dump ('LOAD', 'WK', br (level), ws); // RESTORE ACCUMMULATOR dump ('STR', 'WK', 'ACC', 0); // DUMP ASSIGNMENT ap = k; // RESTORE AP TO AFTER return; } if (k == 1) { dump ('LOAD', 'WK', br (i >> 16 & 15), i & 65535); // INDIRECT ASSIGMENT dump ('STR', 'ACC', 'WK', 0); } else dump ('STR', 'ACC', br (i >> 16 & 15), i & 65535); if (a (j + 1) == 1) { printname (a (j)); fault ('SCAL', 'AR H', 'AS P', 'ARAM'); } return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! // -> CONST L_20: dump ('B', 0, 'BT', findlabel ()); // SCAN/INSERT JUMP LIST AND DUMP JUMP return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! // %START L_30: fault ('%STA', 'RT ?', ' ', ' '); // %START ALONE SHOULD NOT BE A SOURCE STATEMENT return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! // %RETURN L_40: if (rtp (level) != 0) fault ('%RET', 'URN ', 'CONT', 'EXT '); return_ (); // DUMP %RETURN CODE - INCORRECT FOR FN return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! // %RESULT= L_50: i = rtp (level); // ROUTINE/FN TYPE if (i <= 0) fault ('%RES', 'ULT ', 'CONT', 'EXT '); // %BEGIN/%ROUTINE sexpr (); // COMPILE RESULT EXPRESSION return_ (); // LEAVE RESULT IN ACC & DUMP RETURN CODE } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto void sexpr (void) { // COMPILE ARITHMETIC EXPRESSION auto void torp (void); auto void pseval (void); auto void eval (int p); int rpp; int app; int rp[32], pt[32]; #define rp(n) rp[(n)-1] #define pt(n) pt[(n)-1] // REVERSE POLISH, POINTER/TYPE ARRAYS rpp = 1; // RP POINTER torp (); // EXPR TO REV POLISH if (scf == 1) { // PART OF A SIMPLE CONDITION scf = 0; // RESET FLAG comp = a (ap); // COMPARATOR NUMBER if ((a (ap + 3) == 0 && a (ap + 4) == 2)) ap += 5; else { ap += 1; // 2ND EXPR NON-ZERO torp (); // 2ND EXPRESSION TO REVERSE POLISH rp (rpp) = 10; // CODE FOR '-' I.E. (1ST-2ND) pt (rpp) = 1; // FLAG=OPERATOR rpp += 1; // INCREMENT RP POINTER } } app = ap; // SAVE FINAL ANAL REC POINTER pseval (); // PSEUDO-EVALUATE EXPRESSION eval (rpp - 1); // DUMP CODE FOR EXPR EVALUATION ap = app; // RESTORE FINAL ANAL REC POINTER // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! auto void torp (void) { // TRANSFORM EXPRESSION TO REVERSE POLISH auto void store (int i, int j); int op[4]; #define op(n) op[(n)-1] int opp; int i; opp = 0; // OPERATOR STACK POINTER i = a (ap); // <+-\> ap += 1; if ((i == 1 || i == 4)) goto L_1; // + OR NULL i += 9; // CODES FOR - & \ ... L_3: opp += 1; // STACK OPERATOR op (opp) = i; L_1: i = a (ap); // if (i == 3) { // SUB-EXPRESSION ap += 1; // AP TO <+-\> torp (); // TRANSFORM SUB-EXPR TO REV POL } else { store (ap, 0); // STORE ANAL REC POSITION OF OPERAND ap += 2; // AP ON OR AFTER if (i == 1) skipapp (); // OPERAND A NAME } if (a (ap) == 2) { // END OF ap += 1; // AP AFTER EXPRESSION L_2: if (opp == 0) return; // OPERATOR STACK EMPTIED store (op (opp), 1); // UNSTACK REMAINING OPERATORS opp -= 1; goto L_2; } i = a (ap + 1); // ap += 2; // AP ON L_4: if ((opp == 0 || prec (i) > prec (op (opp)))) goto L_3; // OP STACK EMPTY OR NEW OP HIGHER PREC store (op (opp), 1); // UNSTACK TOP OPERATOR opp -= 1; goto L_4; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! auto void store (int i, int j) { // STORE IN RP & PT ARRAYS, I=ANAL REC PTR , J= OP/OPD FLAG if (rpp > 32) { // REV POL ARRAY FULL fault ('EXPR', ' TOO', ' LON', 'G '); rpp = 1; // IN ORDER TO CONTINUE } rp (rpp) = i; // STORE OP/OPD pt (rpp) = j; // STORE FLAG rpp += 1; // NEXT POSITION } } // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! auto void pseval (void) { // PSEUDO-EVALUATION, CHECKING OPERANDS int pst[32]; #define pst(n) pst[(n)-1] // OPERAND POINTER STACK int pstp; int i; int j; int k; pstp = 0; // PST POINTER i = 1; // REV POL ARRAY POINTER L_3: ap = rp (i); // ANAL REC POSITION OF OPERAND if (a (ap) == 1) { // OPERAND A NAME j = link (a (ap + 1)); // LINK TO TAG OF NAME if (j == 0) { printname (a (ap + 1)); fault ('NAME', ' NOT', ' SET', 0); k = 0; // DUMMY TAG VALUE goto L_1; } k = tag (j); // TAG OF NAME j = k >> 28; // 'FORM' OF NAME if (j > 1) { // ARRAY OR ROUTINE/FN TYPE rp (i) = ap + 1; // STORE ANAL REC POSITION OF if (j == 4) { // NAME IS ROUTINE/FN TYPE if (((k >> 24) & 15) == 0) { printname (a (ap + 1)); fault ('RT N', 'AME ', 'IN E', 'XPR '); k = 0; // DUMMY TAG VALUE goto L_1; } pt (i) = (-(1)); // FLAG FOR FUNCTION } else pt (i) = (-(2)); // FLAG FOR ARRAY goto L_2; } // GO TO STACK POINTER if (a (ap + 2) == 1) { printname (a (ap + 1)); fault ('SCAL', 'AR H', 'AS P', 'ARAM'); } L_1: rp (i) = k; // STORE TAG OF NAME FOR SCALARS pt (i) = (-(3)); // FLAG FOR SCALARS } else { // OPERAND IS A rp (i) = a (ap + 1); // STORE VALUE OF CONSTANT pt (i) = (-(4)); // FLAG FOR CONSTANTS } L_2: pstp += 1; // STACK OPERAND POINTER L_4: pst (pstp) = i; i += 1; // REV POL ARRAY POINTER if (i < rpp) { // NOT END OF REV POL YET if (pt (i) == 0) goto L_3; // AN OPERAND IS NEXT if (rp (i) <= 10) { // BINARY OPERATORS pstp -= 1; // PSEUDO-EVALUATE POINTERS pt (i) = pst (pstp); // STACK POINTER TO RESULT } goto L_4; } } // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! auto void eval (int p) { // DUMP CODE FOR EVALUATION OF EXPRESSION auto void opn (int op, int l); int i; int j; int k; i = pt (p); // POINTER/TYPE OF LAST REV POL ENTRY if (i < 0) { // OPERAND opn (0, p); // LOAD OPERAND return; } j = rp (p); // OPERATOR k = p - 1; // START OF 2ND OPERAND if (ucn (j) == 1) { // UNARY OPERATOR if (pt (k) >= (-(2))) eval (k); else opn (0, k); // EVAL IF NODE OTHERWISE LOAD OPERAND dump (opr (j), 'ACC', 0, 0); // DUMP UNARY OPERATION return; } if (pt (i) >= (-(2))) { // FIRST OPERAND A NODE if (pt (k) >= (-(2))) { // SECOND OPERAND A NODE eval (k); // EVALUATE 2ND OPERAND dump ('STR', 'ACC', br (level), wsnext ()); // & STORE IT IN WORKSPACE eval (i); // EVALUATE 1ST OPERAND ws -= 1; // RESTORE WORKSPACE POINTER dump (opr (j), 'ACC', br (level), ws); // DUMP OPERATION } else { // 2ND OPERAND NOT A NODE eval (i); // EVALUATE 1ST OPERAND opn (j, k); // OPERATION WITH 2ND OPERAND } } else { // 1ST OPERAND NOT A NODE if (pt (k) >= (-(2))) { // 2ND OPERAND A NODE eval (k); // EVALUATE 2ND OPERAND if (ucn (j) == 2) { // OPERATOR IS COMMUTATIVE opn (j, i); // OPERATION WITH 1ST OPERAND return; } dump ('STR', 'ACC', br (level), wsnext ()); // STORE VALUE OF 2ND OPERAND IN WORKSPACE opn (0, i); // LOAD 1ST OPERAND ws -= 1; // RESTORE WORKSPACE POINTER dump (opr (j), 'ACC', br (level), ws); // DUMP OPERATION WITH 2ND OPERAND } else { // 2ND OPERAND NOT A NODE opn (0, i); // LOAD 1ST OPERAND opn (j, k); // OPERATION WITH 2ND OPERAND } } return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! auto void opn (int op, int l) { // DUMP SIMPLE OPERATION, OP=OPERATOR, L=RP POSITION OF OPERAND int i; int j; i = pt (l); // KIND OF OPERAND ap = rp (l); // ANAL REC POINTER OR NAME TAGS if (i == (-(1))) { // ROUTINE/FN TYPE rt (); // DUMP CALL ON FUNCTION return; } if (i == (-(2))) { // ARRAY ACCESS arrad (); // CALCULATE ARRAY ELEMENT ADDRESS dump ('LOAD', 'ACC', 'ACC', 0); // LOAD VALUE return; } if (i == (-(3))) { // SCALAR TYPE if (ap >> 28 == 1) { // %NAME TYPE dump ('LOAD', 'WK', br (ap >> 16 & 15), ap & 65535); // LOAD INDIRECT dump (opr (op), 'ACC', 'WK', 0); } else dump (opr (op), 'ACC', br (ap >> 16 & 15), ap & 65535); return; } if ((op != 0 || ap > 65535)) { // CONSTANT NOT 'LDA'-ABLE j = ctnext (); // NEXT HOLE IN CONSTANT TABLE cot (j) = ap; // STORE VALUE dump (opr (op), 'ACC', 'CT', j); } else dump ('LDA', 'ACC', 0, ap); } } } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto void skipsexpr (void) { // SKIP PAST <+-\> IN ANALYSIS RECORD, AP INITIALLY ON <+-\> L_1: ap += 2; // AP ON +1 if (a (ap - 1) == 3) skipsexpr (); else { // SKIP SUB-EXPR ELSE OR ap += 1; // AP ON OR AFTER if (a (ap - 2) == 1) skipapp (); // OPERAND IS A NAME } ap += 1; // AP AFTER if (a (ap - 1) == 1) goto L_1; // MORE OPERANDS } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto void skipapp (void) { // SKIP PAST IN ANALYSIS RECORD L_1: ap += 1; // POINTER TO +1 OR +1 if (a (ap - 1) == 1) { // EXPRESSIONS TO SKIP skipsexpr (); goto L_1; } } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto void sccond (int *label) { // COMPILE CONDITION I.E. , LABEL SET FOR POSITION AFTER UI auto void sc (void); auto void cond (void); auto void store (int ft); int i; int j; int k; int l; int app; int cap[16], lvl[16], tf[16], jmp[16], lbl[16]; #define cap(n) cap[(n)-1] #define lvl(n) lvl[(n)-1] #define tf(n) tf[(n)-1] #define jmp(n) jmp[(n)-1] #define lbl(n) lbl[(n)-1] // ANAL REC POINTERS, NESTING LEVEL, // TRUE/FALSE,JUMP&LABELARRAYS i = 1; // INDEX TO ARRAYS l = 0; // NESTING LEVEL sc (); // PROCESS cond (); // PROCESS app = ap; // PRESERVE FINAL ANAL REC POINTER l = (-(1)); store (1); // PSEUDO-FALSE AT LEVEL -1 l = (-(2)); store (2); // PSEUDO-TRUE AT LEVEL -2 k = i - 1; // LAST POSITION FILLED IN IN ARRAYS i = 1; L_2: j = i; // FIND POSITIONS TO JUMP TO L_1: j += 1; // AFTER COMPARISONS if ((lvl (j) >= lvl (i) || tf (j) == tf (i))) goto L_1; // SKIP HIGHER LEVELS ETC jmp (i) = j; // JUMP TO COMPARISON POSITION J i += 1; if (i < k) goto L_2; // MORE JUMPS TO FILL IN YET if (a (ap) != 2) goto L_3; // UI NOT A JUMP INSTRUCTION ap += 1; // TO j = k - 1; // LAST POSITION FILLED IN tf (j) = 2; // SET AS 'TRUE' jmp (j) = j; // SET JUMP AS THE UI JUMP lbl (j) = findlabel (); // FILL IN BRANCH TABLE POSITION L_3: i = 1; // FILL IN PSEUDO-LABELS FOR INNER JUMPS L_4: if (lbl (jmp (i)) < 0) lbl (jmp (i)) = btnext (); // NEXT BAT POSITION i += 1; if (i < k) goto L_4; // MORE TO FILL IN i = 1; L_7: ap = cap (i); // ANAL REC POINTER FOR 1ST EXPR OF COMP scf = 1; // SET FLAG FOR SEXPR sexpr (); // TO EVALUATE (1ST - 2ND) if (tf (i) == 1) l = false (comp); else l = true (comp); dump (l, 'ACC', 'BT', lbl (jmp (i))); // BRANCH TO REQUIRED POSITION if ((lbl (i) >= 0 && (i != k - 1 || tf (i) == 1))) bat (lbl (i)) = ca; i += 1; // FILL IN LABEL ADDRESS if (i < k) goto L_7; // MORE COMPARISONS YET *label = lbl (k); // FINAL LABEL ap = app; // FINAL ANALYSIS RECORD POINTER // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! auto void store (int ft) { // STORE LEVEL & TRUE/FALSE FLAG if (i > 16) { // ARRAYS FULL fault ('COND', 'N TO', 'O LO', 'NG '); i = 1; // TO CONTINUE } lvl (i) = l; // SAVE NESTING LEVEL tf (i) = ft; // SAVE TRUE/FALSE FLAG lbl (i) = (-(1)); // SET 'LABEL NOT FILLED IN YET' FLAG i += 1; // NEXT ARRAY POSITION } // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! auto void sc (void) { ap += 1; if (a (ap - 1) == 2) { l += 1; // NESTING LEVEL UP 1 FOR SUB-CONDITION sc (); // PROCESS SUB- cond (); // PROCESS SUB- l -= 1; // NESTING LEVEL DOWN AFTER SUB-CONDITION } else { cap (i) = ap; // ANAL REC POINTER FOR SIMPLE COMPARISON skipsexpr (); // SKIP 1ST EXPR OF COMPARISON ap += 1; // SKIP COMPARATOR skipsexpr (); // SKIP 2ND EXPR } } // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! auto void cond (void) { // PROCESS FOR SIMPLE COMPARISONS int i; i = a (ap); // ap += 1; // AP ON if (i != 3) { // NOT NULL ALTERNATIVE OF L_1: store (i); // SAVE %AND OR %OR TYPE OF CONDITION sc (); // PROCESS ap += 1; // POINTER ON +1 OR +1 if (a (ap - 1) == 1) goto L_1; // MORE %ANDS OR %ORS } } } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto void check (void) { // CHECK LABELS ALL SET & STARTS MATCH FINISHES int i; int j; i = jump (level); // POINTER TO JUMP LIST FOR THIS LEVEL L_1: if (i != 0) { // NO LABELS OR JUMPS USED AT THIS LEVEL if (bat (tag (i) & 65535) < 0) { // LABEL SET INCORRECTLY write (tag (i) >> 16, 1); // PRINT OUT LABEL NO OF LABEL NOT SET fault (' LAB', 'EL N', 'OT S', 'ET '); } i = returncell (i); // RETURN JUMP LIST CELL TO ASL goto L_1; } i = start (level); // LINK TO START LIST L_2: if (i != 0) { // A CELL STILL IN LIST fault ('%FIN', 'ISH ', 'MISS', 'ING '); i = returncell (i); // POP UP CELL goto L_2; } } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto void unset (void) { // UNSET NAMES AND CHECK FOR MISSING ROUTINES int i; int j; int k; i = name (level); // NAME LIST POINTER L_1: if (i != 0) { // UNSET NAMES DECLARED AT THIS LEVEL j = tag (i); // NAME IDENT NO k = tag (link (j)); // TAG WORD AT TOP OF LIST link (j) = returncell (link (j)); // POP UP CELL if (k >> 28 == 4) { // ROUTINE/FN TYPE if (bat (k & 65535) < 0) { printname (j); fault ('ROUT', 'INE ', 'MISS', 'ING '); } k = k >> 20 & 15; // NO OF PARAMS L_2: if (k != 0) { // PARAMS PRESENT link (j) = returncell (link (j)); // POP UP CELLS k -= 1; // PARAM COUNT goto L_2; } } if (link (j) == 0) tag (j) = 0; // A PREVIOUS DECLARATION OF SAME NAME i = returncell (i); // RETURN NAME LIST CELL goto L_1; } } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto void pushstart (int flag, int label) { // PUSHDOWN START/FINISH BLOCK INFORMATION int i; i = newcell (); tag (i) = (flag << 16) | (label & 65535); // PACK FLAG & LABEL link (i) = start (level); // PUSH CELL DOWN start (level) = i; // ONTO START LIST } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto void enter (int type, int alloc) { // DUMP CODE FOR NEW LEVEL & INITIALISE LEVEL ARRAYS int i; dump ('STR', br (level), 'STP', 0); // ENTRY SEQUENCE dump ('LDA', br (level), 'STP', 0); dump ('STR', 'WK', 'STP', 1); i = ctnext (); // STATIC ALLOCATION HOLE IN CONST TABLE dump ('ADD', 'STP', 'CT', i); star (level) = i; // REMEMBER POSITION OF HOLE jump (level) = 0; // NO JUMPS AT NEW LEVEL YET name (level) = 0; // NO NAMES AT NEW LEVEL YET rtp (level) = type; // BLOCK/ROUTINE/FN TYPE chpp (level) = chp; // SAVE CHARACTER ARRAY POINTER start (level) = 0; // NO START/FINISH BLOCKS YET rad (level) = alloc; // NEXT RELATIVE ADDRESS TO BE ASSIGNED } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto void return_ (void) { // DUMP CODE FOR %RETURN dump ('LDA', 'STP', br (level), 0); // RESTORE DIJKSTRA DISPLAY dump ('LOAD', br (level), 'STP', 0); dump ('LOAD', 'WK', 'STP', 1); dump ('B', 0, 'WK', 0); // BRANCH TO RETURN ADDRESS } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto void rt (void) { // DUMP CODE FOR A ROUTINE OR FUNCTION CALL int i; int j; int k; int l; int m; int n; int p; i = link (a (ap)); // LINK TO TAG FOR NAME ap += 1; // AP ON j = tag (i); // TAG OF NAME k = ((j >> 20) & 15) + 1; // NO OF PARAMS +1 L_1: k -= 1; // COUNT PARAMS ap += 1; // AP ON +1 if (a (ap - 1) == 2) { // PARAMS ABSENT OR NO MORE TO PROCESS dump ('BAL', 'WK', 'BT', j & 65535); // DUMP BRANCH TO ROUTINE/FN if (k > 0) fault ('TOO ', 'FEW ', 'PARA', 'MS '); return; } if (k <= 0) { // MORE PARAMS THAN SPEC if (k == 0) fault ('TOO ', 'MANY', ' PAR', 'AMS '); // ONLY MONITOR ONCE goto L_2; } i = link (i); // LINK TO NEXT PARAM CELL l = tag (i); // TAG OF PARAM if (l >> 28 == 0) { // SCALAR VALUE sexpr (); // COMPILE EXPRESSION goto L_3; } if ((a (ap) == 4 && a (ap + 1) == 1)) goto L_4; // <+-\> IS NULL & IS A NAME L_5: fault ('NOT ', 'A NA', 'ME P', 'ARAM'); L_2: skipsexpr (); // SKIP INVALID PARAM TO CONTINUE goto L_1; L_4: m = link (a (ap + 2)); // LINK TO TAG FOR PARAM NAME if (m == 0) { printname (a (ap + 2)); fault ('NAME', ' NOT', ' SET', ' '); goto L_2; } n = tag (m); // TAG OF PARAM NAME if (l >> 28 == 1) { // PARAM IS SCALAR NAME TYPE if (n >> 28 == 4) { // ACTUAL NAME IS ROUTINE/FN TYPE printname (a (ap + 2)); goto L_5; } if (n >> 28 >= 2) { // ACTUAL NAME IS AN ARRAY ap += 2; // AP ON arrad (); // CALCULATE ARRAY ELEMENT ADDRESS ap += 1; // AP ON +1 - SHOULD BE if (a (ap - 1) == 1) goto L_5; // FURTHER OPERAND - INVALID goto L_3; } if (a (ap + 3) == 1) { // NOT NULL printname (a (ap + 2)); fault ('SCAL', 'AR H', 'AS P', 'ARAM'); goto L_2; } if (a (ap + 4) == 1) goto L_5; // FURTHER OPERANDS - INVALID if (n >> 28 == 1) p = 'LOAD'; else p = 'LDA'; // LOAD FOR NAME TYPE & LDA FOR VALUE TYPE dump (p, 'ACC', br (n >> 16 & 15), n & 65535); } else { // PARAM IS ARRAY NAME if ((a (ap + 3) != 2 || a (ap + 4) != 2)) goto L_5; // NOT NULL OR MORE OPERANDS if (((n >> 28) & 2) == 0) { // 'FORM' OF ACTUAL IS NOT ARRAY printname (a (ap + 2)); fault ('NOT ', 'AN A', 'RRAY', ' NME'); goto L_2; } if (n >> 28 == 3) { // ACTUAL IS ARRAY NAME m = n & 65535; // POINTER TO TAG CELL OF PARAM LIST n = tag (m); // CORRECT TAG FOR PARAM } if (((n >> 20) & 15) != ((l >> 20) & 15)) { // DIMENSIONS DIFFERENT if (((l >> 20) & 15) == 0) { // FORMAL PARAM DIMENSION UNKNOWN l = tag (i) | ((n & 15) << 20); // FILL FORMAL TAG WITH DIMENSION tag (i) = l; // OF ACTUAL PARAM } else { // DIMENSION OF FORMAL KNOWN if (((n >> 20) & 15) == 0) tag (m) = tag (m) | ((l & 15) << 20); else { // FILL IN DIMENSION OF ACTUAL IF UNKNOWN printname (a (ap + 2)); fault ('ARRA', 'Y DI', 'MENS', 'ION?'); goto L_2; } } } dump ('LOAD', 'ACC', br (n >> 16 & 15), n & 65535); if (((l >> 20) & 15) != 1) { // NOT 1-DIM ARRAY dump ('STR', 'ACC', 'STP', l & 65535); dump ('LOAD', 'ACC', br ((n >> 16) & 15), (n & 65535) + 1); l += 1; } } ap += 5; // AP ON L_3: dump ('STR', 'ACC', 'STP', l & 65535); goto L_1; } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto void arrad (void) { // DUMP CODE TO CALCULATE ARRAY ELEMENT ADDRESS int i; int j; int k; int l; l = a (ap); i = link (l); // LINK TO TAG FOR NAME OF ARRAY j = tag (i); if ((j >> 28) == 3) { // NAME IS AN ARRAY NAME i = j & 65535; // SUBSTITUTE CORRECT TAG VALUE j = tag (i); } ap += 2; // AP ON +1 if (a (ap - 1) == 1) { // INDEXES PRESENT sexpr (); // COMPILE EXPR FOR FIRST INDEX ap += 1; // AP ON +1 if (a (ap - 1) == 1) { // 2ND INDEX PRESENT dump ('STR', 'ACC', br (level), wsnext ()); // STORE 1ST INDEX IN WORKSPACE sexpr (); // COMPILE EXPR FOR 2ND INDEX if (a (ap) == 1) { // 3RD INDEX PRESENT printname (l); fault ('TOO ', 'MANY', ' IND', 'EXES'); skipapp (); // SKIP EXCESS INDEXES } else ap += 1; // AP AFTER EXPRESSION dump ('MLT', 'ACC', br ((j >> 16) & 15), j & 65535); ws -= 1; // RESTORE WORKSPACE POINTER dump ('ADD', 'ACC', br (level), ws); dump ('ADD', 'ACC', br ((j >> 16) & 15), (j & 65535) + 1); k = 2; // DIMENSION MARKER } else { // ONLY ONE INDEX PRESENT dump ('ADD', 'ACC', br (j >> 16 & 15), j & 65535); k = 1; // DIMENSION MARKER } if (k != ((j >> 20) & 15)) { // DIMS FOUND DO NOT AGREE WITH TAG if (((j >> 20) & 15) == 0) tag (i) = tag (i) | k << 20; else printname (l); fault ('ARRA', 'Y DI', 'MENS', 'ION?'); // FILL IN DIMS IF UNKNOWN } } else { printname (l); fault ('NO A', 'RRAY', ' IND', 'EXES'); } } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto int btnext (void) { // ALLOCATE NEXT POSITION IN BRANCH TABLE if (btn > 1023) { // FULL fault ('TOO ', 'MANY', 'LABE', 'LS '); btn = 0; // TRY TO CONTINUE } bat (btn) = (-(1)); // MARKER FOR ADDRESS NOT FILLED IN YET btn += 1; // NEXT POSITION return (btn - 1); // THIS POSITION } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto int ctnext (void) { // ALLOCATE NEXT POSITION IN CONSTANT TABLE if (ctn > 1023) { // FULL fault ('TOO ', 'MANY', ' CON', 'STS '); ctn = 0; // TRY TO CONTINUE } ctn += 1; // NEXT POSITION return (ctn - 1); // THIS POSITION } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto int wsnext (void) { // ALLOCATE NEXT WORK SPACE POSITION ws += 1; if (ws == 11) fault ('COMP', 'ILER', ' WKS', 'PACE'); return (ws - 1); } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto int findlabel (void) { // CHECK & LOCATE OR INSERT LABEL IN JUMP LIST FOR THIS LEVEL int i; int j; label = a (ap); // VALUE OF CONST ap += 1; // AFTER if (label >> 16 != 0) { // INVALID LABEL NUMBER write (label, 1); spaces (2); fault ('INVA', 'LID ', 'LABE', 'L '); return ((-(1))); // 'FAULTY' RESULT } i = jump (level); // JUMP LIST POINTER L_1: if (i != 0) { // SOMETHING IN LIST if (label == tag (i) >> 16) return (tag (i) & 65535); // LABEL ALREADY IN i = link (i); // NEXT CELL IN LIST goto L_1; } i = newcell (); // LABEL NOT IN LIST SO GET NEW CELL j = btnext (); // GET NEXT BRANCH TABLE POSITION tag (i) = label << 16 | j; // FILL IN LIST ENTRY link (i) = jump (level); // PUSHDOWN ONTO JUMP LIST jump (level) = i; // NEW JUMP LIST POINTER return (j); // NEW BRANCH TABLE POSITION } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto void storetag (int nam, int form, int type, int dim, int lev, int ad) { // STORE TAGS I.E. SET NAME & CHECK NOT SET ALREADY int m; int n; m = link (nam); // POINTER TO EXISTING TAGS WORD FOR THIS if ((m != 0 && (lev == ((tag (m) >> 16) & 15) && form != 4))) { printname (nam); fault ('NAME', ' SET', ' TWI', 'CE '); return; } n = newcell (); // NEW CELL FOR TAGS tag (n) = form << 28 | type << 24 | dim << 20 | lev << 16 | ad; // FILL IN TAGS link (n) = link (nam); // PUSHDOWN ONTO TAGS LIST FOR THIS NAME link (nam) = n; n = newcell (); tag (n) = nam; // PUSHDOWN NEW CELL ONTO NAME LIST link (n) = name (level); // FOR NAMES DECLARED AT THIS LEVEL name (level) = n; } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto void dump (int op, int reg, int base, int disp) { // PRINT OUT CURRENT ADDRESS, OPERATION MNEMONIC & OPERANDS auto void pmn (int i); int com; spaces (10); com = ' '; pmn (op); // OPERATOR MNEMONIC com = ','; pmn (reg); // REGISTER MNEMONIC if (disp >= 65536) { printsymbol (','); spaces (7); printname (disp - 65536); } else { if ((base == 'BT' || (base == 'CT' || base == 'PRG'))) { printsymbol (','); spaces (7); } pmn (base); // BASE MNEMONIC write (disp, 1); // DISPLACEMENT } newline (); ca += 1; // INCREMENT CURRENT ADDRESS COUNT // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! auto void pmn (int i) { // PRINT MNEMONIC - CHARS INTO ONE WORD int j; int k; int l; j = 2; // AT LEAST TWO SPACES k = 24; // FIRST SHIFT VALUE L_1: l = i >> k & 255; // UNPACK NEXT CHARACTER if (l == 0) j += 1; else printsymbol (l); k -= 8; // NEXT SHIFT VALUE if (k >= 0) goto L_1; // MORE CHARS POSSIBLY YET if ((i == 'BT' || (i == 'CT' || i == 'PRG'))) printsymbol ('+'); else { printsymbol (com); spaces (j); // TO ALLIGN FIELDS CORRECTLY } } } } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto void fault (int a, int b, int c, int d) { // MONITOR FAULT - A 'PRINT STRING' ROUTINE auto void out (int i); out (a); out (b); out (c); out (d); newline (); faults += 1; // INCREMENT FAULT COUNT // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! auto void out (int i) { // PRINT OUT PACKED CHARS printsymbol (i >> 24); printsymbol (i >> 16 & 255); printsymbol (i >> 8 & 255); printsymbol (i & 255); } } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto int chnext (void) { // ALLOCATE NEXT POSITION IN 'CH' ARRAY if (chp > 512) { // CHARACTER ARRAY FULL fault ('NAME', 'S TO', 'O LO', 'NG '); exit (0); } chp += 1; return (chp - 1); } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto int newcell (void) { // ALLOCATE NEW CELL FOR LIST PROCESSING int i; if (asl == 0) { // END OF AVAILABLE SPACE LIST fault ('ASL ', 'EMPT', 'Y ', ' '); exit (0); } i = asl; // POINTER TO TOP CELL OF ASL asl = link (asl); // ASL POINTER TO NEXT CELL DOWN tag (i) = 0; // CLEAR NEW CELL OUT link (i) = 0; return (i); // INDEX TO NEW CELL } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto int returncell (int i) { // DEALLOCATE CELL AND RETURN IT TO ASL int j; j = link (i); // PRESENT LINK VALUE OF CELL link (i) = asl; // LINK TO TOP OF ASL asl = i; // ASL POINTER TO RETURNED CELL return (j); // RETURN VALUE OF LINK } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! auto void printname (int i) { // PRINT NAME FROM HASH POSITION int j; int k; int l; int m; j = tag (i); // POINTER TO CH ARRAY k = ch (j); // LENGTH & FIRST 3 CHARS l = k >> 24; // NUMBER OF CHARS IN NAME m = 16; // FIRST SHIFT VALUE L_1: printsymbol (k >> m & 255); l -= 1; if (l == 0) { spaces (2); return; } m -= 8; // NEXT SHIFT VALUE if (m < 0) { j += 1; k = ch (j); // NEXT WORD OF CHARS m = 24; } goto L_1; } // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! }