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