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