/* 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 SKIMPC 23/01/80 16.41 // 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 %spec condopt // 5 !----------------------------------------------------------------------- extern int /*spec*/ condopt; #line 7 // 6 %external %routine %spec expr(%integer exprp) // 7 %external %routine %spec dump(%string (7) lab, op, reg, addr) extern void expr(int exprp); #line 8 // 8 %external %routine %spec filllabel(%integer label) extern void dump(char *lab, char *op, char *reg, char *addr); #line 9 // 9 %external %integer %fn %spec fillbranch(%integer label) extern void filllabel(int label); #line 10 // 10 %external %integer %fn %spec nextplabel extern int fillbranch(int label); #line 11 // 11 %external %routine %spec fault(%string (63) mess) extern int nextplabel(); #line 12 // 12 %external %string (7) %fn %spec s(%integer i) extern void fault(char *mess); #line 13 // 13 !----------------------------------------------------------------------- extern char * s(int i); #line 15 // 14 %external %integer condflag = 0 // 15 !----------------------------------------------------------------------- extern int condflag; #line 17 // 16 %external %integer %fn cond(%integer condp, tlabel, flabel) // 17 %routine %spec processcond(%integer condp) extern int cond(int condp, int tlabel, int flabel) { #line 18 // 18 %routine %spec test(%integer ltestp) void processcond(int condp); #line 19 // 19 %routine %spec condrest(%integer condrestp) void test(int ltestp); #line 20 // 20 %routine %spec store(%integer testp, level, andor) void condrest(int condrestp); #line 21 // 21 %routine %spec show(%string (7) an, %integer %array %name a, %integer p) void store(int testp, int level, int andor); #line 22 // 22 %const %string (4) %array true(1 : 6) = %c void show(char *an, int * /*12*/ a, int p); #line 23 // 23 "LBEQ", "LBNE", "LBLE", "LBLT", "LBGE", "LBGT" // bounds [1 : 6] // do it now: const char * *true {NO INIT} #line 26 // 24 // 25 %const %string (4) %array false(1 : 6) = %c // 26 "LBNE", "LBEQ", "LBGT", "LBGE", "LBLT", "LBLE" // bounds [1 : 6] // do it now: const char * *false {NO INIT} #line 29 // 27 // 28 %string (4) opn // 29 %const %integer %array index(1 : 17) = %c char *opn; #line 30 // 30 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17 // bounds [1 : 17] // do it now: const int *index {NO INIT} #line 33 // 31 // 32 %integer %array testpa, levela, andora, brancha(1 : 16), labela(1 : 17) // 33 %integer p, pp, ppp, testp, level, andor, comp // ON DIM DO: int *testpa // ON DIM DO: int *levela // ON DIM DO: int *andora // ON DIM DO: int *brancha int *brancha = ARRAY(int , brancha, 1, 1, 16) DIM 0x0001 0x0004 int *andora = ARRAY(int , andora, 1, 1, 16) DIM 0x0001 0x0004 int *levela = ARRAY(int , levela, 1, 1, 16) DIM 0x0001 0x0004 int *testpa = ARRAY(int , testpa, 1, 1, 16) DIM 0x0001 0x0004 // ON DIM DO: int *labela int *labela = ARRAY(int , labela, 1, 1, 17) DIM 0x0001 0x0001 #line 34 // 34 level = 0 int p; int pp; int ppp; int testp; int level; int andor; int comp; #line 35 // 35 p = 1 level = 0; #line 36 // 36 processcond(condp) p = 1; #line 37 // 37 store(testp, -1, 1) processcond(condp); #line 38 // 38 ! pseudo-%and store(testp, (-1), 1); #line 40 // 39 store(0, -2, 2) // 40 ! pseudo-%or store(0, (-2), 2); #line 42 // 41 p = p - 2 // 42 %for pp = 1, 1, p %cycle p = (p - 2); #line 43 // 43 ! find branch destinations for (pp = 1; pp += 1; pp != p) { #line 45 // 44 level = levela(pp) // 45 andor = andora(pp) level = levela[pp]; #line 46 // 46 %for ppp = pp + 1, 1, p + 1 %cycle andor = andora[pp]; #line 47 // 47 %if levela(ppp) < level %then %start for (ppp = (pp + 1); ppp += 1; ppp != (p + 1)) { #line 48 // 48 level = levela(ppp) if (levela[ppp] >= level) goto L_0009; #line 49 // 49 %if andora(ppp) # andor %then %exit level = levela[ppp]; #line 50 // 50 %finish if (andora[ppp] == andor) goto L_000a; goto L_0008; L_000a: #line 51 // 51 %repeat L_0009: #line 52 // 52 brancha(pp) = ppp + 1 } L_0008: #line 53 // 53 %repeat brancha[pp] = (ppp + 1); #line 54 // 54 %if tlabel >= 0 %then %start } L_0004: #line 55 // 55 andora(p) = 2 if (tlabel < 0) goto L_000b; #line 56 // 56 ! change last branch to branch on true andora[p] = 2; #line 58 // 57 brancha(p) = p + 1 // 58 labela(p + 1) = tlabel brancha[p] = (p + 1); #line 59 // 59 %finish labela[(p + 1)] = tlabel; #line 60 // 60 labela(p + 2) = flabel L_000b: #line 61 // 61 %for pp = 1, 1, p %cycle labela[(p + 2)] = flabel; #line 62 // 62 ! assign private labels where needed for (pp = 1; pp += 1; pp != p) { #line 64 // 63 %if labela(brancha(pp)) < 0 %then labela(brancha(pp)) = nextplabel // 64 %repeat if (labela[brancha[pp]] >= 0) goto L_0010; labela[brancha[pp]] = nextplabel(); L_0010: #line 65 // 65 %if condopt = 1 %then %start } L_000f: #line 66 // 66 newline if (condopt != 1) goto L_0011; #line 67 // 67 show(" ", index, p + 2) newline(); #line 68 // 68 show("TESTP ", testpa, p) show(" ", index, (p + 2)); #line 69 // 69 show("LEVEL ", levela, p + 1) show("TESTP ", testpa, p); #line 70 // 70 show("ANDOR ", andora, p + 1) show("LEVEL ", levela, (p + 1)); #line 71 // 71 show("BRANCH", brancha, p) show("ANDOR ", andora, (p + 1)); #line 72 // 72 show("LABEL ", labela, p + 2) show("BRANCH", brancha, p); #line 73 // 73 newline show("LABEL ", labela, (p + 2)); #line 74 // 74 %finish newline(); #line 75 // 75 %for pp = 1, 1, p %cycle L_0011: #line 76 // 76 ! generate test code and fill labels for (pp = 1; pp += 1; pp != p) { #line 78 // 77 %if labela(pp) >= 0 %then filllabel(labela(pp)) // 78 condflag = 1 if (labela[pp] < 0) goto L_0016; filllabel(labela[pp]); L_0016: #line 79 // 79 expr(testpa(pp)) condflag = 1; #line 80 // 80 comp = a(a(testpa(pp) + 2)) expr(testpa[pp]); #line 81 // 81 %if andora(pp) = 1 %then opn = false(comp) %else opn = true(comp) comp = a[a[(testpa[pp] + 2)]]; #line 82 // 82 dump("", opn, "", "L" . s(labela(brancha(pp)))) if (andora[pp] != 1) goto L_0017; strncpy(opn,false[comp],4+1); goto L_0018; L_0017: strncpy(opn,true[comp],4+1); L_0018: #line 83 // 83 %repeat dump("", opn, "", "L"); #line 84 // 84 %if labela(p + 1) >= 0 %and tlabel < 0 %then filllabel(labela(p + 1)) } L_0015: #line 85 // 85 %if flabel >= 0 %then %result = -1 %else %result = labela(p + 2) if (labela[(p + 1)] < 0) goto L_0019; if (tlabel >= 0) goto L_0019; filllabel(labela[(p + 1)]); L_0019: #line 86 // 86 !----------------------------------------------------------------------- if (flabel < 0) goto L_001a; return((-1)); L_001a: return(labela[(p + 2)]); #line 88 // 87 %routine processcond(%integer condp) // 88 test(a(condp + 1)) goto L_001b; void processcond(int condp) { #line 89 // 89 condrest(a(condp + 2)) test(a[(condp + 1)]); #line 90 // 90 %end condrest(a[(condp + 2)]); #line 91 // 91 !----------------------------------------------------------------------- L_001b: #line 93 // 92 %routine test(%integer ltestp) // 93 %if a(ltestp) = 1 %then testp = ltestp %c goto L_001c; void test(int ltestp) { #line 94 // 94 %else level = level + 1 %and processcond(a(ltestp + 1)) %and level = level - 1 if (a[ltestp] != 1) goto L_001d; testp = ltestp; goto L_001e; L_001d: level = (level + 1); processcond(a[(ltestp + 1)]); level = (level - 1); L_001e: #line 96 // 95 %end // 96 !----------------------------------------------------------------------- L_001c: #line 98 // 97 %routine condrest(%integer condrestp) // 98 %integer andor goto L_001f; void condrest(int condrestp) { #line 99 // 99 andor = a(condrestp) int andor; #line 100 // 100 %unless andor = 3 %then %start andor = a[condrestp]; #line 101 // 101 store(testp, level, andor) %and test(a(condrestp + 1)) %and %c if (andor == 3) goto L_0020; #line 102 // 102 condrestp = a(condrestp + 2) %until a(condrestp) = 2 for (;;) { L_0021: store(testp, level, andor); test(a[(condrestp + 1)]); condrestp = a[(condrestp + 2)]; if (a[condrestp] == 2) goto L_0022; } L_0022: #line 104 // 103 %finish // 104 %end L_0020: #line 105 // 105 !----------------------------------------------------------------------- L_001f: #line 107 // 106 %routine store(%integer testp, level, andor) // 107 %if p > 16 %then fault("CONDITION TOO LONG") %and %stop goto L_0023; void store(int testp, int level, int andor) { #line 108 // 108 testpa(p) = testp if (p <= 16) goto L_0024; fault("CONDITION TOO LONG"); exit(0); L_0024: #line 109 // 109 levela(p) = level testpa[p] = testp; #line 110 // 110 andora(p) = andor levela[p] = level; #line 111 // 111 labela(p) = -1 andora[p] = andor; #line 112 // 112 p = p + 1 labela[p] = (-1); #line 113 // 113 %end p = (p + 1); #line 114 // 114 !----------------------------------------------------------------------- L_0023: #line 116 // 115 %routine show(%string (7) an, %integer %array %name a, %integer p) // 116 %integer pp goto L_0025; void show(char *an, int * /*12*/ a, int p) { #line 117 // 117 printstring(an . " ") int pp; #line 118 // 118 %for pp = 1, 1, p %cycle printstring(an); #line 119 // 119 write(a(pp), 5) for (pp = 1; pp += 1; pp != p) { #line 120 // 120 %repeat write(a[pp], 5); #line 121 // 121 newline } L_0029: #line 122 // 122 %end newline(); #line 123 // 123 %end L_0025: #line 124 // 124 %end %of %file #line 125