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