![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to init.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / f77|
Return to init.c CVS log | Up to [Research Unix] / researchv10no / cmd / f77 |
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[1320]; /* allow long strings */
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 lwmno;
53: int proctype = TYUNKNOWN;
54: char *procname;
55: int rtvlabel[NTYPES];
56: int fudgelabel;
57: Addrp typeaddr;
58: Addrp retslot;
59: int cxslot = -1;
60: int chslot = -1;
61: int chlgslot = -1;
62: int procclass = CLUNKNOWN;
63: int nentry;
64: flag multitype;
65: ftnint procleng;
66: int lastlabno = 10;
67: int lastvarno;
68: int lastargslot;
69: int argloc;
70: ftnint autoleng;
71: ftnint bssleng = 0;
72: int retlabel;
73: int ret0label;
74:
75: int maxctl = MAXCTL;
76: struct Ctlframe *ctls;
77: struct Ctlframe *ctlstack;
78: struct Ctlframe *lastctl;
79:
80: Namep regnamep[MAXREGVAR];
81: int highregvar;
82: int nregvar;
83:
84: int maxext = MAXEXT;
85: struct Extsym *extsymtab;
86: struct Extsym *nextext;
87: struct Extsym *lastext;
88:
89: int maxequiv = MAXEQUIV;
90: struct Equivblock *eqvclass;
91:
92: int maxhash = MAXHASH;
93: struct Hashentry *hashtab;
94: struct Hashentry *lasthash;
95:
96: int maxstno = MAXSTNO;
97: struct Labelblock *labeltab;
98: struct Labelblock *labtabend;
99: struct Labelblock *highlabtab;
100:
101: int maxdim = MAXDIM;
102: struct Rplblock *rpllist = NULL;
103: struct Chain *curdtp = NULL;
104: flag toomanyinit;
105: ftnint curdtelt;
106: chainp templist = NULL;
107: chainp holdtemps = NULL;
108: int dorange = 0;
109: struct Entrypoint *entries = NULL;
110:
111: chainp chains = NULL;
112:
113: flag inioctl;
114: Addrp ioblkp;
115: int iostmt;
116: int nioctl;
117: int nequiv = 0;
118: int eqvstart = 0;
119: int nintnames = 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: lwmno = 0;
135: lastlabno = 10;
136: lastvarno = 0;
137: nliterals = 0;
138: nerr = 0;
139: ndata = 0;
140:
141: ctls = ALLOCN(maxctl, Ctlframe);
142: extsymtab = ALLOCN(maxext, Extsym);
143: eqvclass = ALLOCN(maxequiv, Equivblock);
144: hashtab = ALLOCN(maxhash, Hashentry);
145: labeltab = ALLOCN(maxstno, Labelblock);
146:
147: ctlstack = ctls - 1;
148: lastctl = ctls + maxctl;
149: nextext = extsymtab;
150: lastext = extsymtab + maxext;
151: lasthash = hashtab + maxhash;
152: labtabend = labeltab + maxstno;
153: highlabtab = labeltab;
154: }
155:
156:
157:
158:
159:
160: procinit()
161: {
162: register Namep p;
163: register struct Dimblock *q;
164: register struct Hashentry *hp;
165: register struct Labelblock *lp;
166: struct Chain *cp;
167: int i;
168:
169: pruse(asmfile, USECONST);
170: #if FAMILY == PCC
171: p2pass(USETEXT);
172: #endif
173: parstate = OUTSIDE;
174: headerdone = NO;
175: blklevel = 1;
176: saveall = NO;
177: substars = NO;
178: nwarn = 0;
179: thislabel = NULL;
180: needkwd = 0;
181:
182: ++procno;
183: proctype = TYUNKNOWN;
184: procname = "MAIN_";
185: procclass = CLUNKNOWN;
186: nentry = 0;
187: multitype = NO;
188: typeaddr = NULL;
189: retslot = NULL;
190: cxslot = -1;
191: chslot = -1;
192: chlgslot = -1;
193: procleng = 0;
194: blklevel = 1;
195: lastargslot = 0;
196: #if TARGET==PDP11
197: autoleng = 6;
198: #else
199: autoleng = 0;
200: #endif
201:
202: for(lp = labeltab ; lp < labtabend ; ++lp)
203: lp->stateno = 0;
204:
205: for(hp = hashtab ; hp < lasthash ; ++hp)
206: if(p = hp->varp)
207: {
208: frexpr(p->vleng);
209: if(q = p->vdim)
210: {
211: for(i = 0 ; i < q->ndim ; ++i)
212: {
213: frexpr(q->dims[i].dimsize);
214: frexpr(q->dims[i].dimexpr);
215: }
216: frexpr(q->nelt);
217: frexpr(q->baseoffset);
218: frexpr(q->basexpr);
219: free( (charptr) q);
220: }
221: if(p->vclass == CLNAMELIST)
222: frchain( &(p->varxptr.namelist) );
223: free( (charptr) p);
224: hp->varp = NULL;
225: }
226: nintnames = 0;
227: highlabtab = labeltab;
228:
229: ctlstack = ctls - 1;
230: for(cp = templist ; cp ; cp = cp->nextp)
231: free( (charptr) (cp->datap) );
232: frchain(&templist);
233: holdtemps = NULL;
234: dorange = 0;
235: nregvar = 0;
236: highregvar = 0;
237: entries = NULL;
238: rpllist = NULL;
239: inioctl = NO;
240: ioblkp = NULL;
241: eqvstart += nequiv;
242: nequiv = 0;
243:
244: for(i = 0 ; i<NTYPES ; ++i)
245: rtvlabel[i] = 0;
246: fudgelabel = 0;
247:
248: if(undeftype)
249: setimpl(TYUNKNOWN, (ftnint) 0, 'a', 'z');
250: else
251: {
252: setimpl(TYREAL, (ftnint) 0, 'a', 'z');
253: setimpl(tyint, (ftnint) 0, 'i', 'n');
254: }
255: setimpl(-STGBSS, (ftnint) 0, 'a', 'z'); /* set class */
256: setlog();
257: }
258:
259:
260:
261:
262: setimpl(type, length, c1, c2)
263: int type;
264: ftnint length;
265: int c1, c2;
266: {
267: int i;
268: char buff[100];
269:
270: if(c1==0 || c2==0)
271: return;
272:
273: if(c1 > c2)
274: {
275: sprintf(buff, "characters out of order in implicit:%c-%c", c1, c2);
276: err(buff);
277: }
278: else
279: if(type < 0)
280: for(i = c1 ; i<=c2 ; ++i)
281: implstg[i-'a'] = - type;
282: else
283: {
284: type = lengtype(type, (int) length);
285: if(type != TYCHAR)
286: length = 0;
287: for(i = c1 ; i<=c2 ; ++i)
288: {
289: impltype[i-'a'] = type;
290: implleng[i-'a'] = length;
291: }
292: }
293: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.