![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to 1.fort.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 42BSD / usr.bin / struct|
Return to 1.fort.c CVS log | Up to [CSRG BSD Unix] / 42BSD / usr.bin / struct |
1.1 root 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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.