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