1 /* @(#)r1.c 1.1 (Berkeley) 12/15/82 */ 2 #include "r.h" 3 4 #define wasbreak brkused[brkptr]==1 || brkused[brkptr]==3 5 #define wasnext brkused[brkptr]==2 || brkused[brkptr]==3 6 7 int transfer = 0; /* 1 if just finished retrun, break, next */ 8 9 char fcname[10]; 10 char scrat[500]; 11 12 int brkptr = -1; 13 int brkstk[10]; /* break label */ 14 int typestk[10]; /* type of loop construct */ 15 int brkused[10]; /* loop contains BREAK or NEXT */ 16 17 int forptr = 0; 18 char *forstk[10]; 19 20 repcode() { 21 transfer = 0; 22 outcont(0); 23 putcom("repeat"); 24 yyval = genlab(3); 25 indent++; 26 outcont(yyval); 27 brkstk[++brkptr] = yyval+1; 28 typestk[brkptr] = REPEAT; 29 brkused[brkptr] = 0; 30 } 31 32 untils(p1,un) int p1,un; { 33 outnum(p1+1); 34 outtab(); 35 if (un > 0) { 36 outcode("if(.not."); 37 balpar(); 38 outcode(")"); 39 } 40 transfer = 0; 41 outgoto(p1); 42 indent--; 43 if (wasbreak) 44 outcont(p1+2); 45 brkptr--; 46 } 47 48 ifcode() { 49 transfer = 0; 50 outtab(); 51 outcode("if(.not."); 52 balpar(); 53 outcode(")"); 54 outgoto(yyval=genlab(2)); 55 indent++; 56 } 57 58 elsecode(p1) { 59 outgoto(p1+1); 60 indent--; 61 putcom("else"); 62 indent++; 63 outcont(p1); 64 } 65 66 whilecode() { 67 transfer = 0; 68 outcont(0); 69 putcom("while"); 70 brkstk[++brkptr] = yyval = genlab(2); 71 typestk[brkptr] = WHILE; 72 brkused[brkptr] = 0; 73 outnum(yyval); 74 outtab(); 75 outcode("if(.not."); 76 balpar(); 77 outcode(")"); 78 outgoto(yyval+1); 79 indent++; 80 } 81 82 whilestat(p1) int p1; { 83 outgoto(p1); 84 indent--; 85 putcom("endwhile"); 86 outcont(p1+1); 87 brkptr--; 88 } 89 90 balpar() { 91 register c, lpar; 92 while ((c=gtok(scrat)) == ' ' || c == '\t') 93 ; 94 if (c != '(') { 95 error("missing left paren"); 96 return; 97 } 98 outcode(scrat); 99 lpar = 1; 100 do { 101 c = gtok(scrat); 102 if (c==';' || c=='{' || c=='}' || c==EOF) { 103 pbstr(scrat); 104 break; 105 } 106 if (c=='(') 107 lpar++; 108 else if (c==')') 109 lpar--; 110 else if (c == '\n') { 111 while ((c = gtok(scrat)) == ' ' || c=='\t' || c=='\n') 112 ; 113 pbstr(scrat); 114 continue; 115 } 116 else if (c == '=' && scrat[1] == '\0') 117 error("assigment inside conditional"); 118 outcode(scrat); 119 } while (lpar > 0); 120 if (lpar != 0) 121 error("missing parenthesis"); 122 } 123 124 int labval = 23000; 125 126 genlab(n){ 127 labval += n; 128 return(labval-n); 129 } 130 131 gokcode(p1) { 132 transfer = 0; 133 outtab(); 134 outcode(p1); 135 eatup(); 136 outdon(); 137 } 138 139 eatup() { 140 int t, lpar; 141 char temp[100]; 142 lpar = 0; 143 do { 144 if ((t = gtok(scrat)) == ';' || t == '\n') 145 break; 146 if (t == '{' || t == '}' || t == EOF) { 147 pbstr(scrat); 148 break; 149 } 150 if (t == ',' || t == '+' || t == '-' || t == '*' || t == '(' 151 || t == '&' || t == '|' || t == '=') { 152 while (gtok(temp) == '\n') 153 ; 154 pbstr(temp); 155 } 156 if (t == '(') 157 lpar++; 158 else if (t==')') { 159 lpar--; 160 if (lpar < 0) { 161 error("missing left paren"); 162 return(1); 163 } 164 } 165 outcode(scrat); 166 } while (lpar >= 0); 167 if (lpar > 0) { 168 error("missing right paren"); 169 return(1); 170 } 171 return(0); 172 } 173 174 forcode(){ 175 int lpar, t; 176 char *ps, *qs; 177 178 transfer = 0; 179 outcont(0); 180 putcom("for"); 181 yyval = genlab(3); 182 brkstk[++brkptr] = yyval+1; 183 typestk[brkptr] = FOR; 184 brkused[brkptr] = 0; 185 forstk[forptr++] = malloc(1); 186 if ((t = gnbtok(scrat)) != '(') { 187 error("missing left paren in FOR"); 188 pbstr(scrat); 189 return; 190 } 191 if (gnbtok(scrat) != ';') { /* real init clause */ 192 pbstr(scrat); 193 outtab(); 194 if (eatup() > 0) { 195 error("illegal FOR clause"); 196 return; 197 } 198 outdon(); 199 } 200 if (gnbtok(scrat) == ';') /* empty condition */ 201 outcont(yyval); 202 else { /* non-empty condition */ 203 pbstr(scrat); 204 outnum(yyval); 205 outtab(); 206 outcode("if(.not.("); 207 for (lpar=0; lpar >= 0;) { 208 if ((t = gnbtok(scrat)) == ';') 209 break; 210 if (t == '(') 211 lpar++; 212 else if (t == ')') { 213 lpar--; 214 if (lpar < 0) { 215 error("missing left paren in FOR clause"); 216 return; 217 } 218 } 219 if (t != '\n') 220 outcode(scrat); 221 } 222 outcode("))"); 223 outgoto(yyval+2); 224 if (lpar < 0) 225 error("invalid FOR clause"); 226 } 227 ps = scrat; 228 for (lpar=0; lpar >= 0;) { 229 if ((t = gtok(ps)) == '(') 230 lpar++; 231 else if (t == ')') 232 lpar--; 233 if (lpar >= 0 && t != '\n') 234 while(*ps) 235 ps++; 236 } 237 *ps = '\0'; 238 qs = forstk[forptr-1] = malloc((unsigned)(ps-scrat+1)); 239 ps = scrat; 240 while (*qs++ = *ps++) 241 ; 242 indent++; 243 } 244 245 forstat(p1) int p1; { 246 char *bp, *q; 247 bp = forstk[--forptr]; 248 if (wasnext) 249 outnum(p1+1); 250 if (nonblank(bp)){ 251 outtab(); 252 outcode(bp); 253 outdon(); 254 } 255 outgoto(p1); 256 indent--; 257 putcom("endfor"); 258 outcont(p1+2); 259 for (q=bp; *q++;); 260 free(bp); 261 brkptr--; 262 } 263 264 retcode() { 265 register c; 266 if ((c = gnbtok(scrat)) != '\n' && c != ';' && c != '}') { 267 pbstr(scrat); 268 outtab(); 269 outcode(fcname); 270 outcode(" = "); 271 eatup(); 272 outdon(); 273 } 274 else if (c == '}') 275 pbstr(scrat); 276 outtab(); 277 outcode("return"); 278 outdon(); 279 transfer = 1; 280 } 281 282 docode() { 283 transfer = 0; 284 outtab(); 285 outcode("do "); 286 yyval = genlab(2); 287 brkstk[++brkptr] = yyval; 288 typestk[brkptr] = DO; 289 brkused[brkptr] = 0; 290 outnum(yyval); 291 eatup(); 292 outdon(); 293 indent++; 294 } 295 296 dostat(p1) int p1; { 297 outcont(p1); 298 indent--; 299 if (wasbreak) 300 outcont(p1+1); 301 brkptr--; 302 } 303 304 #ifdef gcos 305 #define atoi(s) (*s-'0') /* crude!!! */ 306 #endif 307 308 breakcode() { 309 int level, t; 310 311 level = 0; 312 if ((t=gnbtok(scrat)) == DIG) 313 level = atoi(scrat) - 1; 314 else if (t != ';') 315 pbstr(scrat); 316 if (brkptr-level < 0) 317 error("illegal BREAK"); 318 else { 319 outgoto(brkstk[brkptr-level]+1); 320 brkused[brkptr-level] |= 1; 321 } 322 transfer = 1; 323 } 324 325 nextcode() { 326 int level, t; 327 328 level = 0; 329 if ((t=gnbtok(scrat)) == DIG) 330 level = atoi(scrat) - 1; 331 else if (t != ';') 332 pbstr(scrat); 333 if (brkptr-level < 0) 334 error("illegal NEXT"); 335 else { 336 outgoto(brkstk[brkptr-level]); 337 brkused[brkptr-level] |= 2; 338 } 339 transfer = 1; 340 } 341 342 nonblank(s) char *s; { 343 int c; 344 while (c = *s++) 345 if (c!=' ' && c!='\t' && c!='\n') 346 return(1); 347 return(0); 348 } 349 350 int errorflag = 0; 351 352 error(s1) char *s1; { 353 if (errorflag == 0) 354 fprintf(stderr, "ratfor:"); 355 fprintf(stderr, "error at line %d, file %s: ",linect[infptr],curfile[infptr]); 356 fprintf(stderr, s1); 357 fprintf(stderr, "\n"); 358 errorflag = 1; 359 } 360 361 errcode() { 362 int c; 363 if (errorflag == 0) 364 fprintf(stderr, "******\n"); 365 fprintf(stderr, "*****F ratfor:"); 366 fprintf(stderr, "syntax error, line %d, file %s\n", linect[infptr], curfile[infptr]); 367 while ((c=getchr())!=';' && c!='}' && c!='\n' && c!=EOF && c!='\0') 368 ; 369 if (c == EOF || c == '\0') 370 putbak(c); 371 errorflag = 1; 372 } 373