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