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