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