Commit | Line | Data |
---|---|---|
19b2a93e KT |
1 | #define lv yylval |
2 | #define v yyval | |
3 | ||
4 | ||
5 | yylex() | |
6 | { | |
7 | register c; | |
8 | register struct tab *tp; | |
9 | extern TERMtype; | |
10 | ||
11 | if(nlexsym != -1) { | |
12 | if (TERMtype == 1) dofix(); /* convert iline */ | |
13 | c = nlexsym; | |
14 | nlexsym = -1; | |
15 | return(c); | |
16 | ||
17 | } | |
18 | while(litflag > 0) { | |
19 | if (TERMtype == 0)c = (int)*iline++; | |
20 | else c = asciich(); | |
21 | if(c == '\n') { | |
22 | nlexsym = 0; | |
23 | return(eol); | |
24 | } | |
25 | } | |
26 | do | |
27 | if (TERMtype == 0)c = (int)*iline++; | |
28 | else c = asciich(); | |
29 | while(c == ' '); | |
30 | if(c == '\n') { | |
31 | nlexsym = 0; | |
32 | return(eol); | |
33 | } | |
34 | if(alpha(c)) | |
35 | return(getnam(c)); | |
36 | if(digit(c) || c == '@' || | |
37 | (c=='.' && digit(*iline))) | |
38 | return(getnum(c)); | |
39 | c &= 0377; | |
40 | for(tp = tab; tp->input; tp++) | |
41 | if(tp->input == c) { | |
42 | lv = tp->lexval; | |
43 | return(tp->retval); | |
44 | } | |
45 | return(unk); | |
46 | } | |
47 | ||
48 | getnam(ic) | |
49 | { | |
50 | char name[NAMS]; | |
51 | register c; | |
52 | register char *cp; | |
53 | register struct nlist *np; | |
54 | ||
55 | cp = name; | |
56 | do { | |
57 | *cp++ = c; | |
58 | if (TERMtype == 0)c = (int)*iline++; | |
59 | else c = asciich(); | |
60 | } while(alpha(c) || digit(c)); | |
61 | *cp++ = 0; | |
62 | iline--; | |
63 | if(litflag < 0) { /* commands */ | |
64 | litflag = 0; | |
65 | for(c=0; comtab[c]; c+=3) | |
66 | if(equal(name, comtab[c])) | |
67 | break; | |
68 | lv = comtab[c+2]; | |
69 | return(comtab[c+1]); | |
70 | } | |
71 | if(a_label(name)){ | |
72 | return(numb); | |
73 | } | |
74 | for(np=nlist; np->namep; np++) | |
75 | if(equal(np->namep, name)) { | |
76 | lv = np; | |
77 | switch(np->use) { | |
78 | ||
79 | case NF: | |
80 | return(nfun); | |
81 | ||
82 | case MF: | |
83 | return(mfun); | |
84 | ||
85 | case DF: | |
86 | return(dfun); | |
87 | } | |
88 | return(nam); | |
89 | } | |
90 | np->namep = alloc(cp-name); | |
91 | copy(CH, name, np->namep, cp-name); | |
92 | np->type = LV; | |
93 | lv = np; | |
94 | return(nam); | |
95 | } | |
96 | ||
97 | a_label(x) | |
98 | register char *x; | |
99 | { | |
100 | register struct lablist *lblthru; | |
101 | ||
102 | lblthru = labldefs.nextll; | |
103 | while(lblthru) { | |
104 | if(equal(lblthru->lname,x)) { | |
105 | datum = (double) lblthru->lno; | |
106 | return(1); | |
107 | } | |
108 | lblthru = lblthru->nextll; | |
109 | } | |
110 | return(0); | |
111 | } | |
112 | ||
113 | getnum(ic) | |
114 | { | |
115 | double d1, d2; | |
116 | register c, n, n1; | |
117 | int s, s1; | |
118 | ||
119 | s = 0; | |
120 | n = 0; | |
121 | d1 = 0.; | |
122 | c = ic; | |
123 | if(c == '@') { | |
124 | s++; | |
125 | if (TERMtype == 0)c = (int)*iline++; | |
126 | else c = asciich(); | |
127 | } | |
128 | while(digit(c)) { | |
129 | d1 = d1*10. + c - '0'; | |
130 | if (TERMtype == 0)c = (int)*iline++; | |
131 | else c = asciich(); | |
132 | } | |
133 | if(c == '.') { | |
134 | if (TERMtype == 0)c = (int)*iline++; | |
135 | else c = asciich(); | |
136 | while(digit(c)) { | |
137 | d1 = d1*10. + c - '0'; | |
138 | if (TERMtype == 0)c = (int)*iline++; | |
139 | else c = asciich(); | |
140 | n--; | |
141 | } | |
142 | } | |
143 | if(c == 'e') { | |
144 | s1 = 0; | |
145 | n1 = 0; | |
146 | if (TERMtype == 0)c = (int)*iline++; | |
147 | else c = asciich(); | |
148 | if(c == '@') { | |
149 | s1++; | |
150 | if (TERMtype == 0)c = (int)*iline++; | |
151 | else c = asciich(); | |
152 | } | |
153 | while(digit(c)) { | |
154 | n1 = n1*10 + c - '0'; | |
155 | if (TERMtype == 0)c = (int)*iline++; | |
156 | else c = asciich(); | |
157 | } | |
158 | if(s1) | |
159 | n -= n1; else | |
160 | n += n1; | |
161 | } | |
162 | n1 = n; | |
163 | if(n1 < 0) | |
164 | n1 = -n1; | |
165 | d2 = 1.; | |
166 | while(n1--) | |
167 | d2 *= 10.; | |
168 | if(n < 0) | |
169 | d1 /= d2; else | |
170 | d1 *= d2; | |
171 | if(s) | |
172 | d1 = -d1; | |
173 | iline--; | |
174 | datum = d1; | |
175 | return(numb); | |
176 | } | |
177 | ||
178 | alpha(s) | |
179 | { | |
180 | register c; | |
181 | ||
182 | c = s & 0377; | |
183 | if(c >= 'a' && c <= 'z') | |
184 | return(1); | |
185 | if(c == 'H') | |
186 | return(1); | |
187 | if(c == 'F') | |
188 | return(1); | |
189 | if(c >= 0220 && c<=0252) | |
190 | return(1); | |
191 | return(0); | |
192 | } | |
193 | ||
194 | digit(s) | |
195 | { | |
196 | register c; | |
197 | ||
198 | c = s; | |
199 | if(c >='0' && c <= '9') | |
200 | return(1); | |
201 | return(0); | |
202 | } | |
203 | ||
204 | /* | |
205 | * s is statement | |
206 | * f is execution flag: | |
207 | * 0 compile immediate | |
208 | * 1 compile L | |
209 | * 2 function definition | |
210 | * 3 function prolog | |
211 | * 4 function epilog | |
212 | * 5 function body | |
213 | */ | |
214 | int ilex[] | |
215 | { | |
216 | lex0, lex1, lex2, lex3, lex4, lex5, lex6 | |
217 | }; | |
218 | compile(s, f) | |
219 | { | |
220 | register char *p, *q; | |
221 | char oline[OBJS]; | |
222 | ||
223 | iline = s; | |
224 | ccharp = oline; | |
225 | litflag = 0; | |
226 | nlexsym = ilex[f]; | |
227 | context = nlexsym; | |
228 | if(yyparse()) { | |
229 | pline(s, iline-s); | |
230 | return(0); | |
231 | } | |
232 | *ccharp++ = EOF; | |
233 | p = alloc(ccharp-oline); | |
234 | iline = p; | |
235 | for(q=oline; q<ccharp;) | |
236 | *p++ = *q++; | |
237 | return(iline); | |
238 | } | |
239 | ||
240 | yyerror() | |
241 | { | |
242 | } | |
243 | ||
244 | name(np, c2) | |
245 | { | |
246 | register char *p; | |
247 | ||
248 | p = ccharp; | |
249 | *ccharp++ = c2; | |
250 | *ccharp++ = np.c[0]; | |
251 | *ccharp++ = np.c[1]; | |
252 | *ccharp++ = np.c[2]; | |
253 | *ccharp++ = np.c[3]; | |
254 | return(p); | |
255 | } | |
256 | ||
257 | equal(a, b) | |
258 | char *a, *b; | |
259 | { | |
260 | register char *c1, *c2; | |
261 | ||
262 | c1 = a; | |
263 | c2 = b; | |
264 | while(*c1++ == *c2) | |
265 | if(*c2++ == 0) | |
266 | return(1); | |
267 | return(0); | |
268 | } | |
269 | ||
270 | invert(a, b) | |
271 | { | |
272 | ||
273 | flop(a, b); | |
274 | flop(b, ccharp); | |
275 | flop(a, ccharp); | |
276 | } | |
277 | ||
278 | flop(a, b) | |
279 | char *a, *b; | |
280 | { | |
281 | register char *a1, *a2; | |
282 | register c; | |
283 | ||
284 | a1 = a; | |
285 | a2 = b; | |
286 | while(a1 < a2) { | |
287 | c = *a1; | |
288 | *a1++ = *--a2; | |
289 | *a2 = c; | |
290 | } | |
291 | } |