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