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