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.3 (Berkeley) 01/03/88"; 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 } 362