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