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
40 FILEP infile;
41 FILEP diagfile;
42
43 long int headoffset;
44
45 char token[100];
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 profileflag = NO;
54 flag optimflag = NO;
55 flag quietflag = NO;
56 flag shiftcase = YES;
57 flag undeftype = NO;
58 flag shortsubs = YES;
59 flag onetripflag = NO;
60 flag checksubs = NO;
61 flag debugflag = NO;
62 int nerr;
63 int nwarn;
64 int ndata;
65
66 flag saveall;
67 flag substars;
68 int parstate = OUTSIDE;
69 flag headerdone = NO;
70 int blklevel;
71 int impltype[26];
72 int implleng[26];
73 int implstg[26];
74
75 int tyint = TYLONG ;
76 int tylogical = TYLONG;
77 ftnint typesize[NTYPES]
78 = { 1, FSZADDR, FSZSHORT, FSZLONG, FSZLONG, 2*FSZLONG,
79 2*FSZLONG, 4*FSZLONG, FSZLONG, 1, 1, 1};
80 int typealign[NTYPES]
81 = { 1, ALIADDR, ALISHORT, ALILONG, ALILONG, ALIDOUBLE,
82 ALILONG, ALIDOUBLE, ALILONG, 1, 1, 1};
83 int procno;
84 int proctype = TYUNKNOWN;
85 char *procname;
86 int rtvlabel[NTYPES];
87 int fudgelabel;
88 struct bigblock *typeaddr;
89 struct bigblock *retslot;
90 int cxslot = -1;
91 int chslot = -1;
92 int chlgslot = -1;
93 int procclass = CLUNKNOWN;
94 int nentry;
95 flag multitype;
96 ftnint procleng;
97 int lastlabno = 10;
98 int lastvarno;
99 int lastargslot;
100 int argloc;
101 ftnint autoleng;
102 ftnint bssleng = 0;
103 int retlabel;
104 int ret0label;
105 struct ctlframe ctls[MAXCTL];
106 struct ctlframe *ctlstack = ctls-1;
107 struct ctlframe *lastctl = ctls+MAXCTL ;
108
109 bigptr regnamep[10]; /* XXX MAXREGVAR */
110 int highregvar;
111
112 struct extsym extsymtab[MAXEXT];
113 struct extsym *nextext = extsymtab;
114 struct extsym *lastext = extsymtab+MAXEXT;
115
116 struct equivblock eqvclass[MAXEQUIV];
117 struct hashentry hashtab[MAXHASH];
118 struct hashentry *lasthash = hashtab+MAXHASH;
119
120 struct labelblock labeltab[MAXSTNO];
121 struct labelblock *labtabend = labeltab+MAXSTNO;
122 struct labelblock *highlabtab = labeltab;
123 chainp rpllist = NULL;
124 chainp curdtp = NULL;
125 flag toomanyinit;
126 ftnint curdtelt;
127 chainp templist = NULL;
128 chainp holdtemps = NULL;
129 int dorange = 0;
130 chainp entries = NULL;
131 chainp chains = NULL;
132
133 flag inioctl;
134 struct bigblock *ioblkp;
135 int iostmt;
136 int nioctl;
137 int nequiv = 0;
138 int nintnames = 0;
139 int nextnames = 0;
140
141 struct literal litpool[MAXLITERALS];
142 int nliterals;
143
144 /*
145 * Return a number for internal labels.
146 */
147 int getlab(void);
148
149 int crslab = 10;
150 int
getlab(void)151 getlab(void)
152 {
153 return crslab++;
154 }
155
156
157 void
fileinit()158 fileinit()
159 {
160 procno = 0;
161 lastlabno = 10;
162 lastvarno = 0;
163 nextext = extsymtab;
164 nliterals = 0;
165 nerr = 0;
166 ndata = 0;
167 }
168
169
170
171
172 void
procinit()173 procinit()
174 {
175 register struct bigblock *p;
176 register struct dimblock *q;
177 register struct hashentry *hp;
178 register struct labelblock *lp;
179 chainp cp;
180 int i;
181
182 setloc(RDATA);
183 parstate = OUTSIDE;
184 headerdone = NO;
185 blklevel = 1;
186 saveall = NO;
187 substars = NO;
188 nwarn = 0;
189 thislabel = NULL;
190 needkwd = 0;
191
192 ++procno;
193 proctype = TYUNKNOWN;
194 procname = "MAIN_ ";
195 procclass = CLUNKNOWN;
196 nentry = 0;
197 multitype = NO;
198 typeaddr = NULL;
199 retslot = NULL;
200 cxslot = -1;
201 chslot = -1;
202 chlgslot = -1;
203 procleng = 0;
204 blklevel = 1;
205 lastargslot = 0;
206 autoleng = AUTOINIT;
207
208 for(lp = labeltab ; lp < labtabend ; ++lp)
209 lp->stateno = 0;
210
211 for(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 }
230 nintnames = 0;
231 highlabtab = labeltab;
232
233 ctlstack = ctls - 1;
234 for(cp = templist ; cp ; cp = cp->chain.nextp)
235 ckfree(cp->chain.datap);
236 frchain(&templist);
237 holdtemps = NULL;
238 dorange = 0;
239 highregvar = 0;
240 entries = NULL;
241 rpllist = NULL;
242 inioctl = NO;
243 ioblkp = NULL;
244 nequiv = 0;
245
246 for(i = 0 ; i<NTYPES ; ++i)
247 rtvlabel[i] = 0;
248 fudgelabel = 0;
249
250 if(undeftype)
251 setimpl(TYUNKNOWN, (ftnint) 0, 'a', 'z');
252 else
253 {
254 setimpl(TYREAL, (ftnint) 0, 'a', 'z');
255 setimpl(tyint, (ftnint) 0, 'i', 'n');
256 }
257 setimpl(-STGBSS, (ftnint) 0, 'a', 'z'); /* set class */
258 setlog();
259 }
260
261
262
263 void
setimpl(type,length,c1,c2)264 setimpl(type, length, c1, c2)
265 int type;
266 ftnint length;
267 int c1, c2;
268 {
269 int i;
270 char buff[100];
271
272 if(c1==0 || c2==0)
273 return;
274
275 if(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