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