4.3BSD - /usr/src/usr.bin/ratfor/r1.c

   1: #ifndef lint
   2: static char sccsid[] = "@(#)r1.c	1.3 (Berkeley) 8/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: }

Defined functions

Defined variables

Defined macros