4.3BSD - /usr/src/usr.bin/f77/src/f77pass1/main.c

   1: /*
   2:  * Copyright (c) 1980 Regents of the University of California.
   3:  * All rights reserved.  The Berkeley software License Agreement
   4:  * specifies the terms and conditions for redistribution.
   5:  */
   6: 
   7: #ifndef lint
   8: char copyright[] =
   9: "@(#) Copyright (c) 1980 Regents of the University of California.\n\
  10:  All rights reserved.\n";
  11: #endif not lint
  12: 
  13: #ifndef lint
  14: static char sccsid[] = "@(#)main.c	5.2 (Berkeley) 8/29/85";
  15: #endif not lint
  16: 
  17: /*
  18:  * main.c
  19:  *
  20:  * Main routine for the f77 compiler, pass 1, 4.2 BSD.
  21:  *
  22:  * University of Utah CS Dept modification history:
  23:  *
  24:  * $Log:	main.c,v $
  25:  * Revision 5.2  85/08/10  04:57:16  donn
  26:  * Jerry Berkman's changes to ifdef 66 code and add -r8/double flag..
  27:  *
  28:  * Revision 5.1  85/08/10  03:48:26  donn
  29:  * 4.3 alpha
  30:  *
  31:  * Revision 3.2  85/01/14  04:21:31  donn
  32:  * Added changes to implement Jerry's '-q' option.
  33:  *
  34:  * Revision 3.1  84/10/29  05:47:03  donn
  35:  * Added Jerry Berkman's change to line buffer stderr.
  36:  *
  37:  */
  38: 
  39: char *xxxvers[] = "\n@(#) FORTRAN 77 PASS 1, VERSION 2.10,  16 AUGUST 1980\n";
  40: 
  41: #include "defs.h"
  42: #include <signal.h>
  43: 
  44: #ifdef SDB
  45: #	include <a.out.h>
  46: #	ifndef N_SO
  47: #		include <stab.h>
  48: #	endif
  49: #endif
  50: 
  51: 
  52: LOCAL char *textname = "";
  53: LOCAL char *asmname = "";
  54: LOCAL char *initname = "";
  55: 
  56: 
  57: extern intexit();
  58: 
  59: flag namesflag = YES;
  60: 
  61: 
  62: 
  63: main(argc, argv)
  64: int argc;
  65: char **argv;
  66: {
  67: char *s;
  68: int k, retcode, *ip;
  69: FILEP opf();
  70: int flovflo();
  71: 
  72: #define DONE(c) { retcode = c; goto finis; }
  73: 
  74: signal(SIGFPE, flovflo);  /* catch overflows */
  75: signal(SIGINT, intexit);
  76: 
  77: #if HERE == PDP11
  78:     ldfps(01200);   /* trap on overflow */
  79: #endif
  80: 
  81: 
  82: setlinebuf(diagfile);
  83: 
  84: --argc;
  85: ++argv;
  86: 
  87: while(argc>0 && argv[0][0]=='-')
  88:     {
  89:     for(s = argv[0]+1 ; *s ; ++s) switch(*s)
  90:         {
  91:         case 'w':
  92:             if(s[1]=='6' && s[2]=='6')
  93:                 {
  94:                 ftn66flag = YES;
  95:                 s += 2;
  96:                 }
  97:             else
  98:                 nowarnflag = YES;
  99:             break;
 100: 
 101:         case 'U':
 102:             shiftcase = NO;
 103:             break;
 104: 
 105:         case 'u':
 106:             undeftype = YES;
 107:             break;
 108: 
 109:         case 'O':
 110:             optimflag = YES;
 111:             break;
 112: 
 113:         case 'd':
 114:             debugflag[0] = YES;
 115: 
 116:             while (*s == 'd' || *s == ',')
 117:                 {
 118:                 k = 0;
 119:                 while( isdigit(*++s) )
 120:                     k = 10*k + (*s - '0');
 121:                 if(k < 0 || k >= MAXDEBUGFLAG)
 122:                     fatali("bad debug number %d",k);
 123:                 debugflag[k] = YES;
 124:                 }
 125:             break;
 126: 
 127:         case 'p':
 128:             profileflag = YES;
 129:             break;
 130: 
 131:         case '8':
 132:             dblflag = YES;
 133:             break;
 134: 
 135:         case 'C':
 136:             checksubs = YES;
 137:             break;
 138: 
 139: #ifdef ONLY66
 140:         case '6':
 141:             no66flag = YES;
 142:             noextflag = YES;
 143:             break;
 144: #endif
 145: 
 146:         case '1':
 147:             onetripflag = YES;
 148:             break;
 149: 
 150: #ifdef SDB
 151:         case 'g':
 152:             sdbflag = YES;
 153:             break;
 154: #endif
 155: 
 156:         case 'q':
 157:             namesflag = NO;
 158:             break;
 159: 
 160:         case 'N':
 161:             switch(*++s)
 162:                 {
 163:                 case 'q':
 164:                     ip = &maxequiv; goto getnum;
 165:                 case 'x':
 166:                     ip = &maxext; goto getnum;
 167:                 case 's':
 168:                     ip = &maxstno; goto getnum;
 169:                 case 'c':
 170:                     ip = &maxctl; goto getnum;
 171:                 case 'n':
 172:                     ip = &maxhash; goto getnum;
 173: 
 174:                 default:
 175:                     fatali("invalid flag -N%c", *s);
 176:                 }
 177:         getnum:
 178:             k = 0;
 179:             while( isdigit(*++s) )
 180:                 k = 10*k + (*s - '0');
 181:             if(k <= 0)
 182:                 fatal("Table size too small");
 183:             *ip = k;
 184:             break;
 185: 
 186:         case 'i':
 187:             if(*++s == '2')
 188:                 tyint = TYSHORT;
 189:             else if(*s == '4')
 190:                 {
 191:                 shortsubs = NO;
 192:                 tyint = TYLONG;
 193:                 }
 194:             else if(*s == 's')
 195:                 shortsubs = YES;
 196:             else
 197:                 fatali("invalid flag -i%c\n", *s);
 198:             tylogical = tyint;
 199:             break;
 200: 
 201:         default:
 202:             fatali("invalid flag %c\n", *s);
 203:         }
 204:     --argc;
 205:     ++argv;
 206:     }
 207: 
 208: if(argc != 4)
 209:     fatali("arg count %d", argc);
 210: textname = argv[3];
 211: initname = argv[2];
 212: asmname = argv[1];
 213: asmfile  = opf(argv[1]);
 214: initfile = opf(argv[2]);
 215: textfile = opf(argv[3]);
 216: 
 217: initkey();
 218: if(inilex( copys(argv[0]) ))
 219:     DONE(1);
 220: if(namesflag == YES)
 221:     fprintf(diagfile, "%s:\n", argv[0]);
 222: 
 223: #ifdef SDB
 224: filenamestab(argv[0]);
 225: #endif
 226: 
 227: fileinit();
 228: procinit();
 229: if(k = yyparse())
 230:     {
 231:     fprintf(diagfile, "Bad parse, return code %d\n", k);
 232:     DONE(1);
 233:     }
 234: if(nerr > 0)
 235:     DONE(1);
 236: if(parstate != OUTSIDE)
 237:     {
 238:     warn("missing END statement");
 239:     endproc();
 240:     }
 241: doext();
 242: preven(ALIDOUBLE);
 243: prtail();
 244: #if FAMILY==PCC
 245:     puteof();
 246: #endif
 247: 
 248: if(nerr > 0)
 249:     DONE(1);
 250: DONE(0);
 251: 
 252: 
 253: finis:
 254:     done(retcode);
 255: }
 256: 
 257: 
 258: 
 259: done(k)
 260: int k;
 261: {
 262:   static char *ioerror = "i/o error on intermediate file %s\n";
 263: 
 264:   if (textfile != NULL && textfile != stdout)
 265:     {
 266:       if (ferror(textfile))
 267:     {
 268:       fprintf(diagfile, ioerror, textname);
 269:       k = 3;
 270:     }
 271:       fclose(textfile);
 272:     }
 273: 
 274:   if (asmfile != NULL && asmfile != stdout)
 275:     {
 276:       if (ferror(asmfile))
 277:     {
 278:       fprintf(diagfile, ioerror, asmname);
 279:       k = 3;
 280:     }
 281:       fclose(asmfile);
 282:     }
 283: 
 284:   if (initfile != NULL && initfile != stdout)
 285:     {
 286:       if (ferror(initfile))
 287:     {
 288:       fprintf(diagfile, ioerror, initname);
 289:       k = 3;
 290:     }
 291:       fclose(initfile);
 292:     }
 293: 
 294:   rmtmpfiles();
 295: 
 296:   exit(k);
 297: }
 298: 
 299: 
 300: LOCAL FILEP opf(fn)
 301: char *fn;
 302: {
 303: FILEP fp;
 304: if( fp = fopen(fn, "w") )
 305:     return(fp);
 306: 
 307: fatalstr("cannot open intermediate file %s", fn);
 308: /* NOTREACHED */
 309: }
 310: 
 311: 
 312: 
 313: clf(p)
 314: FILEP *p;
 315: {
 316: if(p!=NULL && *p!=NULL && *p!=stdout)
 317:     {
 318:     if(ferror(*p))
 319:         fatal("writing error");
 320:     fclose(*p);
 321:     }
 322: *p = NULL;
 323: }
 324: 
 325: 
 326: 
 327: 
 328: flovflo()
 329: {
 330: err("floating exception during constant evaluation");
 331: #if HERE == VAX
 332:     fatal("vax cannot recover from floating exception");
 333:     rmtmpfiles();
 334:     /* vax returns a reserved operand that generates
 335: 	   an illegal operand fault on next instruction,
 336: 	   which if ignored causes an infinite loop.
 337: 	*/
 338: #endif
 339: signal(SIGFPE, flovflo);
 340: }
 341: 
 342: 
 343: 
 344: rmtmpfiles()
 345: {
 346:   close(vdatafile);
 347:   unlink(vdatafname);
 348:   close(vchkfile);
 349:   unlink(vchkfname);
 350:   close(cdatafile);
 351:   unlink(cdatafname);
 352:   close(cchkfile);
 353:   unlink(cchkfname);
 354: }
 355: 
 356: 
 357: 
 358: intexit()
 359: {
 360:   done(1);
 361: }

Defined functions

Defined variables

Defined macros