2.11BSD#431 - /usr/src/usr.bin/f77/main.c

   1: char *xxxvers[] = "\nFORTRAN 77 PASS 1, VERSION 1.21,  20 APRIL 1979\n";
   2: 
   3: #include "defs"
   4: #include "string_defs"
   5: 
   6: 
   7: main(argc, argv)
   8: int argc;
   9: char **argv;
  10: {
  11: char *s;
  12: int k, retcode;
  13: FILEP opf();
  14: 
  15: #define DONE(c) { retcode = c; goto finis; }
  16: 
  17: --argc;
  18: ++argv;
  19: 
  20: while(argc>0 && argv[0][0]=='-')
  21:     {
  22:     for(s = argv[0]+1 ; *s ; ++s) switch(*s)
  23:         {
  24:         case 'w':
  25:             if(s[1]=='6' && s[2]=='6')
  26:                 {
  27:                 ftn66flag = YES;
  28:                 s += 2;
  29:                 }
  30:             else
  31:                 nowarnflag = YES;
  32:             break;
  33: 
  34:         case 'U':
  35:             shiftcase = NO;
  36:             break;
  37: 
  38:         case 'u':
  39:             undeftype = YES;
  40:             break;
  41: 
  42:         case 'O':
  43:             optimflag = YES;
  44:             if( isdigit(s[1]) )
  45:                 {
  46:                 k = *++s - '0';
  47:                 if(k > MAXREGVAR)
  48:                     {
  49:                     error("-O%d: too many register variables", k,0,WARN1);
  50:                     maxregvar = MAXREGVAR;
  51:                     }
  52:                 else
  53:                     maxregvar = k;
  54:                 }
  55:             break;
  56: 
  57:         case 'd':
  58:             debugflag = YES;
  59:             break;
  60: 
  61:         case 'p':
  62:             profileflag = YES;
  63:             break;
  64: 
  65:         case 'C':
  66:             checksubs = YES;
  67:             break;
  68: 
  69:         case '1':
  70:             onetripflag = YES;
  71:             break;
  72: 
  73:         case 'I':
  74:             if(*++s == '2')
  75:                 tyint = TYSHORT;
  76:             else if(*s == '4')
  77:                 {
  78:                 shortsubs = NO;
  79:                 tyint = TYLONG;
  80:                 }
  81:             else if(*s == 's')
  82:                 shortsubs = YES;
  83:             else
  84:                 error("invalid flag -I%c\n", *s,0,FATAL1);
  85:             tylogical = tyint;
  86:             break;
  87: 
  88:         default:
  89:             error("invalid flag %c\n", *s,0,FATAL1);
  90:         }
  91:     --argc;
  92:     ++argv;
  93:     }
  94: 
  95: if(argc != 4)
  96:     error("arg count %d", argc,0,FATAL1);
  97: asmfile  = opf(argv[1]);
  98: initfile = opf(argv[2]);
  99: textfile = opf(argv[3]);
 100: 
 101: initkey();
 102: if(inilex( copys(argv[0]) ))
 103:     DONE(1);
 104: fprintf(diagfile, "%s:\n", argv[0]);
 105: fileinit();
 106: procinit();
 107: if(k = yyparse())
 108:     {
 109:     fprintf(diagfile, "Bad parse, return code %d\n", k);
 110:     DONE(1);
 111:     }
 112: if(nerr > 0)
 113:     DONE(1);
 114: if(parstate != OUTSIDE)
 115:     {
 116:     error("missing END statement",0,0,WARN);
 117:     endproc();
 118:     }
 119: doext();
 120: preven(ALIDOUBLE);
 121: prtail();
 122: #if FAMILY==SCJ
 123:     puteof();
 124: #endif
 125: DONE(0);
 126: 
 127: 
 128: finis:
 129:     done(retcode);
 130:     return(retcode);
 131: }
 132: 
 133: 
 134: 
 135: done(k)
 136: int k;
 137: {
 138: static int recurs   = NO;
 139: 
 140: if(recurs == NO)
 141:     {
 142:     recurs = YES;
 143:     clfiles();
 144:     }
 145: exit(k);
 146: }
 147: 
 148: 
 149: LOCAL FILEP opf(fn)
 150: char *fn;
 151: {
 152: FILEP fp;
 153: if( fp = fopen(fn, "w") )
 154:     return(fp);
 155: 
 156: error("cannot open intermediate file %s", fn,0,FATAL1);
 157: /* NOTREACHED */
 158: }
 159: 
 160: 
 161: 
 162: LOCAL clfiles()
 163: {
 164: clf(&textfile);
 165: clf(&asmfile);
 166: clf(&initfile);
 167: }
 168: 
 169: 
 170: clf(p)
 171: FILEP *p;
 172: {
 173: if(p!=NULL && *p!=NULL && *p!=stdout)
 174:     {
 175:     if(ferror(*p))
 176:         error("writing error",0,0,FATAL);
 177:     fclose(*p);
 178:     }
 179: *p = NULL;
 180: }

Defined functions

Defined variables

Defined macros