Commit | Line | Data |
---|---|---|
aaa7ced1 BJ |
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 | printf("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 | } |