![[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 [CSRG BSD Unix] / 40BSD / cmd / f77|
Return to init.c CVS log | Up to [CSRG BSD Unix] / 40BSD / 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[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: Addrp typeaddr;
57: Addrp 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: Namep 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: Addrp ioblkp;
114: int iostmt;
115: int nioctl;
116: int nequiv = 0;
117: int eqvstart = 0;
118: int nintnames = 0;
119:
120: #ifdef SDB
121: int dbglabel = 0;
122: flag sdbflag = NO;
123: #endif
124:
125: struct Literal litpool[MAXLITERALS];
126: int nliterals;
127:
128:
129:
130: fileinit()
131: {
132: procno = 0;
133: lastlabno = 10;
134: lastvarno = 0;
135: nliterals = 0;
136: nerr = 0;
137: ndata = 0;
138:
139: ctls = ALLOCN(maxctl, Ctlframe);
140: extsymtab = ALLOCN(maxext, Extsym);
141: eqvclass = ALLOCN(maxequiv, Equivblock);
142: hashtab = ALLOCN(maxhash, Hashentry);
143: labeltab = ALLOCN(maxstno, Labelblock);
144:
145: ctlstack = ctls - 1;
146: lastctl = ctls + maxctl;
147: nextext = extsymtab;
148: lastext = extsymtab + maxext;
149: lasthash = hashtab + maxhash;
150: labtabend = labeltab + maxstno;
151: highlabtab = labeltab;
152: }
153:
154:
155:
156:
157:
158: procinit()
159: {
160: register Namep p;
161: register struct Dimblock *q;
162: register struct Hashentry *hp;
163: register struct Labelblock *lp;
164: struct Chain *cp;
165: int i;
166:
167: pruse(asmfile, USECONST);
168: #if FAMILY == PCC
169: p2pass(USETEXT);
170: #endif
171: parstate = OUTSIDE;
172: headerdone = NO;
173: blklevel = 1;
174: saveall = NO;
175: substars = NO;
176: nwarn = 0;
177: thislabel = NULL;
178: needkwd = 0;
179:
180: ++procno;
181: proctype = TYUNKNOWN;
182: procname = "MAIN_ ";
183: procclass = CLUNKNOWN;
184: nentry = 0;
185: multitype = NO;
186: typeaddr = NULL;
187: retslot = NULL;
188: cxslot = -1;
189: chslot = -1;
190: chlgslot = -1;
191: procleng = 0;
192: blklevel = 1;
193: lastargslot = 0;
194: #if TARGET==PDP11
195: autoleng = 6;
196: #else
197: autoleng = 0;
198: #endif
199:
200: for(lp = labeltab ; lp < labtabend ; ++lp)
201: lp->stateno = 0;
202:
203: for(hp = hashtab ; hp < lasthash ; ++hp)
204: if(p = hp->varp)
205: {
206: frexpr(p->vleng);
207: if(q = p->vdim)
208: {
209: for(i = 0 ; i < q->ndim ; ++i)
210: {
211: frexpr(q->dims[i].dimsize);
212: frexpr(q->dims[i].dimexpr);
213: }
214: frexpr(q->nelt);
215: frexpr(q->baseoffset);
216: frexpr(q->basexpr);
217: free( (charptr) q);
218: }
219: if(p->vclass == CLNAMELIST)
220: frchain( &(p->varxptr.namelist) );
221: free( (charptr) p);
222: hp->varp = NULL;
223: }
224: nintnames = 0;
225: highlabtab = labeltab;
226:
227: ctlstack = ctls - 1;
228: for(cp = templist ; cp ; cp = cp->nextp)
229: free( (charptr) (cp->datap) );
230: frchain(&templist);
231: holdtemps = NULL;
232: dorange = 0;
233: nregvar = 0;
234: highregvar = 0;
235: entries = NULL;
236: rpllist = NULL;
237: inioctl = NO;
238: ioblkp = NULL;
239: eqvstart += nequiv;
240: nequiv = 0;
241:
242: for(i = 0 ; i<NTYPES ; ++i)
243: rtvlabel[i] = 0;
244: fudgelabel = 0;
245:
246: if(undeftype)
247: setimpl(TYUNKNOWN, (ftnint) 0, 'a', 'z');
248: else
249: {
250: setimpl(TYREAL, (ftnint) 0, 'a', 'z');
251: setimpl(tyint, (ftnint) 0, 'i', 'n');
252: }
253: setimpl(-STGBSS, (ftnint) 0, 'a', 'z'); /* set class */
254: setlog();
255: }
256:
257:
258:
259:
260: setimpl(type, length, c1, c2)
261: int type;
262: ftnint length;
263: int c1, c2;
264: {
265: int i;
266: char buff[100];
267:
268: if(c1==0 || c2==0)
269: return;
270:
271: if(c1 > c2)
272: {
273: sprintf(buff, "characters out of order in implicit:%c-%c", c1, c2);
274: err(buff);
275: }
276: else
277: if(type < 0)
278: for(i = c1 ; i<=c2 ; ++i)
279: implstg[i-'a'] = - type;
280: else
281: {
282: type = lengtype(type, (int) length);
283: if(type != TYCHAR)
284: length = 0;
285: for(i = c1 ; i<=c2 ; ++i)
286: {
287: impltype[i-'a'] = type;
288: implleng[i-'a'] = length;
289: }
290: }
291: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.