4.3BSD - /usr/src/usr.bin/efl/pass2.c

   1: #include "defs"
   2: #include <ctype.h>
   3: 
   4: static int indent;
   5: 
   6: char *verb[] = { " ", " ", "continue", "call ", "do ", "if ", "if ",
   7:     "goto ", "return", "read ", "write ", "format ", "stop ",
   8:     "data ", "equivalence ", "common ", "external ",
   9:     "rewind", "backspace", "endfile",
  10:     "subroutine ", "function ", "program", "blockdata", "end", CNULL };
  11: 
  12: extern char *ops[];
  13: ptr getsii();
  14: 
  15: /* generate code */
  16: 
  17: pass2()
  18: {
  19: exnull();
  20: if(comments) putcomment();
  21: if(verbose)
  22:     fprintf(diagfile, "    Pass 2\n");
  23: 
  24: dclsect = 0;
  25: indent = 0;
  26: 
  27: namegen();
  28: dclgen();
  29: body(iefile);
  30: datas();
  31: body(icfile);
  32: 
  33: p2stmt(0);
  34: p2key(FEND);
  35: p2flush();
  36: if(verbose)
  37:     fprintf(diagfile, "    Pass 2 done\n");
  38: }
  39: 
  40: datas()
  41: {
  42: register int c, n;
  43: int n1;
  44: 
  45: rewii(idfile);
  46: swii(idfile);
  47: 
  48: for( ; ; )
  49:     {
  50:     c = getic(&n1);
  51:     n = n1;
  52:     switch(c)
  53:         {
  54:         case ICEOF:
  55:             return;
  56: 
  57:         case ICMARK:
  58:             break;
  59: 
  60:         case ICBLANK:
  61:             putblank(n);
  62:             break;
  63: 
  64:         case ICNAME:
  65:             if(*ftnames[n] == '\0')
  66:                 fatal1("no name for n=%d", n);
  67:             p2stmt(0);
  68:             p2key(FDATA);
  69:             p2str( ftnames[n] );
  70:             break;
  71: 
  72:         case ICOP:
  73:             p2str( ops[n] );
  74:             break;
  75: 
  76:         case ICCONST:
  77:             p2str( getsii(n) );
  78:             break;
  79: 
  80:         default:
  81:             fatal1("datas: invalid intermediate tag %d", c);
  82:         }
  83:     }
  84: }
  85: 
  86: body(fileadd)
  87: struct fileblock **fileadd;
  88: {
  89: int n1;
  90: register int n;
  91: register int c;
  92: int prevc;
  93: int ifn;
  94: 
  95: rewii(fileadd);
  96: swii(fileadd);
  97: 
  98: prevc = 0;
  99: ifn = 0;
 100: 
 101: for(;;)
 102:     {
 103:     c = getic(&n1);
 104:     n = n1;
 105:     switch(c)
 106:         {
 107:         case ICEOF:
 108:             return;
 109: 
 110:         case ICBEGIN:
 111:             if(n != 0)
 112:                 {
 113:                 if(prevc)
 114:                     p2key(FCONTINUE);
 115:                 else    prevc = 1;
 116:                 p2stmt( stnos[n] );
 117:                 }
 118:             else if(!prevc)  p2stmt(0);
 119:             break;
 120: 
 121:         case ICKEYWORD:
 122:             p2key(n);
 123:             if(n != FIF2)
 124:                 break;
 125:             getic(&ifn);
 126:             if( indifs[ifn] )
 127:                 skipuntil(ICMARK) ;
 128:             break;
 129: 
 130:         case ICOP:
 131:             p2str( ops[n] );
 132:             break;
 133: 
 134:         case ICNAME:
 135:             if(*ftnames[n]=='\0')
 136:                 fatal1("no name for n=%d", n);
 137:             p2str( ftnames[n] );
 138:             break;
 139: 
 140:         case ICCOMMENT:
 141:             if(prevc)
 142:                 p2key(FCONTINUE);
 143:             p2com(n);
 144:             break;
 145: 
 146:         case ICBLANK:
 147:             putblank(n);
 148:             break;
 149: 
 150:         case ICCONST:
 151:             p2str( getsii(n) );
 152:             break;
 153: 
 154:         case ICINDPTR:
 155:             n = indifs[n];
 156: 
 157:         case ICLABEL:
 158:             p2str(" ");
 159:             p2int( stnos[n] );
 160:             break;
 161: 
 162:         case ICMARK:
 163:             if( indifs[ifn] )
 164:                 {
 165:                 p2str(" ");
 166:                 p2key(FGOTO);
 167:                 p2int( stnos[ indifs[ifn] ] );
 168:                 }
 169:             else
 170:                 {
 171:                 skipuntil(ICINDENT);
 172:                 p2str(" ");
 173:                 }
 174:             break;
 175: 
 176:         case ICINDENT:
 177:             indent = n * INDENTSPACES;
 178:             p2indent(indent);
 179:             break;
 180: 
 181:         default:
 182:             sprintf(msg, "Bad pass2 value %o,%o", c,n);
 183:             fatal(msg);
 184:             break;
 185:         }
 186:     if(c!=ICBEGIN && c!=ICINDENT)
 187:         prevc = 0;
 188:     }
 189: }
 190: 
 191: putname(p)
 192: register ptr p;
 193: {
 194: register int i;
 195: 
 196: if(p->vextbase)
 197:     {
 198:     putic(ICNAME, p->vextbase);
 199:     return;
 200:     }
 201: 
 202: for(i=0 ; i<NFTNTYPES ; ++i)
 203:     if(p->vbase[i])
 204:         {
 205:         putic(ICNAME, p->vbase[i]);
 206:         return;
 207:         }
 208: if(strlen(p->sthead->namep) <= XL)
 209:     fatal1("no fortran slot for name %s", p->sthead->namep);
 210: }
 211: 
 212: 
 213: 
 214: putconst(ty, p)
 215: int ty;
 216: char *p;
 217: {
 218: ptr mkchcon();
 219: 
 220: if(ty != TYCHAR)
 221:     putsii(ICCONST,p);
 222: else    /* change character constant to a variable */
 223:     putname( mkchcon(p) );
 224: }
 225: 
 226: 
 227: putzcon(p)
 228: register ptr p;
 229: {
 230: char buff[100];
 231: sprintf(buff, "(%s,%s)", p->leftp, p->rightp);
 232: putsii(ICCONST,buff);
 233: }
 234: 
 235: 
 236: 
 237: 
 238: 
 239: 
 240: putcomment()
 241: {
 242: register ptr p;
 243: 
 244: for(p = comments ; p ; p = p->nextp)
 245:     {
 246:     putsii(ICCOMMENT, p->datap);
 247:     cfree(p->datap);
 248:     }
 249: frchain(&comments);
 250: }
 251: 
 252: 
 253: putblank(n)
 254: int n;
 255: {
 256: while(n-- > 0)
 257:     p2putc(' ');
 258: }
 259: 
 260: 
 261: 
 262: skipuntil(k)
 263: int k;
 264: {
 265: register int i;
 266: int n;
 267: 
 268: while( (i = getic(&n))!=k && i!=ICEOF)
 269:     if(i==ICCOMMENT || i==ICCONST)
 270:         getsii(n);
 271: }
 272: 
 273: 
 274: p2int(n)    /* put an integer constant in the output */
 275: int n;
 276: {
 277: p2str( convic(n) );
 278: }
 279: 
 280: 
 281: 
 282: 
 283: p2key(n)    /* print a keyword */
 284: int n;
 285: {
 286: p2str( verb[n] );
 287: }
 288: 
 289: 
 290: 
 291: p2str(s)    /* write a character string on the output */
 292: char *s;
 293: {
 294: int n;
 295: 
 296: n = strlen(s);
 297: if(nftnch==LINESPACES-1 && (n==1 || (n==2 && s[1]==' ')) )
 298:     p2putc(s[0]);
 299: 
 300: else    {
 301:     if( n<=LINESPACES && nftnch+n>LINESPACES-1 )
 302:         p2line( min(LINESPACES-n , indent+INDENTSPACES) );
 303: 
 304:     while(*s)
 305:         p2putc(*s++);
 306:     }
 307: }
 308: 
 309: 
 310: 
 311: p2stmt(n)   /* start a statement with label n */
 312: int n;
 313: {
 314: if(n > 0)
 315:     fprintf(codefile,"\n%4d  ", n);
 316: else    fprintf(codefile,"\n      ");
 317: 
 318: nftnch = 0;
 319: nftncont = 0;
 320: }
 321: 
 322: 
 323: p2com(n)        /* copy a comment */
 324: int n;
 325: {
 326: register int k;
 327: register char *q;
 328: 
 329: q = getsii(n);
 330: if(q[0] == '%') /* a literal escape line */
 331:     {
 332:     putc('\n', codefile);
 333:     while(--n > 0)
 334:         putc(*++q, codefile);
 335:     }
 336: else     /* actually a comment line */
 337:     {
 338:     ++q;
 339:     --n;
 340: 
 341:     do  {
 342:         k = (n>71 ? 71 : n);
 343:         fprintf(codefile, "\n");
 344:         putc( tailor.ftnsys==CRAY ? 'C' : 'c' , codefile);
 345:         while(k-- > 0)
 346:             putc(*q++, codefile);
 347:         n -= 71;
 348:         }
 349:            while(n > 0);
 350:     }
 351: }
 352: 
 353: 
 354: 
 355: 
 356: p2flush()
 357: {
 358: if(nftnch > 0)
 359:     {
 360:     fprintf(codefile, "\n");
 361:     nftnch = 0;
 362:     }
 363: }
 364: 
 365: 
 366: 
 367: 
 368: p2putc(c)
 369: char c;
 370: {
 371: if(nftnch >= LINESPACES)    /* end of line */
 372:     p2line(0);
 373: if(tailor.ftnsys == CRAY)
 374:     putc( islower(c) ? toupper(c) : c , codefile);
 375: else
 376:     putc(c, codefile);
 377: ++nftnch;
 378: }
 379: 
 380: 
 381: 
 382: p2line(in)
 383: int in;
 384: {
 385: register char contchar;
 386: 
 387: if(++nftncont > 19)
 388:     {
 389:     execerr("too many continuation lines", CNULL);
 390:     contchar = 'X';
 391:     }
 392: if(tailor.ftncontnu == 1)
 393:     fprintf(codefile, "\n&");
 394: else    {   /* standard column-6 continuation */
 395:     if(nftncont < 20)
 396:         contchar = "0123456789ABCDEFGHIJ" [nftncont];
 397:     fprintf(codefile, "\n     %c", contchar);
 398:     }
 399: 
 400: nftnch = 0;
 401: if(in > 0)
 402:     p2indent(in);
 403: }
 404: 
 405: 
 406: 
 407: p2indent(n)
 408: register int n;
 409: {
 410: while(n-- > 0)
 411:     p2putc(' ');
 412: }

Defined functions

Defined variables