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