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