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