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