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