1 /*- 2 * %sccs.include.proprietary.c% 3 */ 4 5 #ifndef lint 6 static char sccsid[] = "@(#)rlex.c 8.1 (Berkeley) 06/06/93"; 7 #endif /* not lint */ 8 9 # include "r.h" 10 11 char *keyword [] = { 12 "do", 13 "if", 14 "else", 15 "for", 16 "repeat", 17 "until", 18 "while", 19 "break", 20 "next", 21 "define", 22 "include", 23 "return", 24 "switch", 25 "case", 26 "default", 27 0}; 28 29 int keytran[] = { 30 DO, 31 IF, 32 ELSE, 33 FOR, 34 REPEAT, 35 UNTIL, 36 WHILE, 37 BREAK, 38 NEXT, 39 DEFINE, 40 INCLUDE, 41 RETURN, 42 SWITCH, 43 CASE, 44 DEFAULT, 45 0}; 46 47 char *fcnloc; /* spot for "function" */ 48 49 int svargc; 50 char **svargv; 51 char *curfile[10] = { "" }; 52 int infptr = 0; 53 FILE *outfil = { stdout }; 54 FILE *infile[10] = { stdin }; 55 int linect[10]; 56 57 int contfld = CONTFLD; /* place to put continuation char */ 58 int printcom = 0; /* print comments if on */ 59 int hollerith = 0; /* convert "..." to 27H... if on */ 60 61 #ifdef gcos 62 char *ratfor "tssrat"; 63 int bcdrat[2]; 64 char *bwkmeter ". bwkmeter "; 65 int bcdbwk[5]; 66 #endif 67 68 main(argc,argv) int argc; char **argv; { 69 int i; 70 while(argc>1 && argv[1][0]=='-') { 71 if(argv[1][1]=='6') { 72 contfld=6; 73 if (argv[1][2]!='\0') 74 contchar = argv[1][2]; 75 } else if (argv[1][1] == 'C') 76 printcom++; 77 else if (argv[1][1] == 'h') 78 hollerith++; 79 argc--; 80 argv++; 81 } 82 83 #ifdef gcos 84 if (!intss()) { 85 _fixup(); 86 ratfor = "batrat"; 87 } 88 ascbcd(ratfor,bcdrat,6); 89 ascbcd(bwkmeter,bcdbwk,24); 90 acdata(bcdrat[0],1); 91 acupdt(bcdbwk[0]); 92 if (!intss()) { 93 if ((infile[infptr]=fopen("s*", "r")) == NULL) 94 cant("s*"); 95 if ((outfil=fopen("*s", "w")) == NULL) 96 cant("*s"); 97 } 98 #endif 99 100 svargc = argc; 101 svargv = argv; 102 if (svargc > 1) 103 putbak('\0'); 104 for (i=0; keyword[i]; i++) 105 install(keyword[i], "", keytran[i]); 106 fcnloc = install("function", "", 0); 107 yyparse(); 108 #ifdef gcos 109 if (!intss()) 110 bexit(errorflag); 111 #endif 112 exit(errorflag); 113 } 114 115 #ifdef gcos 116 bexit(status) { 117 /* this is the batch version of exit for gcos tss */ 118 FILE *inf, *outf; 119 char c; 120 121 fclose(stderr); /* make sure diagnostics get flushed */ 122 if (status) /* abort */ 123 _nogud(); 124 125 /* good: copy output back to s*, call forty */ 126 127 fclose(outfil,"r"); 128 fclose(infile[0],"r"); 129 inf = fopen("*s", "r"); 130 outf = fopen("s*", "w"); 131 while ((c=getc(inf)) != EOF) 132 putc(c, outf); 133 fclose(inf,"r"); 134 fclose(outf,"r"); 135 __imok(); 136 } 137 #endif 138 139 cant(s) char *s; { 140 linect[infptr] = 0; 141 curfile[infptr] = s; 142 error("can't open"); 143 exit(1); 144 } 145 146 inclstat() { 147 int c; 148 char *ps; 149 char fname[100]; 150 while ((c = getchr()) == ' ' || c == '\t'); 151 if (c == '(') { 152 for (ps=fname; (*ps=getchr()) != ')'; ps++); 153 *ps = '\0'; 154 } else if (c == '"' || c == '\'') { 155 for (ps=fname; (*ps=getchr()) != c; ps++); 156 *ps = '\0'; 157 } else { 158 putbak(c); 159 for (ps=fname; (*ps=getchr()) != ' ' &&*ps!='\t' && *ps!='\n' && *ps!=';'; ps++); 160 *ps = '\0'; 161 } 162 if ((infile[++infptr] = fopen(fname,"r")) == NULL) { 163 cant(fname); 164 exit(1); 165 } 166 linect[infptr] = 0; 167 curfile[infptr] = fname; 168 } 169 170 char str[500]; 171 int nstr; 172 173 yylex() { 174 int c, t; 175 for (;;) { 176 while ((c=gtok(str))==' ' || c=='\n' || c=='\t') 177 ; 178 yylval = c; 179 if (c==';' || c=='{' || c=='}') 180 return(c); 181 if (c==EOF) 182 return(0); 183 yylval = (int) str; 184 if (c == DIG) 185 return(DIGITS); 186 t = lookup(str)->ydef; 187 if (t==DEFINE) 188 defstat(); 189 else if (t==INCLUDE) 190 inclstat(); 191 else if (t > 0) 192 return(t); 193 else 194 return(GOK); 195 } 196 } 197 198 int dbg = 0; 199 200 yyerror(p) char *p; {;} 201 202 203 defstat() { 204 int c,i,val,t,nlp; 205 extern int nstr; 206 extern char str[]; 207 while ((c=getchr())==' ' || c=='\t'); 208 if (c == '(') { 209 t = '('; 210 while ((c=getchr())==' ' || c=='\t'); 211 putbak(c); 212 } 213 else { 214 t = ' '; 215 putbak(c); 216 } 217 for (nstr=0; c=getchr(); nstr++) { 218 if (type[c] != LET && type[c] != DIG) 219 break; 220 str[nstr] = c; 221 } 222 putbak(c); 223 str[nstr] = '\0'; 224 if (c != ' ' && c != '\t' && c != '\n' && c != ',') { 225 error("illegal define statement"); 226 return; 227 } 228 val = nstr+1; 229 if (t == ' ') { 230 while ((c=getchr())==' ' || c=='\t'); 231 putbak(c); 232 for (i=val; (c=getchr())!='\n' && c!='#' && c!='\0'; i++) 233 str[i] = c; 234 putbak(c); 235 } else { 236 while ((c=getchr())==' ' || c=='\t' || c==',' || c=='\n'); 237 putbak(c); 238 nlp = 0; 239 for (i=val; nlp>=0 && (c=str[i]=getchr()); i++) 240 if (c == '(') 241 nlp++; 242 else if (c == ')') 243 nlp--; 244 i--; 245 } 246 for ( ; i>0; i--) 247 if (str[i-1] != ' ' && str[i-1] != '\t') 248 break; 249 str[i] = '\0'; 250 install(str, &str[val], 0); 251 } 252 253