|
|
1.1 ! root 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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.