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