1: #ifndef lint 2: static char sccsid[] = "@(#)1.fort.c 4.1 (Berkeley) 2/11/83"; 3: #endif not lint 4: 5: #include <stdio.h> 6: #include "1.incl.h" 7: #include "1.defs.h" 8: #include "def.h" 9: 10: 11: act(k,c,bufptr) 12: int k,bufptr; 13: char c; 14: { 15: long ftemp; 16: struct lablist *makelab(); 17: switch(k) 18: /*handle labels */ 19: {case 1: 20: if (c != ' ') 21: { 22: ftemp = c - '0'; 23: newlab->labelt = 10L * newlab->labelt + ftemp; 24: 25: if (newlab->labelt > 99999L) 26: { 27: error("in syntax:\n","",""); 28: fprintf(stderr,"line %d: label beginning %D too long\n%s\n", 29: begline,newlab->labelt,buffer); 30: fprintf(stderr,"treating line as straight line code\n"); 31: return(ABORT); 32: } 33: } 34: break; 35: 36: case 3: nlabs++; 37: newlab = newlab->nxtlab = makelab(0L); 38: break; 39: 40: /* handle labsw- switches and labels */ 41: /* handle if statements */ 42: case 30: counter++; break; 43: 44: case 31: 45: counter--; 46: if (counter) return(_if1); 47: else 48: { 49: pred = remtilda(stralloc(&buffer[p1],bufptr - p1)); 50: p3 = bufptr + 1; /* p3 pts. to 1st symbol after ) */ 51: flag = 1; 52: return(_if2); } 53: 54: case 45: /* set p1 to pt.to 1st symbol of pred */ 55: p1 = bufptr + 1; 56: act(30,c,bufptr); break; 57: 58: /* handle do loops */ 59: case 61: p1 = bufptr; break; /* p1 pts. to 1st symbol of increment string */ 60: 61: case 62: counter ++; break; 62: 63: case 63: counter --; break; 64: 65: case 64: 66: if (counter != 0) break; 67: act(162,c,bufptr); 68: return(ABORT); 69: 70: case 70: if (counter) return(_rwp); 71: r1 = bufptr; 72: return(_rwlab); 73: 74: case 72: exp = remtilda( stralloc(&buffer[r1+1],bufptr - r1 - 1)); break; 75: 76: case 73: endlab = newlab; 77: break; 78: 79: case 74: errlab = newlab; 80: break; 81: 82: case 75: reflab = newlab; 83: act(3,c,bufptr); 84: break; 85: 86: case 76: r1 = bufptr; break; 87: 88: case 77: 89: if (!counter) 90: { 91: act(111,c,bufptr); 92: return(ABORT); 93: } 94: counter--; 95: break; 96: /* generate nodes of all types */ 97: case 111: /* st. line code */ 98: stcode = remtilda(stralloc(&buffer[p3],endbuf - p3)); 99: recognize(STLNVX,flag); 100: return(ABORT); 101: 102: case 122: /* uncond. goto */ 103: recognize(ungo,flag); 104: break; 105: 106: case 123: /* assigned goto */ 107: act(72,c,bufptr); 108: faterr("in parsing:\n","assigned goto must have list of labels",""); 109: 110: case 124: /* ass. goto, labels */ 111: recognize(ASGOVX, flag); 112: break; 113: 114: case 125: /* computed goto*/ 115: exp = remtilda( stralloc(&buffer[r1+1],bufptr - r1 - 1)); 116: recognize(COMPVX, flag); 117: return(ABORT); 118: 119: case 133: /* if() = is a simple statement, so reset flag to 0 */ 120: flag = 0; 121: act(111,c,bufptr); 122: return(ABORT); 123: 124: case 141: /* arith. if */ 125: recognize(arithif, 0); 126: break; 127: 128: case 150: /* label assignment */ 129: exp = remtilda( stralloc(&buffer[r1+1],bufptr - r1 - 1)); 130: recognize(ASVX, flag); 131: break; 132: 133: case 162: /* do node */ 134: inc = remtilda(stralloc(&buffer[p1],endbuf - p1)); 135: recognize(DOVX, 0); 136: break; 137: 138: case 180: /* continue statement */ 139: recognize(contst, 0); 140: break; 141: 142: case 200: /* function or subroutine statement */ 143: progtype = sub; 144: nameline = begline; 145: recognize(STLNVX,0); 146: break; 147: 148: 149: case 210: /* block data statement */ 150: progtype = blockdata; 151: act(111,c,bufptr); 152: return(ABORT); 153: 154: case 300: /* return statement */ 155: recognize(RETVX,flag); 156: break; 157: 158: 159: case 350: /* stop statement */ 160: recognize(STOPVX, flag); 161: break; 162: 163: 164: case 400: /* end statement */ 165: if (progtype == sub) 166: act(300, c, bufptr); 167: else 168: act(350, c, bufptr); 169: return(endrt); 170: 171: case 500: 172: prerw = remtilda(stralloc(&buffer[p3],r1 - p3 + 1)); 173: postrw = remtilda(stralloc(&buffer[r2],endbuf - r2)); 174: if (reflab || endlab || errlab) recognize(IOVX,flag); 175: else recognize(STLNVX,flag); 176: return(ABORT); 177: 178: case 510: r2 = bufptr; 179: act(3,c,bufptr); 180: act(500,c,bufptr); 181: return(ABORT); 182: 183: case 520: r2 = bufptr; 184: reflab = newlab; 185: act(3,c,bufptr); 186: act(500,c,bufptr); 187: return(ABORT); 188: 189: 190: case 600: 191: recognize(FMTVX,0); return(ABORT); 192: 193: case 700: 194: stcode = remtilda(stralloc(&buffer[p3],endbuf - p3)); 195: recognize(entry,0); return(ABORT); 196: /* error */ 197: case 999: 198: printf("error: symbol '%c' should not occur as %d'th symbol of: \n%s\n", 199: c,bufptr, buffer); 200: return(ABORT); 201: } 202: return(nulls); 203: } 204: 205: 206: 207: struct lablist *makelab(x) 208: long x; 209: { 210: struct lablist *p; 211: p = challoc (sizeof(*p)); 212: p->labelt = x; 213: p->nxtlab = 0; 214: return(p); 215: } 216: 217: 218: long label(i) 219: int i; 220: { 221: struct lablist *j; 222: for (j = linelabs; i > 0; i--) 223: { 224: if (j == 0) return(0L); 225: j = j->nxtlab; 226: } 227: if (j) 228: return(j->labelt); 229: else 230: return(0L); 231: } 232: 233: 234: freelabs() 235: { 236: struct lablist *j,*k; 237: j = linelabs; 238: while(j != 0) 239: { 240: k = j->nxtlab; 241: chfree(j,sizeof(*j)); 242: j = k; 243: } 244: } 245: 246: 247: stralloc(ad,n) /* allocate space, copy n chars from address ad, add '0' */ 248: int n; char *ad; 249: { 250: char *cp; 251: cp = galloc(n+1); 252: copycs(ad,cp,n); 253: return(cp); 254: } 255: 256: 257: remtilda(s) /* change ~ to blank */ 258: char *s; 259: { 260: int i; 261: for (i = 0; s[i] != '\0'; i++) 262: if (s[i] == '~') s[i] = ' '; 263: return(s); 264: }
|
Last modified: 1983-02-12
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 914 |
|