/* Edinburgh IMP77 Compiler - Version 8.4 */ const char *snl; extern int rem(int p, int q); extern void readsymbol(int typeof_P, void *p); extern real float(int n); extern char * tostring(int p); extern char * substring(char *s, int f, int t); extern int freespace(); extern void svc(int n, struct (null) *r); extern int addr(int typeof_P, void *p); extern int *integer(int n); extern short *shortinteger(int n); extern char *byteinteger(int n); extern char * *string(int n); extern struct (null) record ; (/*should not get here any more*/ int n; /*or here*/) extern real *real(int n); extern long real *longreal(int n); extern char *length(char *s); extern char *charno(char *s, int n); extern int int(real x); extern int intpt(real x); extern void iocp(int n); extern int typeof(int typeof_N, void *n); extern int sizeof(int typeof_N, void *n); extern real fracpt(real x); extern void prompt(char *s); extern int nextsymbol(); extern void skipsymbol(); extern void printsymbol(int sym); extern void printstring(char *s); extern void write(int v, int p); extern void selectinput(int n); extern void selectoutput(int n); extern void openinput(int n, char *fd); extern void openoutput(int n, char *fd); extern void closeinput(); extern void closeoutput(); extern void resetinput(); extern void resetoutput(); extern char * time(); extern char * date(); extern int cputime(); extern int *comreg(int n); extern void read(int typeof_X, void *x); extern void print(real val, int before, int after); extern void printfl(real val, int places); extern void space(); extern void spaces(int n); extern void newline(); extern void newlines(int n); typedef struct FILEFM{int unit; int owner; int n1; int n2;} filefm; typedef struct PARMFM{short dsno; short dact; short ssno; short sact; ; ; char *text; ; ; ; ; struct FILEFM file; ; ; int p1; int p2; int p3; int p4; ; ; int p5; int p6; ; ;} parmfm; typedef struct EVENTFM{int event; int sub; int extra; char *message; int pc; int x;} eventfm; extern struct EVENTFM event; #line 3 // 1 !Graham Toal - latest development version of SKIMPE 23/01/80 18.58 // 2 %external %integer %array %spec a(1 : 500) // 3 // bounds [1 : 500] // do it now: extern int */*spec*/ a {NO INIT} #line 5 // 4 %external %integer %array %spec taglink(0 : 255) // 5 // bounds [0 : 255] // do it now: extern int */*spec*/ taglink {NO INIT} #line 7 // 6 %external %integer %array %spec tag(1 : 512) // 7 // bounds [1 : 512] // do it now: extern int */*spec*/ tag {NO INIT} #line 9 // 8 %external %string (5) %array %spec display(0 : 15) // 9 // bounds [0 : 15] // do it now: extern char * */*spec*/ display {NO INIT} #line 11 // 10 %external %integer %spec level, condflag, expropt // 11 !----------------------------------------------------------------------- extern int /*spec*/ level; extern int /*spec*/ condflag; extern int /*spec*/ expropt; #line 13 // 12 %external %string (7) %fn %spec s(%integer i) // 13 %external %string (255) %fn %spec strint(%integer n, p) extern char * s(int i); #line 14 // 14 %external %string (8) %fn %spec strhex(%integer n) extern char * strint(int n, int p); #line 15 // 15 %external %routine %spec fault(%string (63) s) extern char * strhex(int n); #line 16 // 16 %external %string (255) %fn %spec name(%integer ident) extern void fault(char *s); #line 17 // 17 %external %routine %spec dump(%string (7) lab, op, reg, addr) extern char * name(int ident); #line 18 // 18 %external %integer %fn %spec getwork extern void dump(char *lab, char *op, char *reg, char *addr); #line 19 // 19 %external %routine %spec returnwork(%integer work) extern int getwork(); #line 20 // 20 %external %routine %spec proc(%integer ap) extern void returnwork(int work); #line 21 // 21 %external %routine %spec array(%integer ap) extern void proc(int ap); #line 22 // 22 %external %integer %fn %spec getcoti(%integer const) extern void array(int ap); #line 23 // 23 !----------------------------------------------------------------------- extern int getcoti(int const); #line 25 // 24 %const %integer proceedure = -1, arrayelement = -2, scalar = -3, unary = 11, %c // 25 complex = -2, terminal = 0, true = 1, load = 0, exp = 6, sub = 10, %c #line 29 // 26 mult = 8, div = 7, shr = 2, shl = 1, cmp = 13 // 27 !------------------------------------------------------------------------ // 28 %external %integer %fn intstr(%string (6) val) // 29 %integer i, total extern int intstr(char *val) { #line 30 // 30 total = 0 int i; int total; #line 31 // 31 %for i = 1, 1, length(val) %cycle total = 0; #line 32 // 32 total = total * 10 + charno(val, i) - '0' for (i = 1; i += 1; i != *length(val)) { #line 33 // 33 %repeat total = (((total * 10) + *charno(val, i)) - 48); #line 34 // 34 %result = total } L_0004: #line 35 // 35 %end return(total); #line 36 // 36 %external %routine expr(%integer exprp) #line 37 // 37 %integer %fn %spec totree(%integer exprp) extern void expr(int exprp) { #line 38 // 38 %routine %spec evaluate(%integer exprp) int totree(int exprp); #line 39 // 39 %routine %spec opn(%integer op, ptr) void evaluate(int exprp); #line 40 // 40 %integer %array tree(1 : 64) void opn(int op, int ptr); #line 41 // 41 %integer treep, treenode, treenode1, treenode2, testp, expr1p, expr2p, compp, i, j, l // ON DIM DO: int *tree int *tree = ARRAY(int , tree, 1, 1, 64) DIM 0x0001 0x0001 #line 42 // 42 %const %integer %array reversecomp(1 : 6) = 1, 2, 5, 6, 3, 4 int treep; int treenode; int treenode1; int treenode2; int testp; int expr1p; int expr2p; int compp; int i; int j; int l; #line 43 // 43 // bounds [1 : 6] // do it now: const int *reversecomp {NO INIT} #line 45 // 44 treep = 1 // 45 %if condflag = 0 %then treenode = totree(exprp) %else %start treep = 1; #line 46 // 46 condflag = 0 if (condflag != 0) goto L_0005; treenode = totree(exprp); goto L_0006; L_0005: #line 47 // 47 testp = exprp %spec condflag = 0; #line 48 // 48 ! for = testp = exprp; #line 50 // 49 expr1p = a(testp + 1) // 50 compp = a(testp + 2) expr1p = a[(testp + 1)]; #line 51 // 51 expr2p = a(testp + 3) compp = a[(testp + 2)]; #line 52 // 52 treenode1 = totree(expr1p) expr2p = a[(testp + 3)]; #line 53 // 53 treenode2 = totree(expr2p) treenode1 = totree(expr1p); #line 54 // 54 tree(treep) = 13 treenode2 = totree(expr2p); #line 55 // 55 ! CMP tree[treep] = 13; #line 57 // 56 %if tree(treenode1) = -4 %then %start // 57 a(compp) = reversecomp(a(compp)) if (tree[treenode1] != (-4)) goto L_0007; #line 58 // 58 tree(treep + 1) = treenode2 a[compp] = reversecomp[a[compp]]; #line 59 // 59 tree(treep + 2) = treenode1 tree[(treep + 1)] = treenode2; #line 60 // 60 %finish %else %start tree[(treep + 2)] = treenode1; #line 61 // 61 tree(treep + 1) = treenode1 goto L_0008; L_0007: #line 62 // 62 tree(treep + 2) = treenode2 tree[(treep + 1)] = treenode1; #line 63 // 63 %finish tree[(treep + 2)] = treenode2; #line 64 // 64 treenode = treep L_0008: #line 65 // 65 %finish treenode = treep; #line 66 // 66 %if expropt = 1 %then %start L_0006: #line 67 // 67 newline if (expropt != 1) goto L_0009; #line 68 // 68 %if 0 < tree(treenode) <= 10 %then l = treenode + 2 %else l = treenode + 1 newline(); #line 69 // 69 j = 0 if (0 >= tree[treenode]) goto L_000a; if (tree[treenode] > 10) goto L_000a; l = (treenode + 2); goto L_000b; L_000a: l = (treenode + 1); L_000b: #line 70 // 70 %for i = 1, 1, l %cycle j = 0; #line 71 // 71 write(tree(i), 4) for (i = 1; i += 1; i != l) { #line 72 // 72 j = j + 5 write(tree[i], 4); #line 73 // 73 %if i = treenode %then printstring("*") %and j = j + 1 j = (j + 5); #line 74 // 74 %if tree(i) = -3 %then i = i + 1 %and printstring(" " . strhex(tree(i))) %and j = j + 10 if (i != treenode) goto L_0010; printstring("*"); j = (j + 1); L_0010: #line 75 // 75 %if j > 70 %then newline %and j = 0 if (tree[i] != (-3)) goto L_0011; i = (i + 1); printstring(" "); j = (j + 10); L_0011: #line 76 // 76 %repeat if (j <= 70) goto L_0012; newline(); j = 0; L_0012: #line 77 // 77 newlines(2) } L_000f: #line 78 // 78 %finish newlines(2); #line 79 // 79 evaluate(treenode) L_0009: #line 80 // 80 %return evaluate(treenode); #line 81 // 81 !----------------------------------------------------------------------- return; #line 83 // 82 %integer %fn totree(%integer exprp) // 83 ! create tree form of expression goto L_0013; int totree(int exprp) { #line 85 // 84 %routine %spec pseval(%integer type, datum) // 85 %integer %array os(1 : 4), ps(1 : 5) void pseval(int type, int datum); #line 86 // 86 ! operator & pseudo-evaluation stacks // ON DIM DO: int *os int *os = ARRAY(int , os, 1, 1, 4) DIM 0x0001 0x0001 // ON DIM DO: int *ps int *ps = ARRAY(int , ps, 1, 1, 5) DIM 0x0001 0x0001 #line 88 // 87 %integer osp, psp, unaryp, operandp, exprrestp, opp, namep, actualp, ident, nametag // 88 %const %integer %array prec(1 : 12) = 3, 3, 2, 1, 1, 3, 2, 2, 1, 1, 1, 4 int osp; int psp; int unaryp; int operandp; int exprrestp; int opp; int namep; int actualp; int ident; int nametag; #line 89 // 89 // bounds [1 : 12] // do it now: const int *prec {NO INIT} #line 92 // 90 ! <<,>>,&,!!,!,**,/,*,+,-,-(unary),\ // 91 %integer %fn constop(%integer op, val1) // 92 %switch exec(1:10) goto L_0013; int constop(int op, int val1) { #line 93 // 93 %integer res // bounds [1 : 10] /*todo: gcc jump table extension*/ void **exec; #line 94 // 94 -> exec(op) int res; #line 95 // 95 exec(1): goto *exec[op]; #line 96 // 96 ! << exec_1: #line 98 // 97 res = tree(val1 + 1) << tree(val1 + 3) // 98 -> cont res = (tree[(val1 + 1)] << tree[(val1 + 3)]); #line 99 // 99 exec(2): goto U_006f; #line 100 // 100 ! >> exec_2: #line 102 // 101 res = tree(val1 + 1) >> tree(val1 + 3) // 102 -> cont res = (tree[(val1 + 1)] >> tree[(val1 + 3)]); #line 103 // 103 exec(3): goto U_006f; #line 104 // 104 ! & exec_3: #line 106 // 105 res = tree(val1 + 1) & tree(val1 + 3) // 106 -> cont res = (tree[(val1 + 1)] & tree[(val1 + 3)]); #line 107 // 107 exec(4): goto U_006f; #line 108 // 108 ! !! exec_4: #line 110 // 109 res = tree(val1 + 1) !! tree(val1 + 3) // 110 -> cont res = (tree[(val1 + 1)] ^ tree[(val1 + 3)]); #line 111 // 111 exec(5): goto U_006f; #line 112 // 112 ! ! exec_5: #line 114 // 113 res = tree(val1 + 1) ! tree(val1 + 3) // 114 -> cont res = (tree[(val1 + 1)] | tree[(val1 + 3)]); #line 115 // 115 exec(6): goto U_006f; #line 116 // 116 ! ** exec_6: #line 118 // 117 res = tree(val1 + 1) \\ tree(val1 + 3) // 118 -> cont res = imp_int_exp(tree[(val1 + 1)], tree[(val1 + 3)]); #line 119 // 119 exec(7): goto U_006f; #line 120 // 120 ! / exec_7: #line 122 // 121 %if tree(val1 + 3) = 0 %then fault("DIVISION BY ZERO") %and res = 0 %and -> cont // 122 res = tree(val1 + 1) // tree(val1 + 3) if (tree[(val1 + 3)] != 0) goto L_0014; fault("DIVISION BY ZERO"); res = 0; goto U_006f; L_0014: #line 123 // 123 -> cont res = (tree[(val1 + 1)] / tree[(val1 + 3)]); #line 124 // 124 exec(8): goto U_006f; #line 125 // 125 ! * exec_8: #line 127 // 126 res = tree(val1 + 1) * tree(val1 + 3) // 127 -> cont res = (tree[(val1 + 1)] * tree[(val1 + 3)]); #line 128 // 128 exec(9): goto U_006f; #line 129 // 129 ! + exec_9: #line 131 // 130 res = tree(val1 + 1) + tree(val1 + 3) // 131 -> cont res = (tree[(val1 + 1)] + tree[(val1 + 3)]); #line 132 // 132 exec(10): goto U_006f; #line 133 // 133 ! - exec_10: #line 135 // 134 res = tree(val1 + 1) - tree(val1 + 3) // 135 cont: res = (tree[(val1 + 1)] - tree[(val1 + 3)]); #line 136 // 136 %result = res U_006f: #line 137 // 137 %end return(res); #line 138 // 138 unaryp = a(exprp + 1) L_0013: #line 139 // 139 operandp = a(exprp + 2) unaryp = a[(exprp + 1)]; #line 140 // 140 exprrestp = a(exprp + 3) operandp = a[(exprp + 2)]; #line 141 // 141 %if a(unaryp) <= 2 %then os(1) = a(unaryp) + 10 %and osp = 1 %else osp = 0 exprrestp = a[(exprp + 3)]; #line 142 // 142 psp = 0 if (a[unaryp] > 2) goto L_0015; os[1] = (a[unaryp] + 10); osp = 1; goto L_0016; L_0015: osp = 0; L_0016: #line 143 // 143 %cycle psp = 0; #line 144 // 144 ! for each operand for (;;) { L_0017: #line 146 // 145 %if a(operandp) = 1 %then %start // 146 ! if (a[operandp] != 1) goto L_0018; #line 148 // 147 namep = a(operandp + 1) // 148 actualp = a(operandp + 2) namep = a[(operandp + 1)]; #line 149 // 149 ident = a(namep + 1) actualp = a[(operandp + 2)]; #line 150 // 150 %if taglink(ident) = 0 %then %start ident = a[(namep + 1)]; #line 151 // 151 !? fault(name(ident)." NOT DECLARED") if (taglink[ident] != 0) goto L_0019; #line 153 // 152 pseval(-3, -ident) // 153 ! pseval dummy tag pseval((-3), (-ident)); #line 155 // 154 %finish %else %start // 155 nametag = tag(taglink(ident)) goto L_001a; L_0019: #line 156 // 156 %if nametag >> 28 <= 1 %then %start nametag = tag[taglink[ident]]; #line 157 // 157 ! scalar variable if ((nametag >> 28) > 1) goto L_001b; #line 159 // 158 %if a(actualp) = 1 %then %start // 159 fault("SCALAR " . name(ident) . " HAS PARAMETER") if (a[actualp] != 1) goto L_001c; #line 160 // 160 pseval(-3, 0) fault("SCALAR "); #line 161 // 161 %finish %else pseval(-3, nametag) pseval((-3), 0); #line 162 // 162 %finish %else %start goto L_001d; L_001c: pseval((-3), nametag); L_001d: #line 163 // 163 %if nametag >> 28 <= 3 %then pseval(-2, operandp) %else %start goto L_001e; L_001b: #line 164 // 164 %if nametag >> 24 & 16_F = 0 %then %start if ((nametag >> 28) > 3) goto L_001f; pseval((-2), operandp); goto L_0020; L_001f: #line 165 // 165 fault("ROUTINE NAME " . name(ident) . " IN EXPRESSION") if (((nametag >> 24) & 15) != 0) goto L_0021; #line 166 // 166 pseval(-3, 0) fault("ROUTINE NAME "); #line 167 // 167 %finish %else pseval(-1, operandp) pseval((-3), 0); #line 168 // 168 %finish goto L_0022; L_0021: pseval((-1), operandp); L_0022: #line 169 // 169 %finish L_0020: #line 170 // 170 %finish L_001e: #line 171 // 171 %finish %else %start L_001a: #line 172 // 172 %if a(operandp) = 2 %then pseval(-4, a(a(operandp + 1) + 1)) %c goto L_0023; L_0018: #line 173 // 173 %else psp = psp + 1 %and ps(psp) = totree(a(operandp + 1)) if (a[operandp] != 2) goto L_0024; pseval((-4), a[(a[(operandp + 1)] + 1)]); goto L_0025; L_0024: psp = (psp + 1); ps[psp] = totree(a[(operandp + 1)]); L_0025: #line 175 // 174 %finish // 175 %if a(exprrestp) = 2 %then %exit L_0023: #line 176 // 176 ! no more operands if (a[exprrestp] != 2) goto L_0026; goto L_0027; L_0026: #line 178 // 177 opp = a(exprrestp + 1) // 178 operandp = a(exprrestp + 2) opp = a[(exprrestp + 1)]; #line 179 // 179 exprrestp = a(exprrestp + 3) operandp = a[(exprrestp + 2)]; #line 180 // 180 pseval(os(osp), 0) %and osp = osp - 1 %while osp > 0 %and prec(a(opp)) <= prec(os(osp)) exprrestp = a[(exprrestp + 3)]; #line 181 // 181 ! unstack while prec(new op)<= for (;;) { L_0028: if (osp <= 0) goto L_0029; if (prec[a[opp]] > prec[os[osp]]) goto L_0029; pseval(os[osp], 0); osp = (osp - 1); } L_0029: #line 183 // 182 osp = osp + 1 // 183 ! stack new operator osp = (osp + 1); #line 185 // 184 os(osp) = a(opp) // 185 %repeat os[osp] = a[opp]; #line 186 // 186 pseval(os(osp), 0) %and osp = osp - 1 %while osp > 0 } L_0027: #line 187 // 187 ! unstack rest for (;;) { L_002a: if (osp <= 0) goto L_002b; pseval(os[osp], 0); osp = (osp - 1); } L_002b: #line 189 // 188 %result = ps(1) // 189 !----------------------------------------------------------------------- return(ps[1]); #line 191 // 190 %routine pseval(%integer type, datum) // 191 %routine %spec store(%integer t) goto L_002c; void pseval(int type, int datum) { #line 192 // 192 %integer nodep, temp void store(int t); #line 193 // 193 nodep = treep int nodep; int temp; #line 194 // 194 store(type) nodep = treep; #line 195 // 195 %if type > 0 %then %start store(type); #line 196 // 196 ! operator if (type <= 0) goto L_002d; #line 198 // 197 %if type > 10 %then %start // 198 store(ps(psp)) if (type <= 10) goto L_002e; #line 199 // 199 %finish %else %start store(ps[psp]); #line 200 // 200 %if tree(ps(psp - 1)) = -4 %and tree(ps(psp)) = -4 %c goto L_002f; L_002e: #line 201 // 201 %and ps(psp - 1) = treep - 5 %and ps(psp) = treep - 3 %start if (tree[ps[(psp - 1)]] != (-4)) goto L_0030; if (tree[ps[psp]] != (-4)) goto L_0030; if (ps[(psp - 1)] != (treep - 5)) goto L_0030; if (ps[psp] != (treep - 3)) goto L_0030; #line 203 // 202 temp = constop(type, treep - 5) // 203 %if temp >= 0 %then %start temp = constop(type, (treep - 5)); #line 204 // 204 treep = ps(psp - 1) + 2 if (temp < 0) goto L_0031; #line 205 // 205 tree(ps(psp - 1) + 1) = temp treep = (ps[(psp - 1)] + 2); #line 206 // 206 psp = psp - 1 tree[(ps[(psp - 1)] + 1)] = temp; #line 207 // 207 ps(psp) = treep - 2 psp = (psp - 1); #line 208 // 208 %return ps[psp] = (treep - 2); #line 209 // 209 %finish %else -> over return; #line 210 // 210 %finish %else %start L_0031: goto U_0070; #line 211 // 211 over: L_0030: #line 212 // 212 store(ps(psp - 1)) U_0070: #line 213 // 213 store(ps(psp)) store(ps[(psp - 1)]); #line 214 // 214 psp = psp - 1 store(ps[psp]); #line 215 // 215 %finish psp = (psp - 1); #line 216 // 216 %finish #line 217 // 217 %finish %else store(datum) %and psp = psp + 1 L_002f: #line 218 // 218 ps(psp) = nodep goto L_0032; L_002d: store(datum); psp = (psp + 1); L_0032: #line 219 // 219 !----------------------------------------------------------------------- ps[psp] = nodep; #line 221 // 220 %routine store(%integer t) // 221 %if treep > 64 %then fault("EXPRESSION TOO LONG") %and %stop goto L_002c; void store(int t) { #line 222 // 222 tree(treep) = t if (treep <= 64) goto L_0033; fault("EXPRESSION TOO LONG"); exit(0); L_0033: #line 223 // 223 treep = treep + 1 tree[treep] = t; #line 224 // 224 %end treep = (treep + 1); #line 225 // 225 %end L_002c: #line 226 // 226 %end for (;;) { L_0034: #line 227 // 227 !----------------------------------------------------------------------- L_0034: #line 229 // 228 %const %string (3) %array strop(0 : 13) = "LD", "SHL", "SHR", "AND", "EOR", %c // 229 "OR", "EXP", "DIV", "MUL", "ADD", "SUB", "NEG", "COM", "CMP" // bounds [0 : 13] // do it now: const char * *strop {NO INIT} #line 232 // 230 // 231 %const %integer %array args(0 : 13) = 1, 0, 0, 1, 1, 1, 0, 0, -1, 1, 1, 1, 1, 1 // 232 // bounds [0 : 13] // do it now: const int *args {NO INIT} #line 234 // 233 %const %integer %array commut(0 : 13) = 0, 0, 0, 1, 1, 1, 0, 0, 1, 1, 0, 0, 0, 1 // 234 // bounds [0 : 13] // do it now: const int *commut {NO INIT} #line 236 // 235 %routine doop(%integer op, %string (10) val) // 236 %string (6) const goto L_0035; void doop(int op, char *val) { #line 237 // 237 %integer value char *const; #line 238 // 238 %switch clever(0:13) int value; #line 239 // 239 ! B op VAL // bounds [0 : 13] /*todo: gcc jump table extension*/ void **clever; #line 241 // 240 %if args(op) # 1 %start // 241 %if val -> ("#") . const %then %start if (args[op] == 1) goto L_0036; #line 242 // 242 value = intstr(const) /* TODO */ RESOLVE 00 ? <5> if (!(const)) goto L_0037; #line 243 // 243 -> clever(op) value = intstr(const); #line 244 // 244 clever(mult): goto *clever[op]; #line 245 // 245 %if value = 2 %or value = 4 %then %start clever_8: #line 246 // 246 dump("", "ASL", "B", "") %and value = value >> 1 %while value # 1 if (value == 2) goto L_0038; if (value != 4) goto L_0039; L_0038: #line 247 // 247 %finish for (;;) { L_003a: if (value == 1) goto L_003b; dump("", "ASL", "B", ""); value = (value >> 1); } L_003b: #line 248 // 248 %return %if value = 1 L_0039: #line 249 // 249 -> eval if (value != 1) goto L_003c; return; L_003c: #line 250 // 250 clever(div): goto U_0064; #line 251 // 251 %if value = 2 %or value = 4 %then %start clever_7: #line 252 // 252 dump("", "ASR", "B", "") %and value = value >> 1 %while value # 1 if (value == 2) goto L_003d; if (value != 4) goto L_003e; L_003d: #line 253 // 253 %finish for (;;) { L_003f: if (value == 1) goto L_0040; dump("", "ASR", "B", ""); value = (value >> 1); } L_0040: #line 254 // 254 %return %if value = 1 L_003e: #line 255 // 255 -> eval if (value != 1) goto L_0041; return; L_0041: #line 256 // 256 clever(exp): goto U_0064; #line 257 // 257 %if value = 2 %then %start clever_6: #line 258 // 258 dump("", "TFR", "", "B,A") if (value != 2) goto L_0042; #line 259 // 259 dump("", "MUL", "", "") dump("", "TFR", "", "B,A"); #line 260 // 260 %return dump("", "MUL", "", ""); #line 261 // 261 %finish %else -> eval return; #line 262 // 262 clever(shl): L_0042: goto U_0064; #line 263 // 263 %if 1 <= value <= 2 %then %start clever_1: #line 264 // 264 dump("", "LSL", "B", "") %and value = value - 1 %until value = 0 if (1 > value) goto L_0043; if (value > 2) goto L_0043; #line 265 // 265 %finish for (;;) { L_0044: dump("", "LSL", "B", ""); value = (value - 1); if (value == 0) goto L_0045; } L_0045: #line 266 // 266 %return %unless 3 <= value <= 7 L_0043: #line 267 // 267 -> eval if (3 > value) goto L_0046; if (value <= 7) goto L_0047; L_0046: return; L_0047: #line 268 // 268 clever(shr): goto U_0064; #line 269 // 269 %if 1 <= value <= 2 %then %start clever_2: #line 270 // 270 dump("", "LSR", "B", "") %and value = value - 1 %until value = 0 if (1 > value) goto L_0048; if (value > 2) goto L_0048; #line 271 // 271 %finish for (;;) { L_0049: dump("", "LSR", "B", ""); value = (value - 1); if (value == 0) goto L_004a; } L_004a: #line 272 // 272 %return %unless 3 <= value <= 7 L_0048: #line 273 // 273 -> eval if (3 > value) goto L_004b; if (value <= 7) goto L_004c; L_004b: return; L_004c: #line 274 // 274 clever(*): goto U_0064; #line 275 // 275 clever_0: clever_3: clever_4: clever_5: clever_9: clever_10: clever_11: clever_12: clever_13: #line 277 // 276 eval: // 277 %finish U_0064: #line 278 // 278 dump("", "LD", "A", val) L_0037: #line 279 // 279 %if args(op) < 0 %start dump("", "LD", "A", val); #line 280 // 280 dump("", "MUL", "", "") if (args[op] >= 0) goto L_004d; #line 281 // 281 %finish %else %start dump("", "MUL", "", ""); #line 282 // 282 dump("", "LBSR", "", strop(op)) goto L_004e; L_004d: #line 283 // 283 %finish dump("", "LBSR", "", strop[op]); #line 284 // 284 %finish %else %start L_004e: #line 285 // 285 dump("", strop(op), "B", val) goto L_004f; L_0036: #line 286 // 286 %finish dump("", strop[op], "B", val); #line 287 // 287 %end L_004f: #line 288 // 288 %routine opn(%integer op, nodep) L_0035: #line 289 // 289 %integer type, basep, varp, disp goto L_0050; void opn(int op, int nodep) { #line 290 // 290 %string (4) base int type; int basep; int varp; int disp; #line 291 // 291 type = tree(nodep) char *base; #line 292 // 292 %if type > scalar %then fault("*BUG") type = tree[nodep]; #line 293 // 293 varp = tree(nodep + 1) if (type <= -3) goto L_0051; fault("*BUG"); L_0051: #line 294 // 294 %if varp < 0 %then %start varp = tree[(nodep + 1)]; #line 295 // 295 doop(op, name(-varp)) if (varp >= 0) goto L_0052; #line 296 // 296 %finish %else %start doop(op, name((-varp))); #line 297 // 297 %if type = scalar %start goto L_0053; L_0052: #line 298 // 298 basep = varp >> 16 & 16_F if (type != -3) goto L_0054; #line 299 // 299 base = display(basep) basep = ((varp >> 16) & 15); #line 300 // 300 base = ",Y" %if basep = level strncpy(base,display[basep],4+1); #line 301 // 301 base = ",X" %if basep = 1 if (basep != level) goto L_0055; strncpy(base,",Y",4+1); L_0055: #line 302 // 302 disp = varp & 16_FFFF if (basep != 1) goto L_0056; strncpy(base,",X",4+1); L_0056: #line 303 // 303 %if varp >> 28 = 1 %start disp = (varp & 65535); #line 304 // 304 %if basep = level # 1 %start if ((varp >> 28) != 1) goto L_0057; #line 305 // 305 doop(op, "[" . "-" . s(disp) . base . "]") if (basep != level) goto L_0058; if (level == 1) goto L_0058; #line 306 // 306 %finish %else %if basep # level # 1 %start doop(op, "[-"); #line 307 // 307 dump("", "PSH", "U", "A,B") goto L_0059; L_0058: if (basep == level) goto L_005a; if (level == 1) goto L_005a; #line 308 // 308 dump("", "LD", "D", base) dump("", "PSH", "U", "A,B"); #line 309 // 309 dump("", "ADD", "D", "#" . s(disp)) dump("", "LD", "D", base); #line 310 // 310 dump("", "ST", "D", "0,X") dump("", "ADD", "D", "#"); #line 311 // 311 dump("", "PUL", "U", "A,B") dump("", "ST", "D", "0,X"); #line 312 // 312 doop(op, "[0,X]") dump("", "PUL", "U", "A,B"); #line 313 // 313 %finish doop(op, "[0,X]"); #line 314 // 314 %return L_005a: L_0059: #line 315 // 315 %finish return; #line 316 // 316 %if basep = level %or basep = 1 %start L_0057: #line 317 // 317 doop(op, "-" . s(disp) . base) if (basep == level) goto L_005b; if (basep != 1) goto L_005c; L_005b: #line 318 // 318 %finish %else %start doop(op, "-"); #line 319 // 319 dump("", "PSH", "U", "A,B") goto L_005d; L_005c: #line 320 // 320 dump("", "LD", "D", base) dump("", "PSH", "U", "A,B"); #line 321 // 321 dump("", "ADD", "D", "#" . s(disp)) dump("", "LD", "D", base); #line 322 // 322 dump("", "ST", "D", "0,X") dump("", "ADD", "D", "#"); #line 323 // 323 dump("", "PUL", "U", "A,B") dump("", "ST", "D", "0,X"); #line 324 // 324 doop(op, "[0,X]") dump("", "PUL", "U", "A,B"); #line 325 // 325 %finish doop(op, "[0,X]"); #line 326 // 326 %finish %else %start L_005d: #line 327 // 327 doop(op, "#" . s(varp)) goto L_005e; L_0054: #line 328 // 328 %finish doop(op, "#"); #line 329 // 329 %finish L_005e: #line 330 // 330 %end L_0053: #line 331 // 331 %routine regop(%integer op, %string (7) r1, r2) L_0050: #line 332 // 332 ! R1 op R2 goto L_005f; void regop(int op, char *r1, char *r2) { #line 334 // 333 %if args(op) # 1 %start // 334 %if args(op) < 0 %start if (args[op] == 1) goto L_0060; #line 335 // 335 dump("", "MUL", "", "") if (args[op] >= 0) goto L_0061; #line 336 // 336 %finish %else %start dump("", "MUL", "", ""); #line 337 // 337 dump("", "LBSR", "", strop(op)) goto L_0062; L_0061: #line 338 // 338 %finish dump("", "LBSR", "", strop[op]); #line 339 // 339 %finish %else %start L_0062: #line 340 // 340 dump("", strop(op), r1, r2) goto L_0063; L_0060: #line 341 // 341 %finish dump("", strop[op], r1, r2); #line 342 // 342 %end L_0063: #line 343 // 343 %routine loadb(%integer nodep) L_005f: #line 344 // 344 %integer type, datum goto L_0064; void loadb(int nodep) { #line 345 // 345 type = tree(nodep) int type; int datum; #line 346 // 346 datum = tree(nodep + 1) type = tree[nodep]; #line 347 // 347 %if type = proceedure %start datum = tree[(nodep + 1)]; #line 348 // 348 proc(datum) if (type != -1) goto L_0065; #line 349 // 349 %return proc(datum); #line 350 // 350 %finish return; #line 351 // 351 %if type = arrayelement %start L_0065: #line 352 // 352 array(datum) if (type != -2) goto L_0066; #line 353 // 353 dump("", "LD", "B", "[0,X]") array(datum); #line 354 // 354 %return dump("", "LD", "B", "[0,X]"); #line 355 // 355 %finish return; #line 356 // 356 opn(load, nodep) L_0066: #line 357 // 357 %end opn(0, nodep); #line 358 // 358 %routine evaluate(%integer nodep) L_0064: #line 359 // 359 %integer op, opd1p, opd2p goto L_0067; void evaluate(int nodep) { #line 360 // 360 %if tree(nodep) <= terminal %start int op; int opd1p; int opd2p; #line 361 // 361 loadb(nodep) if (tree[nodep] > 0) goto L_0068; #line 362 // 362 %return loadb(nodep); #line 363 // 363 %finish return; #line 364 // 364 op = tree(nodep) L_0068: #line 365 // 365 opd1p = tree(nodep + 1) op = tree[nodep]; #line 366 // 366 %if cmp > op >= unary %start opd1p = tree[(nodep + 1)]; #line 367 // 367 ! if (13 <= op) goto L_0069; if (op < 11) goto L_0069; #line 371 // 368 ! TEST FOR CONST NODE HERE // 369 ! // 370 evaluate(opd1p) // 371 dump("", strop(op), "B", "") evaluate(opd1p); #line 372 // 372 %return dump("", strop[op], "B", ""); #line 373 // 373 %finish return; #line 374 // 374 opd2p = tree(nodep + 2) L_0069: #line 375 // 375 ! opd2p = tree[(nodep + 2)]; #line 379 // 37