Commit | Line | Data |
---|---|---|
832026c6 C |
1 | #include "stdio.h" |
2 | ||
3 | #define HASHEDTABLE 1 | |
4 | ||
5 | ||
6 | #define NFTNTYPES 5 | |
7 | #define NEFLTYPES 12 | |
8 | ||
9 | #define MEMSIZE 12000 | |
10 | ||
11 | #define MAXSTNO 200 | |
12 | #define MAXINCLUDEDEPTH 10 | |
13 | #define MAXBLOCKDEPTH 30 | |
14 | #define MAXINDIFS 100 | |
15 | #define MAXFTNAMES 200 | |
16 | #define MAXEFLNAMES 401 | |
17 | ||
18 | #define EXECPOOL 20 | |
19 | #define EXPRPOOL 40 | |
20 | ||
21 | #define NAMESPERLINE 6 | |
22 | ||
23 | #define LINESPACES 66 | |
24 | #define INDENTSPACES 3 | |
25 | ||
26 | extern int yylineno; | |
27 | extern int dumpic; | |
28 | extern int memdump; | |
29 | extern int dbgflag; | |
30 | extern int nowarnflag; | |
31 | extern int nocommentflag; | |
32 | extern int verbose; | |
33 | extern int dumpcore; | |
34 | #define TEST if(dbgflag) | |
35 | #define efgetc (efmacp?*efmacp++:getc(yyin)) | |
36 | extern char msg[]; | |
37 | ||
38 | #define UNIX 1 | |
39 | #define GCOS 2 | |
40 | #define GCOSBCD 3 | |
41 | ||
42 | #define FIELDMAX 32768. | |
43 | ||
44 | typedef *ptr; | |
45 | #define ALLOC(x) intalloc(sizeof(struct x)) | |
46 | ||
47 | extern FILE *diagfile; | |
48 | extern FILE *codefile; | |
49 | extern FILE *yyin; | |
50 | extern FILE *fileptrs[]; | |
51 | extern char *filenames[]; | |
52 | extern int filelines[]; | |
53 | extern int filedepth; | |
54 | extern char *efmacp; | |
55 | extern int filemacs[]; | |
56 | extern int pushchars[]; | |
57 | ||
58 | extern struct fileblock *iifilep; | |
59 | ||
60 | extern int mem[]; | |
61 | extern unsigned int nmemused; | |
62 | extern long int totfreed; | |
63 | extern long int totalloc; | |
64 | ||
65 | extern int nhid[]; | |
66 | extern int ndecl[]; | |
67 | ||
68 | extern int indifs[]; | |
69 | extern int nxtindif; | |
70 | extern int afterif; | |
71 | ||
72 | extern neflnames; | |
73 | ||
74 | extern int nftnch; | |
75 | extern int nftncont; | |
76 | ||
77 | extern char ftnames[MAXFTNAMES][7]; | |
78 | extern int nftnames; | |
79 | extern int nftnm0; | |
80 | extern int impltype[]; | |
81 | extern int ftnmask[]; | |
82 | ||
83 | extern double fieldmax; | |
84 | extern int ftnefl[]; | |
85 | extern int eflftn[]; | |
86 | ||
87 | extern ptr thisexec; | |
88 | extern ptr thisctl; | |
89 | extern int pushlex; | |
90 | extern int igeol; | |
91 | extern int ateof; | |
92 | extern int eofneed; | |
93 | extern int forcerr; | |
94 | extern int comneed; | |
95 | extern int optneed; | |
96 | extern int defneed; | |
97 | extern int lettneed; | |
98 | ||
99 | extern int prevbg; | |
100 | ||
101 | extern ptr hidlist; | |
102 | extern ptr commonlist; | |
103 | extern ptr tempvarlist; | |
104 | extern ptr temptypelist; | |
105 | extern ptr gonelist; | |
106 | extern int blklevel; | |
107 | extern int ctllevel; | |
108 | extern int dclsect; | |
109 | extern int instruct; | |
110 | extern int inbound; | |
111 | extern int inproc; | |
112 | ||
113 | extern int ncases; | |
114 | extern ptr comments; | |
115 | extern ptr prevcomments; | |
116 | extern ptr genequivs; | |
117 | extern ptr arrays; | |
118 | extern ptr generlist; | |
119 | extern ptr knownlist; | |
120 | ||
121 | extern int graal; | |
122 | extern ptr thisproc; | |
123 | extern ptr thisargs; | |
124 | ||
125 | extern int langopt; | |
126 | extern int dotsopt; | |
127 | extern int dbgopt; | |
128 | extern int dbglevel; | |
129 | ||
130 | extern int stnos[]; | |
131 | extern int nxtstno; | |
132 | extern int constno; | |
133 | extern int labno; | |
134 | extern int nerrs; | |
135 | extern int nbad; | |
136 | extern int nwarns; | |
137 | ||
138 | struct headbits | |
139 | { | |
140 | int tag:8; | |
141 | int subtype:8; | |
142 | int blklevel:8; | |
143 | }; | |
144 | ||
145 | extern struct fileblock | |
146 | { | |
147 | FILE *fileptr; | |
148 | char filename[20]; | |
149 | }; | |
150 | ||
151 | extern struct fileblock *ibfile; | |
152 | extern struct fileblock *icfile; | |
153 | extern struct fileblock *idfile; | |
154 | extern struct fileblock *iefile; | |
155 | ||
156 | extern struct chain | |
157 | { | |
158 | ptr nextp; | |
159 | ptr datap; | |
160 | } ; | |
161 | ||
162 | typedef struct chain *chainp; | |
163 | ||
164 | extern struct comentry | |
165 | { | |
166 | struct headbits header; | |
167 | char comname[7]; | |
168 | long int comleng; | |
169 | int cominit:2; | |
170 | chainp comchain; | |
171 | } ; | |
172 | ||
173 | extern struct stentry | |
174 | { | |
175 | struct headbits header; | |
176 | char *namep; | |
177 | ptr varp; | |
178 | int hashval; | |
179 | }; | |
180 | ||
181 | extern struct stentry *hashtab[]; | |
182 | extern struct stentry **hashend; | |
183 | ||
184 | extern struct typeblock | |
185 | { | |
186 | struct headbits header; | |
187 | ptr sthead; | |
188 | ptr strdesc; | |
189 | int stralign; | |
190 | int strsize; | |
191 | int basetypes; | |
192 | } ; | |
193 | ||
194 | extern struct keyblock | |
195 | { | |
196 | struct headbits header; | |
197 | ptr sthead; | |
198 | } ; | |
199 | ||
200 | ||
201 | extern struct varblock | |
202 | { | |
203 | struct headbits header; | |
204 | ptr sthead; | |
205 | ptr vinit; | |
206 | int vadjdim:1; | |
207 | int vdcldone:1; | |
208 | int vdclstart:1; | |
209 | int vnamedone:1; | |
210 | int vprec:1; | |
211 | int vext:1; | |
212 | int vproc:2; | |
213 | int needpar:1; | |
214 | int vtype:4; | |
215 | int vclass:3; | |
216 | ptr vtypep; | |
217 | ptr vdim; | |
218 | ptr vsubs; | |
219 | ptr voffset; | |
220 | int vextbase; | |
221 | int vbase[NFTNTYPES]; | |
222 | } ; | |
223 | ||
224 | extern struct atblock | |
225 | { | |
226 | int atprec; | |
227 | int attype; | |
228 | int atext; | |
229 | int atclass; | |
230 | ptr attypep; | |
231 | ptr atcommon; | |
232 | ptr atdim; | |
233 | } ; | |
234 | ||
235 | extern struct dimblock | |
236 | { | |
237 | ptr nextp; | |
238 | ptr lowerb; | |
239 | ptr upperb; | |
240 | } ; | |
241 | ||
242 | extern struct exprblock /* must be same size as varblock */ | |
243 | { | |
244 | struct headbits header; | |
245 | ptr leftp; | |
246 | ptr rightp; | |
247 | int vadjdim:1; | |
248 | int vdcldone:1; | |
249 | int vdclstart:1; | |
250 | int vnamedone:1; | |
251 | int vprec:1; | |
252 | int vext:1; | |
253 | int vproc:2; | |
254 | int needpar:1; | |
255 | int vtype:4; | |
256 | int vclass:3; | |
257 | ptr vtypep; | |
258 | ptr vdim; | |
259 | ptr vsubs; | |
260 | ptr voffset; | |
261 | int vextbase; | |
262 | int vbase[NFTNTYPES]; | |
263 | } ; | |
264 | ||
265 | ||
266 | typedef union { struct varblock ; struct exprblock; } *nodep; | |
267 | ||
268 | extern struct execblock | |
269 | { | |
270 | struct headbits header; | |
271 | ptr temps; | |
272 | int labelno; | |
273 | int uniffable:1; | |
274 | int brnchend:1; | |
275 | int labeled:1; | |
276 | int copylab:1; | |
277 | int labdefined:1; | |
278 | int labused:1; | |
279 | int labinacc:1; | |
280 | ptr execdesc; | |
281 | ptr prevexec; | |
282 | int nxtlabno; | |
283 | int nftnst; | |
284 | } ; | |
285 | ||
286 | ||
287 | extern struct ctlblock /* must be same size as execblock */ | |
288 | { | |
289 | struct headbits header; | |
290 | ptr loopvar; | |
291 | ptr loopctl; | |
292 | ptr prevctl; | |
293 | int nextlab; | |
294 | int breaklab; | |
295 | int xlab; | |
296 | int indifn; | |
297 | } ; | |
298 | ||
299 | extern struct caseblock | |
300 | { | |
301 | struct headbits header; | |
302 | ptr nextcase; | |
303 | int labelno; | |
304 | int uniffable:1; | |
305 | int brnchend:1; | |
306 | int labeled:1; | |
307 | int copylab:1; | |
308 | int labdefined:1; | |
309 | int labused:1; | |
310 | int labinacc:1; | |
311 | ptr casexpr; | |
312 | } ; | |
313 | ||
314 | extern struct labelblock | |
315 | { | |
316 | struct headbits header; | |
317 | ptr sthead; | |
318 | int labelno; | |
319 | int uniffable:1; | |
320 | int brnchend:1; | |
321 | int labeled:1; | |
322 | int copylab:1; | |
323 | int labdefined:1; | |
324 | int labused:1; | |
325 | int labinacc:1; | |
326 | } ; | |
327 | ||
328 | extern struct defblock | |
329 | { | |
330 | struct headbits header; | |
331 | ptr sthead; | |
332 | char *valp; | |
333 | } ; | |
334 | ||
335 | extern struct doblock | |
336 | { | |
337 | struct headbits header; | |
338 | ptr dovar; | |
339 | ptr dopar[3]; | |
340 | } ; | |
341 | ||
342 | extern struct fieldspec | |
343 | { | |
344 | struct headbits header; | |
345 | int flbound; | |
346 | int frange; | |
347 | int frshift; | |
348 | int fanymore; | |
349 | } ; | |
350 | ||
351 | ||
352 | extern struct genblock | |
353 | { | |
354 | struct headbits header; | |
355 | ptr nextgenf; | |
356 | char *genname; | |
357 | char *genfname[NEFLTYPES]; | |
358 | int genftype[NEFLTYPES]; | |
359 | } ; | |
360 | ||
361 | ||
362 | extern struct knownname | |
363 | { | |
364 | struct headbits header; | |
365 | ptr nextfunct; | |
366 | char *funcname; | |
367 | int functype; | |
368 | } ; | |
369 | ||
370 | extern struct iostblock | |
371 | { | |
372 | struct headbits header; | |
373 | ptr leftp; /* padding */ | |
374 | ptr right; /* padding */ | |
375 | int vadjdim:1; | |
376 | int vdcldone:1; | |
377 | int vdclstart:1; | |
378 | int vnamedone:1; | |
379 | int vprec:1; | |
380 | int vext:1; | |
381 | int vproc:2; | |
382 | int needpar:1; | |
383 | int vtype:4; | |
384 | int vclass:3; | |
385 | int iokwd; | |
386 | ptr iounit; | |
387 | ptr iolist; | |
388 | int iojunk[7]; /* padding */ | |
389 | } ; | |
390 | ||
391 | extern struct ioitem | |
392 | { | |
393 | struct headbits header; | |
394 | ptr ioexpr; | |
395 | char *iofmt; | |
396 | } ; | |
397 | ||
398 | ||
399 | extern struct tailoring | |
400 | { | |
401 | int ftnsys; | |
402 | int errmode; | |
403 | int charcomp; | |
404 | int ftnin; | |
405 | int ftnout; | |
406 | int ftncontnu; | |
407 | char *procheader; | |
408 | int ftnchwd; | |
409 | int ftnsize[NFTNTYPES]; | |
410 | int ftnalign[NFTNTYPES]; | |
411 | char *dfltfmt[NEFLTYPES]; | |
412 | int hollincall; | |
413 | int deltastno; | |
414 | int dclintrinsics; | |
415 | } tailor; | |
416 | \f | |
417 | /*Block tags */ | |
418 | ||
419 | #define TAROP 1 | |
420 | #define TASGNOP 2 | |
421 | #define TLOGOP 3 | |
422 | #define TRELOP 4 | |
423 | #define TCALL 5 | |
424 | #define TREPOP 6 | |
425 | #define TLIST 7 | |
426 | #define TCONST 8 | |
427 | #define TNAME 9 | |
428 | #define TERROR 10 | |
429 | #define TCOMMON 11 | |
430 | #define TSTRUCT 12 | |
431 | #define TSTFUNCT 13 | |
432 | #define TEXEC 14 | |
433 | #define TTEMP 15 | |
434 | #define TDEFINE 16 | |
435 | #define TKEYWORD 17 | |
436 | #define TLABEL 18 | |
437 | #define TCASE 19 | |
438 | #define TNOTOP 20 | |
439 | #define TNEGOP 21 | |
440 | #define TDOBLOCK 22 | |
441 | #define TCONTROL 23 | |
442 | #define TKNOWNFUNCT 24 | |
443 | #define TFIELD 25 | |
444 | #define TGENERIC 26 | |
445 | #define TIOSTAT 27 | |
446 | ||
447 | /* Operator subtypes */ | |
448 | ||
449 | #define OPPLUS 1 | |
450 | #define OPMINUS 2 | |
451 | #define OPSTAR 3 | |
452 | #define OPSLASH 4 | |
453 | #define OPPOWER 5 | |
454 | ||
455 | #define OPNOT 6 | |
456 | #define OPAND 7 | |
457 | #define OP2AND 8 | |
458 | #define OP2OR 9 | |
459 | #define OPOR 10 | |
460 | ||
461 | #define OPEQ 11 | |
462 | #define OPLT 12 | |
463 | #define OPGT 13 | |
464 | #define OPLE 14 | |
465 | #define OPGE 15 | |
466 | #define OPNE 16 | |
467 | ||
468 | #define OPLPAR 17 | |
469 | #define OPRPAR 18 | |
470 | #define OPEQUALS 19 | |
471 | #define OPCOMMA 20 | |
472 | ||
473 | #define OPASGN 0 | |
474 | #define OPREL 0 | |
475 | ||
476 | ||
477 | /* Simplification types */ | |
478 | ||
479 | #define LVAL 1 | |
480 | #define RVAL 2 | |
481 | #define SUBVAL 3 | |
482 | #define IFVAL 4 | |
483 | ||
484 | ||
485 | /* Parser return values */ | |
486 | ||
487 | #define PARSERR 1 | |
488 | #define PARSEOF 2 | |
489 | #define PARSOPT 3 | |
490 | #define PARSDCL 4 | |
491 | #define PARSDEF 5 | |
492 | #define PARSPROC 6 | |
493 | \f | |
494 | ||
495 | /* Symbol table types */ | |
496 | ||
497 | #define TYUNDEFINED 0 | |
498 | #define TYINT 1 | |
499 | #define TYREAL 2 | |
500 | #define TYLREAL 3 | |
501 | #define TYLOG 4 | |
502 | #define TYCOMPLEX 5 | |
503 | #define TYCHAR 6 | |
504 | #define TYSTRUCT 7 | |
505 | #define TYLABEL 8 | |
506 | #define TYSUBR 9 | |
507 | #define TYFIELD 10 | |
508 | #define TYHOLLERITH 11 | |
509 | ||
510 | ||
511 | ||
512 | /* Fortran types */ | |
513 | ||
514 | #define FTNINT 0 | |
515 | #define FTNREAL 1 | |
516 | #define FTNLOG 2 | |
517 | #define FTNCOMPLEX 3 | |
518 | #define FTNDOUBLE 4 | |
519 | #define FTNCHAR 5 | |
520 | ||
521 | ||
522 | ||
523 | /* symbol table classes */ | |
524 | ||
525 | #define CLUNDEFINED 0 | |
526 | #define CLARG 1 | |
527 | #define CLVALUE 2 | |
528 | #define CLSTAT 3 | |
529 | #define CLAUTO 4 | |
530 | #define CLCOMMON 5 | |
531 | #define CLMOS 6 | |
532 | #define CLEXT 7 | |
533 | ||
534 | ||
535 | /* values of vproc */ | |
536 | ||
537 | #define PROCUNKNOWN 0 | |
538 | #define PROCNO 1 | |
539 | #define PROCYES 2 | |
540 | #define PROCINTRINSIC 3 | |
541 | ||
542 | ||
543 | ||
544 | /* ctlblock subtypes */ | |
545 | ||
546 | #define STNULL 1 | |
547 | #define STIF 2 | |
548 | #define STIFELSE 3 | |
549 | #define STREPEAT 4 | |
550 | #define STWHILE 5 | |
551 | #define STFOR 6 | |
552 | #define STDO 7 | |
553 | #define STSWITCH 8 | |
554 | #define STRETURN 9 | |
555 | #define STGOTO 10 | |
556 | #define STCALL 11 | |
557 | #define STPROC 12 | |
558 | ||
559 | ||
560 | ||
561 | /* intermediate code definitions */ | |
562 | ||
563 | #define ICEOF 0 | |
564 | #define ICBEGIN 1 | |
565 | #define ICKEYWORD 2 | |
566 | #define ICOP 3 | |
567 | #define ICNAME 4 | |
568 | #define ICCONST 5 | |
569 | #define ICLABEL 6 | |
570 | #define ICMARK 7 | |
571 | #define ICINDENT 8 | |
572 | #define ICCOMMENT 9 | |
573 | #define ICINDPTR 10 | |
574 | #define ICBLANK 11 | |
575 | ||
576 | #define FCONTINUE 2 | |
577 | #define FCALL 3 | |
578 | #define FDO 4 | |
579 | #define FIF1 5 | |
580 | #define FIF2 6 | |
581 | #define FGOTO 7 | |
582 | #define FRETURN 8 | |
583 | #define FREAD 9 | |
584 | #define FWRITE 10 | |
585 | #define FFORMAT 11 | |
586 | #define FSTOP 12 | |
587 | #define FDATA 13 | |
588 | #define FEQUIVALENCE 14 |