* Copyright (c) 1980 Regents of the University of California.
* All rights reserved. The Berkeley software License Agreement
* specifies the terms and conditions for redistribution.
static char sccsid
[] = "@(#)f77.c 5.4 (Berkeley) %G%";
* Driver program for the 4.2 BSD f77 compiler.
* University of Utah CS Dept modification history:
* Revision 5.4 85/12/17 19:12:14 donn
* Dynamically allocate buffer; add lint fixes.
* Revision 5.3 85/11/25 00:00:02 donn
* Revision 5.2 85/08/10 05:16:14 donn
* Ifdeffed 66 code, added -r8 flag. From Jerry Berkman.
* Revision 5.1 85/08/10 03:32:12 donn
* Revision 1.14 85/03/01 00:07:57 donn
* Portability fix from Ralph Campbell.
* Revision 1.13 85/02/12 19:31:47 donn
* Use CATNAME to get the name of a concatenation command instead of
* explicitly running 'cat' -- you can get the wrong 'cat' the old way!
* Revision 1.12 85/01/14 06:42:30 donn
* Changed to call the peephole optimizer with the '-f' flag, so that
* floating point moves are translated to integer moves.
* Revision 1.11 85/01/14 04:38:59 donn
* Jerry's change to pass -O to f1 so it knows whether the peephole optimizer
* will be run. This is necessary in order to handle movf/movl translation.
* Revision 1.10 85/01/14 03:59:12 donn
* Added Jerry Berkman's fix for the '-q' flag.
* Revision 1.9 84/11/09 01:51:26 donn
* Cosmetic change to stupid() suggested by John McCarthy at Memorial
* Revision 1.8 84/09/14 16:02:34 donn
* Added changes to notice when people do 'f77 -c foo.f -o bar.o' and tell
* them why it doesn't do what they think it does.
* Revision 1.7 84/08/24 21:08:31 donn
* Added call to setrlimit() to prevent core dumps when not debugging.
* Reorganized the include file arrangment somewhat.
* Revision 1.6 84/08/24 20:20:24 donn
* Changed stupidity check on Jerry Berkman's suggestion -- now it balks if
* the load file exists and has a sensitive suffix.
* Revision 1.5 84/08/15 18:56:44 donn
* Added test for -O combined with -g, suggested by Raleigh Romine. To keep
* things simple, if both are specified then the second in the list is thrown
* out and the user is warned.
* Revision 1.4 84/08/05 21:33:15 donn
* Added stupidity check -- f77 won't load on a file that it's asked to
* Revision 1.3 84/08/04 22:58:24 donn
* Improved error reporting -- we now explain why we died and what we did.
* Only works on 4.2. Added at the instigation of Jerry Berkman.
* Revision 1.2 84/07/28 13:11:24 donn
* Added Ralph Campbell's changes to reduce offsets to data.
char *xxxvers
= "\n@(#) F77 DRIVER, VERSION 4.2, 1984 JULY 28\n";
* Some 4.2 BSD capabilities.
#include <sys/resource.h>
static FILEP diagfile
= {stderr
} ;
static int sigivalue
= 0;
static int sigqvalue
= 0;
static int sighvalue
= 0;
static int sigtvalue
= 0;
static char *pass1name
= PASS1NAME
;
static char *pass2name
= PASS2NAME
;
static char *pass2opt
= PASS2OPT
;
static char *asmname
= ASMNAME
;
static char *ldname
= LDNAME
;
static char *footname
= FOOTNAME
;
static char *proffoot
= PROFFOOT
;
static char *macroname
= "m4";
static char *shellname
= "/bin/sh";
static char *cppname
= "/lib/cpp";
static char *aoutname
= "a.out" ;
static char *temppref
= TEMPPREF
;
static char textfname
[44];
static char asmfname
[44];
static char asmpass2
[44];
static char initfname
[44];
static char sortfname
[44];
static char prepfname
[44];
static char objfdefault
[44];
static char optzfname
[44];
static char setfname
[44];
static char fflags
[50] = "-";
static char cflags
[50] = "-c";
static char eflags
[30] = "system=gcos ";
static char eflags
[30] = "system=unix ";
static char rflags
[30] = "";
static char lflag
[3] = "-x";
static char *fflagp
= fflags
+1;
static char *f2flagp
= f2flags
;
static char *eflagp
= eflags
+12;
static char *rflagp
= rflags
;
static char *cppflags
= "";
static flag loadflag
= YES
;
static flag saveasmflag
= NO
;
static flag profileflag
= NO
;
static flag optimflag
= NO
;
static flag debugflag
= NO
;
static flag verbose
= NO
;
static flag fortonly
= NO
;
static flag macroflag
= NO
;
static flag sdbflag
= NO
;
static flag namesflag
= YES
;
static flag nofloating
= NO
;
char *setdoto(), *lastchar(), *lastfield(), *copys(), *argvtos();
sigivalue
= signal(SIGINT
, SIG_IGN
) == SIG_IGN
;
sigqvalue
= signal(SIGQUIT
,SIG_IGN
) == SIG_IGN
;
sighvalue
= signal(SIGHUP
, SIG_IGN
) == SIG_IGN
;
sigtvalue
= signal(SIGTERM
,SIG_IGN
) == SIG_IGN
;
cppargs
= (char **) ckalloc( argc
* sizeof(*cppargs
) );
loadargs
= (char **) ckalloc( (argc
+20) * sizeof(*loadargs
) );
#if HERE==PDP11 || HERE==VAX
for (i
= 0, n
= 50; i
< argc
; ++i
)
n
+= strlen(argv
[i
]) + 1;
buff
= (char *) ckalloc(n
);
while(argc
>0 && argv
[0][0]=='-' && argv
[0][1]!='\0')
for(s
= argv
[0]+1 ; *s
; ++s
) switch(*s
)
case 'T': /* use special passes */
pass1name
= s
+1; goto endfor
;
pass2name
= s
+1; goto endfor
;
pass2opt
= s
+1; goto endfor
;
asmname
= s
+1; goto endfor
;
ldname
= s
+1; goto endfor
;
footname
= s
+1; goto endfor
;
macroname
= s
+1; goto endfor
;
temppref
= s
+1; goto endfor
;
fatali("bad option -T%c", *s
);
fprintf(diagfile
, "invalid flag 6%c\n", s
[1]);
if(s
[1]=='6' && s
[2]=='6')
fprintf(diagfile
, "-O and -g are incompatible; -O ignored\n");
if( oneof(*++s
, "qxscn") )
fprintf(diagfile
, "invalid flag -N%c\n", *s
);
(void) strcat(cflags
, " -S");
if( new_aoutname
== YES
){
fprintf(diagfile
, "-c prevents loading, -o %s ignored\n", aoutname
);
fprintf(diagfile
,"\nBerkeley F77, version %s\n",
while( isdigit(*s
) || *s
== ',' )
fprintf(diagfile
, "-g and -O are incompatible; -g ignored\n");
(void) strcat(cflags
," -g");
(void) strcat(cflags
," -p");
if( ! strcmp(s
, "onetrip") )
fprintf(diagfile
, "-c prevents loading, -o %s ignored\n", aoutname
);
if((s
[1]=='2' || s
[1]=='4') && s
[2] == '\0')
fprintf(diagfile
, "invalid flag -i%c\n", s
[1]);
case 'r': /* -r8 - double the precision */
if(s
[1] == '8' && s
[2] == '\0')
case 'l': /* letter ell--library */
case 'E': /* EFL flag argument */
while( *rflagp
++ = *++s
)
r
.rlim_cur
= r
.rlim_max
= 0;
(void) setrlimit(RLIMIT_CORE
, &r
);
cppflags
= argvtos (ncpp
,cppargs
);
*loadp
++ = (profileflag
? NOFLPROF
: NOFLFOOT
);
*loadp
++ = (profileflag
? proffoot
: footname
);
for(i
= 0 ; i
<argc
; ++i
)
switch(c
= dotchar(infname
= argv
[i
]) )
case 'r': /* Ratfor file */
if( unreadable(argv
[i
]) )
sprintf(buff
, "%s %s >%s", macroname
, infname
, prepfname
);
sprintf(buff
, "efl %s %s >%s", eflags
, infname
, fortfile
);
sprintf(buff
, "ratfor %s %s >%s", rflags
, infname
, fortfile
);
infname
= argv
[i
] = lastfield(argv
[i
]);
*lastchar(infname
) = 'f';
if( nodup(t
= setdoto(argv
[i
])) )
case 'F': /* C preprocessor -> Fortran file */
if( unreadable(argv
[i
]) )
sprintf(buff
,"%s %s %s >%s", cppname
, cppflags
, infname
, fortfile
);
infname
= argv
[i
] = lastfield(argv
[i
]);
*lastchar(infname
) = 'f';
if (nodup(t
= setdoto(argv
[i
])) )
case 'f': /* Fortran file */
if( unreadable(argv
[i
]) )
else if( dofort(argv
[i
]) )
else if( nodup(t
=setdoto(argv
[i
])) )
case 's': /* Assembler file */
if( unreadable(argv
[i
]) )
#if HERE==PDP11 || HERE==VAX
fprintf(diagfile
, "%s:\n", argv
[i
]);
sprintf(buff
, "cc %s %s", cflags
, argv
[i
] );
if( nodup(t
= setdoto(argv
[i
])) )
if( ! strcmp(argv
[i
], "-o") ) {
fprintf(diagfile
, "-c prevents loading, -o %s ignored\n", aoutname
);
if( loadflag
&& stupid(aoutname
) )
* argvtos() copies a list of arguments contained in an array of character
* strings to a single dynamically allocated string. Each argument is
* separated by one blank space. Returns a pointer to the string or null
register char *s
; /* string pointer */
register int i
; /* string buffer pointer */
char *malloc(); /* memory allocator */
char *realloc(); /* increase size of storage */
char *sbuf
; /* string buffer */
int nbytes
; /* bytes of memory required */
int nu
; /* no. of SBUFINCR units required */
int sbufsize
; /* current size of sbuf */
int strlen(); /* string length */
if ((sbuf
= malloc((unsigned)sbufsize
)) == NULL
)
fatal("out of memory (argvtos)");
for (i
= 0; argc
-- > 0; ++argv
)
if ((nbytes
= (i
+strlen(*argv
)+1-sbufsize
)) > 0)
nu
= (nbytes
+SBUFINCR
-1)/SBUFINCR
;
sbufsize
+= nu
* SBUFINCR
;
fatal("argument length exceeded (argvtos)");
if ((sbuf
= realloc(sbuf
, (unsigned)sbufsize
)) == NULL
)
fatal("out of memory (argvtos)");
for (s
= *argv
; *s
!= '\0'; i
++, s
++)
sprintf(buff
, "%s %s %s %s %s %s",
pass1name
, fflags
, s
, asmfname
, initfname
, textfname
);
fprintf(diagfile
, "\nError. No assembly.\n");
fprintf(diagfile
, "\ncompiler error.\n");
fprintf(diagfile
, "PASS2.");
sprintf(buff
, "%s %s - %s", pass2name
, textfname
, asmpass2
);
sprintf(buff
, "%s -A%s <%s >%s", pass2name
, setfname
, textfname
, asmpass2
);
sprintf(buff
, "%s %s %s >%s",
pass2name
, f2flags
, textfname
, asmpass2
);
char *lastchar(), *setdoto();
#if TARGET==PDP11 || TARGET==VAX
sprintf(buff
, "%s -f %s %s", pass2opt
, asmpass2
, optzfname
);
sprintf(buff
,"mv %s %s", optzfname
, asmpass2
);
fatal("can't rename optimizer output file");
sprintf(buff
, "%s %s %s %s %s >%s", CATNAME
, asmfname
, initfname
,
setfname
, asmpass2
, obj
);
sprintf(buff
, "%s %s %s %s >%s",
CATNAME
, asmfname
, asmpass2
, initfname
, obj
);
sprintf(buff
, "%s %s %s %s >%s",
CATNAME
, asmfname
, initfname
, asmpass2
, obj
);
sprintf(buff
, "%s %s %s %s >%s",
CATNAME
, asmfname
, initfname
, asmpass2
, obj
);
fatal("can't concatenate assembly files");
fprintf(diagfile
, " ASM.");
sprintf(buff
, "%s -o %s %s %s %s %s", asmname
, obj
, asmfname
,
initfname
, setfname
, asmpass2
);
/* vax assembler currently accepts only one input file */
sprintf(buff
, "%s %s %s >>%s",
CATNAME
, asmpass2
, initfname
, asmfname
);
sprintf(buff
, "%s %s %s >>%s",
CATNAME
, initfname
, asmpass2
, asmfname
);
fatal("can't concatenate assembly files");
sprintf(buff
, "%s -J -o %s %s", asmname
, obj
, asmfname
);
sprintf(buff
, "%s -o %s %s", asmname
, obj
, asmfname
);
sprintf(buff
, "%s -u -o %s %s %s", asmname
, obj
, asmfname
, asmpass2
);
#if TARGET!=INTERDATA && TARGET!=PDP11 && TARGET!=VAX
sprintf(buff
, "%s -o %s %s %s", asmname
, obj
, asmfname
, asmpass2
);
fatal("assembler error");
#if HERE==PDP11 && TARGET!=PDP11
register char *v0
[], *v
[];
for(p
= p_liblist
; *p
; *v
++ = *p
++)
for(p
= liblist
; *p
; *v
++ = *p
++)
fprintf(diagfile
, "LOAD.");
fprintf(diagfile
, "%s ", *p
);
#if HERE==PDP11 || HERE==INTERDATA || HERE==VAX
if( (waitpid
= fork()) == 0)
fatalstr("couldn't load %s", ldname
);
char buff1
[100], buff2
[100];
sprintf(buff1
, "nopt %s -o junk.%d", aoutname
, pid
);
sprintf(buff2
, "mv junk.%d %s", pid
, aoutname
);
if( sys(buff1
) || sys(buff2
) )
/* Process control and Shell-simulating routines */
char *argv
[100], path
[100];
fprintf(diagfile
, "%s\n", str
);
while( !isspace(*t
) && *t
!='\0' )
if(argc
== 1) /* no command */
for(t
= argv
[1] ; *s
++ = *t
++ ; )
if((waitpid
= fork()) == 0)
if(freopen(inname
, "r", stdin
) == NULL
)
fatalstr("Cannot open %s", inname
);
if(freopen(outname
, (append
? "a" : "w"), stdout
) == NULL
)
fatalstr("Cannot open %s", outname
);
texec(path
+9, argv
); /* command */
texec(path
+4, argv
); /* /bin/command */
texec(path
, argv
); /* /usr/bin/command */
fatalstr("Cannot load %s",path
+9);
return( await(waitpid
) );
/* modified version from the Shell */
fatalstr("%s: too large", f
);
(void) signal(SIGQUIT
,k
);
(void) signal(SIGTERM
,k
);
* Fancy 4.2 BSD signal printing stuff.
char harmless
[NSIG
] = { 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1 };
extern char *sys_siglist
[];
while ( (w
= wait(&status
)) != waitpid
)
debugflag
= 0; /* Prevent us from dumping core ourselves */
if(status
.w_termsig
!= SIGINT
&& status
.w_termsig
< NSIG
)
fprintf(diagfile
, "%s%s\n", sys_siglist
[status
.w_termsig
],
status
.w_coredump
? " -- core dumped" : "");
if(status
.w_termsig
< NSIG
&& ! harmless
[status
.w_termsig
])
fatal("see a system manager");
return(status
.w_retcode
);
fprintf(diagfile
, "Termination code %d\n", status
);
/* File Name and File Manipulation Routines */
fprintf(diagfile
, "Error: Cannot read file %s\n", s
);
fprintf(diagfile
, "Loading on %s would destroy it\n", s
);
if(p
!=NULL
&& *p
!=NULL
&& *p
!=stdout
)
/* return -1 if file does not exist, 0 if it is of zero length
and 1 if of positive length
if(stat(filename
,&buf
) < 0)
return(buf
.size0
|| buf
.size1
);
return( buf
.st_size
> 0 );
/* if(!debugflag && fn!=NULL && *fn!='\0') */
if(fn
!=NULL
&& *fn
!='\0')
sprintf(name
, "/tmp/%s%d.%s", temppref
, pid
, suff
);
if(s
[0]=='.' && s
[1]!='\0' && s
[2]=='\0')
fatalstr("cannot open intermediate file %s", s
);
if( p
= (ptr
) calloc(1, (unsigned) n
) )
p
= q
= (char *) ckalloc(n
);
return( copyn( strlen(s
)+1 , s
) );
for(p
= loadargs
; p
< loadp
; ++p
)
fprintf(diagfile
, "Compiler error in file %s: %s\n", infname
, t
);
fprintf(diagfile
, "Error in file %s: %s\n", infname
, s
);