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