#include #include "1.incl.h" #include "1.defs.h" #include "def.h" act(k,c,bufptr) int k,bufptr; char c; { long ftemp; struct lablist *makelab(); switch(k) /*handle labels */ {case 1: if (c != ' ') { ftemp = c - '0'; newlab->labelt = 10L * newlab->labelt + ftemp; if (newlab->labelt > 99999L) { error("in syntax:\n","",""); fprintf(stderr,"line %d: label beginning %D too long\n%s\n", begline,newlab->labelt,buffer); fprintf(stderr,"treating line as straight line code\n"); return(ABORT); } } break; case 3: nlabs++; newlab = newlab->nxtlab = makelab(0L); break; /* handle labsw- switches and labels */ /* handle if statements */ case 30: counter++; break; case 31: counter--; if (counter) return(_if1); else { pred = remtilda(stralloc(&buffer[p1],bufptr - p1)); p3 = bufptr + 1; /* p3 pts. to 1st symbol after ) */ flag = 1; return(_if2); } case 45: /* set p1 to pt.to 1st symbol of pred */ p1 = bufptr + 1; act(30,c,bufptr); break; /* handle do loops */ case 61: p1 = bufptr; break; /* p1 pts. to 1st symbol of increment string */ case 62: counter ++; break; case 63: counter --; break; case 64: if (counter != 0) break; act(162,c,bufptr); return(ABORT); case 70: if (counter) return(_rwp); r1 = bufptr; return(_rwlab); case 72: exp = remtilda( stralloc(&buffer[r1+1],bufptr - r1 - 1)); break; case 73: endlab = newlab; break; case 74: errlab = newlab; break; case 75: reflab = newlab; act(3,c,bufptr); break; case 76: r1 = bufptr; break; case 77: if (!counter) { act(111,c,bufptr); return(ABORT); } counter--; break; /* generate nodes of all types */ case 111: /* st. line code */ stcode = remtilda(stralloc(&buffer[p3],endbuf - p3)); recognize(STLNVX,flag); return(ABORT); case 122: /* uncond. goto */ recognize(ungo,flag); break; case 123: /* assigned goto */ act(72,c,bufptr); faterr("in parsing:\n","assigned goto must have list of labels",""); case 124: /* ass. goto, labels */ recognize(ASGOVX, flag); break; case 125: /* computed goto*/ exp = remtilda( stralloc(&buffer[r1+1],bufptr - r1 - 1)); recognize(COMPVX, flag); return(ABORT); case 133: /* if() = is a simple statement, so reset flag to 0 */ flag = 0; act(111,c,bufptr); return(ABORT); case 141: /* arith. if */ recognize(arithif, 0); break; case 150: /* label assignment */ exp = remtilda( stralloc(&buffer[r1+1],bufptr - r1 - 1)); recognize(ASVX, flag); break; case 162: /* do node */ inc = remtilda(stralloc(&buffer[p1],endbuf - p1)); recognize(DOVX, 0); break; case 180: /* continue statement */ recognize(contst, 0); break; case 200: /* function or subroutine statement */ progtype = sub; nameline = begline; recognize(STLNVX,0); break; case 210: /* block data statement */ progtype = blockdata; act(111,c,bufptr); return(ABORT); case 300: /* return statement */ recognize(RETVX,flag); break; case 350: /* stop statement */ recognize(STOPVX, flag); break; case 400: /* end statement */ if (progtype == sub) act(300, c, bufptr); else act(350, c, bufptr); return(endrt); case 500: prerw = remtilda(stralloc(&buffer[p3],r1 - p3 + 1)); postrw = remtilda(stralloc(&buffer[r2],endbuf - r2)); if (reflab || endlab || errlab) recognize(IOVX,flag); else recognize(STLNVX,flag); return(ABORT); case 510: r2 = bufptr; act(3,c,bufptr); act(500,c,bufptr); return(ABORT); case 520: r2 = bufptr; reflab = newlab; act(3,c,bufptr); act(500,c,bufptr); return(ABORT); case 600: recognize(FMTVX,0); return(ABORT); case 700: stcode = remtilda(stralloc(&buffer[p3],endbuf - p3)); recognize(entry,0); return(ABORT); /* error */ case 999: fprintf(stderr,"error: symbol '%c' should not occur as %d'th symbol of: \n%s\n", c,bufptr, buffer); return(ABORT); } return(nulls); } struct lablist *makelab(x) long x; { struct lablist *p; p = challoc (sizeof(*p)); p->labelt = x; p->nxtlab = 0; return(p); } long label(i) int i; { struct lablist *j; for (j = linelabs; i > 0; i--) { if (j == 0) return(0L); j = j->nxtlab; } if (j) return(j->labelt); else return(0L); } freelabs() { struct lablist *j,*k; j = linelabs; while(j != 0) { k = j->nxtlab; chfree(j,sizeof(*j)); j = k; } } stralloc(ad,n) /* allocate space, copy n chars from address ad, add '0' */ int n; char *ad; { char *cp; cp = galloc(n+1); copycs(ad,cp,n); return(cp); } remtilda(s) /* change ~ to blank */ char *s; { int i; for (i = 0; s[i] != '\0'; i++) if (s[i] == '~') s[i] = ' '; return(s); }