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