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.2 (Berkeley) 8/29/85"; 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: int lowbss = 0; 115: int 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: }