|
|
1.1 root 1: #include "stdio.h"
2: #ifndef NULL
3: /* ANSI C version */
4: #include "stddef.h"
5: #endif
6:
7: #ifdef unix
8: # include <ctype.h>
9: #endif
10:
11: #include "ftypes"
12: #include "defines"
13: #include "machdefs"
14:
15: #define VL 6
16:
17: #define MAXDIM 20
18: #define MAXINCLUDES 10
19: #define MAXLITERALS 20
20: #define MAXCTL 20
21: #define MAXHASH 401
22: #define MAXSTNO 801
23: #define MAXEXT 200
24: #define MAXEQUIV 150
25: #define MAXLABLIST 125
26:
27: typedef union Expression *expptr;
28: typedef union Taggedblock *tagptr;
29: typedef struct Chain *chainp;
30: typedef struct Addrblock *Addrp;
31: typedef struct Constblock *Constp;
32: typedef struct Exprblock *Exprp;
33: typedef struct Nameblock *Namep;
34:
35: extern FILEP infile;
36: extern FILEP diagfile;
37: extern FILEP textfile;
38: extern FILEP asmfile;
39: extern FILEP initfile;
40: extern long int headoffset;
41:
42: extern char token [ ];
43: extern int toklen;
44: extern int lineno;
45: extern char *infname;
46: extern int needkwd;
47: extern struct Labelblock *thislabel;
48:
49: extern int maxctl;
50: extern int maxequiv;
51: extern int maxstno;
52: extern int maxhash;
53: extern int maxext;
54:
55: extern flag profileflag;
56: extern flag optimflag;
57: extern flag nowarnflag;
58: extern flag ftn66flag;
59: extern flag no66flag;
60: extern flag noextflag;
61: extern flag shiftcase;
62: extern flag undeftype;
63: extern flag shortsubs;
64: extern flag onetripflag;
65: extern flag checksubs;
66: extern flag debugflag;
67: extern int nerr;
68: extern int nwarn;
69: extern int ndata;
70:
71: extern int parstate;
72: extern flag headerdone;
73: extern int blklevel;
74: extern flag saveall;
75: extern flag substars;
76: extern int impltype[ ];
77: extern int implleng[ ];
78: extern int implstg[ ];
79:
80: extern int tyint;
81: extern int tylogical;
82: extern ftnint typesize[];
83: extern int typealign[];
84: extern int procno;
85: extern int proctype;
86: extern char * procname;
87: extern int rtvlabel[ ];
88: extern int fudgelabel; /* to confuse the pdp11 optimizer */
89: extern Addrp typeaddr;
90: extern Addrp retslot;
91: extern int cxslot;
92: extern int chslot;
93: extern int chlgslot;
94: extern int procclass;
95: extern ftnint procleng;
96: extern int nentry;
97: extern flag multitype;
98: extern int blklevel;
99: extern int lastlabno;
100: extern int lastvarno;
101: extern int lastargslot;
102: extern int argloc;
103: extern ftnint autoleng;
104: extern ftnint bssleng;
105: extern int retlabel;
106: extern int ret0label;
107: extern int dorange;
108: extern int regnum[ ];
109: extern Namep regnamep[ ];
110: extern int maxregvar;
111: extern int highregvar;
112: extern int nregvar;
113:
114: extern chainp templist;
115: extern int maxdim;
116: extern chainp holdtemps;
117: extern struct Entrypoint *entries;
118: extern struct Rplblock *rpllist;
119: extern struct Chain *curdtp;
120: extern ftnint curdtelt;
121: extern flag toomanyinit;
122:
123: extern flag inioctl;
124: extern int iostmt;
125: extern Addrp ioblkp;
126: extern int nioctl;
127: extern int nequiv;
128: extern int eqvstart; /* offset to eqv number to guarantee uniqueness */
129: extern int nintnames;
130:
131: #ifdef SDB
132: extern int dbglabel;
133: extern flag sdbflag;
134: #endif
135:
136: struct Chain
137: {
138: chainp nextp;
139: tagptr datap;
140: };
141:
142: extern chainp chains;
143:
144: struct Headblock
145: {
146: field tag;
147: field vtype;
148: field vclass;
149: field vstg;
150: expptr vleng;
151: } ;
152:
153: struct Ctlframe
154: {
155: unsigned ctltype:8;
156: unsigned dostepsign:8;
157: int ctlabels[4];
158: int dolabel;
159: Namep donamep;
160: expptr domax;
161: expptr dostep;
162: };
163: #define endlabel ctlabels[0]
164: #define elselabel ctlabels[1]
165: #define dobodylabel ctlabels[1]
166: #define doposlabel ctlabels[2]
167: #define doneglabel ctlabels[3]
168: extern struct Ctlframe *ctls;
169: extern struct Ctlframe *ctlstack;
170: extern struct Ctlframe *lastctl;
171:
172: struct Comvar {
173: struct Comvar *next;
174: char *name, *tyid;
175: int type;
176: ftnint offset, nelt;
177: };
178:
179: struct Extsym
180: {
181: char extname[XL];
182: field extstg;
183: unsigned extsave:1;
184: unsigned extinit:1;
185: chainp extp;
186: struct Comvar *cv;
187: ftnint extleng;
188: ftnint maxleng;
189: };
190:
191: extern struct Extsym *extsymtab;
192: extern struct Extsym *nextext;
193: extern struct Extsym *lastext;
194: extern int complex_seen, dcomplex_seen;
195:
196: struct Labelblock
197: {
198: int labelno;
199: unsigned blklevel:8;
200: unsigned labused:1;
201: unsigned labinacc:1;
202: unsigned labdefined:1;
203: unsigned labtype:2;
204: ftnint stateno;
205: };
206:
207: extern struct Labelblock *labeltab;
208: extern struct Labelblock *labtabend;
209: extern struct Labelblock *highlabtab;
210:
211: struct Entrypoint
212: {
213: struct Entrypoint *entnextp;
214: struct Extsym *entryname;
215: chainp arglist;
216: int entrylabel;
217: int typelabel;
218: Namep enamep;
219: };
220:
221: struct Primblock
222: {
223: field tag;
224: field vtype;
225: Namep namep;
226: struct Listblock *argsp;
227: expptr fcharp;
228: expptr lcharp;
229: };
230:
231:
232: struct Hashentry
233: {
234: int hashval;
235: Namep varp;
236: };
237: extern struct Hashentry *hashtab;
238: extern struct Hashentry *lasthash;
239:
240: struct Intrpacked /* bits for intrinsic function description */
241: {
242: unsigned f1:3;
243: unsigned f2:4;
244: unsigned f3:7;
245: };
246:
247: struct Nameblock
248: {
249: field tag;
250: field vtype;
251: field vclass;
252: field vstg;
253: expptr vleng;
254: char varname[VL];
255: unsigned vdovar:1;
256: unsigned vdcldone:1;
257: unsigned vadjdim:1;
258: unsigned vsave:1;
259: unsigned vprocclass:3;
260: unsigned vregno:4;
261: unsigned vimpldovar:1;
262: union {
263: int varno;
264: struct Intrpacked intrdesc; /* bits for intrinsic function*/
265: } vardesc;
266: struct Dimblock *vdim;
267: ftnint voffset;
268: union {
269: chainp namelist; /* points to chain of names in */
270: chainp vstfdesc; /* points to (formals, expr) pair */
271: } varxptr;
272: int nlmemno; /* for namelist */
273: };
274:
275:
276: struct Paramblock
277: {
278: field tag;
279: field vtype;
280: field vclass;
281: field vstg;
282: expptr vleng;
283: char varname[VL];
284: expptr paramval;
285: } ;
286:
287:
288: struct Exprblock
289: {
290: field tag;
291: field vtype;
292: field vclass;
293: field vstg;
294: expptr vleng;
295: unsigned opcode:6;
296: expptr leftp;
297: expptr rightp;
298: };
299:
300:
301: union Constant
302: {
303: char *ccp;
304: ftnint ci;
305: double cd[2];
306: };
307:
308: struct Constblock
309: {
310: field tag;
311: field vtype;
312: field vclass;
313: field vstg;
314: expptr vleng;
315: union Constant Const;
316: };
317:
318:
319: struct Listblock
320: {
321: field tag;
322: field vtype;
323: chainp listp;
324: };
325:
326:
327:
328: struct Addrblock
329: {
330: field tag;
331: field vtype;
332: field vclass;
333: field vstg;
334: expptr vleng;
335: int memno;
336: expptr memoffset;
337: unsigned istemp:1;
338: unsigned ntempelt:10;
339: ftnint varleng;
340: };
341:
342:
343:
344: struct Errorblock
345: {
346: field tag;
347: field vtype;
348: };
349:
350:
351: union Expression
352: {
353: field tag;
354: struct Headblock headblock;
355: struct Exprblock exprblock;
356: struct Addrblock addrblock;
357: struct Constblock constblock;
358: struct Errorblock errorblock;
359: struct Listblock listblock;
360: struct Primblock primblock;
361: } ;
362:
363:
364:
365: struct Dimblock
366: {
367: int ndim;
368: expptr nelt;
369: expptr baseoffset;
370: expptr basexpr;
371: struct
372: {
373: expptr dimsize;
374: expptr dimexpr;
375: } dims[1];
376: };
377:
378:
379: struct Impldoblock
380: {
381: field tag;
382: unsigned isactive:1;
383: unsigned isbusy:1;
384: Namep varnp;
385: Constp varvp;
386: chainp impdospec;
387: expptr implb;
388: expptr impub;
389: expptr impstep;
390: ftnint impdiff;
391: ftnint implim;
392: struct Chain *datalist;
393: };
394:
395:
396: struct Rplblock /* name replacement block */
397: {
398: struct Rplblock *rplnextp;
399: Namep rplnp;
400: expptr rplvp;
401: expptr rplxp;
402: int rpltag;
403: };
404:
405:
406:
407: struct Equivblock
408: {
409: struct Eqvchain *equivs;
410: flag eqvinit;
411: #ifdef SDB
412: int comno;
413: #endif
414: long int eqvtop;
415: long int eqvbottom;
416: } ;
417: #define eqvleng eqvtop
418:
419: extern struct Equivblock *eqvclass;
420:
421:
422: struct Eqvchain
423: {
424: struct Eqvchain *eqvnextp;
425: union
426: {
427: struct Primblock *eqvlhs;
428: Namep eqvname;
429: } eqvitem;
430: long int eqvoffset;
431: } ;
432:
433:
434: union Taggedblock
435: {
436: field tag;
437: struct Headblock headblock;
438: struct Nameblock nameblock;
439: struct Paramblock paramblock;
440: struct Exprblock exprblock;
441: struct Constblock constblock;
442: struct Listblock listblock;
443: struct Addrblock addrblock;
444: struct Errorblock errorblock;
445: struct Primblock primblock;
446: struct Impldoblock impldoblock;
447: } ;
448:
449:
450:
451:
452: struct Literal
453: {
454: short littype;
455: short litnum;
456: union {
457: ftnint litival;
458: double litdval;
459: struct {
460: char litclen; /* small integer */
461: char litcstr[XL];
462: } litcval;
463: } litval;
464: };
465:
466: extern struct Literal litpool[ ];
467: extern int nliterals;
468:
469:
470:
471: /* popular functions with non integer return values */
472:
473:
474: int *ckalloc();
475: char *varstr(), *nounder(), *varunder();
476: char *copyn(), *copys();
477: chainp hookup(), mkchain();
478: ftnint convci();
479: char *convic();
480: char *setdoto();
481: double convcd();
482: Namep mkname();
483: struct Labelblock *mklabel(), *execlab();
484: struct Extsym *mkext(), *newentry();
485: expptr addrof(), call1(), call2(), call3(), call4();
486: Addrp builtin(), mktemp(), mktmpn(), autovar();
487: Addrp mkplace(), mkaddr(), putconst(), memversion();
488: expptr mkprim(), mklhs(), mkexpr(), mkconv(), mkfunct(), fixexpr(), fixtype();
489: expptr errnode(), mkintcon();
490: tagptr cpexpr();
491: ftnint lmin(), lmax(), iarrlen();
492: extern int bugwarn;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.