Commit | Line | Data |
---|---|---|
0d57d6f5 TL |
1 | #include <stdio.h> |
2 | ||
3 | #ifdef unix | |
4 | # include <ctype.h> | |
5 | #endif | |
6 | ||
7 | #include "ftypes" | |
8 | #include "defines" | |
9 | #include "locdefs" | |
10 | ||
11 | #define VL 6 | |
12 | ||
13 | #define MAXINCLUDES 10 | |
14 | #define MAXLITERALS 20 | |
15 | #define MAXCTL 20 | |
16 | #define MAXHASH 401 | |
17 | #define MAXSTNO 201 | |
18 | #define MAXEXT 200 | |
19 | #define MAXEQUIV 150 | |
20 | #define MAXLABLIST 100 | |
21 | ||
22 | typedef union expression *expptr; | |
23 | typedef union taggedblock *tagptr; | |
24 | typedef union chainedblock *chainp; | |
25 | ||
26 | extern FILEP infile; | |
27 | extern FILEP diagfile; | |
28 | extern FILEP textfile; | |
29 | extern FILEP asmfile; | |
30 | extern FILEP initfile; | |
31 | extern long int headoffset; | |
32 | ||
33 | extern char token [ ]; | |
34 | extern int toklen; | |
35 | extern int yylval; | |
36 | extern int lineno; | |
37 | extern char *infname; | |
38 | extern int needkwd; | |
39 | extern struct labelblock *thislabel; | |
40 | ||
41 | extern flag profileflag; | |
42 | extern flag optimflag; | |
43 | extern flag nowarnflag; | |
44 | extern flag ftn66flag; | |
45 | extern flag shiftcase; | |
46 | extern flag undeftype; | |
47 | extern flag shortsubs; | |
48 | extern flag onetripflag; | |
49 | extern flag checksubs; | |
50 | extern flag debugflag; | |
51 | extern int nerr; | |
52 | extern int nwarn; | |
53 | extern int ndata; | |
54 | ||
55 | extern int parstate; | |
56 | extern flag headerdone; | |
57 | extern int blklevel; | |
58 | extern flag saveall; | |
59 | extern flag substars; | |
60 | extern int impltype[ ]; | |
61 | extern int implleng[ ]; | |
62 | extern int implstg[ ]; | |
63 | ||
64 | extern int tyint; | |
65 | extern int tylogical; | |
66 | extern ftnint typesize[]; | |
67 | extern int typealign[]; | |
68 | extern int procno; | |
69 | extern int proctype; | |
70 | extern char * procname; | |
71 | extern int rtvlabel[ ]; | |
72 | extern int fudgelabel; /* to confuse the pdp11 optimizer */ | |
73 | extern struct addrblock *typeaddr; | |
74 | extern struct addrblock *retslot; | |
75 | extern int cxslot; | |
76 | extern int chslot; | |
77 | extern int chlgslot; | |
78 | extern int procclass; | |
79 | extern ftnint procleng; | |
80 | extern int nentry; | |
81 | extern flag multitype; | |
82 | extern int blklevel; | |
83 | extern int lastlabno; | |
84 | extern int lastvarno; | |
85 | extern int lastargslot; | |
86 | extern int argloc; | |
87 | extern ftnint autoleng; | |
88 | extern ftnint bssleng; | |
89 | extern int retlabel; | |
90 | extern int ret0label; | |
91 | extern int dorange; | |
92 | extern int regnum[ ]; | |
93 | extern struct nameblock *regnamep[ ]; | |
94 | extern int maxregvar; | |
95 | extern int highregvar; | |
96 | extern int nregvar; | |
97 | ||
98 | extern chainp templist; | |
99 | extern chainp holdtemps; | |
100 | extern struct entrypoint *entries; | |
101 | extern struct rplblock *rpllist; | |
102 | extern chainp curdtp; | |
103 | extern ftnint curdtelt; | |
104 | extern flag toomanyinit; | |
105 | ||
106 | extern flag inioctl; | |
107 | extern int iostmt; | |
108 | extern struct addrblock *ioblkp; | |
109 | extern int nioctl; | |
110 | extern int nequiv; | |
111 | extern int nintnames; | |
112 | extern int nextnames; | |
113 | \f | |
114 | struct chain | |
115 | { | |
116 | chainp nextp; | |
117 | tagptr datap; | |
118 | }; | |
119 | ||
120 | extern chainp chains; | |
121 | ||
122 | struct ctlframe | |
123 | { | |
124 | unsigned ctltype:8; | |
125 | unsigned dostepsign:8; | |
126 | int ctlabels[4]; | |
127 | int dolabel; | |
128 | struct nameblock *donamep; | |
129 | expptr domax; | |
130 | expptr dostep; | |
131 | }; | |
132 | #define endlabel ctlabels[0] | |
133 | #define elselabel ctlabels[1] | |
134 | #define dobodylabel ctlabels[1] | |
135 | #define doposlabel ctlabels[2] | |
136 | #define doneglabel ctlabels[3] | |
137 | extern struct ctlframe ctls[ ]; | |
138 | extern struct ctlframe *ctlstack; | |
139 | extern struct ctlframe *lastctl; | |
140 | ||
141 | struct extsym | |
142 | { | |
143 | char extname[XL]; | |
144 | unsigned extstg:4; | |
145 | unsigned extsave:1; | |
146 | unsigned extinit:1; | |
147 | ptr extp; | |
148 | ftnint extleng; | |
149 | ftnint maxleng; | |
150 | }; | |
151 | ||
152 | extern struct extsym extsymtab[ ]; | |
153 | extern struct extsym *nextext; | |
154 | extern struct extsym *lastext; | |
155 | ||
156 | struct labelblock | |
157 | { | |
158 | int labelno; | |
159 | unsigned blklevel:8; | |
160 | unsigned labused:1; | |
161 | unsigned labinacc:1; | |
162 | unsigned labdefined:1; | |
163 | unsigned labtype:2; | |
164 | ftnint stateno; | |
165 | }; | |
166 | ||
167 | extern struct labelblock labeltab[ ]; | |
168 | extern struct labelblock *labtabend; | |
169 | extern struct labelblock *highlabtab; | |
170 | ||
171 | struct entrypoint | |
172 | { | |
173 | chainp nextp; | |
174 | struct extsym *entryname; | |
175 | chainp arglist; | |
176 | int entrylabel; | |
177 | int typelabel; | |
178 | ptr enamep; | |
179 | }; | |
180 | ||
181 | struct primblock | |
182 | { | |
183 | unsigned tag:4; | |
184 | unsigned vtype:4; | |
185 | struct nameblock *namep; | |
186 | struct listblock *argsp; | |
187 | expptr fcharp; | |
188 | expptr lcharp; | |
189 | }; | |
190 | ||
191 | ||
192 | struct hashentry | |
193 | { | |
194 | int hashval; | |
195 | struct nameblock *varp; | |
196 | }; | |
197 | extern struct hashentry hashtab[ ]; | |
198 | extern struct hashentry *lasthash; | |
199 | ||
200 | struct intrpacked /* bits for intrinsic function description */ | |
201 | { | |
202 | unsigned f1:3; | |
203 | unsigned f2:4; | |
204 | unsigned f3:7; | |
205 | }; | |
206 | ||
207 | struct nameblock | |
208 | { | |
209 | unsigned tag:4; | |
210 | unsigned vtype:4; | |
211 | unsigned vclass:4; | |
212 | unsigned vstg:4; | |
213 | expptr vleng; | |
214 | char varname[VL]; | |
215 | unsigned vdovar:1; | |
216 | unsigned vdcldone:1; | |
217 | unsigned vadjdim:1; | |
218 | unsigned vsave:1; | |
219 | unsigned vprocclass:3; | |
220 | unsigned vregno:4; | |
221 | union { | |
222 | int varno; | |
223 | chainp vstfdesc; /* points to (formals, expr) pair */ | |
224 | struct intrpacked intrdesc; /* bits for intrinsic function */ | |
225 | } vardesc; | |
226 | struct dimblock *vdim; | |
227 | int voffset; | |
228 | }; | |
229 | ||
230 | ||
231 | struct paramblock | |
232 | { | |
233 | unsigned tag:4; | |
234 | unsigned vtype:4; | |
235 | unsigned vclass:4; | |
236 | expptr vleng; | |
237 | char varname[VL]; | |
238 | ptr paramval; | |
239 | } ; | |
240 | ||
241 | ||
242 | struct exprblock | |
243 | { | |
244 | unsigned tag:4; | |
245 | unsigned vtype:4; | |
246 | unsigned vclass:4; | |
247 | expptr vleng; | |
248 | unsigned opcode:6; | |
249 | expptr leftp; | |
250 | expptr rightp; | |
251 | }; | |
252 | ||
253 | ||
254 | union constant | |
255 | { | |
256 | char *ccp; | |
257 | ftnint ci; | |
258 | double cd[2]; | |
259 | }; | |
260 | ||
261 | struct constblock | |
262 | { | |
263 | unsigned tag:4; | |
264 | unsigned vtype:4; | |
265 | expptr vleng; | |
266 | union constant const; | |
267 | }; | |
268 | ||
269 | ||
270 | struct listblock | |
271 | { | |
272 | unsigned tag:4; | |
273 | unsigned vtype:4; | |
274 | chainp listp; | |
275 | }; | |
276 | ||
277 | ||
278 | ||
279 | struct addrblock | |
280 | { | |
281 | unsigned tag:4; | |
282 | unsigned vtype:4; | |
283 | unsigned vclass:4; | |
284 | unsigned vstg:4; | |
285 | expptr vleng; | |
286 | int memno; | |
287 | expptr memoffset; | |
288 | unsigned istemp:1; | |
289 | unsigned ntempelt:10; | |
290 | }; | |
291 | ||
292 | ||
293 | ||
294 | struct errorblock | |
295 | { | |
296 | unsigned tag:4; | |
297 | unsigned vtype:4; | |
298 | }; | |
299 | ||
300 | ||
301 | union expression | |
302 | { | |
303 | struct exprblock; | |
304 | struct addrblock; | |
305 | struct constblock; | |
306 | struct errorblock; | |
307 | struct listblock; | |
308 | struct primblock; | |
309 | } ; | |
310 | ||
311 | ||
312 | ||
313 | struct dimblock | |
314 | { | |
315 | int ndim; | |
316 | expptr nelt; | |
317 | expptr baseoffset; | |
318 | expptr basexpr; | |
319 | struct | |
320 | { | |
321 | expptr dimsize; | |
322 | expptr dimexpr; | |
323 | } dims[1]; | |
324 | }; | |
325 | ||
326 | ||
327 | struct impldoblock | |
328 | { | |
329 | unsigned tag:4; | |
330 | unsigned isactive:1; | |
331 | unsigned isbusy:1; | |
332 | struct nameblock *varnp; | |
333 | struct constblock *varvp; | |
334 | expptr implb; | |
335 | expptr impub; | |
336 | expptr impstep; | |
337 | ftnint impdiff; | |
338 | ftnint implim; | |
339 | chainp datalist; | |
340 | }; | |
341 | ||
342 | ||
343 | struct rplblock /* name replacement block */ | |
344 | { | |
345 | chainp nextp; | |
346 | struct nameblock *rplnp; | |
347 | ptr rplvp; | |
348 | struct exprblock *rplxp; | |
349 | int rpltag; | |
350 | }; | |
351 | ||
352 | ||
353 | ||
354 | struct equivblock | |
355 | { | |
356 | ptr equivs; | |
357 | unsigned eqvinit:1; | |
358 | long int eqvtop; | |
359 | long int eqvbottom; | |
360 | } ; | |
361 | #define eqvleng eqvtop | |
362 | ||
363 | extern struct equivblock eqvclass[ ]; | |
364 | ||
365 | ||
366 | struct eqvchain | |
367 | { | |
368 | chainp nextp; | |
369 | ptr eqvitem; | |
370 | long int eqvoffset; | |
371 | } ; | |
372 | ||
373 | union chainedblock | |
374 | { | |
375 | struct chain; | |
376 | struct entrypoint; | |
377 | struct rplblock; | |
378 | struct eqvchain; | |
379 | }; | |
380 | ||
381 | ||
382 | ||
383 | union taggedblock | |
384 | { | |
385 | struct nameblock; | |
386 | struct paramblock; | |
387 | struct exprblock; | |
388 | struct constblock; | |
389 | struct listblock; | |
390 | struct addrblock; | |
391 | struct errorblock; | |
392 | struct primblock; | |
393 | struct impldoblock; | |
394 | } ; | |
395 | ||
396 | ||
397 | ||
398 | ||
399 | struct literal | |
400 | { | |
401 | short littype; | |
402 | short litnum; | |
403 | union { | |
404 | ftnint litival; | |
405 | double litdval; | |
406 | struct { | |
407 | char litclen; /* small integer */ | |
408 | char litcstr[XL]; | |
409 | } litcval; | |
410 | } litval; | |
411 | }; | |
412 | ||
413 | extern struct literal litpool[ ]; | |
414 | extern int nliterals; | |
415 | ||
416 | ||
417 | ||
418 | ||
419 | ||
420 | /* popular functions with non integer return values */ | |
421 | ||
422 | ||
423 | int *ckalloc(); | |
424 | char *varstr(), *nounder(), *varunder(); | |
425 | char *copyn(), *copys(); | |
426 | chainp hookup(), mkchain(); | |
427 | ftnint convci(); | |
428 | char *convic(); | |
429 | char *setdoto(); | |
430 | double convcd(); | |
431 | struct nameblock *mkname(); | |
432 | struct labelblock *mklabel(); | |
433 | struct extsym *mkext(), *newentry(); | |
434 | struct exprblock *addrof(), *call1(), *call2(), *call3(), *call4(); | |
435 | struct addrblock *builtin(), *mktemp(), *mktmpn(); | |
436 | struct addrblock *autovar(), *mklhs(), *mkaddr(), *putconst(), *memversion(); | |
437 | struct constblock *mkintcon(); | |
438 | expptr mkexpr(), mkconv(), mkfunct(), fixexpr(), fixtype(); | |
439 | tagptr cpexpr(), mkprim(); | |
440 | struct errorblock *errnode(); |