/* 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 5 // 1 !Graham Toal - last working version of SKIMPA 10/02/81 11.57 // 2 // 3 !!%external %string (127) %fn %spec cliparam // 4 %external %integer %fn %spec outstream // 5 %external %routine %spec resetinput extern int outstream(); #line 6 // 6 %external %routine %spec closeinput extern void resetinput(); #line 7 // 7 %external %routine %spec closeoutput extern void closeinput(); #line 8 // 8 %external %routine %spec openinput(%integer stream, %string (255) file) extern void closeoutput(); #line 9 // 9 %external %routine %spec openoutput(%integer stream, %string (255) file) extern void openinput(int stream, char *file); #line 10 // 10 %const %string (1) snl = " extern void openoutput(int stream, char *file); #line 11 // 11 " const char *snl; #line 14 // 12 // 13 %external %integer %spec faults // 14 extern int /*spec*/ faults; #line 16 // 15 %routine do(%string (127) text) // 16 !?%EXTERNALROUTINESPEC M6809 void do(char *text) { #line 20 // 17 !! For invoking assembler after successful compilation... // 18 ! system(text) // 19 printstring(text); newline // 20 %end printstring(text); #line 20 newline(); #line 21 // 21 #line 23 // 22 %external %integer %array a(1 : 500) // 23 // bounds [1 : 500] // do it now: extern int *a; /* uninitialised */ #line 26 // 24 ! initialisation for i/o routines // 25 %external %byte %integer %array named(1 : 1024) = %c // 26 10, 'R', 'E', 'A', 'D', 'S', 'Y', 'M', 'B', 'O', 'L', // bounds [1 : 1024] // do it now: extern char *named {NO INIT} #line 40 // 27 10, 'N', 'E', 'X', 'T', 'S', 'Y', 'M', 'B', 'O', 'L', // 28 10, 'S', 'K', 'I', 'P', 'S', 'Y', 'M', 'B', 'O', 'L', // 29 11, 'P', 'R', 'I', 'N', 'T', 'S', 'Y', 'M', 'B', 'O', 'L', // 30 5, 'S', 'P', 'A', 'C', 'E', // 31 6, 'S', 'P', 'A', 'C', 'E', 'S', // 32 7, 'N', 'E', 'W', 'L', 'I', 'N', 'E', // 33 8, 'N', 'E', 'W', 'L', 'I', 'N', 'E', 'S', // 34 7, 'N', 'E', 'W', 'P', 'A', 'G', 'E', // 35 4, 'R', 'E', 'A', 'D', // 36 5, 'W', 'R', 'I', 'T', 'E', // 37 0(930) // 38 // 39 %external %integer %array namedlink(0 : 255) = 0, 76, 0(12), 89, 0(54), 84, // 40 0(118), 52, 0(11), 1, 12, 23, 34, 0(4), 67, 0(23), 46, 0(5), 59, 0(17) // bounds [0 : 255] // do it now: extern int *namedlink {NO INIT} #line 43 // 41 // 42 %external %integer %array taglink(0 : 255) = 0, 13, 0(12), 16, 0(54), 14, // 43 0(118), 8, 0(11), 1, 3, 4, 5, 0(4), 11, 0(23), 7, 0(5), 10, 0(17) // bounds [0 : 255] // do it now: extern int *taglink {NO INIT} #line 46 // 44 // 45 %external %integer %array tag(1 : 512) = 16_40100001, 16_11010002, 16_41000002, // 46 16_40000003, 16_40100004, 16_01010002, 16_40000005, 16_40100006, 16_01010002, // bounds [1 : 512] // do it now: extern int *tag {NO INIT} #line 51 // 47 16_40000007, 16_40100008, 16_01010002, 16_40000009, 16_4010000A, 16_11010002, // 48 16_4020000B, 16_01010002, 16_01010003, 0(494) // 49 // 50 %external %integer %array link(1 : 512) = 2, 0, 0, 0, 6, 0, 0, 9, 0, 0, 12, 0, // 51 0, 15, 0, 17, 18, 0, 0(494) // bounds [1 : 512] // do it now: extern int *link {NO INIT} #line 54 // 52 // 53 %external %integer namedp = 95 // 54 %external %integer tagasl = 19 extern int namedp; #line 55 // 55 %external %integer expropt = 0 extern int tagasl; #line 56 // 56 %external %integer condopt = 0 extern int expropt; #line 57 // 57 %external %integer tagsopt = 0 extern int condopt; #line 58 // 58 %external %integer traceopt = 0 extern int tagsopt; #line 59 // 59 %external %integer checkopt = 0 extern int traceopt; #line 60 // 60 %external %integer infoopt = 0 extern int checkopt; #line 61 // 61 !----------------------------------------------------------------------- extern int infoopt; #line 63 // 62 %external %routine %spec statement(%integer statementp) // 63 %external %string (255) %fn %spec strint(%integer n, p) extern void statement(int statementp); #line 64 // 64 %external %routine %spec fault(%string (63) mess) extern char * strint(int n, int p); #line 65 // 65 %external %routine %spec dump(%string (7) opn, reg, base, %integer disp) extern void fault(char *mess); #line 66 // 66 %external %string (255) %fn %spec name(%integer ident) extern void dump(char *opn, char *reg, char *base, int disp); #line 67 // 67 !----------------------------------------------------------------------- extern char * name(int ident); #line 69 // 68 %external %routine skimp(%string (255) cliparam) // 69 %string (63) s, param extern void skimp(char *cliparam) { #line 70 // 70 %routine %spec readps char *s; char *param; #line 71 // 71 %routine %spec readstatement void readps(); #line 72 // 72 %routine %spec rpsym(%integer %name l) void readstatement(); #line 73 // 73 %integer %fn %spec findk(%string (*) %name k) void rpsym(int *l); #line 74 // 74 %integer %fn %spec compare(%integer p) int findk(char * *k); #line 75 // 75 %record %format kdf(%byte %integer l, n, a, b) int compare(int p); #line 76 // 76 %record (kdf) %array kd(1 : 255) typedef struct KDF{char l; char n; char a; char b;} kdf; #line 77 // 77 %string (15) %array pn(256 : 319) // ON DIM DO: struct KDF *kd struct KDF *kd = ARRAY(struct KDF , kd, 1, 1, 255) DIM 0x0001 0x0001 #line 78 // 78 %integer %array pp(256 : 319) // ON DIM DO: char * *pn char * *pn = ARRAY(char * , pn, 1, 256, 319) DIM 0x0001 0x0001 #line 79 // 79 %integer %array ps(1 : 512) // ON DIM DO: int *pp int *pp = ARRAY(int , pp, 1, 256, 319) DIM 0x0001 0x0001 #line 80 // 80 %integer %array t, tt(1 : 256) // ON DIM DO: int *ps int *ps = ARRAY(int , ps, 1, 1, 512) DIM 0x0001 0x0001 #line 81 // 81 %integer tp, ap, ttp, i, j, psflag // ON DIM DO: int *t // ON DIM DO: int *tt int *tt = ARRAY(int , tt, 1, 1, 256) DIM 0x0001 0x0002 int *t = ARRAY(int , t, 1, 1, 256) DIM 0x0001 0x0002 #line 82 // 82 %string (63) file, options, option, as int tp; int ap; int ttp; int i; int j; int psflag; #line 83 // 83 %own %integer lexopt = 0 char *file; char *options; char *option; char *as; #line 84 // 84 %own %integer analopt = 0 static int lexopt; #line 85 // 85 %own %integer codeopt = 1 static int analopt; #line 86 // 86 %own %integer listopt = 1 static int codeopt; #line 87 // 87 %own %integer assmopt = 0 static int listopt; #line 88 // 88 %own %integer shift = 32 static int assmopt; #line 89 // 89 %own %string (63) assopt = "" static int shift; #line 90 // 90 s = cliparam static char *assopt; #line 91 // 91 %if s -> ("/") . options %then %start strncpy(s,cliparam,63+1); #line 92 // 92 %unless options -> options . (" ") . file %then file = "" /* TODO */ RESOLVE 00 ? <5> if (!(options)) goto L_0001; #line 93 // 93 %cycle /* TODO */ RESOLVE 00 ? <7> if (file) goto L_0002; strncpy(file,"",63+1); L_0002: #line 94 // 94 %unless options -> option . ("/") . options %then %c for (;;) { L_0003: #line 95 // 95 option = options %and options = "" /* TODO */ RESOLVE 00 ? <7> if (options) goto L_0004; strncpy(option,options,63+1); strncpy(options,"",63+1); L_0004: #line 97 // 96 %if option -> ("NO") . option %then i = 0 %else i = 1 // 97 %if option = "LEX" %then lexopt = i %and %continue %c /* TODO */ RESOLVE 00 ? <5> if (!(option)) goto L_0005; i = 0; goto L_0006; L_0005: i = 1; L_0006: #line 98 // 98 %else %if option = "ANAL" %then analopt = i %and %continue %c if (option != "LEX") goto L_0007; lexopt = i; goto L_0008; L_0007: if (option != "ANAL") goto L_0009; analopt = i; goto L_0008; L_0009: if (option != "EXPR") goto L_000a; expropt = i; goto L_0008; L_000a: if (option != "COND") goto L_000b; condopt = i; goto L_0008; L_000b: if (option != "TAGS") goto L_000c; tagsopt = i; goto L_0008; L_000c: #line 103 // 99 %else %if option = "EXPR" %then expropt = i %and %continue %c // 100 %else %if option = "COND" %then condopt = i %and %continue %c // 101 %else %if option = "TAGS" %then tagsopt = i %and %continue %else %start // 102 %if option -> ("OPT=") . assopt %then assmopt = i %and %continue %c // 103 %else %if option = "TRACE" %then traceopt = i %and %continue %c /* TODO */ RESOLVE 00 ? <5> if (!(assopt)) goto L_000d; assmopt = i; goto L_0008; L_000d: if (option != "TRACE") goto L_000e; traceopt = i; goto L_0008; L_000e: if (option != "CHECK") goto L_000f; checkopt = i; goto L_0008; L_000f: if (option != "LIST") goto L_0010; listopt = i; goto L_0008; L_0010: if (option != "CODE") goto L_0011; codeopt = i; goto L_0008; L_0011: if (option != "INFO") goto L_0012; infoopt = i; goto L_0008; L_0012: #line 109 // 104 %else %if option = "CHECK" %then checkopt = i %and %continue %c // 105 %else %if option = "LIST" %then listopt = i %and %continue %c // 106 %else %if option = "CODE" %then codeopt = i %and %continue %c // 107 %else %if option = "INFO" %then infoopt = i %and %continue // 108 %finish // 109 printstring(option . " OPTION ? #line 110 // 110 ") printstring(option); #line 112 // 111 %stop // 112 %repeat %until options = "" exit(0); #line 113 // 113 %finish %else file = s L_0008: if (options == "") goto L_0013; } L_0013: #line 114 // 114 %begin goto L_0014; L_0001: strncpy(file,s,63+1); L_0014: #line 115 // 115 %on %event 9, 13 %start int main(int argc, char **argv) { #line 116 // 116 closeinput if (imp_onevent(0x2200)) goto L_0015 /* returns FALSE during longjump setup */ #line 117 // 117 closeoutput closeinput(); #line 118 // 118 printstring("FILE NOT FOUND - OR SOME OTHER ERROR!" . snl) ;! %if event_event = 9 closeoutput(); #line 119 // 119 %stop %if file = "" %or codeopt = listopt = 0 %or faults > 0 printstring("FILE NOT FOUND - OR SOME OTHER ERROR!"); #line 120 // 120 param = "" if (file == "") goto L_0016; if (codeopt != listopt) goto L_0017; if (listopt == 0) goto L_0016; L_0017: if (faults <= 0) goto L_0018; L_0016: exit(0); L_0018: #line 121 // 121 %if codeopt = 0 %then param = param . "/NOOBJECT" strncpy(param,"",63+1); #line 122 // 122 %if listopt = 1 %then param = param . "/LIST" if (codeopt != 0) goto L_0019; strncpy(param,param,63+1); L_0019: #line 123 // 123 do("ass68 " . file . " " . param) if (listopt != 1) goto L_001a; strncpy(param,param,63+1); L_001a: #line 124 // 124 %stop do("ass68 "); #line 125 // 125 %finish exit(0); #line 126 // 126 readps L_0015: #line 127 // 127 %if file = "" %then openoutput(1, "/dev/stdout") %else openoutput(1, file . ".asm") readps(); #line 128 // 128 selectoutput(1) if (file != "") goto L_001b; openoutput(1, "/dev/stdout"); goto L_001c; L_001b: openoutput(1, file); L_001c: #line 129 // 129 printstring(" NAM " . file . snl) %if file # "" selectoutput(1); #line 130 // 130 printstring(" OPT " . assopt . snl) %if assmopt = 1 if (file == "") goto L_001d; printstring(" NAM "); L_001d: #line 131 // 131 printstring(" if (assmopt != 1) goto L_001e; printstring(" OPT "); L_001e: #line 132 // 132 * File: " . file . " printstring(" * File: "); #line 135 // 133 * Options: ") // 134 %if lexopt = 1 %then printstring("/LEX ") // 135 %if analopt = 1 %then printstring("/ANAL ") if (lexopt != 1) goto L_001f; printstring("/LEX "); L_001f: #line 136 // 136 %if expropt = 1 %then printstring("/EXPR ") if (analopt != 1) goto L_0020; printstring("/ANAL "); L_0020: #line 137 // 137 %if condopt = 1 %then printstring("/COND ") if (expropt != 1) goto L_0021; printstring("/EXPR "); L_0021: #line 138 // 138 %if tagsopt = 1 %then printstring("/TAGS ") if (condopt != 1) goto L_0022; printstring("/COND "); L_0022: #line 139 // 139 %if infoopt = 1 %then printstring("/INFO ") if (tagsopt != 1) goto L_0023; printstring("/TAGS "); L_0023: #line 140 // 140 %if traceopt = 1 %then printstring("/TRACE ") if (infoopt != 1) goto L_0024; printstring("/INFO "); L_0024: #line 141 // 141 %if checkopt = 1 %then printstring("/CHECK ") if (traceopt != 1) goto L_0025; printstring("/TRACE "); L_0025: #line 142 // 142 %if listopt = 0 %then printstring("/NOLIST ") if (checkopt != 1) goto L_0026; printstring("/CHECK "); L_0026: #line 143 // 143 %if codeopt = 0 %then printstring("/NOCODE ") if (listopt != 0) goto L_0027; printstring("/NOLIST "); L_0027: #line 144 // 144 %if assmopt = 1 %then printstring("/OPT=" . assopt) if (codeopt != 0) goto L_0028; printstring("/NOCODE "); L_0028: #line 145 // 145 newline if (assmopt != 1) goto L_0029; printstring("/OPT="); L_0029: #line 146 // 146 %if psflag # 0 %then fault("PHRASE STRUCTURE FAULTY") %and %stop newline(); #line 147 // 147 %if file = "" %then openinput(1, "/dev/stdout") %else openinput(1, file . ".imp") if (psflag == 0) goto L_002a; fault("PHRASE STRUCTURE FAULTY"); exit(0); L_002a: #line 148 // 148 selectinput(1) if (file != "") goto L_002b; openinput(1, "/dev/stdout"); goto L_002c; L_002b: openinput(1, file); L_002c: if (option *ERROR* "OPT=") goto L_002d; ? <'5'> ? <'0'> ? <32> ? <32>