|
|
1.1 root 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:
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:
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
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.