|
|
1.1 root 1: #include "defs"
2:
3:
4: FILEP infile = { stdin };
5: FILEP diagfile = { stderr };
6:
7: FILEP textfile;
8: FILEP asmfile;
9: FILEP initfile;
10: long int headoffset;
11:
12: char token[200];
13: int toklen;
14: int lineno;
15: char *infname;
16: int needkwd;
17: struct Labelblock *thislabel = NULL;
18: flag nowarnflag = NO;
19: flag ftn66flag = NO;
20: flag no66flag = NO;
21: flag noextflag = NO;
22: flag profileflag = NO;
23: flag optimflag = NO;
24: flag shiftcase = YES;
25: flag undeftype = NO;
26: flag shortsubs = YES;
27: flag onetripflag = NO;
28: flag checksubs = NO;
29: flag debugflag = NO;
30: int nerr;
31: int nwarn;
32: int ndata;
33:
34: flag saveall;
35: flag substars;
36: int parstate = OUTSIDE;
37: flag headerdone = NO;
38: int blklevel;
39: int impltype[26];
40: int implleng[26];
41: int implstg[26];
42:
43: int tyint = TYLONG ;
44: int tylogical = TYLONG;
45: ftnint typesize[NTYPES]
46: = { 1, SZADDR, SZSHORT, SZLONG, SZLONG, 2*SZLONG,
47: 2*SZLONG, 4*SZLONG, SZLONG, 1, 1, 1};
48: int typealign[NTYPES]
49: = { 1, ALIADDR, ALISHORT, ALILONG, ALILONG, ALIDOUBLE,
50: ALILONG, ALIDOUBLE, ALILONG, 1, 1, 1};
51: int procno;
52: int proctype = TYUNKNOWN;
53: char *procname;
54: int rtvlabel[NTYPES];
55: int fudgelabel;
56: struct Addrblock *typeaddr;
57: struct Addrblock *retslot;
58: int cxslot = -1;
59: int chslot = -1;
60: int chlgslot = -1;
61: int procclass = CLUNKNOWN;
62: int nentry;
63: flag multitype;
64: ftnint procleng;
65: int lastlabno = 10;
66: int lastvarno;
67: int lastargslot;
68: int argloc;
69: ftnint autoleng;
70: ftnint bssleng = 0;
71: int retlabel;
72: int ret0label;
73:
74: int maxctl = MAXCTL;
75: struct Ctlframe *ctls;
76: struct Ctlframe *ctlstack;
77: struct Ctlframe *lastctl;
78:
79: struct Nameblock *regnamep[MAXREGVAR];
80: int highregvar;
81: int nregvar;
82:
83: int maxext = MAXEXT;
84: struct Extsym *extsymtab;
85: struct Extsym *nextext;
86: struct Extsym *lastext;
87:
88: int maxequiv = MAXEQUIV;
89: struct Equivblock *eqvclass;
90:
91: int maxhash = MAXHASH;
92: struct Hashentry *hashtab;
93: struct Hashentry *lasthash;
94:
95: int maxstno = MAXSTNO;
96: struct Labelblock *labeltab;
97: struct Labelblock *labtabend;
98: struct Labelblock *highlabtab;
99:
100: int maxdim = MAXDIM;
101: struct Rplblock *rpllist = NULL;
102: struct Chain *curdtp = NULL;
103: flag toomanyinit;
104: ftnint curdtelt;
105: chainp templist = NULL;
106: chainp holdtemps = NULL;
107: int dorange = 0;
108: struct Entrypoint *entries = NULL;
109:
110: chainp chains = NULL;
111:
112: flag inioctl;
113: struct Addrblock *ioblkp;
114: int iostmt;
115: int nioctl;
116: int nequiv = 0;
117: int eqvstart = 0;
118: int nintnames = 0;
119: int nextnames = 0;
120:
121: #ifdef SDB
122: int dbglabel = 0;
123: flag sdbflag = NO;
124: #endif
125:
126: struct Literal litpool[MAXLITERALS];
127: int nliterals;
128:
129:
130:
131: fileinit()
132: {
133: procno = 0;
134: lastlabno = 10;
135: lastvarno = 0;
136: nliterals = 0;
137: nerr = 0;
138: ndata = 0;
139:
140: ctls = ALLOCN(maxctl, Ctlframe);
141: extsymtab = ALLOCN(maxext, Extsym);
142: eqvclass = ALLOCN(maxequiv, Equivblock);
143: hashtab = ALLOCN(maxhash, Hashentry);
144: labeltab = ALLOCN(maxstno, Labelblock);
145:
146: ctlstack = ctls - 1;
147: lastctl = ctls + maxctl;
148: nextext = extsymtab;
149: lastext = extsymtab + maxext;
150: lasthash = hashtab + maxhash;
151: labtabend = labeltab + maxstno;
152: highlabtab = labeltab;
153: }
154:
155:
156:
157:
158:
159: procinit()
160: {
161: register struct Nameblock *p;
162: register struct Dimblock *q;
163: register struct Hashentry *hp;
164: register struct Labelblock *lp;
165: struct Chain *cp;
166: int i;
167:
168: pruse(asmfile, USECONST);
169: #if FAMILY == PCC
170: p2pass(USETEXT);
171: #endif
172: parstate = OUTSIDE;
173: headerdone = NO;
174: blklevel = 1;
175: saveall = NO;
176: substars = NO;
177: nwarn = 0;
178: thislabel = NULL;
179: needkwd = 0;
180:
181: ++procno;
182: proctype = TYUNKNOWN;
183: procname = "MAIN_ ";
184: procclass = CLUNKNOWN;
185: nentry = 0;
186: multitype = NO;
187: typeaddr = NULL;
188: retslot = NULL;
189: cxslot = -1;
190: chslot = -1;
191: chlgslot = -1;
192: procleng = 0;
193: blklevel = 1;
194: lastargslot = 0;
195: #if TARGET==PDP11
196: autoleng = 6;
197: #else
198: autoleng = 0;
199: #endif
200:
201: for(lp = labeltab ; lp < labtabend ; ++lp)
202: lp->stateno = 0;
203:
204: for(hp = hashtab ; hp < lasthash ; ++hp)
205: if(p = hp->varp)
206: {
207: frexpr(p->vleng);
208: if(q = p->vdim)
209: {
210: for(i = 0 ; i < q->ndim ; ++i)
211: {
212: frexpr(q->dims[i].dimsize);
213: frexpr(q->dims[i].dimexpr);
214: }
215: frexpr(q->nelt);
216: frexpr(q->baseoffset);
217: frexpr(q->basexpr);
218: free(q);
219: }
220: free(p);
221: hp->varp = NULL;
222: }
223: nintnames = 0;
224: highlabtab = labeltab;
225:
226: ctlstack = ctls - 1;
227: for(cp = templist ; cp ; cp = cp->nextp)
228: free(cp->datap);
229: frchain(&templist);
230: holdtemps = NULL;
231: dorange = 0;
232: nregvar = 0;
233: highregvar = 0;
234: entries = NULL;
235: rpllist = NULL;
236: inioctl = NO;
237: ioblkp = NULL;
238: eqvstart += nequiv;
239: nequiv = 0;
240:
241: for(i = 0 ; i<NTYPES ; ++i)
242: rtvlabel[i] = 0;
243: fudgelabel = 0;
244:
245: if(undeftype)
246: setimpl(TYUNKNOWN, (ftnint) 0, 'a', 'z');
247: else
248: {
249: setimpl(TYREAL, (ftnint) 0, 'a', 'z');
250: setimpl(tyint, (ftnint) 0, 'i', 'n');
251: }
252: setimpl(-STGBSS, (ftnint) 0, 'a', 'z'); /* set class */
253: setlog();
254: }
255:
256:
257:
258:
259: setimpl(type, length, c1, c2)
260: int type;
261: ftnint length;
262: int c1, c2;
263: {
264: int i;
265: char buff[100];
266:
267: if(c1==0 || c2==0)
268: return;
269:
270: if(c1 > c2)
271: {
272: sprintf(buff, "characters out of order in implicit:%c-%c", c1, c2);
273: err(buff);
274: }
275: else
276: if(type < 0)
277: for(i = c1 ; i<=c2 ; ++i)
278: implstg[i-'a'] = - type;
279: else
280: {
281: type = lengtype(type, (int) length);
282: if(type != TYCHAR)
283: length = 0;
284: for(i = c1 ; i<=c2 ; ++i)
285: {
286: impltype[i-'a'] = type;
287: implleng[i-'a'] = length;
288: }
289: }
290: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.