1 /* Id: f77.c,v 1.22 2011/08/04 08:32:32 mickey Exp */
2 /* $NetBSD: f77.c,v 1.1.1.4 2011/09/01 12:47:05 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
addarg(char ** ary,int * num,char * arg)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
main(int argc,char ** argv)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 snprintf(buff, sizeof(buff), "%s %s >%s",
303 macroname, infname, prepfname);
304 if(sys(buff)) {
305 rmf(prepfname);
306 break;
307 }
308 infname = prepfname;
309 }
310
311 if(c == 'e')
312 snprintf(buff, sizeof(buff), "efl %s %s >%s",
313 eflags, infname, fortfile);
314 else
315 snprintf(buff, sizeof(buff), "ratfor %s %s >%s",
316 rflags, infname, fortfile);
317 status = sys(buff);
318 if(macroflag)
319 rmf(infname);
320 if(status) {
321 loadflag = NO;
322 rmf(fortfile);
323 break;
324 }
325
326 if( ! fortonly ) {
327 infname = argv[i] = lastfield(argv[i]);
328 *lastchar(infname) = 'f';
329
330 if( dofort(argv[i]) )
331 loadflag = NO;
332 else {
333 if( nodup(t = setdoto(argv[i])) )
334 *loadp++ = t;
335 rmf(fortfile);
336 }
337 }
338 break;
339
340 case 'f': /* Fortran file */
341 case 'F':
342 if( unreadable(argv[i]) )
343 break;
344 if( dofort(argv[i]) )
345 loadflag = NO;
346 else if( nodup(t=setdoto(argv[i])) )
347 *loadp++ = t;
348 break;
349
350 case 'c': /* C file */
351 case 's': /* Assembler file */
352 if( unreadable(argv[i]) )
353 break;
354 fprintf(diagfile, "%s:\n", argv[i]);
355 snprintf(buff, sizeof(buff), "cc -c %s", argv[i]);
356 if( sys(buff) )
357 loadflag = NO;
358 else
359 if( nodup(t = setdoto(argv[i])) )
360 *loadp++ = t;
361 break;
362
363 case 'o':
364 if( nodup(argv[i]) )
365 *loadp++ = argv[i];
366 break;
367
368 default:
369 if( ! strcmp(argv[i], "-o") )
370 aoutname = argv[++i];
371 else
372 *loadp++ = argv[i];
373 break;
374 }
375
376 if(loadflag)
377 doload(loadargs, loadp);
378 done(0);
379 return 0;
380 }
381
382 #define ADD(x) addarg(params, &nparms, (x))
383
384 static int
dofort(char * s)385 dofort(char *s)
386 {
387 int nparms, i;
388 char *params[MAXARGS];
389
390 nparms = 0;
391 ADD(FCOM);
392 for (i = 0; i < ffmax; i++)
393 ADD(ffary[i]);
394 ADD(s);
395 ADD(asmfname);
396 ADD(NULL);
397
398 infname = s;
399 if (callsys(fcom, params))
400 errorx("Error. No assembly.");
401 doasm(s);
402
403 if (saveasmflag == NO)
404 rmf(asmfname);
405 return(0);
406 }
407
408
409 static void
doasm(char * s)410 doasm(char *s)
411 {
412 char *obj;
413 char *params[MAXARGS];
414 int nparms;
415
416 if (oflag && loadflag == NO)
417 obj = aoutname;
418 else
419 obj = setdoto(s);
420
421 nparms = 0;
422 ADD(asmname);
423 ADD("-o");
424 ADD(obj);
425 ADD(asmfname);
426 ADD(NULL);
427
428 if (callsys(asmname, params))
429 fatal1("assembler error");
430 if(verbose)
431 fprintf(diagfile, "\n");
432 }
433
434
435 static void
doload(char * v0[],char * v[])436 doload(char *v0[], char *v[])
437 {
438 int nparms, i;
439 char *params[MAXARGS];
440 char **p;
441
442 nparms = 0;
443 ADD(ldname);
444 ADD("-X");
445 ADD("-d");
446 for (i = 0; dynlinker[i]; i++)
447 ADD(dynlinker[i]);
448 ADD("-o");
449 ADD(aoutname);
450 ADD(crt0file);
451 for (i = 0; startfiles[i]; i++)
452 ADD(startfiles[i]);
453 *v = NULL;
454 for(p = v0; *p ; p++)
455 ADD(*p);
456 if (libdir)
457 ADD(libdir);
458 for(p = liblist ; *p ; p++)
459 ADD(*p);
460 for (i = 0; endfiles[i]; i++)
461 ADD(endfiles[i]);
462 ADD(NULL);
463
464 if (callsys(ldname, params))
465 fatal1("couldn't load %s", ldname);
466
467 if(verbose)
468 fprintf(diagfile, "\n");
469 }
470
471 /* Process control and Shell-simulating routines */
472
473 /*
474 * Execute f[] with parameter array v[].
475 * Copied from cc.
476 */
477 static int
callsys(char f[],char * v[])478 callsys(char f[], char *v[])
479 {
480 int t, status = 0;
481 pid_t p;
482 char *s;
483
484 if (debugflag || verbose) {
485 fprintf(stderr, "%s ", f);
486 for (t = 1; v[t]; t++)
487 fprintf(stderr, "%s ", v[t]);
488 fprintf(stderr, "\n");
489 }
490
491 if ((p = fork()) == 0) {
492 #ifdef notyet
493 if (Bflag) {
494 size_t len = strlen(Bflag) + 8;
495 char *a = malloc(len);
496 if (a == NULL) {
497 error("callsys: malloc failed");
498 exit(1);
499 }
500 if ((s = strrchr(f, '/'))) {
501 strlcpy(a, Bflag, len);
502 strlcat(a, s, len);
503 execv(a, v);
504 }
505 }
506 #endif
507 execvp(f, v);
508 if ((s = strrchr(f, '/')))
509 execvp(s+1, v);
510 fprintf(stderr, "Can't find %s\n", f);
511 _exit(100);
512 } else {
513 if (p == -1) {
514 printf("Try again\n");
515 return(100);
516 }
517 }
518 while (waitpid(p, &status, 0) == -1 && errno == EINTR)
519 ;
520 if (WIFEXITED(status))
521 return (WEXITSTATUS(status));
522 if (WIFSIGNALED(status))
523 done(1);
524 fatal1("Fatal error in %s", f);
525 return 0; /* XXX */
526 }
527
528
529 static int
sys(char * str)530 sys(char *str)
531 {
532 char *s, *t;
533 char *argv[100], path[100];
534 char *inname, *outname;
535 int append = 0;
536 int wait_pid;
537 int argc;
538
539
540 if(debugflag)
541 fprintf(diagfile, "%s\n", str);
542 inname = NULL;
543 outname = NULL;
544 argv[0] = shellname;
545 argc = 1;
546
547 t = str;
548 while( isspace((int)*t) )
549 ++t;
550 while(*t) {
551 if(*t == '<')
552 inname = t+1;
553 else if(*t == '>') {
554 if(t[1] == '>') {
555 append = YES;
556 outname = t+2;
557 } else {
558 append = NO;
559 outname = t+1;
560 }
561 } else
562 argv[argc++] = t;
563 while( !isspace((int)*t) && *t!='\0' )
564 ++t;
565 if(*t) {
566 *t++ = '\0';
567 while( isspace((int)*t) )
568 ++t;
569 }
570 }
571
572 if(argc == 1) /* no command */
573 return(-1);
574 argv[argc] = 0;
575
576 s = path;
577 t = "/usr/bin/";
578 while(*t)
579 *s++ = *t++;
580 for(t = argv[1] ; (*s++ = *t++) ; )
581 ;
582 if((wait_pid = fork()) == 0) {
583 if(inname)
584 freopen(inname, "r", stdin);
585 if(outname)
586 freopen(outname, (append ? "a" : "w"), stdout);
587 enbint(SIG_DFL);
588
589 texec(path+9, argv); /* command */
590 texec(path+4, argv); /* /bin/command */
591 texec(path , argv); /* /usr/bin/command */
592
593 fatal1("Cannot load %s",path+9);
594 }
595
596 return( await(wait_pid) );
597 }
598
599 /* modified version from the Shell */
600 static void
texec(char * f,char ** av)601 texec(char *f, char **av)
602 {
603
604 execv(f, av+1);
605
606 if (errno==ENOEXEC) {
607 av[1] = f;
608 execv(shellname, av);
609 fatal1("No shell!");
610 }
611 if (errno==ENOMEM)
612 fatal1("%s: too large", f);
613 }
614
615 /*
616 * Cleanup and exit with value k.
617 */
618 static void
done(int k)619 done(int k)
620 {
621 static int recurs = NO;
622
623 if(recurs == NO) {
624 recurs = YES;
625 if (saveasmflag == NO)
626 rmf(asmfname);
627 }
628 exit(k);
629 }
630
631
632 static void
enbint(void (* k)(int))633 enbint(void (*k)(int))
634 {
635 if(sigivalue == 0)
636 signal(SIGINT,k);
637 if(sigqvalue == 0)
638 signal(SIGQUIT,k);
639 }
640
641
642
643 static void
intrupt(int a)644 intrupt(int a)
645 {
646 done(2);
647 }
648
649
650 static int
await(int wait_pid)651 await(int wait_pid)
652 {
653 int w, status;
654
655 enbint(SIG_IGN);
656 while ( (w = wait(&status)) != wait_pid)
657 if(w == -1)
658 fatal1("bad wait code");
659 enbint(intrupt);
660 if(status & 0377)
661 {
662 if(status != SIGINT)
663 fprintf(diagfile, "Termination code %d", status);
664 done(3);
665 }
666 return(status>>8);
667 }
668
669 /* File Name and File Manipulation Routines */
670
671 static int
unreadable(char * s)672 unreadable(char *s)
673 {
674 FILE *fp;
675
676 if((fp = fopen(s, "r"))) {
677 fclose(fp);
678 return(NO);
679 } else {
680 fprintf(diagfile, "Error: Cannot read file %s\n", s);
681 loadflag = NO;
682 return(YES);
683 }
684 }
685
686
687 static void
crfnames(void)688 crfnames(void)
689 {
690 snprintf(asmfname, sizeof(asmfname), "fort%d.%s", pid, "s");
691 snprintf(prepfname, sizeof(prepfname), "fort%d.%s", pid, "p");
692 }
693
694
695
696 static void
rmf(char * fn)697 rmf(char *fn)
698 {
699 if(!debugflag && fn!=NULL && *fn!='\0')
700 unlink(fn);
701 }
702
703
704 static int
dotchar(char * s)705 dotchar(char *s)
706 {
707 for( ; *s ; ++s)
708 if(s[0]=='.' && s[1]!='\0' && s[2]=='\0')
709 return( s[1] );
710 return(NO);
711 }
712
713
714 static char *
lastfield(char * s)715 lastfield(char *s)
716 {
717 char *t;
718 for(t = s; *s ; ++s)
719 if(*s == '/')
720 t = s+1;
721 return(t);
722 }
723
724
725 static char *
lastchar(char * s)726 lastchar(char *s)
727 {
728 while(*s)
729 ++s;
730 return(s-1);
731 }
732
733
734 static char *
setdoto(char * s)735 setdoto(char *s)
736 {
737 *lastchar(s) = 'o';
738 return( lastfield(s) );
739 }
740
741
742 static char *
copyn(int n,char * s)743 copyn(int n, char *s)
744 {
745 char *p, *q;
746
747 p = q = (char *)calloc(1, (unsigned) n + 1);
748 if (!p)
749 fatal1("out of memory");
750
751 while(n-- > 0)
752 *q++ = *s++;
753 return (p);
754 }
755
756
757 static int
nodup(char * s)758 nodup(char *s)
759 {
760 char **p;
761
762 for(p = loadargs ; p < loadp ; ++p)
763 if( !strcmp(*p, s) )
764 return(NO);
765
766 return(YES);
767 }
768
769
770 static void
errorx(char * fmt,...)771 errorx(char *fmt, ...)
772 {
773 va_list ap;
774
775 va_start(ap, fmt);
776 vfprintf(diagfile, fmt, ap);
777 fprintf(diagfile, "\n");
778 va_end(ap);
779
780 if (debugflag)
781 abort();
782 done(1);
783 }
784
785
786 static void
fatal1(char * fmt,...)787 fatal1(char *fmt, ...)
788 {
789 va_list ap;
790
791 va_start(ap, fmt);
792 fprintf(diagfile, "Compiler error in file %s: ", infname);
793 vfprintf(diagfile, fmt, ap);
794 fprintf(diagfile, "\n");
795 va_end(ap);
796
797 if (debugflag)
798 abort();
799 done(1);
800 }
801