/*
 *
 *      EPCL UNIX COMPILER DRIVER.
 * Stripped down to deal with IMP only 
 * and restricted ti UNIX5.4 systems (pds) 31/10/94

/* Values Recognised by -DCOMP= */
#define GCF 1
#define SUN 2
#define SEQUENT 3
#define UNISYS 4
#define DRS 5
#define CLAN 6
#define TADPOLE 7
#define DRSNX  8
#define SUN386  9
#define UNICORN  10
#define M88000 11
#define AURORA 12
#define PENTIUM 13

#define NO 0
#define YES 1

#define UNIX5d4 YES

#include <stdio.h>

#include <ctype.h>


typedef FILE *FILEP;
typedef short flag;
#define NIMPCOMPILER     "p5impcompiler   "
#define FORTRANCOMPILER " epcf77compiler  "
#define NUL             '\0'
#define MAXNOOPTIONS    200



#define ASMNAME         "as"
#define LDNAME          "ld"
#define CPPNAME         "/usr/ccs/lib/cpp"
#define FOOTNAME        "/usr/ccs/lib/crt1.o"
#define PROFFOOT        "/usr/ccs/lib/mcrt1.o"
#define GPRFFOOT        "/usr/lib/gcrt0.o"


/* static char *pascalliblist [ ] = { "/usr/tam/pascal/library/paslib", "-lc", NULL }; */
static char *impliblist  [ ] = {
		"-lp5IMP",
		                                "-Y","P,/usr/ccs/lib:/usr/lib","-Qy","-lc",
		                                "/usr/ccs/lib/crtn.o", NULL };
static char *sdbentry   =  "/usr/lib/sdbentry.o";
#include <signal.h>

static FILEP diagfile   = {
		stderr};
static int sigivalue    = 0;
static int sigqvalue    = 0;
static int sighvalue    = 0;
static int sigtvalue    = 0;

static char *fortrancompiler    = FORTRANCOMPILER ;
static char *nimpcompiler        = NIMPCOMPILER ;
static char *ldname     = LDNAME ;
static char *footname   = FOOTNAME;
static char *cppname    = CPPNAME;
static char *proffoot   = PROFFOOT;
static char *gprffoot   = GPRFFOOT;
static char *shellname  = "/bin/sh";
static char *aoutname   = "a.out" ;

static char *entryname[]= {
		"-e", "start", NULL};
static char *constloaderargs[]= {
		"-dy","/usr/ccs/lib/crti.o",
		                                 "/usr/ccs/lib/values-Xt.o", NULL };

static char *infname;
static char **drivername;

static char fflags[128] = "-";          /* RATFOR flags */
static char cflags[128] = "";
static char rflags[30]  = "";
static char lflag[128] = "-x";          /* Loader flags */
static char *fflagp     = fflags;
static char *cflagp     = cflags;
static char *lflagp     = lflag+1;
static char *rflagp     = rflags;
static char **loadargs;
static char **loadp;
static char *options = "";             /* long winded options */

static flag erred       = NO;
static flag loadflag    = YES;
static flag profileflag = NO;
static flag debugflag   = NO;
static flag optflag     = NO;
static flag verbose     = NO;
static flag fortonly    = NO;

/* Unix  5 variants          */
static flag load3f = NO;               /* not used if SEQUENT or UNISYS */
static flag loadVax = YES;             /* not used if SEQUENT or UNISYS */
static flag loadC77 = NO;              /* not used (yet)                */
static flag loadNAG = NO;              /* YES if -NAG and UNISYS        */

int drive_sdb = 0;      /* semaphore for flagging -g option */
int parallel  = NO;     /* semaphore for flagging -mp option */
int atsflag   = NO;     /* semaphore for flagging -ats option */
int kap       = NO;     /* semaphore for KAP/EPC preprocessor */
int kapf      = NO;     /* semaphore for KAP/EPC preprocessor -f option */
int kapl      = NO;     /* semaphore for KAP/EPC preprocessor -l option */
char **liblist;
char *entryroute;

char tempsource[200];    /* holds new .f filename for files passed to cpp */
static char partmpfout[20];
static char partmplout[20];




main(argc, argv)
int argc;
char **argv;
{
	int i,j, c, status;
	char *setdoto(), *lastchar(), *lastfield();
	char *ckalloc(), *copys();
	register char *s;
	char fortfile[20], *t;
	char buff[100];
	int intrupt();
	char *CppOptions[MAXNOOPTIONS];	/* for C command line arguments */
	char **ptrCppOptions;
	char **ptr;                     /* utility ptr to an array of ptrs */
	int CppOnly = NO;

	char *tmpspntr;


	ptrCppOptions =  CppOptions;	/* initialise */

	/* record original settings for these interrupts */

	sigivalue = (int) signal(SIGINT, SIG_IGN) & 01;
	sigqvalue = (int) signal(SIGQUIT,SIG_IGN) & 01;
	sighvalue = (int) signal(SIGHUP, SIG_IGN) & 01;
	sigtvalue = (int) signal(SIGTERM,SIG_IGN) & 01;
	enbint(intrupt); /* redirect previously undirected interrupts to my routine */

	options = '\0';

	drive_sdb = 0;          /* set to false */

	loadargs = (char **) ckalloc( (argc+20) * sizeof(*loadargs) ); /* get more space for loader args */
	loadp = loadargs+1;

	drivername=argv      /* First letter of command identifies imp or fortran */;

	liblist = impliblist;


	--argc;        /* ******* cycle through params ******* */
	++argv;

	while(argc>0 && argv[0][0]=='-' && argv[0][1]!='\0')
	{
		for(s = argv[0]+1 ; *s ; ++s) switch(*s)
		{

		case 'w':   /* No warnigs or comments */
			/* -w77 Suppress warnings about non-standard F77*/
			/* features.  likewise any extentions */
			*fflagp++='-'; 
			*fflagp++= *s; 
			*fflagp++=' ';
			break;




		case 'S':           /* code listing (sun native, gcf, and Clan) */
			/* available with 68020  code generators    */


		case 'a':           /* cross reference */
			*fflagp++='-'; 
			*fflagp++= *s; 
			*fflagp++=' ';                 /* a */
			break;

		case 'u':           /* default variable type is undefined */
		case 'q':           /* code listing                       */
		case 'x':           /* inhibit instruction scheduling     */

copyfflag:
			*fflagp++='-'; 
			*fflagp++= *s; 
			*fflagp++=' ';
			break;



		case 'k':   /* KAP/EPC preprocessor options          */
		case 'K':
			s++;
			if ((checkif("pic", s, 0)==YES) || checkif("PIC", s ,0)==YES) {
				*fflagp++= '-';
				*fflagp++=*s++;
				*fflagp++=*s++;
				*fflagp++=*s;
				*fflagp++= '+';
				*fflagp++=' ';
				break;
			}
			s--;
			goto copylflag;


		case 'G':           /* Listing switched on */

			*fflagp++='-'; 
			*fflagp++= *s; 
			*fflagp++=' ';
			if (s[1] == '1' || s[1] == '2') {
				*s++;
				goto copylflag;
			}
			break;



		case 'h':           /* Pass on Heap option to ld */
			lflag[1] = *s;
			lflag[2] = '\0';
			*loadp++ = copys(lflag);
			argv++;
			argc--;                       /* go to next parameter for size */
			s = argv[0];                  /* map s onto next parameter */
			j = 0;
			while (isdigit(*s))           /* cycle through decimal size */
			{
				lflag[j] = *s++;           /* copy each digit */
				j++;
			}
			lflag[j] = '\0';


			*loadp++ = copys(lflag);      /* pass whole thing to ld */
			lflag[0] = '-';
			lflag[1] = '\0';
			lflag[2] = '\0';
			goto endfor;


		case 'g':           /* SDB flag */
			*fflagp++ = '-';
			*fflagp++ = 'g';
			*fflagp++=' ';
			drive_sdb = 1;
			break;

		case 'O':
			optflag= YES;
			*fflagp++ = '-';
			*fflagp++ = 'O';
			*fflagp++ = 'X';
			*fflagp++ = ' ';
			break;

		case 'P':           /*  FULL WORD OPTIONS */
			if (options) {
				tmpspntr = (char *)malloc(strlen(options) + strlen(*++argv) + 2);
				if (tmpspntr == NULL) {
					fprintf(stderr, "Malloc failed!\n");
					exit(1);
				}
				strcpy(tmpspntr, options);
				strcat(tmpspntr, ",");
				strcat(tmpspntr, *argv);
				options = tmpspntr;
			} else
				options = *++argv;

			--argc;
			break;


		case 'c':
			loadflag = NO;
			break;

		case '#':
		case 'v':               /* Report progress through passes */
			verbose = YES;
			debugflag = YES;
			break;

		case 'p':
			profileflag = YES;


			if ( s[1] == 'l') {
				profileflag = NO;
				*fflagp++ = *s++;
			}
			if ( s[1] == 't') {
				profileflag = NO;
				*fflagp++ = *s++;
			}
			goto copyfflag;

		case 'o':
			if( ! strcmp(s, "onetrip") )
			{
				*fflagp++ = '1';
				goto endfor;
			}
			if (argv[1]== NULL)
			{
				fprintf(diagfile,"%s: No output file found for '-o' option\n",*drivername);
				done(1);
			}
			aoutname = *++argv;
			if (dotchar(aoutname) )
				--argv;  /* save param for re-use. */
			else --argc;
			break;




		case 'r':           /*  -r8  double precision */
			if ( s[1] == '8' ) {
				*fflagp++ = *s++;
				goto copyfflag;
			}
			goto copylflag;


		case 'I':           /* Fortran - Default INT size */
			/* C - Directories in which to search for files */
			if(s[1]=='2' || s[1]=='4' )	/* Fortran */
			{
				*fflagp++ = *s++;
				goto copyfflag;
			}
			else	/* C */
			{

				*ptrCppOptions++ = s-1;

				while (*s != '\0')
				{
					*fflagp++ = *s++;
				}
				*fflagp++ = '+';
				goto endfor;
			}

		case 'l':       /* letter ell--library */
			s[-1] = '-';
			*loadp++ = s-1;
			goto endfor;

		case 'R':        /* RATFOR */
			while( *rflagp++ = *++s )
				;
			*rflagp++ = ' ';
			goto endfor;

		case 'M':        /* possible loader option */
			goto copylflag;

		case 'm':
			if (checkif("misalign", s, 0) == YES) {   /* for RISC                    */
				if (options) {
					tmpspntr = (char *)malloc(strlen(options) + 12);
					if (tmpspntr == NULL) {
						fprintf(stderr, "Malloc failed!\n");
						exit(1);
					}
					strcpy(tmpspntr, options);
					strcat(tmpspntr, ",misalign");
					options = tmpspntr;
				} else 
					options = "misalign";
				goto endfor;
			}
			if ( checkif ("mp" , s , 0 ) == YES ) {    /* mp for parallel processing */
				*fflagp++ = *s++;  /* m */
				*fflagp++ = *s++;  /* p */
				parallel = YES;
				goto endfor;
			}
			/* For Imp -m means max of everything.Others pass to loader */
			*fflagp++ = 'm';
			break;








copylflag:
		default:
			strcpy(&lflag[1],s);        /* copy the rest of the option to the loader */
			*loadp++ = copys(lflag);
			goto endfor;
		}

endfor:
		--argc;
		++argv;
	}

	if(argc<=0) {          /*check for file args*/
		printf("%s",*drivername);
		printf(": No input files specified\n");
		done(1);
	}

	*fflagp = '\0';

	loadargs[0] = ldname;
	/* *loadp++ = (profileflag ? proffoot : footname); */


#if UNIX5d4 == YES
	*loadp++ = constloaderargs[0];   /*   place -dy                     */
	*loadp++ = constloaderargs[1];   /*   place /usr/ccs/lib/crti.o     */
	*loadp++ = constloaderargs[2];   /*   place /usr/ccs/lib/values-Xt.o*/
#endif                           /*         on the load line        */


	/* *loadp++ = footname; */
	*loadp++ = (profileflag ? proffoot : footname);





	/*********** CYCLE THROUGH FILE NAMES **************/

	for(i = 0 ; i<argc ; ++i)               /* SWITCH ON LAST CHARACTER OF NAME */
		switch(c =  dotchar(infname = argv[i]) )
		{
		case 'r':       /* Ratfor file */
			if( unreadable(argv[i]) )
			{
				erred = YES;
				break;
			}
			s = fortfile;
			t = lastfield(argv[i]);
			while( *s++ = *t++)
				;
			s[-2] = 'f';

			sprintf(buff, "ratfor %s %s >%s", rflags, infname, fortfile);
			status = sys(buff);
			if(status)
			{
				erred = YES;
				rmf(fortfile);
				break;
			}

			if( ! fortonly )
			{
				infname = argv[i] = lastfield(argv[i]);
				*lastchar(infname) = 'f';

				if( docomp(fortrancompiler,argv[i]) )
					erred = YES;
				else {
					if( nodup(t = setdoto(argv[i])) )
						*loadp++ = t;
					rmf(fortfile);
				}
			}
			break;

			/*   case 'p': */     /* Pascal file */
			/*   liblist = pascalliblist; */
			/*   if ( unreadable(argv[i] )) */
			/*     erred = YES; */
			/*   else if ( docomp(PASCALCOMPILER ,argv[i]) ) */
			/*     erred = YES; */
			/*   else if( nodup(t=setdoto(argv[i])) ) */
			/*     *loadp++ = t; */
			/*   break;  */


		case 'i':       /* Imp80 file */
			liblist = impliblist;
			if( unreadable(argv[i]) )
				erred = YES;
			else if( docomp(nimpcompiler,argv[i]) )
				erred = YES;
			else if( nodup(t=setdoto(argv[i])) )
				*loadp++ = t;
			break;

		case 'f':       /* Fortran file */
		case 'k':       /* Preprocessed KAP file */
			if ( CppOnly == YES && c == 'k') {
				kapf = NO;
				kapl = NO;
				break;
			}
			if( unreadable(argv[i]) ) {
				erred = YES;
				break;
			}

			if( docomp(fortrancompiler,argv[i]) ) {
				erred = YES;
				break;
			}
			if (kap == YES && kapf == NO)
				unlink(infname);
			kapf = NO;
			kapl = NO;

			if( nodup(t=setdoto(argv[i])) )
				*loadp++ = t;
			break;

		case 's':       /* Assembler file */
			if( unreadable(argv[i]) )
			{
				erred = YES;
				break;
			}
			fprintf(diagfile, "%s:\n", argv[i]);

			if (c== 'c' && cflags[0]==NULL) {
				if (drive_sdb == YES) copyCparm (cflagp,"-g ");
				if (optflag   == YES) copyCparm (cflagp,"-O ");
				for (ptr= CppOptions; *ptr!=0; ptr++) {
					copyCparm (cflagp,*ptr);
					copyCparm (cflagp," ");
				}

			}

			sprintf(buff, "cc  -c %s %s", cflags, argv[i] );

			if( sys(buff) )
				erred = YES;
				else
				if( nodup(t = setdoto(argv[i])) )
					*loadp++ = t;
			break;


		case 'o':  /* LINK in previously compiled objects */
			if( nodup(argv[i]) )
				*loadp++ = argv[i];
			break;

		default:
			if( ! strcmp(argv[i], "-o") ) /* Perhaps its a -o option out of place? */
			{
				if (argv[i+1]==NULL)
				{
					fprintf(diagfile,"%s: No output file found for '-o' option\n",*drivername);
					done (1);
				}
				aoutname = argv[++i];
			}
			else
			{

				*loadp++ = argv[i];
			}
			break;
		}

	if(loadflag && !erred) {

		doload(loadargs, loadp);  /* Go on and LOAD if no errors */
	}
	done(erred);
}
















































docomp(compiler,source)       /* CALL COMPILER CONTROL */
char *compiler;
char *source;
{
	char buff[200];
	/* Prevent NULL pointer dereference */
	if (!options)
		options = "";
	sprintf(buff, "%s %s %s %s",compiler, fflags, source, options);
	infname = source;
	if(verbose) fprintf(diagfile, "COMPILE:");
	switch( sys(buff) )                   /* FORK as per BUFF */
	{
	case 1:
		goto error;
	case 0:
		break;
	default:
		goto comperror;
	}

ret:
	return(0);

error:
	return(1);

comperror:
	fprintf(diagfile, "\ncompiler error.\n");
	return(2);
}





doload(v0, v)
register char *v0[], *v[];
{
	char **p;
	int waitpid;
	char temp[100];
	int n;
	int len;






	for(p = liblist ; *p ; *v++ = *p++);


	*v++ = "-o";
	strcpy(temp , aoutname);
	if (dotchar(temp))
	{
		len = strlen(temp)-2;
		temp[len] = '\0';
	}
	*v++ = temp;
	*v = NULL;

	if(verbose) fprintf(diagfile, "LOAD:");
	if (v0[1]==NULL) {
		v0[1]= v0[0];
		++v0;
	}
	if(debugflag) {
		for(p = v0 ; p<v ; ++p)
			fprintf(diagfile, "%s ", *p);
		fprintf(diagfile, "\n");
	}

	if( (waitpid = fork()) == 0) {
		enbint(SIG_DFL);
		execvp(ldname, v0);
		fatalstr("couldn't load %s", ldname);
	}
	await(waitpid, 0);

	if(verbose) fprintf(diagfile, "\n");
}




/* Process control and Shell-simulating routines */

sys(str)
char *str;
{
	register char *s, *t;
	char *argv[100], path[100];
	char *inname, **outname;
	int append;
	int waitpid;
	int argc;
	int waitpid2;

	if (debugflag) fprintf(diagfile, "%s\n", str);

	inname  = NULL;
	outname = NULL;
	argv[0] = shellname;
	argc = 1;

	t = str;
	while( isspace(*t) )
		++t;
	while(*t)
	{
		if(*t == '<')
			inname = t+1;
		else if(*t == '>')
		{
			if(t[1] == '>')
			{
				append = YES;
				outname = argv+argc;
			}
			else {
				append = NO;
				outname = argv+argc;
			}
		}

		else
			argv[argc++] = t;
		while( !isspace(*t) && *t!='\0' )
			++t;
		if(*t)
		{
			*t++ = '\0';
			while( isspace(*t) )
				++t;
		}
	}

	if (argc == 1) return(-1);   /* no command */

	argv[argc] = 0;

	/* kick off  process */

	s = path;
	t = "/usr/bin/";
	while(*t)
		*s++ = *t++;
	for(t = argv[1] ; *s++ = *t++ ; )
		;
	if((waitpid = fork()) == 0)
	{
		if(inname)
			freopen(inname, "r", stdin);

		/*** the following two lines have been commented out as they cause
				     the error - Termination code 139 to occur
				 if (*outname)
				  freopen(*outname, (append ? "a" : "w"), stdout);
				***/

		enbint(SIG_DFL);

		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, 0) );
}





#include "errno.h"

/* modified version from the Shell */
texec(f, av)
char *f;
char **av;
{
	extern int errno;

	execvp(f, av+1);

	if (errno==ENOEXEC)
	{
		av[1] = f;
		execv(shellname, av);
		fatal("No shell!");
	}
	if (errno==ENOMEM)
		fatalstr("%s: too large", f);
}






done(k)
int k;
{
	static int recurs       = NO;

	if(recurs == NO)
	{
		recurs = YES;
	}
	exit(k);
}






enbint(k)           /* Point signals at my INTRUPT routine */
void (*k)();         /* UNLESS already directed */
{
	if(sigivalue == 0)
		signal(SIGINT,k);
	if(sigqvalue == 0)
		signal(SIGQUIT,k);
	if(sighvalue == 0)
		signal(SIGHUP,k);
	if(sigtvalue == 0)
		signal(SIGTERM,k);
}




intrupt()
{
	done(2);
}



await(waitpid,waitpid2)
int waitpid,waitpid2;
{
	int w, status;

	enbint(SIG_IGN);
	while ( ((w = wait(&status)) != waitpid) && (w != waitpid2) )
		if(w == -1)
			fatal("bad wait code");
	enbint(intrupt);
	if(status & 0377)
	{
		if(status != SIGINT)
			fprintf(diagfile, "Termination code %d", status);
		done(3);
	}
	return(status>>8);
}
















/* File Name and File Manipulation Routines */

unreadable(s)
register char *s;
{
	register FILE *fp;


	if(fp = fopen(s, "r"))
	{
		fclose(fp);
		return(NO);
	}

	else
	{
		fprintf(diagfile, "Error: Cannot read file %s\n", s);
		return(YES);
	}

}



rmf(fn)
register char *fn;
{
	if(!debugflag && fn!=NULL && *fn!='\0')
		unlink(fn);
}



dotchar(s)
register char *s;
{
	for( ; *s ; ++s) if(s[0]=='.' && s[1]!='\0' && s[2]=='\0') return( s[1] );
	return(NO);
}



char *lastfield(s)
/* returns the last file in a pathname*/
register char *s;
{
	register char *t;
	for(t = s; *s ; ++s)
		if(*s == '/')
			t = s+1;
	return(t);
}



char *lastchar(s)
register char *s;
{
	while(*s)
		++s;
	return(s-1);
}

char *setdoto(s)
/* replaces string.ext with string.o */
register char *s;
{
	*lastchar(s) = 'o';
	return(lastfield(s) );
}


char *ckalloc(n)
int n;
{
	char *p, *calloc();

	if( p = calloc(1, (unsigned) n) )
		return(p);

	fatal("out of memory");
	/* NOTREACHED */
}





char *
copyn(n, s)
register int n;
register char *s;
{
	register char *p, *q;

	p = q = ckalloc(n);
	while(n-- > 0)
		*q++ = *s++;
	return(p);
}



char *
copys(s)
char *s;
{
	return( copyn( strlen(s)+1 , s) );
}



oneof(c,s)
register c;
register char *s;
{
	while( *s )
		if(*s++ == c)
			return(YES);
	return(NO);
}



copyCparm (cparms,option)
char *cparms;
char *option;
{
	strcpy(cparms,option);
	cflagp= cflagp+strlen(option);
}




checkif (option, s , failaction)
char *option,*s;
int failaction;
{
	char *save = s;
	int   optionl = strlen(option);

	if (optionl<= strlen(s)+1) {
		while (*option) {
			if (*s++ != *option++) goto fail;
		}
		return (YES);
	}

fail:
	if (failaction == 0) return (NO);

	fprintf (diagfile,"%s: invalid flag -%.*s\n", *drivername, optionl , save);
	done(1);
}



nodup(s)
char *s;
{
	register char **p;

	for(p = loadargs ; p < loadp ; ++p)
		if( !strcmp(*p, s) )
			return(NO);

	return(YES);
}



static fatal(t)
char *t;
{
	fprintf(diagfile, "Compiler error in file %s: %s\n", infname, t);
	if(debugflag)
		abort();
	done(1);
	exit(1);
}




static fatali(t,d,e)
char *t;
int d,e;
{
	char buff[100];
	sprintf(buff, t, d, e);
	fatal(buff);
}




static fatalstr(t, s)
char *t, *s;
{
	char buff[100];
	sprintf(buff, t, s);
	fatal(buff);
}