1
/* $Id: f77.c,v 1.21 2008/12/27 00:36:39 sgk Exp $ */
3
* Copyright(C) Caldera International Inc. 2001-2002. All rights reserved.
5
* Redistribution and use in source and binary forms, with or without
6
* modification, are permitted provided that the following conditions
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
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.
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.
36
char xxxvers[] = "FORTRAN 77 DRIVER, VERSION 1.11, 28 JULY 1978\n";
59
static int sigivalue = 0;
60
static int sigqvalue = 0;
67
#define ASSEMBLER "as"
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;
88
static char asmfname[15];
89
static char prepfname[15];
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;
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;
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 *, ...);
127
addarg(char **ary, int *num, char *arg)
130
if ((*num) == MAXARGS) {
131
fprintf(stderr, "argument array too small\n");
137
main(int argc, char **argv)
141
char fortfile[20], *t;
146
sigivalue = (int) signal(SIGINT, SIG_IGN) & 01;
147
sigqvalue = (int) signal(SIGQUIT, SIG_IGN) & 01;
153
loadargs = (char **)calloc(1, (argc + 20) * sizeof(*loadargs));
155
fatal1("out of memory");
161
while(argc>0 && argv[0][0]=='-' && argv[0][1]!='\0') {
162
for(s = argv[0]+1 ; *s ; ++s)
164
case 'T': /* use special passes */
167
fcom = s+1; goto endfor;
169
asmname = s+1; goto endfor;
171
ldname = s+1; goto endfor;
173
macroname = s+1; goto endfor;
175
fatal1("bad option -T%c", *s);
179
case 'w': /* F66 warn or no warn */
180
addarg(ffary, &ffmax, s-1);
185
* Suppress printing of procedure names during
188
addarg(ffary, &ffmax, s-1);
197
addarg(ffary, &ffmax, s-1);
202
addarg(ffary, &ffmax, s-1);
231
if(!strcmp(s, "onetrip")) {
232
addarg(ffary, &ffmax, s-1);
246
if(s[1]=='2' || s[1]=='4' || s[1]=='s')
248
fprintf(diagfile, "invalid flag -I%c\n", s[1]);
251
case 'l': /* letter ell--library */
256
case 'E': /* EFL flag argument */
257
while(( *eflagp++ = *++s))
262
while(( *rflagp++ = *++s ))
268
*loadp++ = copyn(strlen(lflag), lflag);
277
fprintf(stderr, xxxvers);
280
errorx("No input files");
284
*loadp++ = (profileflag ? NOFLPROF : NOFLFOOT);
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]) )
295
t = lastfield(argv[i]);
296
while(( *s++ = *t++))
301
sprintf(buff, "%s %s >%s", macroname, infname, prepfname);
310
sprintf(buff, "efl %s %s >%s", eflags, infname, fortfile);
312
sprintf(buff, "ratfor %s %s >%s", rflags, infname, fortfile);
323
infname = argv[i] = lastfield(argv[i]);
324
*lastchar(infname) = 'f';
326
if( dofort(argv[i]) )
329
if( nodup(t = setdoto(argv[i])) )
336
case 'f': /* Fortran file */
338
if( unreadable(argv[i]) )
340
if( dofort(argv[i]) )
342
else if( nodup(t=setdoto(argv[i])) )
346
case 'c': /* C file */
347
case 's': /* Assembler file */
348
if( unreadable(argv[i]) )
350
fprintf(diagfile, "%s:\n", argv[i]);
351
sprintf(buff, "cc -c %s", argv[i] );
355
if( nodup(t = setdoto(argv[i])) )
365
if( ! strcmp(argv[i], "-o") )
366
aoutname = argv[++i];
373
doload(loadargs, loadp);
378
#define ADD(x) addarg(params, &nparms, (x))
384
char *params[MAXARGS];
388
for (i = 0; i < ffmax; i++)
395
if (callsys(fcom, params))
396
errorx("Error. No assembly.");
399
if (saveasmflag == NO)
409
char *params[MAXARGS];
412
if (oflag && loadflag == NO)
424
if (callsys(asmname, params))
425
fatal1("assembler error");
427
fprintf(diagfile, "\n");
432
doload(char *v0[], char *v[])
435
char *params[MAXARGS];
442
for (i = 0; dynlinker[i]; i++)
447
for (i = 0; startfiles[i]; i++)
450
for(p = v0; *p ; p++)
454
for(p = liblist ; *p ; p++)
456
for (i = 0; endfiles[i]; i++)
460
if (callsys(ldname, params))
461
fatal1("couldn't load %s", ldname);
464
fprintf(diagfile, "\n");
467
/* Process control and Shell-simulating routines */
470
* Execute f[] with parameter array v[].
474
callsys(char f[], char *v[])
480
if (debugflag || verbose) {
481
fprintf(stderr, "%s ", f);
482
for (t = 1; v[t]; t++)
483
fprintf(stderr, "%s ", v[t]);
484
fprintf(stderr, "\n");
487
if ((p = fork()) == 0) {
490
size_t len = strlen(Bflag) + 8;
491
char *a = malloc(len);
493
error("callsys: malloc failed");
496
if ((s = strrchr(f, '/'))) {
497
strlcpy(a, Bflag, len);
504
if ((s = strrchr(f, '/')))
506
fprintf(stderr, "Can't find %s\n", f);
510
printf("Try again\n");
514
while (waitpid(p, &status, 0) == -1 && errno == EINTR)
516
if (WIFEXITED(status))
517
return (WEXITSTATUS(status));
518
if (WIFSIGNALED(status))
520
fatal1("Fatal error in %s", f);
529
char *argv[100], path[100];
530
char *inname, *outname;
537
fprintf(diagfile, "%s\n", str);
544
while( isspace((int)*t) )
559
while( !isspace((int)*t) && *t!='\0' )
563
while( isspace((int)*t) )
568
if(argc == 1) /* no command */
576
for(t = argv[1] ; (*s++ = *t++) ; )
578
if((wait_pid = fork()) == 0) {
580
freopen(inname, "r", stdin);
582
freopen(outname, (append ? "a" : "w"), stdout);
585
texec(path+9, argv); /* command */
586
texec(path+4, argv); /* /bin/command */
587
texec(path , argv); /* /usr/bin/command */
589
fatal1("Cannot load %s",path+9);
592
return( await(wait_pid) );
595
/* modified version from the Shell */
597
texec(char *f, char **av)
602
if (errno==ENOEXEC) {
604
execv(shellname, av);
608
fatal1("%s: too large", f);
612
* Cleanup and exit with value k.
617
static int recurs = NO;
621
if (saveasmflag == NO)
629
enbint(void (*k)(int))
652
while ( (w = wait(&status)) != wait_pid)
654
fatal1("bad wait code");
659
fprintf(diagfile, "Termination code %d", status);
665
/* File Name and File Manipulation Routines */
672
if((fp = fopen(s, "r"))) {
676
fprintf(diagfile, "Error: Cannot read file %s\n", s);
686
sprintf(asmfname, "fort%d.%s", pid, "s");
687
sprintf(prepfname, "fort%d.%s", pid, "p");
695
if(!debugflag && fn!=NULL && *fn!='\0')
704
if(s[0]=='.' && s[1]!='\0' && s[2]=='\0')
734
return( lastfield(s) );
739
copyn(int n, char *s)
743
p = q = (char *)calloc(1, (unsigned) n + 1);
745
fatal1("out of memory");
758
for(p = loadargs ; p < loadp ; ++p)
767
errorx(char *fmt, ...)
772
vfprintf(diagfile, fmt, ap);
773
fprintf(diagfile, "\n");
783
fatal1(char *fmt, ...)
788
fprintf(diagfile, "Compiler error in file %s: ", infname);
789
vfprintf(diagfile, fmt, ap);
790
fprintf(diagfile, "\n");
added
removed
uspace/app/pcc/f77/f77/f77.c
