|
|
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 Extsym
169: {
170: char extname[XL];
171: field extstg;
172: unsigned extsave:1;
173: unsigned extinit:1;
174: chainp extp;
175: ftnint extleng;
176: ftnint maxleng;
177: };
178:
179: extern struct Extsym *extsymtab;
180: extern struct Extsym *nextext;
181: extern struct Extsym *lastext;
182:
183: struct Labelblock
184: {
185: int labelno;
186: unsigned blklevel:8;
187: unsigned labused:1;
188: unsigned labinacc:1;
189: unsigned labdefined:1;
190: unsigned labtype:2;
191: ftnint stateno;
192: };
193:
194: extern struct Labelblock *labeltab;
195: extern struct Labelblock *labtabend;
196: extern struct Labelblock *highlabtab;
197:
198: struct Entrypoint
199: {
200: struct Entrypoint *entnextp;
201: struct Extsym *entryname;
202: chainp arglist;
203: int entrylabel;
204: int typelabel;
205: Namep enamep;
206: };
207:
208: struct Primblock
209: {
210: field tag;
211: field vtype;
212: Namep namep;
213: struct Listblock *argsp;
214: expptr fcharp;
215: expptr lcharp;
216: };
217:
218:
219: struct Hashentry
220: {
221: int hashval;
222: Namep varp;
223: };
224: extern struct Hashentry *hashtab;
225: extern struct Hashentry *lasthash;
226:
227: struct Intrpacked /* bits for intrinsic function description */
228: {
229: unsigned f1:3;
230: unsigned f2:4;
231: unsigned f3:7;
232: };
233:
234: struct Nameblock
235: {
236: field tag;
237: field vtype;
238: field vclass;
239: field vstg;
240: expptr vleng;
241: char varname[VL];
242: unsigned vdovar:1;
243: unsigned vdcldone:1;
244: unsigned vadjdim:1;
245: unsigned vsave:1;
246: unsigned vprocclass:3;
247: unsigned vregno:4;
248: union {
249: int varno;
250: struct Intrpacked intrdesc; /* bits for intrinsic function*/
251: } vardesc;
252: struct Dimblock *vdim;
253: ftnint voffset;
254: union {
255: chainp namelist; /* points to chain of names in */
256: chainp vstfdesc; /* points to (formals, expr) pair */
257: } varxptr;
258: };
259:
260:
261: struct Paramblock
262: {
263: field tag;
264: field vtype;
265: field vclass;
266: field vstg;
267: expptr vleng;
268: char varname[VL];
269: expptr paramval;
270: } ;
271:
272:
273: struct Exprblock
274: {
275: field tag;
276: field vtype;
277: field vclass;
278: field vstg;
279: expptr vleng;
280: unsigned opcode:6;
281: expptr leftp;
282: expptr rightp;
283: };
284:
285:
286: union Constant
287: {
288: char *ccp;
289: ftnint ci;
290: double cd[2];
291: };
292:
293: struct Constblock
294: {
295: field tag;
296: field vtype;
297: field vclass;
298: field vstg;
299: expptr vleng;
300: union Constant const;
301: };
302:
303:
304: struct Listblock
305: {
306: field tag;
307: field vtype;
308: chainp listp;
309: };
310:
311:
312:
313: struct Addrblock
314: {
315: field tag;
316: field vtype;
317: field vclass;
318: field vstg;
319: expptr vleng;
320: int memno;
321: expptr memoffset;
322: unsigned istemp:1;
323: unsigned ntempelt:10;
324: ftnint varleng;
325: };
326:
327:
328:
329: struct Errorblock
330: {
331: field tag;
332: field vtype;
333: };
334:
335:
336: union Expression
337: {
338: field tag;
339: struct Headblock headblock;
340: struct Exprblock exprblock;
341: struct Addrblock addrblock;
342: struct Constblock constblock;
343: struct Errorblock errorblock;
344: struct Listblock listblock;
345: struct Primblock primblock;
346: } ;
347:
348:
349:
350: struct Dimblock
351: {
352: int ndim;
353: expptr nelt;
354: expptr baseoffset;
355: expptr basexpr;
356: struct
357: {
358: expptr dimsize;
359: expptr dimexpr;
360: } dims[1];
361: };
362:
363:
364: struct Impldoblock
365: {
366: field tag;
367: unsigned isactive:1;
368: unsigned isbusy:1;
369: Namep varnp;
370: Constp varvp;
371: chainp impdospec;
372: expptr implb;
373: expptr impub;
374: expptr impstep;
375: ftnint impdiff;
376: ftnint implim;
377: struct Chain *datalist;
378: };
379:
380:
381: struct Rplblock /* name replacement block */
382: {
383: struct Rplblock *rplnextp;
384: Namep rplnp;
385: expptr rplvp;
386: expptr rplxp;
387: int rpltag;
388: };
389:
390:
391:
392: struct Equivblock
393: {
394: struct Eqvchain *equivs;
395: flag eqvinit;
396: long int eqvtop;
397: long int eqvbottom;
398: } ;
399: #define eqvleng eqvtop
400:
401: extern struct Equivblock *eqvclass;
402:
403:
404: struct Eqvchain
405: {
406: struct Eqvchain *eqvnextp;
407: union
408: {
409: struct Primblock *eqvlhs;
410: Namep eqvname;
411: } eqvitem;
412: long int eqvoffset;
413: } ;
414:
415:
416: union Taggedblock
417: {
418: field tag;
419: struct Headblock headblock;
420: struct Nameblock nameblock;
421: struct Paramblock paramblock;
422: struct Exprblock exprblock;
423: struct Constblock constblock;
424: struct Listblock listblock;
425: struct Addrblock addrblock;
426: struct Errorblock errorblock;
427: struct Primblock primblock;
428: struct Impldoblock impldoblock;
429: } ;
430:
431:
432:
433:
434: struct Literal
435: {
436: short littype;
437: short litnum;
438: union {
439: ftnint litival;
440: double litdval;
441: struct {
442: char litclen; /* small integer */
443: char litcstr[XL];
444: } litcval;
445: } litval;
446: };
447:
448: extern struct Literal litpool[ ];
449: extern int nliterals;
450:
451:
452:
453: /* popular functions with non integer return values */
454:
455:
456: int *ckalloc();
457: char *varstr(), *nounder(), *varunder();
458: char *copyn(), *copys();
459: chainp hookup(), mkchain();
460: ftnint convci();
461: char *convic();
462: char *setdoto();
463: double convcd();
464: Namep mkname();
465: struct Labelblock *mklabel(), *execlab();
466: struct Extsym *mkext(), *newentry();
467: expptr addrof(), call1(), call2(), call3(), call4();
468: Addrp builtin(), mktemp(), mktmpn(), autovar();
469: Addrp mkplace(), mkaddr(), putconst(), memversion();
470: expptr mkprim(), mklhs(), mkexpr(), mkconv(), mkfunct(), fixexpr(), fixtype();
471: expptr errnode(), mkintcon();
472: tagptr cpexpr();
473: ftnint lmin(), lmax(), iarrlen();
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.