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