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