1 /* @(#)r1.c 1.2 (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 transfer = 0; 251 } 252 if (nonblank(bp)){ 253 outtab(); 254 outcode(bp); 255 outdon(); 256 } 257 outgoto(p1); 258 indent--; 259 putcom("endfor"); 260 outcont(p1+2); 261 for (q=bp; *q++;); 262 free(bp); 263 brkptr--; 264 } 265 266 retcode() { 267 register c; 268 if ((c = gnbtok(scrat)) != '\n' && c != ';' && c != '}') { 269 pbstr(scrat); 270 outtab(); 271 outcode(fcname); 272 outcode(" = "); 273 eatup(); 274 outdon(); 275 } 276 else if (c == '}') 277 pbstr(scrat); 278 outtab(); 279 outcode("return"); 280 outdon(); 281 transfer = 1; 282 } 283 284 docode() { 285 transfer = 0; 286 outtab(); 287 outcode("do "); 288 yyval = genlab(2); 289 brkstk[++brkptr] = yyval; 290 typestk[brkptr] = DO; 291 brkused[brkptr] = 0; 292 outnum(yyval); 293 eatup(); 294 outdon(); 295 indent++; 296 } 297 298 dostat(p1) int p1; { 299 outcont(p1); 300 indent--; 301 if (wasbreak) 302 outcont(p1+1); 303 brkptr--; 304 } 305 306 #ifdef gcos 307 #define atoi(s) (*s-'0') /* crude!!! */ 308 #endif 309 310 breakcode() { 311 int level, t; 312 313 level = 0; 314 if ((t=gnbtok(scrat)) == DIG) 315 level = atoi(scrat) - 1; 316 else if (t != ';') 317 pbstr(scrat); 318 if (brkptr-level < 0) 319 error("illegal BREAK"); 320 else { 321 outgoto(brkstk[brkptr-level]+1); 322 brkused[brkptr-level] |= 1; 323 } 324 transfer = 1; 325 } 326 327 nextcode() { 328 int level, t; 329 330 level = 0; 331 if ((t=gnbtok(scrat)) == DIG) 332 level = atoi(scrat) - 1; 333 else if (t != ';') 334 pbstr(scrat); 335 if (brkptr-level < 0) 336 error("illegal NEXT"); 337 else { 338 outgoto(brkstk[brkptr-level]); 339 brkused[brkptr-level] |= 2; 340 } 341 transfer = 1; 342 } 343 344 nonblank(s) char *s; { 345 int c; 346 while (c = *s++) 347 if (c!=' ' && c!='\t' && c!='\n') 348 return(1); 349 return(0); 350 } 351 352 int errorflag = 0; 353 354 error(s1) char *s1; { 355 if (errorflag == 0) 356 fprintf(stderr, "ratfor:"); 357 fprintf(stderr, "error at line %d, file %s: ",linect[infptr],curfile[infptr]); 358 fprintf(stderr, s1); 359 fprintf(stderr, "\n"); 360 errorflag = 1; 361 } 362 363 errcode() { 364 int c; 365 if (errorflag == 0) 366 fprintf(stderr, "******\n"); 367 fprintf(stderr, "*****F ratfor:"); 368 fprintf(stderr, "syntax error, line %d, file %s\n", linect[infptr], curfile[infptr]); 369 while ((c=getchr())!=';' && c!='}' && c!='\n' && c!=EOF && c!='\0') 370 ; 371 if (c == EOF || c == '\0') 372 putbak(c); 373 errorflag = 1; 374 } 375