/* 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 4 // 1 !Graham Toal - latest development version of SKIMPB 12/02/80 16.25 // 2 // 3 %const %integer true = 0, false = 1 // 4 #line 6 // 5 %external %integer %fn %spec find(%integer flag, %integer %name ty, la) // 6 %external %integer %array %spec a(1 : 500) extern int find(int flag, int *ty, int *la); #line 7 // 7 // bounds [1 : 500] // do it now: extern int */*spec*/ a {NO INIT} #line 9 // 8 %external %integer %array %spec taglink(0 : 255) // 9 // bounds [0 : 255] // do it now: extern int */*spec*/ taglink {NO INIT} #line 11 // 10 %external %integer %array %spec tag(1 : 512) // 11 // bounds [1 : 512] // do it now: extern int */*spec*/ tag {NO INIT} #line 13 // 12 %external %integer %array %spec link(1 : 512) // 13 // bounds [1 : 512] // do it now: extern int */*spec*/ link {NO INIT} #line 16 // 14 !----------------------------------------------------------------------- // 15 %external %routine %spec expr(%integer exprp) // 16 %external %integer %fn %spec cond(%integer condp, tlabel, flabel) extern void expr(int exprp); #line 17 // 17 %external %string (7) %fn %spec s(%integer n) extern int cond(int condp, int tlabel, int flabel); #line 18 // 18 %external %string (255) %fn %spec strint(%integer n, p) extern char * s(int n); #line 19 // 19 %external %integer %fn %spec getwork extern char * strint(int n, int p); #line 20 // 20 %external %routine %spec returnwork(%integer work) extern int getwork(); #line 21 // 21 %external %routine %spec clearwork extern void returnwork(int work); #line 22 // 22 %external %integer %fn %spec newtag extern void clearwork(); #line 23 // 23 %external %routine %spec pushtag(%integer ident, form, type, dim, level, rad) extern int newtag(); #line 24 // 24 %external %routine %spec poptags extern void pushtag(int ident, int form, int type, int dim, int level, int rad); #line 25 // 25 %external %integer %fn %spec getlabel(%integer constp) extern void poptags(); #line 26 // 26 %external %routine %spec filllabel(%integer label) extern int getlabel(int constp); #line 27 // 27 %external %integer %fn %spec fillbranch(%integer label) extern void filllabel(int label); #line 28 // 28 %external %routine %spec poplabels extern int fillbranch(int label); #line 29 // 29 %external %integer %fn %spec nextplabel extern void poplabels(); #line 30 // 30 %external %routine %spec dump(%string (7) lab, op, reg, addr) extern int nextplabel(); #line 31 // 31 %external %routine %spec fault(%string (63) mess) extern void dump(char *lab, char *op, char *reg, char *addr); #line 32 // 32 %external %string (255) %fn %spec name(%integer ident) extern void fault(char *mess); #line 33 // 33 %external %routine %spec pushstart(%integer flag, plab) extern char * name(int ident); #line 34 // 34 %external %routine %spec popstart(%integer %name flag, plab) extern void pushstart(int flag, int plab); #line 35 // 35 %external %routine %spec findcontinue(%integer %name type, flag) extern void popstart(int *flag, int *plab); #line 36 // 36 %external %routine %spec findexit(%integer %name type, flag) extern void findcontinue(int *type, int *flag); #line 37 // 37 %external %routine %spec popcycle(%integer %name type, lab) extern void findexit(int *type, int *flag); #line 38 // 38 %external %routine %spec clearstart extern void popcycle(int *type, int *lab); #line 39 // 39 %external %integer %fn %spec enter extern void clearstart(); #line 40 // 40 %external %routine %spec dumpreturn extern int enter(); #line 41 // 41 %external %routine %spec proc(%integer procp) extern void dumpreturn(); #line 42 // 42 %external %routine %spec array(%integer arrayp) extern void proc(int procp); #line 43 // 43 %external %routine %spec endofprog extern void array(int arrayp); #line 44 // 44 !----------------------------------------------------------------------- extern void endofprog(); #line 46 // 45 %external %integer %array nextrad(0 : 15) // 46 // bounds [0 : 15] // do it now: extern int *nextrad; /* uninitialised */ #line 48 // 47 %external %string (5) %array display(0 : 15) = "Bug", "-2,X", "-4,X", %c // 48 "-6,X", "-8,X", "-10,X", "-12,X", "-14,X", "-16,X", "-18,X", "-20,X", %c // bounds [0 : 15] // do it now: extern char * *display {NO INIT} #line 52 // 49 "-22,X", "-24,X", "-26,X", "-28,X", "-30,X" // 50 // 51 %external %integer level, nextcad = 1, pstr = 0 // 52 !----------------------------------------------------------------------- extern int level; extern int nextcad; extern int pstr; #line 54 // 53 %own %integer %array proctype(0 : 15) // 54 // bounds [0 : 15] // do it now: static int *proctype; /* uninitialised */ #line 56 // 55 %own %integer %array staticalloc(0 : 15) // 56 // bounds [0 : 15] // do it now: static int *staticalloc; /* uninitialised */ #line 58 // 57 %own %string (3) %array regs(1 : 2) = "A", "A,B" // 58 // bounds [1 : 2] // do it now: static char * *regs {NO INIT} #line 60 // 59 %external %integer %array rt(0 : 15) // 60 // bounds [0 : 15] // do it now: extern int *rt; /* uninitialised */ #line 62 // 61 %external %integer %array parms(0 : 15) // 62 // bounds [0 : 15] // do it now: extern int *parms; /* uninitialised */ #line 64 // 63 %external %integer %spec traceopt, checkopt // 64 %external %integer aopt = 0 extern int /*spec*/ traceopt; extern int /*spec*/ checkopt; #line 65 // 65 !----------------------------------------------------------------------- extern int aopt; #line 67 // 66 %external %routine statement(%integer statementp) // 67 %own %integer access = 1 extern void statement(int statementp) { #line 68 // 68 %routine %spec doloop(%integer loopsp) static int access; #line 69 // 69 %routine %spec instr(%integer instrp) void doloop(int loopsp); #line 70 // 70 %string (4) base, b1, b2 void instr(int instrp); #line 71 // 71 %switch sttype(1:13) char *base; char *b1; char *b2; #line 72 // 72 %integer condp, instrp, elsep, constp, arrayp, namep, namesp, expr1p, %c // bounds [1 : 13] /*todo: gcc jump table extension*/ void **sttype; #line 73 // 73 expr2p, instr2p, tlabel, flabel, label, fplabel, tplabel, work1, work2, %c int condp; int instrp; int elsep; int constp; int arrayp; int namep; int namesp; int expr1p; int expr2p; int instr2p; int tlabel; int flabel; int label; int fplabel; int tplabel; int work1; int work2; int flag; int plabel; int procp; int formalp; int formp; int params; int procid; int ident; int form; int paramt; int paraml; int dim; int basep; int type; int cyclab; int cntlab; int extlab; #line 77 // 74 flag, plabel, procp, formalp, formp, params, procid, ident, form, paramt, %c // 75 paraml, dim, basep, type, cyclab, cntlab, extlab // 76 -> sttype(a(statementp)) // 77 !----------------------------------------------------------------------- goto *sttype[a[statementp]]; #line 79 // 78 sttype(1): // 79 ! sttype_1: #line 81 // 80 %if access = 0 %then fault("ACCESS?") %and access = 1 // 81 dump("", "SWI", "3", "") %if traceopt = 1 if (access != 0) goto L_0001; fault("ACCESS?"); access = 1; L_0001: #line 82 // 82 %unless a(a(a(statementp + 2) + 1)) = 2 %then doloop(a(statementp + 2)) if (traceopt != 1) goto L_0002; dump("", "SWI", "3", ""); L_0002: #line 83 // 83 instr(a(statementp + 1)) if (a[a[(a[(statementp + 2)] + 1)]] == 2) goto L_0003; doloop(a[(statementp + 2)]); L_0003: #line 84 // 84 %if a(a(a(statementp + 2) + 1)) = 2 %then %return instr(a[(statementp + 1)]); #line 85 // 85 %if access = 0 %then fault("DUBIOUS STATEMENT") %and access = 1 if (a[a[(a[(statementp + 2)] + 1)]] != 2) goto L_0004; return; L_0004: #line 86 // 86 condp = a(a(a(statementp + 2) + 1) + 1) if (access != 0) goto L_0005; fault("DUBIOUS STATEMENT"); access = 1; L_0005: #line 87 // 87 a(1) = 1 condp = a[(a[(a[(statementp + 2)] + 1)] + 1)]; #line 88 // 88 a(2) = 3 a[1] = 1; #line 89 // 89 %if a(a(statementp + 2)) <= 2 %then a(3) = 2 %else a(3) = 1 a[2] = 3; #line 90 // 90 statementp = 1 if (a[a[(statementp + 2)]] > 2) goto L_0006; a[3] = 2; goto L_0007; L_0006: a[3] = 1; L_0007: #line 91 // 91 -> untilst statementp = 1; #line 92 // 92 !----------------------------------------------------------------------- goto U_0090; #line 94 // 93 sttype(2): // 94 ! "IF""THEN" sttype_2: #line 96 // 95 condp = a(statementp + 1) // 96 instrp = a(statementp + 2) condp = a[(statementp + 1)]; #line 97 // 97 elsep = a(statementp + 3) instrp = a[(statementp + 2)]; #line 98 // 98 %if access = 0 %then fault("ACCESS?") %and access = 1 elsep = a[(statementp + 3)]; #line 99 // 99 dump("", "SWI", "3", "") %if traceopt = 1 if (access != 0) goto L_0008; fault("ACCESS?"); access = 1; L_0008: #line 100 // 100 %if 7 <= a(instrp) <= 8 %or a(instrp) = 2 %then %start if (traceopt != 1) goto L_0009; dump("", "SWI", "3", ""); L_0009: #line 101 // 101 ! branch if (7 > a[instrp]) goto L_000a; if (a[instrp] <= 8) goto L_000b; L_000a: if (a[instrp] != 2) goto L_000c; L_000b: #line 103 // 102 %if a(instrp) = 7 %then findcontinue(type, tlabel) %c // 103 %else %if a(instrp) = 8 %then findexit(type, tlabel) %else %start if (a[instrp] != 7) goto L_000d; findcontinue(type, tlabel); goto L_000e; L_000d: if (a[instrp] != 8) goto L_000f; findexit(type, tlabel); goto L_000e; L_000f: #line 105 // 104 constp = a(instrp + 1) // 105 tlabel = getlabel(constp) constp = a[(instrp + 1)]; #line 106 // 106 %finish tlabel = getlabel(constp); #line 107 // 107 %if a(elsep) = 2 %then filllabel(cond(condp, tlabel, -1)) %else %start L_000e: #line 108 // 108 instrp = a(elsep + 1) if (a[elsep] != 2) goto L_0010; filllabel(cond(condp, tlabel, (-1))); goto L_0011; L_0010: #line 109 // 109 %if 7 <= a(instrp) <= 8 %or a(instrp) = 2 %then %start instrp = a[(elsep + 1)]; #line 110 // 110 ! branch if (7 > a[instrp]) goto L_0012; if (a[instrp] <= 8) goto L_0013; L_0012: if (a[instrp] != 2) goto L_0014; L_0013: #line 112 // 111 %if a(instrp) = 7 %then findcontinue(type, flabel) %c // 112 %else %if a(instrp) = 8 %then findexit(type, flabel) %else %start if (a[instrp] != 7) goto L_0015; findcontinue(type, flabel); goto L_0016; L_0015: if (a[instrp] != 8) goto L_0017; findexit(type, flabel); goto L_0016; L_0017: #line 114 // 113 constp = a(instrp + 1) // 114 flabel = getlabel(constp) constp = a[(instrp + 1)]; #line 115 // 115 %finish flabel = getlabel(constp); #line 116 // 116 access = 0 L_0016: #line 117 // 117 filllabel(cond(condp, tlabel, flabel)) access = 0; #line 118 // 118 dump("", "LBRA", "", "L" . s(flabel)) filllabel(cond(condp, tlabel, flabel)); #line 119 // 119 %return dump("", "LBRA", "", "L"); #line 120 // 120 %finish %else %start return; #line 121 // 121 filllabel(cond(condp, tlabel, -1)) L_0014: #line 122 // 122 %if a(instrp) = 3 %then pushstart(1, -1) %else instr(instrp) filllabel(cond(condp, tlabel, (-1))); #line 123 // 123 %finish if (a[instrp] != 3) goto L_0018; pushstart(1, (-1)); goto L_0019; L_0018: instr(instrp); L_0019: #line 124 // 124 %finish #line 125 // 125 %finish %else %start L_0011: #line 126 // 126 %if a(elsep) = 2 %then %start goto L_001a; L_000c: #line 127 // 127 fplabel = cond(condp, -1, -1) if (a[elsep] != 2) goto L_001b; #line 128 // 128 %if a(instrp) = 3 %then pushstart(0, fplabel) %else instr(instrp) %and filllabel(fplabel) fplabel = cond(condp, (-1), (-1)); #line 129 // 129 %finish %else %start if (a[instrp] != 3) goto L_001c; pushstart(0, fplabel); goto L_001d; L_001c: instr(instrp); filllabel(fplabel); L_001d: #line 130 // 130 instr2p = a(elsep + 1) goto L_001e; L_001b: #line 131 // 131 %if 7 <= a(instr2p) <= 8 %or a(instr2p) = 2 %then %start instr2p = a[(elsep + 1)]; #line 132 // 132 ! branch if (7 > a[instr2p]) goto L_001f; if (a[instr2p] <= 8) goto L_0020; L_001f: if (a[instr2p] != 2) goto L_0021; L_0020: #line 134 // 133 %if a(instr2p) = 7 %then findcontinue(type, flabel) %c // 134 %else %if a(instr2p) = 8 %then findexit(type, flabel) %else %start if (a[instr2p] != 7) goto L_0022; findcontinue(type, flabel); goto L_0023; L_0022: if (a[instr2p] != 8) goto L_0024; findexit(type, flabel); goto L_0023; L_0024: #line 136 // 135 constp = a(instr2p + 1) // 136 flabel = getlabel(constp) constp = a[(instr2p + 1)]; #line 137 // 137 %finish flabel = getlabel(constp); #line 138 // 138 fplabel = cond(condp, -1, flabel) L_0023: #line 139 // 139 ! result always -1 fplabel = cond(condp, (-1), flabel); #line 141 // 140 instr(instrp) // 141 %finish %else %start instr(instrp); #line 142 // 142 fplabel = cond(condp, -1, -1) goto L_0025; L_0021: #line 143 // 143 instr(instrp) fplabel = cond(condp, (-1), (-1)); #line 144 // 144 tplabel = nextplabel instr(instrp); #line 145 // 145 dump("", "LBRA", "", "L" . s(tplabel)) tplabel = nextplabel(); #line 146 // 146 filllabel(fplabel) dump("", "LBRA", "", "L"); #line 147 // 147 %if a(instr2p) = 3 %then pushstart(1, tplabel) %c filllabel(fplabel); #line 148 // 148 %else instr(instr2p) %and filllabel(tplabel) if (a[instr2p] != 3) goto L_0026; pushstart(1, tplabel); goto L_0027; L_0026: instr(instr2p); filllabel(tplabel); L_0027: #line 150 // 149 %finish // 150 %finish L_0025: #line 151 // 151 %finish L_001e: #line 152 // 152 access = 1 L_001a: #line 153 // 153 %return access = 1; #line 154 // 154 !----------------------------------------------------------------------- return; #line 156 // 155 sttype(3): // 156 ! ':' sttype_3: #line 158 // 157 access = 1 // 158 constp = a(statementp + 1) access = 1; #line 159 // 159 statementp = a(statementp + 2) constp = a[(statementp + 1)]; #line 160 // 160 label = getlabel(constp) statementp = a[(statementp + 2)]; #line 161 // 161 filllabel(label) label = getlabel(constp); #line 162 // 162 statement(statementp) filllabel(label); #line 163 // 163 %return statement(statementp); #line 164 // 164 !----------------------------------------------------------------------- return; #line 166 // 165 sttype(4): // 166 ! "FINISH" sttype_4: #line 168 // 167 access = 1 // 168 elsep = a(statementp + 1) access = 1; #line 169 // 169 popstart(flag, plabel) elsep = a[(statementp + 1)]; #line 170 // 170 %if flag = 0 %then %start popstart(flag, plabel); #line 171 // 171 ! first %start/%finish if (flag != 0) goto L_0028; #line 173 // 172 %if a(elsep) = 1 %then %start // 173 instrp = a(elsep + 1) if (a[elsep] != 1) goto L_0029; #line 174 // 174 tplabel = nextplabel instrp = a[(elsep + 1)]; #line 175 // 175 dump("", "LBRA", "", "L" . s(tplabel)) tplabel = nextplabel(); #line 176 // 176 filllabel(plabel) dump("", "LBRA", "", "L"); #line 177 // 177 %if a(instrp) = 3 %then pushstart(1, tplabel) %c filllabel(plabel); #line 178 // 178 %else instr(instrp) %and filllabel(tplabel) if (a[instrp] != 3) goto L_002a; pushstart(1, tplabel); goto L_002b; L_002a: instr(instrp); filllabel(tplabel); L_002b: #line 180 // 179 %finish %else filllabel(plabel) // 180 %finish %else %start goto L_002c; L_0029: filllabel(plabel); L_002c: #line 181 // 181 ! second %start/%finish goto L_002d; L_0028: #line 183 // 182 %if a(elsep) = 1 %then fault("SPURIOUS %ELSE") %else filllabel(plabel) // 183 %finish if (a[elsep] != 1) goto L_002e; fault("SPURIOUS %ELSE"); goto L_002f; L_002e: filllabel(plabel); L_002f: #line 184 // 184 %return L_002d: #line 185 // 185 !----------------------------------------------------------------------- return; #line 187 // 186 sttype(5): // 187 ! "INTEGER" sttype_5: #line 189 // 188 arrayp = a(statementp + 1) // 189 namep = a(arrayp + 1) arrayp = a[(statementp + 1)]; #line 190 // 190 namesp = a(arrayp + 2) namep = a[(arrayp + 1)]; #line 191 // 191 %if a(arrayp) = 1 %then %start namesp = a[(arrayp + 2)]; #line 192 // 192 ! array declaration if (a[arrayp] != 1) goto L_0030; #line 194 // 193 dump("", "SWI", "3", "") %if traceopt = 1 // 194 %if access = 0 %then fault("ACCESS?") %and access = 1 if (traceopt != 1) goto L_0031; dump("", "SWI", "3", ""); L_0031: #line 195 // 195 %if find(2, cyclab, type) = true %then fault("ORDER?") if (access != 0) goto L_0032; fault("ACCESS?"); access = 1; L_0032: #line 196 // 196 %if level = 1 %then base = ",X" %else base = ",Y" if (find(2, cyclab, type) != 0) goto L_0033; fault("ORDER?"); L_0033: #line 197 // 197 %cycle if (level != 1) goto L_0034; strncpy(base,",X",4+1); goto L_0035; L_0034: strncpy(base,",Y",4+1); L_0035: #line 198 // 198 expr1p = a(arrayp + 3) for (;;) { L_0036: #line 199 // 199 expr2p = a(arrayp + 4) expr1p = a[(arrayp + 3)]; #line 200 // 200 expr(expr1p) expr2p = a[(arrayp + 4)]; #line 201 // 201 dump("", "SEX", "", "") expr(expr1p); #line 202 // 202 dump("", "PSH", "U", "A,B") dump("", "SEX", "", ""); #line 203 // 203 work1 = getwork dump("", "PSH", "U", "A,B"); #line 204 // 204 !***dump("STR","ACC",display(level),work1) work1 = getwork(); #line 206 // 205 expr(expr2p) // 206 dump("", "SEX", "", "") expr(expr2p); #line 207 // 207 dump("", "ADD", "D", "#1") dump("", "SEX", "", ""); #line 208 // 208 dump("", "PSH", "U", "A,B") dump("", "ADD", "D", "#1"); #line 209 // 209 dump("", "TFR", "", "S,D") dump("", "PSH", "U", "A,B"); #line 210 // 210 !***dump("LDA","ACC","ACC",1) dump("", "TFR", "", "S,D"); #line 212 // 211 work2 = getwork // 212 !***dump("STR","ACC",display(level),work2) work2 = getwork(); #line 214 // 213 %cycle // 214 staticalloc(level) = staticalloc(level) + 2 for (;;) { L_0037: #line 215 // 215 nextrad(level) = nextrad(level) + 2 staticalloc[level] = (staticalloc[level] + 2); #line 216 // 216 pushtag(a(namep + 1), 2, 1, 2, level, nextrad(level)) nextrad[level] = (nextrad[level] + 2); #line 217 // 217 dump("", "SUB", "D", "0,U") pushtag(a[(namep + 1)], 2, 1, 2, level, nextrad[level]); #line 218 // 218 dump("", "ST", "D", "-" . s(nextrad(level)) . base) dump("", "SUB", "D", "0,U"); #line 219 // 219 dump("", "ADD", "D", "2,U") dump("", "ST", "D", "-"); #line 220 // 220 ! DUMP("","SUB","D","#1") dump("", "ADD", "D", "2,U"); #line 225 // 221 !***dump("SUB","STP",display(level),work1) // 222 !***dump("STR","STP",display(level),nextrad(level)) // 223 !***dump("ADD","STP",display(level),work2) // 224 %if a(namesp) = 2 %then %exit // 225 namep = a(namesp + 1) if (a[namesp] != 2) goto L_0038; goto L_0039; L_0038: #line 226 // 226 namesp = a(namesp + 2) namep = a[(namesp + 1)]; #line 227 // 227 %repeat namesp = a[(namesp + 2)]; #line 228 // 228 dump("", "TFR", "", "D,S") } L_0039: #line 229 // 229 dump("", "LEA", "U", "4,U") dump("", "TFR", "", "D,S"); #line 230 // 230 returnwork(work1) dump("", "LEA", "U", "4,U"); #line 231 // 231 returnwork(work2) returnwork(work1); #line 232 // 232 %if a(a(arrayp + 5)) = 1 %then %start returnwork(work2); #line 233 // 233 arrayp = a(arrayp + 5) if (a[a[(arrayp + 5)]] != 1) goto L_003a; #line 234 // 234 namep = a(arrayp + 1) arrayp = a[(arrayp + 5)]; #line 235 // 235 namesp = a(arrayp + 2) namep = a[(arrayp + 1)]; #line 236 // 236 %continue namesp = a[(arrayp + 2)]; #line 237 // 237 %finish %else %return goto L_003b; #line 238 // 238 %repeat L_003a: return; #line 239 // 239 %finish %else %start L_003b: } #line 240 // 240 %cycle L_0030: #line 241 // 241 staticalloc(level) = staticalloc(level) + 1 for (;;) { L_003c: #line 242 // 242 nextrad(level) = nextrad(level) + 1 staticalloc[level] = (staticalloc[level] + 1); #line 243 // 243 pushtag(a(namep + 1), 0, 1, 1, level, nextrad(level)) nextrad[level] = (nextrad[level] + 1); #line 244 // 244 %if a(namesp) = 2 %then %exit pushtag(a[(namep + 1)], 0, 1, 1, level, nextrad[level]); #line 245 // 245 namep = a(namesp + 1) if (a[namesp] != 2) goto L_003d; goto L_003e; L_003d: #line 246 // 246 namesp = a(namesp + 2) namep = a[(namesp + 1)]; #line 247 // 247 %repeat namesp = a[(namesp + 2)]; #line 248 // 248 %finish } L_003e: #line 249 // 249 %return #line 250 // 250 !----------------------------------------------------------------------- return; #line 252 // 251 sttype(6): // 252 ! sttype_6: #line 254 // 253 %if level = 0 %then fault("PROCEDURE BEFORE %BEGIN") // 254 %if level = 15 %then fault("PROCEDURE NESTING TOO DEEP") if (level != 0) goto L_003f; fault("PROCEDURE BEFORE %BEGIN"); L_003f: #line 255 // 255 access = 1 if (level != 15) goto L_0040; fault("PROCEDURE NESTING TOO DEEP"); L_0040: #line 256 // 256 procp = a(statementp + 1) access = 1; #line 257 // 257 namep = a(statementp + 2) procp = a[(statementp + 1)]; #line 258 // 258 formalp = a(statementp + 3) namep = a[(statementp + 2)]; #line 259 // 259 procid = a(namep + 1) formalp = a[(statementp + 3)]; #line 260 // 260 ! skipproc(level)=nextcad procid = a[(namep + 1)]; #line 262 // 261 pushtag(procid, 4, a(procp) - 1, 0, level, nextcad) // 262 level = level + 1 pushtag(procid, 4, (a[procp] - 1), 0, level, nextcad); #line 263 // 263 rt(level) = tag(taglink(procid)) & 16_FFFF level = (level + 1); #line 264 // 264 dump("", "LBRA", "", "S" . s(rt(level))) rt[level] = (tag[taglink[procid]] & 65535); #line 265 // 265 dump("E" . s(rt(level)), "EQU", "", "*") dump("", "LBRA", "", "S"); #line 266 // 266 proctype(level) = a(procp) dump("E", "EQU", "", "*"); #line 267 // 267 staticalloc(level) = enter proctype[level] = a[procp]; #line 268 // 268 ! nextrad(level)=2 staticalloc[level] = enter(); #line 270 // 269 parms(level) = 0 // 270 %if a(formalp) = 2 %then -> retn parms[level] = 0; #line 271 // 271 ! no parameters if (a[formalp] != 2) goto L_0041; goto U_0091; L_0041: #line 273 // 272 params = 0 // 273 paraml = taglink(procid) params = 0; #line 274 // 274 %cycle paraml = taglink[procid]; #line 275 // 275 formp = a(formalp + 1) for (;;) { L_0042: #line 276 // 276 namep = a(formalp + 2) formp = a[(formalp + 1)]; #line 277 // 277 namesp = a(formalp + 3) namep = a[(formalp + 2)]; #line 278 // 278 formalp = a(formalp + 4) namesp = a[(formalp + 3)]; #line 279 // 279 %if a(formp) = 1 %then form = 3 %and dim = 2 %else %start formalp = a[(formalp + 4)]; #line 280 // 280 %if a(formp) = 2 %then form = 1 %and dim = 2 %c if (a[formp] != 1) goto L_0043; form = 3; dim = 2; goto L_0044; L_0043: #line 281 // 281 %else form = 0 %and dim = 1 if (a[formp] != 2) goto L_0045; form = 1; dim = 2; goto L_0046; L_0045: form = 0; dim = 1; L_0046: #line 283 // 282 %finish // 283 %cycle L_0044: #line 284 // 284 ident = a(namep + 1) for (;;) { L_0047: #line 285 // 285 ! declare parameters as locals ident = a[(namep + 1)]; #line 287 // 286 nextrad(level) = nextrad(level) + dim // 287 staticalloc(level) = staticalloc(level) + dim nextrad[level] = (nextrad[level] + dim); #line 288 // 288 pushtag(ident, form, 1, dim, level, nextrad(level)) staticalloc[level] = (staticalloc[level] + dim); #line 289 // 289 ! DUMP("","PUL","U",REGS(DIM)) pushtag(ident, form, 1, dim, level, nextrad[level]); #line 293 // 290 ! DUMP("","PSH","S",REGS(DIM)) // 291 ! append parameter tag cells to procedure tag cell // 292 paramt = newtag // 293 tag(paramt) = tag(taglink(ident)) paramt = newtag(); #line 294 // 294 link(paramt) = link(paraml) tag[paramt] = tag[taglink[ident]]; #line 295 // 295 link(paraml) = paramt link[paramt] = link[paraml]; #line 296 // 296 paraml = paramt link[paraml] = paramt; #line 297 // 297 parms(level) = parms(level) + dim paraml = paramt; #line 298 // 298 params = params + 1 parms[level] = (parms[level] + dim); #line 299 // 299 %if params > 15 %then fault(name(procid) . " HAS TOO MANY PARAMETERS") %and %stop params = (params + 1); #line 300 // 300 %if a(namesp) = 2 %then %exit if (params <= 15) goto L_0048; fault(name(procid)); exit(0); L_0048: #line 301 // 301 namep = a(namesp + 1) if (a[namesp] != 2) goto L_0049; goto L_004a; L_0049: #line 302 // 302 namesp = a(namesp + 2) namep = a[(namesp + 1)]; #line 303 // 303 %repeat namesp = a[(namesp + 2)]; #line 304 // 304 %repeat %until a(formalp) = 2 } L_004a: #line 305 // 305 ! insert number of parameters into tag cell if (a[formalp] == 2) goto L_004b; } L_004b: #line 307 // 306 tag(taglink(procid)) = tag(taglink(procid)) ! params << 20 // 307 retn: tag[taglink[procid]] = (tag[taglink[procid]] | (params << 20)); #line 308 // 308 dump("", "LEA", "S", "-A" . s(rt(level)) . ",S") U_0091: #line 309 // 309 %return dump("", "LEA", "S", "-A"); #line 310 // 310 !----------------------------------------------------------------------- return; #line 312 // 311 sttype(7): // 312 ! "END" sttype_7: #line 314 // 313 %if level > 1 %start // 314 ! DUMP("P".S(RT(LEVEL)),"EQU","",S(PARMS(LEVEL))) if (level <= 1) goto L_004c; #line 316 // 315 %if proctype(level) # 1 %and checkopt = 1 %then dump("", "SWI", "", "") // 316 ! %RESULT NOT ENCOUNTERED if (proctype[level] == 1) goto L_004d; if (checkopt != 1) goto L_004d; dump("", "SWI", "", ""); L_004d: #line 319 // 317 ! DUMP("R".S(RT(LEVEL)),"EQU","","*") // 318 %finish // 319 poptags L_004c: #line 320 // 320 poplabels poptags(); #line 321 // 321 clearstart poplabels(); #line 322 // 322 clearwork clearstart(); #line 323 // 323 dump("A" . s(rt(level)), "EQU", "", s(staticalloc(level))) clearwork(); #line 324 // 324 %if proctype(level) >= 1 %and access = 1 %then dumpreturn dump("A", "EQU", "", s(staticalloc[level])); #line 325 // 325 access = 1 if (proctype[level] < 1) goto L_004e; if (access != 1) goto L_004e; dumpreturn(); L_004e: #line 326 // 326 level = level - 1 access = 1; #line 327 // 327 %if a(a(statementp + 1)) = 2 %then %start level = (level - 1); #line 328 // 328 ! %end if (a[a[(statementp + 1)]] != 2) goto L_004f; #line 330 // 329 %if level <= 0 %then fault("SPURIOUS %END") %and endofprog // 330 dump("S" . s(rt(level + 1)), "EQU", "", "*") if (level > 0) goto L_0050; fault("SPURIOUS %END"); endofprog(); L_0050: #line 331 // 331 %finish %else %start dump("S", "EQU", "", "*"); #line 332 // 332 ! %endofprogram goto L_0051; L_004f: #line 334 // 333 %if level # 0 %then fault("TOO FEW %ENDS") // 334 endofprog if (level == 0) goto L_0052; fault("TOO FEW %ENDS"); L_0052: #line 335 // 335 %finish endofprog(); #line 336 // 336 %return L_0051: #line 337 // 337 !----------------------------------------------------------------------- return; #line 339 // 338 sttype(8): // 339 ! "BEGIN" sttype_8: #line 341 // 340 %if level # 0 %then fault("SPURIOUS %BEGIN") %else %start // 341 rt(1) = 0 if (level == 0) goto L_0053; fault("SPURIOUS %BEGIN"); goto L_0054; L_0053: #line 342 // 342 level = 1 rt[1] = 0; #line 343 // 343 proctype(1) = 0 level = 1; #line 344 // 344 staticalloc(1) = enter proctype[1] = 0; #line 345 // 345 nextrad(1) = staticalloc(1) staticalloc[1] = enter(); #line 346 // 346 %finish nextrad[1] = staticalloc[1]; #line 347 // 347 %return L_0054: #line 348 // 348 sttype(9): return; #line 349 // 349 ! %CYCLE sttype_9: #line 351 // 350 %if access = 0 %then fault("WARNING - ACCESS???") %and access = 1 // 351 dump("", "SWI", "3", "") %if traceopt = 1 if (access != 0) goto L_0055; fault("WARNING - ACCESS???"); access = 1; L_0055: #line 352 // 352 doloop(a(statementp + 1)) if (traceopt != 1) goto L_0056; dump("", "SWI", "3", ""); L_0056: #line 353 // 353 %return doloop(a[(statementp + 1)]); #line 354 // 354 sttype(10): return; #line 355 // 355 ! %REPEAT sttype_10: #line 357 // 356 condp = a(a(statementp + 1) + 1) // 357 dump("", "SWI", "3", "") %if traceopt = 1 condp = a[(a[(statementp + 1)] + 1)]; #line 358 // 358 untilst: if (traceopt != 1) goto L_0057; dump("", "SWI", "3", ""); L_0057: #line 359 // 359 access = 1 U_0090: #line 360 // 360 popcycle(type, cyclab) access = 1; #line 361 // 361 cntlab = cyclab + 1 popcycle(type, cyclab); #line 362 // 362 extlab = cntlab + 1 cntlab = (cyclab + 1); #line 363 // 363 %if a(a(statementp + 1)) # 2 %then %start extlab = (cntlab + 1); #line 364 // 364 dump("L" . s(cntlab), "EQU", "", "*") if (a[a[(statementp + 1)]] == 2) goto L_0058; #line 365 // 365 tplabel = cond(condp, -1, cyclab) dump("L", "EQU", "", "*"); #line 366 // 366 %if type = 2 %then dump("L" . s(extlab), "LEA", "U", "4,U") %c tplabel = cond(condp, (-1), cyclab); #line 367 // 367 %else dump("L" . s(extlab), "EQU", "", "*") if (type != 2) goto L_0059; dump("L", "LEA", "U", "4,U"); goto L_005a; L_0059: dump("L", "EQU", "", "*"); L_005a: #line 369 // 368 %finish %else %start // 369 dump("L" . s(cntlab), "LBRA", "", "L" . s(cyclab)) goto L_005b; L_0058: #line 370 // 370 %if type = 2 %then dump("L" . s(extlab), "LEA", "U", "4,U") %c dump("L", "LBRA", "", "L"); #line 371 // 371 %else dump("L" . s(extlab), "EQU", "", "*") if (type != 2) goto L_005c; dump("L", "LEA", "U", "4,U"); goto L_005d; L_005c: dump("L", "EQU", "", "*"); L_005d: #line 373 // 372 %finish // 373 %return L_005b: #line 374 // 374 sttype(13): return; #line 375 // 375 ! "PRINTTEXT" sttype_13: #line 377 // 376 pstr = 1 // 377 fault("ACCESS?") %and access = 1 %if access = 0 pstr = 1; #line 378 // 378 dump("", "SWI", "3", "") %if traceopt = 1 if (access != 0) goto L_005e; fault("ACCESS?"); access = 1; L_005e: #line 379 // 379 dump("", "LBSR", "", "PSTR") if (traceopt != 1) goto L_005f; dump("", "SWI", "3", ""); L_005f: #line 380 // 380 printstring(" FCB ") dump("", "LBSR", "", "PSTR"); #line 381 // 381 work1 = 4 printstring(" FCB "); #line 382 // 382 %cycle work1 = 4; #line 383 // 383 work2 = a(work1) for (;;) { L_0060: #line 384 // 384 %if work2 # 16_80 %then write(work2, 0) %else printstring("$80") %and %exit work2 = a[work1]; #line 385 // 385 printsymbol(',') if (work2 == 128) goto L_0061; write(work2, 0); goto L_0062; L_0061: printstring("$80"); goto L_0063; L_0062: #line 386 // 386 work1 = work1 + 1 printsymbol(44); #line 387 // 387 %repeat work1 = (work1 + 1); #line 388 // 388 newline } L_0063: #line 389 // 389 %return newline(); #line 390 // 390 sttype(11): return; #line 391 // 391 ! "CONSTANT" ' instype_2: #line 468 // 467 access = 0 // 468 constp = a(instrp + 1) access = 0; #line 469 // 469 label = getlabel(constp) constp = a[(instrp + 1)]; #line 470 // 470 dump("", "LBRA", "", "L" . s(label)) label = getlabel(constp); #line 471 // 471 %return dump("", "LBRA", "", "L"); #line 472 // 472 !----------------------------------------------------------------------- return; #line 474 // 473 instype(3): // 474 ! "START" instype_3: #line 476 // 475 fault("ILLEGAL %START") // 476 %return fault("ILLEGAL %START"); #line 477 // 477 !----------------------------------------------------------------------- return; #line 479 // 478 instype(4): // 479 ! "RETURN" instype_4: #line 481 // 480 %if proctype(level) # 1 %then fault("%RETURN OUT OF CONTEXT") // 481 access = 0 if (proctype[level] == 1) goto L_007a; fault("%RETURN OUT OF CONTEXT"); L_007a: #line 482 // 482 dumpreturn access = 0; #line 483 // 483 ! DUMP("","LBRA","","R".S(RT(LEVEL))) dumpreturn(); #line 485 // 484 %return // 485 !----------------------------------------------------------------------- return; #line 487 // 486 instype(5): // 487 ! "RESULT"'=' instype_5: #line 489 // 488 %if proctype(level) # 2 %then fault("%RESULT OUT OF CONTEXT") // 489 access = 0 if (proctype[level] == 2) goto L_007b; fault("%RESULT OUT OF CONTEXT"); L_007b: #line 490 // 490 expr(a(instrp + 1)) access = 0; #line 491 // 491 dumpreturn expr(a[(instrp + 1)]); #line 492 // 492 ! DUMP("","LBRA","","R".S(RT(LEVEL))) dumpreturn(); #line 494 // 493 %return // 494 !----------------------------------------------------------------------- return; #line 496 // 495 instype(6): // 496 ! "STOP" instype_6: #line 498 // 497 access = 0 // 498 dump("", "SWI", "2", "") access = 0; #line 499 // 499 ! CALL MONITOR AND HALT? dump("", "SWI", "2", ""); #line 501 // 500 %return // 501 instype(7): return; #line 502 // 502 access = 0 instype_7: #line 503 // 503 findcontinue(type, lab) access = 0; #line 504 // 504 dump("", "LBRA", "", "L" . s(lab)) findcontinue(type, lab); #line 505 // 505 %return dump("", "LBRA", "", "L"); #line 506 // 506 instype(8): return; #line 507 // 507 access = 0 instype_8: #line 508 // 508 findexit(type, lab) access = 0; #line 509 // 509 dump("", "LBRA", "", "L" . s(lab)) findexit(type, lab); #line 510 // 510 %return dump("", "LBRA", "", "L"); #line 511 // 511 instype(9): return; #line 512 // 512 ! # instype_9: #line 514 // 513 dump("", name(a(a(instrp + 1) + 1)), "", "#" . s(a(a(instrp + 2) + 1))) // 514 %return dump("", name(a[(a[(instrp + 1)] + 1)]), "", "#"); #line 515 // 515 instype(10): return; #line 516 // 516 ! instype_10: #line 518 // 517 dump("", name(a(a(instrp + 1) + 1)), "", s(a(a(instrp + 2) + 1))) // 518 %return dump("", name(a[(a[(instrp + 1)] + 1)]), "", s(a[(a[(instrp + 2)] + 1)])); #line 519 // 519 instype(11): return; #line 520 // 520 ! # instype_11: #line 522 // 521 namep = a(instrp + 2) // 522 ident = a(namep + 1) namep = a[(instrp + 2)]; #line 523 // 523 dump("", name(a(a(instrp + 1) + 1)), "", "#" . name(ident)) ident = a[(namep + 1)]; #line 524 // 524 %return dump("", name(a[(a[(instrp + 1)] + 1)]), "", "#"); #line 525 // 525 instype(12): return; #line 526 // 526 ! instype_12: #line 528 // 527 namep = a(instrp + 2) // 528 ident = a(namep + 1) namep = a[(instrp + 2)]; #line 529 // 529 nametag = tag(taglink(ident)) %if taglink(ident) # 0 ident = a[(namep + 1)]; #line 530 // 530 %if taglink(ident) = 0 %or nametag >> 28 = 4 %start if (taglink[ident] == 0) goto L_007c; nametag = tag[taglink[ident]]; L_007c: #line 531 // 531 dump("", name(a(a(instrp + 1) + 1)), "", name(ident)) if (taglink[ident] == 0) goto L_007d; if ((nametag >> 28) != 4) goto L_007e; L_007d: #line 532 // 532 %finish %else %start dump("", name(a[(a[(instrp + 1)] + 1)]), "", name(ident)); #line 533 // 533 basep = nametag >> 16 & 15 goto L_007f; L_007e: #line 534 // 534 disp = nametag & 16_FFFF basep = ((nametag >> 16) & 15); #line 535 // 535 base = display(basep) disp = (nametag & 65535); #line 536 // 536 base = ",Y" %if basep = level strncpy(base,display[basep],4+1); #line 537 // 537 base = ",X" %if basep = 1 if (basep != level) goto L_0080; strncpy(base,",Y",4+1); L_0080: #line 538 // 538 b1 = "" if (basep != 1) goto L_0081; strncpy(base,",X",4+1); L_0081: #line 539 // 539 b2 = "" strncpy(b1,"",4+1); #line 540 // 540 b1 = "[" %and b2 = "]" %if nametag >> 28 = 1 strncpy(b2,"",4+1); #line 541 // 541 dump("", name(a(a(instrp + 1) + 1)), "", b1 . "-" . s(disp) . base . b2) if ((nametag >> 28) != 1) goto L_0082; strncpy(b1,"[",4+1); strncpy(b2,"]",4+1); L_0082: #line 542 // 542 %finish dump("", name(a[(a[(instrp + 1)] + 1)]), "", b1); #line 543 // 543 %return L_007f: #line 544 // 544 instype(13): return; #line 545 // 545 ! instype_13: #line 547 // 546 %begin // 547 %string (255) addr int main(int argc, char **argv) { #line 548 // 548 %integer i, sym char *addr; #line 549 // 549 addr = "" int i; int sym; #line 550 // 550 i = 10 strncpy(addr,"",255+1); #line 551 // 551 %cycle i = 10; #line 552 // 552 sym = a(i) for (;;) { L_0083: #line 553 // 553 i = i + 1 sym = a[i]; #line 554 // 554 %exit %if sym = 128 i = (i + 1); #line 555 // 555 addr = addr . tostring(sym) if (sym != 128) goto L_0084; goto L_0085; L_0084: #line 556 // 556 %repeat strncpy(addr,addr,255+1); #line 557 // 557 dump("", name(a(a(instrp + 1) + 1)), "", addr) } L_0085: #line 558 // 558 %end dump("", name(a[(a[(instrp + 1)] + 1)]), "", addr); #line 559 // 559 %return return(0); } #line 560 // 560 instype(14): return; #line 561 // 561 ! instype_14: #line 563 // 562 dump("", name(a(a(instrp + 1) + 1)), "", "") // 563 %return dump("", name(a[(a[(instrp + 1)] + 1)]), "", ""); #line 564 // 564 %end return; #line 565 // 565 %routine doloop(%integer loopsp) L_0064: #line 566 // 566 %integer type, cyclab, cntlab, extlab, namep, actualp, forp, %c goto L_0086; void doloop(int loopsp) { #line 567 // 567 initp, incrp, finalp, tplabel, condp, whilep, disp, nametag int type; int cyclab; int cntlab; int extlab; int namep; int actualp; int forp; int initp; int incrp; int finalp; int tplabel; int condp; int whilep; int disp; int nametag; #line 569 // 568 %string (7) base, reg // 569 %switch cycle(1:3) char *base; char *reg; #line 570 // 570 %if a(loopsp) = 1 %then type = 2 %else type = 3 // bounds [1 : 3] /*todo: gcc jump table extension*/ void **cycle; #line 571 // 571 cyclab = nextplabel if (a[loopsp] != 1) goto L_0087; type = 2; goto L_0088; L_0087: type = 3; L_0088: #line 572 // 572 cntlab = nextplabel cyclab = nextplabel(); #line 573 // 573 extlab = nextplabel cntlab = nextplabel(); #line 574 // 574 pushstart(type, cyclab) extlab = nextplabel(); #line 575 // 575 -> cycle(a(loopsp)) pushstart(type, cyclab); #line 576 // 576 cycle(1): goto *cycle[a[loopsp]]; #line 577 // 577 !FOR cycle_1: #line 579 // 578 forp = a(loopsp + 1) // 579 namep = a(forp + 1) forp = a[(loopsp + 1)]; #line 580 // 580 actualp = a(forp + 2) namep = a[(forp + 1)]; #line 581 // 581 initp = a(forp + 3) actualp = a[(forp + 2)]; #line 582 // 582 incrp = a(forp + 4) initp = a[(forp + 3)]; #line 583 // 583 finalp = a(forp + 5) incrp = a[(forp + 4)]; #line 584 // 584 ident = a(namep + 1) finalp = a[(forp + 5)]; #line 585 // 585 reg = "D" ident = a[(namep + 1)]; #line 586 // 586 !? %if taglink(ident)=0 %then fault(name(ident)." NOT DECLARED") %andreturn strncpy(reg,"D",7+1); #line 588 // 587 %if taglink(ident) = 0 %then %start // 588 dump("", "LD", "D", "#" . name(ident)) if (taglink[ident] != 0) goto L_0089; #line 589 // 589 %finish %else %start dump("", "LD", "D", "#"); #line 590 // 590 nametag = tag(taglink(ident)) goto L_008a; L_0089: #line 591 // 591 %if nametag >> 28 = 4 %then %start nametag = tag[taglink[ident]]; #line 592 // 592 fault("NOT A DESTINATION") if ((nametag >> 28) != 4) goto L_008b; #line 593 // 593 %return fault("NOT A DESTINATION"); #line 594 // 594 %finish return; #line 595 // 595 %if nametag >> 28 = 2 %start L_008b: #line 596 // 596 aopt = 1 if ((nametag >> 28) != 2) goto L_008c; #line 597 // 597 array(forp) aopt = 1; #line 598 // 598 %finish %else %start array(forp); #line 599 // 599 basep = nametag >> 16 & 16_F goto L_008d; L_008c: #line 600 // 600 base = display(basep) basep = ((nametag >> 16) & 15); #line 601 // 601 disp = nametag & 16_FFFF strncpy(base,display[basep],7+1); #line 602 // 602 base = "Y" %if basep = level disp = (nametag & 65535); #line 603 // 603 base = "X" %if basep = 1 if (basep != level) goto L_008e; strncpy(base,"Y",7+1); L_008e: #line 604 // 604 %if nametag >> 28 = 1 %then %start if (basep != 1) goto L_008f; strncpy(base,"X",7+1); L_008f: #line 605 // 605 %if 1 < basep < level %then %start if ((nametag >> 28) != 1) goto L_0090; #line 606 // 606 dump("", "LD", "D", base) if (1 >= basep) goto L_0091; if (basep >= level) goto L_0091; #line 607 // 607 dump("", "SUB", "D", "#" . s(disp)) dump("", "LD", "D", base); #line 608 // 608 dump("", "ST", "D", "0,X") dump("", "SUB", "D", "#"); #line 609 // 609 dump("", "LD", "D", "[0,X]") dump("", "ST", "D", "0,X"); #line 610 // 610 %finish %else %start dump("", "LD", "D", "[0,X]"); #line 611 // 611 dump("", "LD", "D", "-" . s(disp) . "," . base) goto L_0092; L_0091: #line 612 // 612 %finish dump("", "LD", "D", "-"); #line 613 // 613 %finish %else %start L_0092: #line 614 // 614 %if 1 < basep < level %then %start goto L_0093; L_0090: #line 615 // 615 dump("", "LD", "D", base) if (1 >= basep) goto L_0094; if (basep >= level) goto L_0094; #line 616 // 616 dump("", "SUB", "D", "#" . s(disp)) dump("", "LD", "D", base); #line 617 // 617 %finish %else %start dump("", "SUB", "D", "#"); #line 618 // 618 %if basep = 1 = level %then %start goto L_0095; L_0094: #line 619 // 619 dump("", "LEA", "Y", "-" . s(disp) . ",X") if (basep != 1) goto L_0096; if (1 != level) goto L_0096; #line 620 // 620 reg = "Y" dump("", "LEA", "Y", "-"); #line 621 // 621 %finish %else %start strncpy(reg,"Y",7+1); #line 622 // 622 dump("", "TFR", "", base . ",D") goto L_0097; L_0096: #line 623 // 623 dump("", "SUB", "D", "#" . s(disp)) dump("", "TFR", "", base); #line 624 // 624 %finish dump("", "SUB", "D", "#"); #line 625 // 625 %finish L_0097: #line 626 // 626 %if a(actualp) = 1 %then fault(name(ident) . " DECLARED AS SCALAR") L_0095: #line 627 // 627 %finish if (a[actualp] != 1) goto L_0098; fault(name(ident)); L_0098: #line 628 // 628 %finish L_0093: #line 629 // 629 %finish L_008d: #line 630 // 630 dump("", "PSH", "U", reg) L_008a: #line 631 // 631 expr(finalp) dump("", "PSH", "U", reg); #line 632 // 632 dump("", "PSH", "U", "B") expr(finalp); #line 633 // 633 expr(incrp) dump("", "PSH", "U", "B"); #line 634 // 634 dump("", "PSH", "U", "B") expr(incrp); #line 635 // 635 expr(initp) dump("", "PSH", "U", "B"); #line 636 // 636 dump("", "SUB", "B", ",U") expr(initp); #line 637 // 637 dump("", "ST", "B", "[2,U]") dump("", "SUB", "B", ",U"); #line 638 // 638 dump("L" . s(cyclab), "EQU", "", "*") dump("", "ST", "B", "[2,U]"); #line 639 // 639 dump("", "LD", "B", "[2,U]") dump("L", "EQU", "", "*"); #line 640 // 640 dump("", "CMP", "B", "1,U") dump("", "LD", "B", "[2,U]"); #line 641 // 641 dump("", "LBEQ", "", "L" . s(extlab)) dump("", "CMP", "B", "1,U"); #line 642 // 642 dump("", "ADD", "B", ",U") dump("", "LBEQ", "", "L"); #line 643 // 643 dump("", "ST", "B", "[2,U]") dump("", "ADD", "B", ",U"); #line 644 // 644 %return dump("", "ST", "B", "[2,U]"); #line 645 // 645 cycle(*): return; #line 646 // 646 cycle_2: cycle_3: #line 648 // 647 dump("L" . s(cyclab), "EQU", "", "*") // 648 %return %if a(loopsp) # 2 dump("L", "EQU", "", "*"); #line 649 // 649 whilep = a(loopsp + 1) if (a[loopsp] == 2) goto L_0099; return; L_0099: #line 650 // 650 condp = a(whilep + 1) whilep = a[(loopsp + 1)]; #line 651 // 651 tplabel = cond(condp, -1, extlab) condp = a[(whilep + 1)]; #line 652 // 652 %end tplabel = cond(condp, (-1), extlab); #line 653 // 653 %end L_0086: #line 654 // 654 %end %of %file #line 655