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 151 getlab(void) 152 { 153 return crslab++; 154 } 155 156 157 void 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 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 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