2.9BSD - /usr/src/cmd/f77/init.c

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