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