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