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