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