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