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