1 /* Id: f77.c,v 1.21 2008/12/27 00:36:39 sgk Exp */ 2 /* $NetBSD: f77.c,v 1.1.1.3 2010/06/03 18:57:45 plunky Exp $ */ 3 /* 4 * Copyright(C) Caldera International Inc. 2001-2002. All rights reserved. 5 * 6 * Redistribution and use in source and binary forms, with or without 7 * modification, are permitted provided that the following conditions 8 * are met: 9 * 10 * Redistributions of source code and documentation must retain the above 11 * copyright notice, this list of conditions and the following disclaimer. 12 * Redistributions in binary form must reproduce the above copyright 13 * notice, this list of conditionsand the following disclaimer in the 14 * documentation and/or other materials provided with the distribution. 15 * All advertising materials mentioning features or use of this software 16 * must display the following acknowledgement: 17 * This product includes software developed or owned by Caldera 18 * International, Inc. 19 * Neither the name of Caldera International, Inc. nor the names of other 20 * contributors may be used to endorse or promote products derived from 21 * this software without specific prior written permission. 22 * 23 * USE OF THE SOFTWARE PROVIDED FOR UNDER THIS LICENSE BY CALDERA 24 * INTERNATIONAL, INC. AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR 25 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 26 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 27 * DISCLAIMED. IN NO EVENT SHALL CALDERA INTERNATIONAL, INC. BE LIABLE 28 * FOR ANY DIRECT, INDIRECT INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 29 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 30 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 31 * HOWEVER CAUSED AND ON ANY THEORY OFLIABILITY, WHETHER IN CONTRACT, 32 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING 33 * IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 34 * POSSIBILITY OF SUCH DAMAGE. 35 */ 36 37 char xxxvers[] = "FORTRAN 77 DRIVER, VERSION 1.11, 28 JULY 1978\n"; 38 39 #include <sys/wait.h> 40 41 #include <stdio.h> 42 #include <ctype.h> 43 #include <signal.h> 44 #include <unistd.h> 45 #include <string.h> 46 #include <stdlib.h> 47 #include <stdarg.h> 48 #include <errno.h> 49 50 #include "ccconfig.h" 51 52 typedef FILE *FILEP; 53 typedef int flag; 54 #define YES 1 55 #define NO 0 56 57 FILEP diagfile; 58 59 static int pid; 60 static int sigivalue = 0; 61 static int sigqvalue = 0; 62 63 #ifndef FCOM 64 #define FCOM "fcom" 65 #endif 66 67 #ifndef ASSEMBLER 68 #define ASSEMBLER "as" 69 #endif 70 71 #ifndef LINKER 72 #define LINKER "ld" 73 #endif 74 75 static char *fcom = LIBEXECDIR "/" FCOM ; 76 static char *asmname = ASSEMBLER ; 77 static char *ldname = LINKER ; 78 static char *startfiles[] = STARTFILES; 79 static char *endfiles[] = ENDFILES; 80 static char *dynlinker[] = DYNLINKER; 81 static char *crt0file = CRT0FILE; 82 static char *macroname = "m4"; 83 static char *shellname = "/bin/sh"; 84 static char *aoutname = "a.out" ; 85 static char *libdir = LIBDIR ; 86 static char *liblist[] = F77LIBLIST; 87 88 static char *infname; 89 static char asmfname[15]; 90 static char prepfname[15]; 91 92 #define MAXARGS 100 93 int ffmax; 94 static char *ffary[MAXARGS]; 95 static char eflags[30] = ""; 96 static char rflags[30] = ""; 97 static char lflag[3] = "-x"; 98 static char *eflagp = eflags; 99 static char *rflagp = rflags; 100 static char **loadargs; 101 static char **loadp; 102 static int oflag; 103 104 static flag loadflag = YES; 105 static flag saveasmflag = NO; 106 static flag profileflag = NO; 107 static flag optimflag = NO; 108 static flag debugflag = NO; 109 static flag verbose = NO; 110 static flag fortonly = NO; 111 static flag macroflag = NO; 112 113 static char *setdoto(char *), *lastchar(char *), *lastfield(char *); 114 static void intrupt(int); 115 static void enbint(void (*)(int)); 116 static void crfnames(void); 117 static void fatal1(char *, ...); 118 static void done(int), texec(char *, char **); 119 static char *copyn(int, char *); 120 static int dotchar(char *), unreadable(char *), sys(char *), dofort(char *); 121 static int nodup(char *); 122 static int await(int); 123 static void rmf(char *), doload(char *[], char *[]), doasm(char *); 124 static int callsys(char *, char **); 125 static void errorx(char *, ...); 126 127 static void 128 addarg(char **ary, int *num, char *arg) 129 { 130 ary[(*num)++] = arg; 131 if ((*num) == MAXARGS) { 132 fprintf(stderr, "argument array too small\n"); 133 exit(1); 134 } 135 } 136 137 int 138 main(int argc, char **argv) 139 { 140 int i, c, status; 141 char *s; 142 char fortfile[20], *t; 143 char buff[100]; 144 145 diagfile = stderr; 146 147 sigivalue = (int) signal(SIGINT, SIG_IGN) & 01; 148 sigqvalue = (int) signal(SIGQUIT, SIG_IGN) & 01; 149 enbint(intrupt); 150 151 pid = getpid(); 152 crfnames(); 153 154 loadargs = (char **)calloc(1, (argc + 20) * sizeof(*loadargs)); 155 if (!loadargs) 156 fatal1("out of memory"); 157 loadp = loadargs; 158 159 --argc; 160 ++argv; 161 162 while(argc>0 && argv[0][0]=='-' && argv[0][1]!='\0') { 163 for(s = argv[0]+1 ; *s ; ++s) 164 switch(*s) { 165 case 'T': /* use special passes */ 166 switch(*++s) { 167 case '1': 168 fcom = s+1; goto endfor; 169 case 'a': 170 asmname = s+1; goto endfor; 171 case 'l': 172 ldname = s+1; goto endfor; 173 case 'm': 174 macroname = s+1; goto endfor; 175 default: 176 fatal1("bad option -T%c", *s); 177 } 178 break; 179 180 case 'w': /* F66 warn or no warn */ 181 addarg(ffary, &ffmax, s-1); 182 break; 183 184 case 'q': 185 /* 186 * Suppress printing of procedure names during 187 * compilation. 188 */ 189 addarg(ffary, &ffmax, s-1); 190 break; 191 192 copyfflag: 193 case 'u': 194 case 'U': 195 case 'M': 196 case '1': 197 case 'C': 198 addarg(ffary, &ffmax, s-1); 199 break; 200 201 case 'O': 202 optimflag = YES; 203 addarg(ffary, &ffmax, s-1); 204 break; 205 206 case 'm': 207 if(s[1] == '4') 208 ++s; 209 macroflag = YES; 210 break; 211 212 case 'S': 213 saveasmflag = YES; 214 215 case 'c': 216 loadflag = NO; 217 break; 218 219 case 'v': 220 verbose = YES; 221 break; 222 223 case 'd': 224 debugflag = YES; 225 goto copyfflag; 226 227 case 'p': 228 profileflag = YES; 229 goto copyfflag; 230 231 case 'o': 232 if(!strcmp(s, "onetrip")) { 233 addarg(ffary, &ffmax, s-1); 234 goto endfor; 235 } 236 oflag = 1; 237 aoutname = *++argv; 238 --argc; 239 break; 240 241 case 'F': 242 fortonly = YES; 243 loadflag = NO; 244 break; 245 246 case 'I': 247 if(s[1]=='2' || s[1]=='4' || s[1]=='s') 248 goto copyfflag; 249 fprintf(diagfile, "invalid flag -I%c\n", s[1]); 250 done(1); 251 252 case 'l': /* letter ell--library */ 253 s[-1] = '-'; 254 *loadp++ = s-1; 255 goto endfor; 256 257 case 'E': /* EFL flag argument */ 258 while(( *eflagp++ = *++s)) 259 ; 260 *eflagp++ = ' '; 261 goto endfor; 262 case 'R': 263 while(( *rflagp++ = *++s )) 264 ; 265 *rflagp++ = ' '; 266 goto endfor; 267 default: 268 lflag[1] = *s; 269 *loadp++ = copyn(strlen(lflag), lflag); 270 break; 271 } 272 endfor: 273 --argc; 274 ++argv; 275 } 276 277 if (verbose) 278 fprintf(stderr, xxxvers); 279 280 if (argc == 0) 281 errorx("No input files"); 282 283 #ifdef mach_pdp11 284 if(nofloating) 285 *loadp++ = (profileflag ? NOFLPROF : NOFLFOOT); 286 else 287 #endif 288 289 for(i = 0 ; i<argc ; ++i) 290 switch(c = dotchar(infname = argv[i]) ) { 291 case 'r': /* Ratfor file */ 292 case 'e': /* EFL file */ 293 if( unreadable(argv[i]) ) 294 break; 295 s = fortfile; 296 t = lastfield(argv[i]); 297 while(( *s++ = *t++)) 298 ; 299 s[-2] = 'f'; 300 301 if(macroflag) { 302 sprintf(buff, "%s %s >%s", macroname, infname, prepfname); 303 if(sys(buff)) { 304 rmf(prepfname); 305 break; 306 } 307 infname = prepfname; 308 } 309 310 if(c == 'e') 311 sprintf(buff, "efl %s %s >%s", eflags, infname, fortfile); 312 else 313 sprintf(buff, "ratfor %s %s >%s", rflags, infname, fortfile); 314 status = sys(buff); 315 if(macroflag) 316 rmf(infname); 317 if(status) { 318 loadflag = NO; 319 rmf(fortfile); 320 break; 321 } 322 323 if( ! fortonly ) { 324 infname = argv[i] = lastfield(argv[i]); 325 *lastchar(infname) = 'f'; 326 327 if( dofort(argv[i]) ) 328 loadflag = NO; 329 else { 330 if( nodup(t = setdoto(argv[i])) ) 331 *loadp++ = t; 332 rmf(fortfile); 333 } 334 } 335 break; 336 337 case 'f': /* Fortran file */ 338 case 'F': 339 if( unreadable(argv[i]) ) 340 break; 341 if( dofort(argv[i]) ) 342 loadflag = NO; 343 else if( nodup(t=setdoto(argv[i])) ) 344 *loadp++ = t; 345 break; 346 347 case 'c': /* C file */ 348 case 's': /* Assembler file */ 349 if( unreadable(argv[i]) ) 350 break; 351 fprintf(diagfile, "%s:\n", argv[i]); 352 sprintf(buff, "cc -c %s", argv[i] ); 353 if( sys(buff) ) 354 loadflag = NO; 355 else 356 if( nodup(t = setdoto(argv[i])) ) 357 *loadp++ = t; 358 break; 359 360 case 'o': 361 if( nodup(argv[i]) ) 362 *loadp++ = argv[i]; 363 break; 364 365 default: 366 if( ! strcmp(argv[i], "-o") ) 367 aoutname = argv[++i]; 368 else 369 *loadp++ = argv[i]; 370 break; 371 } 372 373 if(loadflag) 374 doload(loadargs, loadp); 375 done(0); 376 return 0; 377 } 378 379 #define ADD(x) addarg(params, &nparms, (x)) 380 381 static int 382 dofort(char *s) 383 { 384 int nparms, i; 385 char *params[MAXARGS]; 386 387 nparms = 0; 388 ADD(FCOM); 389 for (i = 0; i < ffmax; i++) 390 ADD(ffary[i]); 391 ADD(s); 392 ADD(asmfname); 393 ADD(NULL); 394 395 infname = s; 396 if (callsys(fcom, params)) 397 errorx("Error. No assembly."); 398 doasm(s); 399 400 if (saveasmflag == NO) 401 rmf(asmfname); 402 return(0); 403 } 404 405 406 static void 407 doasm(char *s) 408 { 409 char *obj; 410 char *params[MAXARGS]; 411 int nparms; 412 413 if (oflag && loadflag == NO) 414 obj = aoutname; 415 else 416 obj = setdoto(s); 417 418 nparms = 0; 419 ADD(asmname); 420 ADD("-o"); 421 ADD(obj); 422 ADD(asmfname); 423 ADD(NULL); 424 425 if (callsys(asmname, params)) 426 fatal1("assembler error"); 427 if(verbose) 428 fprintf(diagfile, "\n"); 429 } 430 431 432 static void 433 doload(char *v0[], char *v[]) 434 { 435 int nparms, i; 436 char *params[MAXARGS]; 437 char **p; 438 439 nparms = 0; 440 ADD(ldname); 441 ADD("-X"); 442 ADD("-d"); 443 for (i = 0; dynlinker[i]; i++) 444 ADD(dynlinker[i]); 445 ADD("-o"); 446 ADD(aoutname); 447 ADD(crt0file); 448 for (i = 0; startfiles[i]; i++) 449 ADD(startfiles[i]); 450 *v = NULL; 451 for(p = v0; *p ; p++) 452 ADD(*p); 453 if (libdir) 454 ADD(libdir); 455 for(p = liblist ; *p ; p++) 456 ADD(*p); 457 for (i = 0; endfiles[i]; i++) 458 ADD(endfiles[i]); 459 ADD(NULL); 460 461 if (callsys(ldname, params)) 462 fatal1("couldn't load %s", ldname); 463 464 if(verbose) 465 fprintf(diagfile, "\n"); 466 } 467 468 /* Process control and Shell-simulating routines */ 469 470 /* 471 * Execute f[] with parameter array v[]. 472 * Copied from cc. 473 */ 474 static int 475 callsys(char f[], char *v[]) 476 { 477 int t, status = 0; 478 pid_t p; 479 char *s; 480 481 if (debugflag || verbose) { 482 fprintf(stderr, "%s ", f); 483 for (t = 1; v[t]; t++) 484 fprintf(stderr, "%s ", v[t]); 485 fprintf(stderr, "\n"); 486 } 487 488 if ((p = fork()) == 0) { 489 #ifdef notyet 490 if (Bflag) { 491 size_t len = strlen(Bflag) + 8; 492 char *a = malloc(len); 493 if (a == NULL) { 494 error("callsys: malloc failed"); 495 exit(1); 496 } 497 if ((s = strrchr(f, '/'))) { 498 strlcpy(a, Bflag, len); 499 strlcat(a, s, len); 500 execv(a, v); 501 } 502 } 503 #endif 504 execvp(f, v); 505 if ((s = strrchr(f, '/'))) 506 execvp(s+1, v); 507 fprintf(stderr, "Can't find %s\n", f); 508 _exit(100); 509 } else { 510 if (p == -1) { 511 printf("Try again\n"); 512 return(100); 513 } 514 } 515 while (waitpid(p, &status, 0) == -1 && errno == EINTR) 516 ; 517 if (WIFEXITED(status)) 518 return (WEXITSTATUS(status)); 519 if (WIFSIGNALED(status)) 520 done(1); 521 fatal1("Fatal error in %s", f); 522 return 0; /* XXX */ 523 } 524 525 526 static int 527 sys(char *str) 528 { 529 char *s, *t; 530 char *argv[100], path[100]; 531 char *inname, *outname; 532 int append = 0; 533 int wait_pid; 534 int argc; 535 536 537 if(debugflag) 538 fprintf(diagfile, "%s\n", str); 539 inname = NULL; 540 outname = NULL; 541 argv[0] = shellname; 542 argc = 1; 543 544 t = str; 545 while( isspace((int)*t) ) 546 ++t; 547 while(*t) { 548 if(*t == '<') 549 inname = t+1; 550 else if(*t == '>') { 551 if(t[1] == '>') { 552 append = YES; 553 outname = t+2; 554 } else { 555 append = NO; 556 outname = t+1; 557 } 558 } else 559 argv[argc++] = t; 560 while( !isspace((int)*t) && *t!='\0' ) 561 ++t; 562 if(*t) { 563 *t++ = '\0'; 564 while( isspace((int)*t) ) 565 ++t; 566 } 567 } 568 569 if(argc == 1) /* no command */ 570 return(-1); 571 argv[argc] = 0; 572 573 s = path; 574 t = "/usr/bin/"; 575 while(*t) 576 *s++ = *t++; 577 for(t = argv[1] ; (*s++ = *t++) ; ) 578 ; 579 if((wait_pid = fork()) == 0) { 580 if(inname) 581 freopen(inname, "r", stdin); 582 if(outname) 583 freopen(outname, (append ? "a" : "w"), stdout); 584 enbint(SIG_DFL); 585 586 texec(path+9, argv); /* command */ 587 texec(path+4, argv); /* /bin/command */ 588 texec(path , argv); /* /usr/bin/command */ 589 590 fatal1("Cannot load %s",path+9); 591 } 592 593 return( await(wait_pid) ); 594 } 595 596 /* modified version from the Shell */ 597 static void 598 texec(char *f, char **av) 599 { 600 601 execv(f, av+1); 602 603 if (errno==ENOEXEC) { 604 av[1] = f; 605 execv(shellname, av); 606 fatal1("No shell!"); 607 } 608 if (errno==ENOMEM) 609 fatal1("%s: too large", f); 610 } 611 612 /* 613 * Cleanup and exit with value k. 614 */ 615 static void 616 done(int k) 617 { 618 static int recurs = NO; 619 620 if(recurs == NO) { 621 recurs = YES; 622 if (saveasmflag == NO) 623 rmf(asmfname); 624 } 625 exit(k); 626 } 627 628 629 static void 630 enbint(void (*k)(int)) 631 { 632 if(sigivalue == 0) 633 signal(SIGINT,k); 634 if(sigqvalue == 0) 635 signal(SIGQUIT,k); 636 } 637 638 639 640 static void 641 intrupt(int a) 642 { 643 done(2); 644 } 645 646 647 static int 648 await(int wait_pid) 649 { 650 int w, status; 651 652 enbint(SIG_IGN); 653 while ( (w = wait(&status)) != wait_pid) 654 if(w == -1) 655 fatal1("bad wait code"); 656 enbint(intrupt); 657 if(status & 0377) 658 { 659 if(status != SIGINT) 660 fprintf(diagfile, "Termination code %d", status); 661 done(3); 662 } 663 return(status>>8); 664 } 665 666 /* File Name and File Manipulation Routines */ 667 668 static int 669 unreadable(char *s) 670 { 671 FILE *fp; 672 673 if((fp = fopen(s, "r"))) { 674 fclose(fp); 675 return(NO); 676 } else { 677 fprintf(diagfile, "Error: Cannot read file %s\n", s); 678 loadflag = NO; 679 return(YES); 680 } 681 } 682 683 684 static void 685 crfnames(void) 686 { 687 sprintf(asmfname, "fort%d.%s", pid, "s"); 688 sprintf(prepfname, "fort%d.%s", pid, "p"); 689 } 690 691 692 693 static void 694 rmf(char *fn) 695 { 696 if(!debugflag && fn!=NULL && *fn!='\0') 697 unlink(fn); 698 } 699 700 701 static int 702 dotchar(char *s) 703 { 704 for( ; *s ; ++s) 705 if(s[0]=='.' && s[1]!='\0' && s[2]=='\0') 706 return( s[1] ); 707 return(NO); 708 } 709 710 711 static char * 712 lastfield(char *s) 713 { 714 char *t; 715 for(t = s; *s ; ++s) 716 if(*s == '/') 717 t = s+1; 718 return(t); 719 } 720 721 722 static char * 723 lastchar(char *s) 724 { 725 while(*s) 726 ++s; 727 return(s-1); 728 } 729 730 731 static char * 732 setdoto(char *s) 733 { 734 *lastchar(s) = 'o'; 735 return( lastfield(s) ); 736 } 737 738 739 static char * 740 copyn(int n, char *s) 741 { 742 char *p, *q; 743 744 p = q = (char *)calloc(1, (unsigned) n + 1); 745 if (!p) 746 fatal1("out of memory"); 747 748 while(n-- > 0) 749 *q++ = *s++; 750 return (p); 751 } 752 753 754 static int 755 nodup(char *s) 756 { 757 char **p; 758 759 for(p = loadargs ; p < loadp ; ++p) 760 if( !strcmp(*p, s) ) 761 return(NO); 762 763 return(YES); 764 } 765 766 767 static void 768 errorx(char *fmt, ...) 769 { 770 va_list ap; 771 772 va_start(ap, fmt); 773 vfprintf(diagfile, fmt, ap); 774 fprintf(diagfile, "\n"); 775 va_end(ap); 776 777 if (debugflag) 778 abort(); 779 done(1); 780 } 781 782 783 static void 784 fatal1(char *fmt, ...) 785 { 786 va_list ap; 787 788 va_start(ap, fmt); 789 fprintf(diagfile, "Compiler error in file %s: ", infname); 790 vfprintf(diagfile, fmt, ap); 791 fprintf(diagfile, "\n"); 792 va_end(ap); 793 794 if (debugflag) 795 abort(); 796 done(1); 797 } 798