1/*	Id: init.c,v 1.16 2008/12/24 17:40:41 sgk Exp 	*/
2/*	$NetBSD: init.c,v 1.1.1.3 2010/06/03 18:57:48 plunky Exp $	*/
3/*
4 * Copyright(C) Caldera International Inc. 2001-2002. All rights reserved.
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * Redistributions of source code and documentation must retain the above
11 * copyright notice, this list of conditions and the following disclaimer.
12 * Redistributions in binary form must reproduce the above copyright
13 * notice, this list of conditionsand the following disclaimer in the
14 * documentation and/or other materials provided with the distribution.
15 * All advertising materials mentioning features or use of this software
16 * must display the following acknowledgement:
17 * 	This product includes software developed or owned by Caldera
18 *	International, Inc.
19 * Neither the name of Caldera International, Inc. nor the names of other
20 * contributors may be used to endorse or promote products derived from
21 * this software without specific prior written permission.
22 *
23 * USE OF THE SOFTWARE PROVIDED FOR UNDER THIS LICENSE BY CALDERA
24 * INTERNATIONAL, INC. AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR
25 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
26 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
27 * DISCLAIMED.  IN NO EVENT SHALL CALDERA INTERNATIONAL, INC. BE LIABLE
28 * FOR ANY DIRECT, INDIRECT INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
29 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
30 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
31 * HOWEVER CAUSED AND ON ANY THEORY OFLIABILITY, WHETHER IN CONTRACT,
32 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
33 * IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
34 * POSSIBILITY OF SUCH DAMAGE.
35 */
36#include "defines.h"
37#include "defs.h"
38
39
40FILEP infile;
41FILEP diagfile;
42
43long int headoffset;
44
45char token[100];
46int toklen;
47int lineno;
48char *infname;
49int needkwd;
50struct labelblock *thislabel	= NULL;
51flag nowarnflag	= NO;
52flag ftn66flag	= NO;
53flag profileflag	= NO;
54flag optimflag	= NO;
55flag quietflag	= NO;
56flag shiftcase	= YES;
57flag undeftype	= NO;
58flag shortsubs	= YES;
59flag onetripflag	= NO;
60flag checksubs	= NO;
61flag debugflag	= NO;
62int nerr;
63int nwarn;
64int ndata;
65
66flag saveall;
67flag substars;
68int parstate	= OUTSIDE;
69flag headerdone	= NO;
70int blklevel;
71int impltype[26];
72int implleng[26];
73int implstg[26];
74
75int tyint	= TYLONG ;
76int tylogical	= TYLONG;
77ftnint typesize[NTYPES]
78	= { 1, FSZADDR, FSZSHORT, FSZLONG, FSZLONG, 2*FSZLONG,
79	    2*FSZLONG, 4*FSZLONG, FSZLONG, 1, 1, 1};
80int typealign[NTYPES]
81	= { 1, ALIADDR, ALISHORT, ALILONG, ALILONG, ALIDOUBLE,
82	    ALILONG, ALIDOUBLE, ALILONG, 1, 1, 1};
83int procno;
84int proctype	= TYUNKNOWN;
85char *procname;
86int rtvlabel[NTYPES];
87int fudgelabel;
88struct bigblock *typeaddr;
89struct bigblock *retslot;
90int cxslot	= -1;
91int chslot	= -1;
92int chlgslot	= -1;
93int procclass	= CLUNKNOWN;
94int nentry;
95flag multitype;
96ftnint procleng;
97int lastlabno	= 10;
98int lastvarno;
99int lastargslot;
100int argloc;
101ftnint autoleng;
102ftnint bssleng	= 0;
103int retlabel;
104int ret0label;
105struct ctlframe ctls[MAXCTL];
106struct ctlframe *ctlstack	= ctls-1;
107struct ctlframe *lastctl	= ctls+MAXCTL ;
108
109bigptr regnamep[10]; /* XXX MAXREGVAR */
110int highregvar;
111
112struct extsym extsymtab[MAXEXT];
113struct extsym *nextext	= extsymtab;
114struct extsym *lastext	= extsymtab+MAXEXT;
115
116struct equivblock eqvclass[MAXEQUIV];
117struct hashentry hashtab[MAXHASH];
118struct hashentry *lasthash	= hashtab+MAXHASH;
119
120struct labelblock labeltab[MAXSTNO];
121struct labelblock *labtabend	= labeltab+MAXSTNO;
122struct labelblock *highlabtab =	labeltab;
123chainp rpllist	= NULL;
124chainp curdtp	= NULL;
125flag toomanyinit;
126ftnint curdtelt;
127chainp templist	= NULL;
128chainp holdtemps	= NULL;
129int dorange	= 0;
130chainp entries	= NULL;
131chainp chains	= NULL;
132
133flag inioctl;
134struct bigblock *ioblkp;
135int iostmt;
136int nioctl;
137int nequiv	= 0;
138int nintnames	= 0;
139int nextnames	= 0;
140
141struct literal litpool[MAXLITERALS];
142int nliterals;
143
144/*
145 * Return a number for internal labels.
146 */
147int getlab(void);
148
149int crslab = 10;
150int
151getlab(void)
152{
153	return crslab++;
154}
155
156
157void
158fileinit()
159{
160procno = 0;
161lastlabno = 10;
162lastvarno = 0;
163nextext = extsymtab;
164nliterals = 0;
165nerr = 0;
166ndata = 0;
167}
168
169
170
171
172void
173procinit()
174{
175register struct bigblock *p;
176register struct dimblock *q;
177register struct hashentry *hp;
178register struct labelblock *lp;
179chainp cp;
180int i;
181
182	setloc(RDATA);
183parstate = OUTSIDE;
184headerdone = NO;
185blklevel = 1;
186saveall = NO;
187substars = NO;
188nwarn = 0;
189thislabel = NULL;
190needkwd = 0;
191
192++procno;
193proctype = TYUNKNOWN;
194procname = "MAIN_    ";
195procclass = CLUNKNOWN;
196nentry = 0;
197multitype = NO;
198typeaddr = NULL;
199retslot = NULL;
200cxslot = -1;
201chslot = -1;
202chlgslot = -1;
203procleng = 0;
204blklevel = 1;
205lastargslot = 0;
206	autoleng = AUTOINIT;
207
208for(lp = labeltab ; lp < labtabend ; ++lp)
209	lp->stateno = 0;
210
211for(hp = hashtab ; hp < lasthash ; ++hp)
212	if((p = hp->varp))
213		{
214		frexpr(p->vleng);
215		if((q = p->b_name.vdim))
216			{
217			for(i = 0 ; i < q->ndim ; ++i)
218				{
219				frexpr(q->dims[i].dimsize);
220				frexpr(q->dims[i].dimexpr);
221				}
222			frexpr(q->nelt);
223			frexpr(q->baseoffset);
224			frexpr(q->basexpr);
225			ckfree(q);
226			}
227		ckfree(p);
228		hp->varp = NULL;
229		}
230nintnames = 0;
231highlabtab = labeltab;
232
233ctlstack = ctls - 1;
234for(cp = templist ; cp ; cp = cp->chain.nextp)
235	ckfree(cp->chain.datap);
236frchain(&templist);
237holdtemps = NULL;
238dorange = 0;
239highregvar = 0;
240entries = NULL;
241rpllist = NULL;
242inioctl = NO;
243ioblkp = NULL;
244nequiv = 0;
245
246for(i = 0 ; i<NTYPES ; ++i)
247	rtvlabel[i] = 0;
248fudgelabel = 0;
249
250if(undeftype)
251	setimpl(TYUNKNOWN, (ftnint) 0, 'a', 'z');
252else
253	{
254	setimpl(TYREAL, (ftnint) 0, 'a', 'z');
255	setimpl(tyint,  (ftnint) 0, 'i', 'n');
256	}
257setimpl(-STGBSS, (ftnint) 0, 'a', 'z');	/* set class */
258setlog();
259}
260
261
262
263void
264setimpl(type, length, c1, c2)
265int type;
266ftnint length;
267int c1, c2;
268{
269int i;
270char buff[100];
271
272if(c1==0 || c2==0)
273	return;
274
275if(c1 > c2) {
276	sprintf(buff, "characters out of order in implicit:%c-%c", c1, c2);
277	err(buff);
278} else
279	if(type < 0)
280		for(i = c1 ; i<=c2 ; ++i)
281			implstg[i-'a'] = - type;
282	else
283		{
284		type = lengtype(type, (int) length);
285		if(type != TYCHAR)
286			length = 0;
287		for(i = c1 ; i<=c2 ; ++i)
288			{
289			impltype[i-'a'] = type;
290			implleng[i-'a'] = length;
291			}
292		}
293}
294