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