1 /*- 2 * Copyright (c) 1980 The Regents of the University of California. 3 * All rights reserved. 4 * 5 * %sccs.include.proprietary.c% 6 */ 7 8 #ifndef lint 9 static char sccsid[] = "@(#)init.c 5.5 (Berkeley) 04/12/91"; 10 #endif /* not lint */ 11 12 /* 13 * init.c 14 * 15 * Initializations for f77 compiler, pass 1. 16 * 17 * University of Utah CS Dept modification history: 18 * 19 * $Header: init.c,v 5.2 85/08/10 04:30:57 donn Exp $ 20 * $Log: init.c,v $ 21 * Revision 5.2 85/08/10 04:30:57 donn 22 * Jerry Berkman's changes to ifdef 66 code and handle -r8/double flag. 23 * 24 * Revision 5.1 85/08/10 03:47:33 donn 25 * 4.3 alpha 26 * 27 * Revision 2.1 84/07/19 12:03:26 donn 28 * Changed comment headers for UofU. 29 * 30 * Revision 1.3 84/02/28 21:07:53 donn 31 * Added Berkeley changes for call argument temporaries fix. 32 * 33 * Fixed incorrect check of 'cdatafile' when 'cchkfile' is opened. -- Donn 34 */ 35 36 #include "defs.h" 37 #include "io.h" 38 #include <sys/file.h> 39 #include "pathnames.h" 40 41 42 FILEP infile = { stdin }; 43 FILEP diagfile = { stderr }; 44 45 FILEP textfile; 46 FILEP asmfile; 47 FILEP initfile; 48 long int headoffset; 49 50 char token[1321]; 51 int toklen; 52 int lineno; 53 char *infname; 54 int needkwd; 55 struct Labelblock *thislabel = NULL; 56 flag nowarnflag = NO; 57 flag ftn66flag = NO; 58 #ifdef ONLY66 59 flag no66flag = NO; 60 flag noextflag = NO; 61 #endif 62 flag dblflag = NO; 63 flag profileflag = NO; 64 flag optimflag = NO; 65 flag shiftcase = YES; 66 flag undeftype = NO; 67 flag shortsubs = YES; 68 flag onetripflag = NO; 69 flag checksubs = NO; 70 flag debugflag [MAXDEBUGFLAG] = { NO }; 71 flag equivdcl = NO; 72 int nerr; 73 int nwarn; 74 int ndata; 75 76 flag saveall; 77 flag substars; 78 int parstate = OUTSIDE; 79 flag headerdone = NO; 80 int blklevel; 81 int impltype[26]; 82 int implleng[26]; 83 int implstg[26]; 84 85 int tyint = TYLONG ; 86 int tylogical = TYLONG; 87 ftnint typesize[NTYPES] 88 = { 1, SZADDR, SZSHORT, SZLONG, SZLONG, 2*SZLONG, 89 2*SZLONG, 4*SZLONG, SZLONG, 1, 1, 1}; 90 int typealign[NTYPES] 91 = { 1, ALIADDR, ALISHORT, ALILONG, ALILONG, ALIDOUBLE, 92 ALILONG, ALIDOUBLE, ALILONG, 1, 1, 1}; 93 int procno; 94 int lwmno; 95 int proctype = TYUNKNOWN; 96 char *procname; 97 int rtvlabel[NTYPES]; 98 int fudgelabel; 99 Addrp typeaddr; 100 Addrp retslot; 101 int cxslot = -1; 102 int chslot = -1; 103 int chlgslot = -1; 104 int procclass = CLUNKNOWN; 105 int nentry; 106 flag multitype; 107 ftnint procleng; 108 int lastlabno = 10; 109 int lastvarno; 110 int lastargslot; 111 int argloc; 112 ftnint autoleng; 113 ftnint bssleng = 0; 114 int retlabel; 115 int ret0label; 116 ftnint lowbss = 0; 117 ftnint highbss = 0; 118 int bsslabel; 119 flag anyinits = NO; 120 flag anylocals = NO; 121 122 int maxctl = MAXCTL; 123 struct Ctlframe *ctls; 124 struct Ctlframe *ctlstack; 125 struct Ctlframe *lastctl; 126 127 Namep regnamep[MAXREGVAR]; 128 int highregvar; 129 int nregvar; 130 131 int maxext = MAXEXT; 132 struct Extsym *extsymtab; 133 struct Extsym *nextext; 134 struct Extsym *lastext; 135 136 int maxequiv = MAXEQUIV; 137 struct Equivblock *eqvclass; 138 139 int maxhash = MAXHASH; 140 struct Hashentry *hashtab; 141 struct Hashentry *lasthash; 142 143 int maxstno = MAXSTNO; 144 struct Labelblock *labeltab; 145 struct Labelblock *labtabend; 146 struct Labelblock *highlabtab; 147 148 int maxdim = MAXDIM; 149 struct Rplblock *rpllist = NULL; 150 struct Chain *curdtp = NULL; 151 flag toomanyinit; 152 ftnint curdtelt; 153 chainp templist = NULL; 154 chainp argtemplist = CHNULL; 155 chainp activearglist = CHNULL; 156 chainp holdtemps = NULL; 157 int dorange = 0; 158 struct Entrypoint *entries = NULL; 159 160 chainp chains = NULL; 161 162 flag inioctl; 163 Addrp ioblkp; 164 int iostmt; 165 int nioctl; 166 int nequiv = 0; 167 int eqvstart = 0; 168 int nintnames = 0; 169 170 #ifdef SDB 171 int dbglabel = 0; 172 flag sdbflag = NO; 173 #endif 174 175 struct Literal litpool[MAXLITERALS]; 176 int nliterals; 177 178 int cdatafile; 179 int cchkfile; 180 int vdatafile; 181 int vchkfile; 182 183 char cdatafname[44] = ""; 184 char cchkfname[44] = ""; 185 char vdatafname[44] = ""; 186 char vchkfname[44] = ""; 187 188 long cdatahwm = 0; 189 long vdatahwm = 0; 190 191 ioblock *iodata = NULL; 192 193 194 195 fileinit() 196 { 197 int pid; 198 199 pid = getpid(); 200 sprintf(cdatafname, "%s/fortcd.%d", _PATH_TMP, pid); 201 sprintf(cchkfname, "%s/fortcc.%d", _PATH_TMP, pid); 202 sprintf(vdatafname, "%s/fortvd.%d", _PATH_TMP, pid); 203 sprintf(vchkfname, "%s/fortvc.%d", _PATH_TMP, pid); 204 205 cdatafile = open(cdatafname, O_CREAT | O_RDWR, 0600); 206 if (cdatafile < 0) 207 fatalstr("cannot open tmp file %s", cdatafname); 208 209 cchkfile = open(cchkfname, O_CREAT | O_RDWR, 0600); 210 if (cchkfile < 0) 211 fatalstr("cannot open tmp file %s", cchkfname); 212 213 pruse(initfile, USEINIT); 214 215 procno = 0; 216 lwmno = 0; 217 lastlabno = 10; 218 lastvarno = 0; 219 nliterals = 0; 220 nerr = 0; 221 ndata = 0; 222 223 ctls = ALLOCN(maxctl, Ctlframe); 224 extsymtab = ALLOCN(maxext, Extsym); 225 eqvclass = ALLOCN(maxequiv, Equivblock); 226 hashtab = ALLOCN(maxhash, Hashentry); 227 labeltab = ALLOCN(maxstno, Labelblock); 228 229 ctlstack = ctls - 1; 230 lastctl = ctls + maxctl; 231 nextext = extsymtab; 232 lastext = extsymtab + maxext; 233 lasthash = hashtab + maxhash; 234 labtabend = labeltab + maxstno; 235 highlabtab = labeltab; 236 } 237 238 239 240 241 242 procinit() 243 { 244 register Namep p; 245 register struct Dimblock *q; 246 register struct Hashentry *hp; 247 register struct Labelblock *lp; 248 struct Chain *cp; 249 int i; 250 251 vdatafile = open(vdatafname, O_CREAT | O_RDWR, 0600); 252 if (vdatafile < 0) 253 fatalstr("cannot open tmp file %s", vdatafname); 254 255 vchkfile = open(vchkfname, O_CREAT | O_RDWR, 0600); 256 if (vchkfile < 0) 257 fatalstr("cannot open tmp file %s", vchkfname); 258 259 pruse(asmfile, USECONST); 260 #if FAMILY == PCC 261 p2pass(USETEXT); 262 #endif 263 parstate = OUTSIDE; 264 headerdone = NO; 265 blklevel = 1; 266 saveall = NO; 267 substars = NO; 268 nwarn = 0; 269 thislabel = NULL; 270 needkwd = 0; 271 272 ++procno; 273 proctype = TYUNKNOWN; 274 procname = "MAIN "; 275 procclass = CLUNKNOWN; 276 nentry = 0; 277 multitype = NO; 278 typeaddr = NULL; 279 retslot = NULL; 280 cxslot = -1; 281 chslot = -1; 282 chlgslot = -1; 283 procleng = 0; 284 blklevel = 1; 285 lastargslot = 0; 286 #if TARGET==PDP11 287 autoleng = 6; 288 #else 289 autoleng = 0; 290 #endif 291 292 for(lp = labeltab ; lp < labtabend ; ++lp) 293 lp->stateno = 0; 294 295 for(hp = hashtab ; hp < lasthash ; ++hp) 296 if(p = hp->varp) 297 { 298 frexpr(p->vleng); 299 if(q = p->vdim) 300 { 301 for(i = 0 ; i < q->ndim ; ++i) 302 { 303 frexpr(q->dims[i].dimsize); 304 frexpr(q->dims[i].dimexpr); 305 } 306 frexpr(q->nelt); 307 frexpr(q->baseoffset); 308 frexpr(q->basexpr); 309 free( (charptr) q); 310 } 311 if(p->vclass == CLNAMELIST) 312 frchain( &(p->varxptr.namelist) ); 313 free( (charptr) p); 314 hp->varp = NULL; 315 } 316 nintnames = 0; 317 highlabtab = labeltab; 318 319 ctlstack = ctls - 1; 320 for(cp = templist ; cp ; cp = cp->nextp) 321 free( (charptr) (cp->datap) ); 322 frchain(&templist); 323 for (cp = argtemplist; cp; cp = cp->nextp) 324 free((char *) (cp->datap)); 325 frchain(&argtemplist); 326 holdtemps = NULL; 327 dorange = 0; 328 nregvar = 0; 329 highregvar = 0; 330 entries = NULL; 331 rpllist = NULL; 332 inioctl = NO; 333 ioblkp = NULL; 334 eqvstart += nequiv; 335 nequiv = 0; 336 337 for(i = 0 ; i<NTYPES ; ++i) 338 rtvlabel[i] = 0; 339 fudgelabel = 0; 340 341 if(undeftype) 342 setimpl(TYUNKNOWN, (ftnint) 0, 'a', 'z'); 343 else 344 { 345 setimpl(dblflag ? TYDREAL : TYREAL, (ftnint) 0, 'a', 'z'); 346 setimpl(tyint, (ftnint) 0, 'i', 'n'); 347 } 348 setimpl(-STGBSS, (ftnint) 0, 'a', 'z'); /* set class */ 349 setlog(); 350 setopt(); 351 352 bsslabel = ++lastvarno; 353 anylocals = NO; 354 anyinits = NO; 355 } 356 357 358 359 360 setimpl(type, length, c1, c2) 361 int type; 362 ftnint length; 363 int c1, c2; 364 { 365 int i; 366 char buff[100]; 367 368 if(c1==0 || c2==0) 369 return; 370 371 if(c1 > c2) 372 { 373 sprintf(buff, "characters out of order in implicit:%c-%c", c1, c2); 374 err(buff); 375 } 376 else 377 if(type < 0) 378 for(i = c1 ; i<=c2 ; ++i) 379 implstg[i-'a'] = - type; 380 else 381 { 382 type = lengtype(type, (int) length); 383 if(type != TYCHAR) 384 length = 0; 385 for(i = c1 ; i<=c2 ; ++i) 386 { 387 impltype[i-'a'] = type; 388 implleng[i-'a'] = length; 389 } 390 } 391 } 392