1: #include "r.h"
   2: 
   3: #define wasbreak    brkused[brkptr]==1 || brkused[brkptr]==3
   4: #define wasnext brkused[brkptr]==2 || brkused[brkptr]==3
   5: 
   6: int transfer    = 0;    /* 1 if just finished retrun, break, next */
   7: 
   8: char    fcname[10];
   9: char    scrat[500];
  10: 
  11: int brkptr  = -1;
  12: int brkstk[10]; /* break label */
  13: int typestk[10];    /* type of loop construct */
  14: int brkused[10];    /* loop contains BREAK or NEXT */
  15: 
  16: int forptr  = 0;
  17: char    *forstk[10];
  18: 
  19: repcode() {
  20:     transfer = 0;
  21:     outcont(0);
  22:     putcom("repeat");
  23:     yyval = genlab(3);
  24:     indent++;
  25:     outcont(yyval);
  26:     brkstk[++brkptr] = yyval+1;
  27:     typestk[brkptr] = REPEAT;
  28:     brkused[brkptr] = 0;
  29: }
  30: 
  31: untils(p1,un) int p1,un; {
  32:     outnum(p1+1);
  33:     outtab();
  34:     if (un > 0) {
  35:         outcode("if(.not.");
  36:         balpar();
  37:         outcode(")");
  38:     }
  39:     transfer = 0;
  40:     outgoto(p1);
  41:     indent--;
  42:     if (wasbreak)
  43:         outcont(p1+2);
  44:     brkptr--;
  45: }
  46: 
  47: ifcode() {
  48:     transfer = 0;
  49:     outtab();
  50:     outcode("if(.not.");
  51:     balpar();
  52:     outcode(")");
  53:     outgoto(yyval=genlab(2));
  54:     indent++;
  55: }
  56: 
  57: elsecode(p1) {
  58:     outgoto(p1+1);
  59:     indent--;
  60:     putcom("else");
  61:     indent++;
  62:     outcont(p1);
  63: }
  64: 
  65: whilecode() {
  66:     transfer = 0;
  67:     outcont(0);
  68:     putcom("while");
  69:     brkstk[++brkptr] = yyval = genlab(2);
  70:     typestk[brkptr] = WHILE;
  71:     brkused[brkptr] = 0;
  72:     outnum(yyval);
  73:     outtab();
  74:     outcode("if(.not.");
  75:     balpar();
  76:     outcode(")");
  77:     outgoto(yyval+1);
  78:     indent++;
  79: }
  80: 
  81: whilestat(p1) int p1; {
  82:     outgoto(p1);
  83:     indent--;
  84:     putcom("endwhile");
  85:     outcont(p1+1);
  86:     brkptr--;
  87: }
  88: 
  89: balpar() {
  90:     register c, lpar;
  91:     while ((c=gtok(scrat)) == ' ' || c == '\t')
  92:         ;
  93:     if (c != '(') {
  94:         error("missing left paren");
  95:         return;
  96:     }
  97:     outcode(scrat);
  98:     lpar = 1;
  99:     do {
 100:         c = gtok(scrat);
 101:         if (c==';' || c=='{' || c=='}' || c==EOF) {
 102:             pbstr(scrat);
 103:             break;
 104:         }
 105:         if (c=='(')
 106:             lpar++;
 107:         else if (c==')')
 108:             lpar--;
 109:         else if (c == '\n') {
 110:             while ((c = gtok(scrat)) == ' ' || c=='\t' || c=='\n')
 111:                 ;
 112:             pbstr(scrat);
 113:             continue;
 114:         }
 115:         else if (c == '=' && scrat[1] == '\0')
 116:             error("assigment inside conditional");
 117:         outcode(scrat);
 118:     } while (lpar > 0);
 119:     if (lpar != 0)
 120:         error("missing parenthesis");
 121: }
 122: 
 123: int labval  = 23000;
 124: 
 125: genlab(n){
 126:     labval += n;
 127:     return(labval-n);
 128: }
 129: 
 130: gokcode(p1) {
 131:     transfer = 0;
 132:     outtab();
 133:     outcode(p1);
 134:     eatup();
 135:     outdon();
 136: }
 137: 
 138: eatup() {
 139:     int t, lpar;
 140:     char temp[100];
 141:     lpar = 0;
 142:     do {
 143:         if ((t = gtok(scrat)) == ';' || t == '\n')
 144:             break;
 145:         if (t == '{' || t == '}' || t == EOF) {
 146:             pbstr(scrat);
 147:             break;
 148:         }
 149:         if (t == ',' || t == '+' || t == '-' || t == '*' || t == '('
 150:           || t == '&' || t == '|' || t == '=') {
 151:             while (gtok(temp) == '\n')
 152:                 ;
 153:             pbstr(temp);
 154:         }
 155:         if (t == '(')
 156:             lpar++;
 157:         else if (t==')') {
 158:             lpar--;
 159:             if (lpar < 0) {
 160:                 error("missing left paren");
 161:                 return(1);
 162:             }
 163:         }
 164:         outcode(scrat);
 165:     } while (lpar >= 0);
 166:     if (lpar > 0) {
 167:         error("missing right paren");
 168:         return(1);
 169:     }
 170:     return(0);
 171: }
 172: 
 173: forcode(){
 174:     int lpar, t;
 175:     char *ps, *qs;
 176: 
 177:     transfer = 0;
 178:     outcont(0);
 179:     putcom("for");
 180:     yyval = genlab(3);
 181:     brkstk[++brkptr] = yyval+1;
 182:     typestk[brkptr] = FOR;
 183:     brkused[brkptr] = 0;
 184:     forstk[forptr++] = malloc(1);
 185:     if ((t = gnbtok(scrat)) != '(') {
 186:         error("missing left paren in FOR");
 187:         pbstr(scrat);
 188:         return;
 189:     }
 190:     if (gnbtok(scrat) != ';') { /* real init clause */
 191:         pbstr(scrat);
 192:         outtab();
 193:         if (eatup() > 0) {
 194:             error("illegal FOR clause");
 195:             return;
 196:         }
 197:         outdon();
 198:     }
 199:     if (gnbtok(scrat) == ';')   /* empty condition */
 200:         outcont(yyval);
 201:     else {  /* non-empty condition */
 202:         pbstr(scrat);
 203:         outnum(yyval);
 204:         outtab();
 205:         outcode("if(.not.(");
 206:         for (lpar=0; lpar >= 0;) {
 207:             if ((t = gnbtok(scrat)) == ';')
 208:                 break;
 209:             if (t == '(')
 210:                 lpar++;
 211:             else if (t == ')') {
 212:                 lpar--;
 213:                 if (lpar < 0) {
 214:                     error("missing left paren in FOR clause");
 215:                     return;
 216:                 }
 217:             }
 218:             if (t != '\n')
 219:                 outcode(scrat);
 220:         }
 221:         outcode("))");
 222:         outgoto(yyval+2);
 223:         if (lpar < 0)
 224:             error("invalid FOR clause");
 225:     }
 226:     ps = scrat;
 227:     for (lpar=0; lpar >= 0;) {
 228:         if ((t = gtok(ps)) == '(')
 229:             lpar++;
 230:         else if (t == ')')
 231:             lpar--;
 232:         if (lpar >= 0 && t != '\n')
 233:             while(*ps)
 234:                 ps++;
 235:     }
 236:     *ps = '\0';
 237:     qs = forstk[forptr-1] = malloc((unsigned)(ps-scrat+1));
 238:     ps = scrat;
 239:     while (*qs++ = *ps++)
 240:         ;
 241:     indent++;
 242: }
 243: 
 244: forstat(p1) int p1; {
 245:     char *bp, *q;
 246:     bp = forstk[--forptr];
 247:     if (wasnext)
 248:         outnum(p1+1);
 249:     if (nonblank(bp)){
 250:         outtab();
 251:         outcode(bp);
 252:         outdon();
 253:     }
 254:     transfer = 0;
 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: }

Defined functions

balpar defined in line 89; used 4 times
breakcode defined in line 308; never used
docode defined in line 282; never used
dostat defined in line 296; never used
eatup defined in line 138; used 4 times
elsecode defined in line 57; never used
errcode defined in line 361; never used
error defined in line 352; used 21 times
forcode defined in line 173; never used
forstat defined in line 244; never used
genlab defined in line 125; used 7 times
gokcode defined in line 130; never used
ifcode defined in line 47; never used
nextcode defined in line 325; never used
nonblank defined in line 342; used 1 times
repcode defined in line 19; never used
retcode defined in line 264; never used
untils defined in line 31; never used
whilecode defined in line 65; never used
whilestat defined in line 81; never used

Defined variables

brkptr defined in line 11; used 26 times
brkstk defined in line 12; used 6 times
brkused defined in line 14; used 10 times
errorflag defined in line 350; used 10 times
fcname defined in line 8; used 4 times
forptr defined in line 16; used 3 times
forstk defined in line 17; used 3 times
labval defined in line 123; used 2 times
scrat defined in line 9; used 31 times
transfer defined in line 6; used 25 times
typestk defined in line 13; used 4 times

Defined macros

atoi defined in line 305; used 2 times
wasbreak defined in line 3; used 2 times
wasnext defined in line 4; used 1 times
Last modified: 1981-07-10
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 1678
Valid CSS Valid XHTML 1.0 Strict