xref: /original-bsd/usr.bin/f77/f77.vax/f77.c (revision 23cd6db2)
1 /*
2  * Copyright (c) 1980 Regents of the University of California.
3  * All rights reserved.  The Berkeley software License Agreement
4  * specifies the terms and conditions for redistribution.
5  */
6 
7 #ifndef lint
8 static	char sccsid[] = "@(#)f77.c	5.7 (Berkeley) 04/04/90";
9 #endif
10 
11 /*
12  * f77.c
13  *
14  * Driver program for the 4.2 BSD f77 compiler.
15  *
16  * University of Utah CS Dept modification history:
17  *
18  * $Log:	f77.c,v $
19  * Revision 5.4  85/12/17  19:12:14  donn
20  * Dynamically allocate buffer; add lint fixes.
21  *
22  * Revision 5.3  85/11/25  00:00:02  donn
23  * 4.3 beta
24  *
25  * Revision 5.2  85/08/10  05:16:14  donn
26  * Ifdeffed 66 code, added -r8 flag.  From Jerry Berkman.
27  *
28  * Revision 5.1  85/08/10  03:32:12  donn
29  * 4.3 alpha
30  *
31  * Revision 1.14  85/03/01  00:07:57  donn
32  * Portability fix from Ralph Campbell.
33  *
34  * Revision 1.13  85/02/12  19:31:47  donn
35  * Use CATNAME to get the name of a concatenation command instead of
36  * explicitly running 'cat' -- you can get the wrong 'cat' the old way!
37  *
38  * Revision 1.12  85/01/14  06:42:30  donn
39  * Changed to call the peephole optimizer with the '-f' flag, so that
40  * floating point moves are translated to integer moves.
41  *
42  * Revision 1.11  85/01/14  04:38:59  donn
43  * Jerry's change to pass -O to f1 so it knows whether the peephole optimizer
44  * will be run.  This is necessary in order to handle movf/movl translation.
45  *
46  * Revision 1.10  85/01/14  03:59:12  donn
47  * Added Jerry Berkman's fix for the '-q' flag.
48  *
49  * Revision 1.9  84/11/09  01:51:26  donn
50  * Cosmetic change to stupid() suggested by John McCarthy at Memorial
51  * University, St. Johns.
52  *
53  * Revision 1.8  84/09/14  16:02:34  donn
54  * Added changes to notice when people do 'f77 -c foo.f -o bar.o' and tell
55  * them why it doesn't do what they think it does.
56  *
57  * Revision 1.7  84/08/24  21:08:31  donn
58  * Added call to setrlimit() to prevent core dumps when not debugging.
59  * Reorganized the include file arrangment somewhat.
60  *
61  * Revision 1.6  84/08/24  20:20:24  donn
62  * Changed stupidity check on Jerry Berkman's suggestion -- now it balks if
63  * the load file exists and has a sensitive suffix.
64  *
65  * Revision 1.5  84/08/15  18:56:44  donn
66  * Added test for -O combined with -g, suggested by Raleigh Romine.  To keep
67  * things simple, if both are specified then the second in the list is thrown
68  * out and the user is warned.
69  *
70  * Revision 1.4  84/08/05  21:33:15  donn
71  * Added stupidity check -- f77 won't load on a file that it's asked to
72  * compile as well.
73  *
74  * Revision 1.3  84/08/04  22:58:24  donn
75  * Improved error reporting -- we now explain why we died and what we did.
76  * Only works on 4.2.  Added at the instigation of Jerry Berkman.
77  *
78  * Revision 1.2  84/07/28  13:11:24  donn
79  * Added Ralph Campbell's changes to reduce offsets to data.
80  *
81  */
82 
83 char *xxxvers = "\n@(#) F77 DRIVER, VERSION 4.2,   1984 JULY 28\n";
84 #include <sys/types.h>
85 #include <sys/stat.h>
86 #include <sys/signal.h>
87 #include <ctype.h>
88 #include <stdio.h>
89 
90 #ifdef	SIGPROF
91 /*
92  * Some 4.2 BSD capabilities.
93  */
94 #include <sys/time.h>
95 #include <sys/resource.h>
96 #define	NOCORE		1
97 #include <sys/wait.h>
98 #define PSIGNAL		1
99 #endif
100 
101 #include "defines.h"
102 #include "machdefs.h"
103 #include "pathnames.h"
104 #include "version.h"
105 
106 static FILEP diagfile	= {stderr} ;
107 static int pid;
108 static int sigivalue	= 0;
109 static int sigqvalue	= 0;
110 static int sighvalue	= 0;
111 static int sigtvalue	= 0;
112 
113 static char *pass1name	= PASS1NAME ;
114 static char *pass2name	= PASS2NAME ;
115 static char *pass2opt	= PASS2OPT ;
116 static char *asmname	= ASMNAME ;
117 static char *ldname	= LDNAME ;
118 static char *footname	= FOOTNAME;
119 static char *proffoot	= PROFFOOT;
120 static char *macroname	= "m4";
121 static char *shellname	= _PATH_BSHELL;
122 static char *cppname	= _PATH_CPP;
123 static char *aoutname	= "a.out" ;
124 static char *temppref	= TEMPPREF;
125 
126 static char *infname;
127 static char textfname[44];
128 static char asmfname[44];
129 static char asmpass2[44];
130 static char initfname[44];
131 static char sortfname[44];
132 static char prepfname[44];
133 static char objfdefault[44];
134 static char optzfname[44];
135 static char setfname[44];
136 
137 static char fflags[50]	= "-";
138 static char f2flags[50];
139 static char cflags[50]	= "-c";
140 #if TARGET == GCOS
141 	static char eflags[30]	= "system=gcos ";
142 #else
143 	static char eflags[30]	= "system=unix ";
144 #endif
145 static char rflags[30]	= "";
146 static char lflag[3]	= "-x";
147 static char *fflagp	= fflags+1;
148 static char *f2flagp	= f2flags;
149 static char *eflagp	= eflags+12;
150 static char *rflagp	= rflags;
151 static char *cppflags	= "";
152 static char **cppargs;
153 static char **loadargs;
154 static char **loadp;
155 
156 static flag erred	= NO;
157 static flag loadflag	= YES;
158 static flag saveasmflag	= NO;
159 static flag profileflag	= NO;
160 static flag optimflag	= NO;
161 static flag debugflag	= NO;
162 static flag verbose	= NO;
163 static flag fortonly	= NO;
164 static flag macroflag	= NO;
165 static flag sdbflag	= NO;
166 static flag namesflag	= YES;
167 
168 #if TARGET == PDP11
169 static flag nofloating	= NO;
170 #endif
171 
172 static int ncpp;
173 
174 
175 main(argc, argv)
176 int argc;
177 char **argv;
178 {
179 register int i, n;
180 int c, status;
181 char *setdoto(), *lastchar(), *lastfield(), *copys(), *argvtos();
182 ptr ckalloc();
183 char *strcat();
184 register char *s;
185 char fortfile[20], *t;
186 char *buff;
187 int intrupt();
188 int new_aoutname = NO;
189 
190 sigivalue = signal(SIGINT, SIG_IGN) == SIG_IGN;
191 sigqvalue = signal(SIGQUIT,SIG_IGN) == SIG_IGN;
192 sighvalue = signal(SIGHUP, SIG_IGN) == SIG_IGN;
193 sigtvalue = signal(SIGTERM,SIG_IGN) == SIG_IGN;
194 enbint(intrupt);
195 
196 pid = getpid();
197 crfnames();
198 
199 cppargs  = (char **) ckalloc( argc * sizeof(*cppargs) );
200 loadargs = (char **) ckalloc( (argc+20) * sizeof(*loadargs) );
201 loadargs[1] = "-X";
202 loadargs[2] = "-u";
203 #if HERE==PDP11 || HERE==VAX
204 	loadargs[3] = "_MAIN_";
205 #endif
206 #if HERE == INTERDATA
207 	loadargs[3] = "main";
208 #endif
209 loadp = loadargs + 4;
210 
211 --argc;
212 ++argv;
213 
214 for (i = 0, n = 50; i < argc; ++i)
215 	n += strlen(argv[i]) + 1;
216 buff = (char *) ckalloc(n);
217 
218 while(argc>0 && argv[0][0]=='-' && argv[0][1]!='\0')
219 	{
220 	for(s = argv[0]+1 ; *s ; ++s) switch(*s)
221 		{
222 		case 'T':  /* use special passes */
223 			switch(*++s)
224 				{
225 				case '1':
226 					pass1name = s+1; goto endfor;
227 				case '2':
228 					pass2name = s+1; goto endfor;
229 				case 'p':
230 					pass2opt = s+1; goto endfor;
231 				case 'a':
232 					asmname = s+1; goto endfor;
233 				case 'l':
234 					ldname = s+1; goto endfor;
235 				case 'F':
236 					footname = s+1; goto endfor;
237 				case 'm':
238 					macroname = s+1; goto endfor;
239 				case 't':
240 					temppref = s+1; goto endfor;
241 				default:
242 					fatali("bad option -T%c", *s);
243 				}
244 			break;
245 
246 #ifdef ONLY66
247 		case '6':
248 			if(s[1]=='6')
249 				{
250 				*fflagp++ = *s++;
251 				goto copyfflag;
252 				}
253 			else	{
254 				fprintf(diagfile, "invalid flag 6%c\n", s[1]);
255 				done(1);
256 				}
257 #endif
258 
259 		case 'w':
260 			if(s[1]=='6' && s[2]=='6')
261 				{
262 				*fflagp++ = *s++;
263 				*fflagp++ = *s++;
264 				}
265 
266 		copyfflag:
267 		case 'u':
268 		case 'U':
269 		case '1':
270 		case 'C':
271 			*fflagp++ = *s;
272 			break;
273 
274 		case 'O':
275 			if(sdbflag)
276 				{
277 				fprintf(diagfile, "-O and -g are incompatible; -O ignored\n");
278 				break;
279 				}
280 			optimflag = YES;
281 			*f2flagp++ = '-';
282 			*f2flagp++ = 'O';
283 			*f2flagp++ = ' ';
284 #if TARGET == INTERDATA
285 				*loadp++ = "-r";
286 				*loadp++ = "-d";
287 #endif
288 			*fflagp++ = 'O';
289 			break;
290 
291 		case 'N':
292 			*fflagp++ = 'N';
293 			if( oneof(*++s, "qxscn") )
294 				*fflagp++ = *s++;
295 			else	{
296 				fprintf(diagfile, "invalid flag -N%c\n", *s);
297 				done(1);
298 				}
299 			while( isdigit(*s) )
300 				*fflagp++ = *s++;
301 			*fflagp++ = 'X';
302 			goto endfor;
303 
304 		case 'm':
305 			if(s[1] == '4')
306 				++s;
307 			macroflag = YES;
308 			break;
309 
310 		case 'S':
311 			(void) strcat(cflags, " -S");
312 			saveasmflag = YES;
313 
314 		case 'c':
315 			if( new_aoutname == YES ){
316 				fprintf(diagfile, "-c prevents loading, -o %s ignored\n", aoutname);
317 				new_aoutname = NO;
318 				}
319 			loadflag = NO;
320 			break;
321 
322 		case 'v':
323 			verbose = YES;
324 			fprintf(diagfile,"\nBerkeley F77, version %s\n",
325 				VERSIONNUMBER);
326 			break;
327 
328 		case 'd':
329 			debugflag = YES;
330 			*fflagp++ = 'd';
331 			s++;
332 			while( isdigit(*s) || *s == ',' )
333 				*fflagp++ = *s++;
334 			*fflagp++ = 'X';
335 			goto endfor;
336 
337 		case 'M':
338 			*loadp++ = "-M";
339 			break;
340 
341 		case 'g':
342 			if(optimflag)
343 				{
344 				fprintf(diagfile, "-g and -O are incompatible; -g ignored\n");
345 				break;
346 				}
347 			(void) strcat(cflags," -g");
348 			sdbflag = YES;
349 			goto copyfflag;
350 
351 		case 'p':
352 			profileflag = YES;
353 			(void) strcat(cflags," -p");
354 			*fflagp++ = 'p';
355 			if(s[1] == 'g')
356 				{
357 				proffoot = GPRFFOOT;
358 				s++;
359 				}
360 			break;
361 
362 		case 'q':
363 			namesflag = NO;
364 			*fflagp++ = *s;
365 			break;
366 
367 		case 'o':
368 			if( ! strcmp(s, "onetrip") )
369 				{
370 				*fflagp++ = '1';
371 				goto endfor;
372 				}
373 			new_aoutname = YES;
374 			aoutname = *++argv;
375 			--argc;
376 			if( loadflag == NO ){
377 				fprintf(diagfile, "-c prevents loading, -o %s ignored\n", aoutname);
378 				new_aoutname = NO;
379 				}
380 			break;
381 
382 #if TARGET == PDP11
383 		case 'f':
384 			nofloating = YES;
385 			pass2name = NOFLPASS2;
386 		break;
387 #endif
388 
389 		case 'F':
390 			fortonly = YES;
391 			loadflag = NO;
392 			break;
393 		case 'D':
394 		case 'I':
395 			cppargs[ncpp++] = *argv;
396 			goto endfor;
397 
398 		case 'i':
399 			if((s[1]=='2' || s[1]=='4') && s[2] == '\0')
400 				{
401 				*fflagp++ = *s++;
402 				goto copyfflag;
403 				}
404 			fprintf(diagfile, "invalid flag -i%c\n", s[1]);
405 			done(1);
406 
407 		case 'r':	/* -r8 - double the precision */
408 			if(s[1] == '8' && s[2] == '\0')
409 				{
410 				s++;
411 				goto copyfflag;
412 				}
413 			else
414 				{
415 				*loadp++ = "-r";
416 				break;
417 				}
418 
419 		case 'l':	/* letter ell--library */
420 			s[-1] = '-';
421 			*loadp++ = s-1;
422 			goto endfor;
423 
424 		case 'E':	/* EFL flag argument */
425 			while( *eflagp++ = *++s)
426 				;
427 			*eflagp++ = ' ';
428 			goto endfor;
429 		case 'R':
430 			while( *rflagp++ = *++s )
431 				;
432 			*rflagp++ = ' ';
433 			goto endfor;
434 		default:
435 			lflag[1] = *s;
436 			*loadp++ = copys(lflag);
437 			break;
438 		}
439 endfor:
440 	--argc;
441 	++argv;
442 	}
443 
444 #ifdef	NOCORE
445 if(!debugflag)
446 	{
447 	struct rlimit r;
448 
449 	r.rlim_cur = r.rlim_max = 0;
450 	(void) setrlimit(RLIMIT_CORE, &r);
451 	}
452 #endif	NOCORE
453 
454 *fflagp = '\0';
455 
456 if (ncpp > 0)
457 	cppflags = argvtos (ncpp,cppargs);
458 
459 loadargs[0] = ldname;
460 #if TARGET == PDP11
461 	if(nofloating)
462 		*loadp++ = (profileflag ? NOFLPROF : NOFLFOOT);
463 	else
464 #endif
465 *loadp++ = (profileflag ? proffoot : footname);
466 
467 for(i = 0 ; i<argc ; ++i)
468 	switch(c =  dotchar(infname = argv[i]) )
469 		{
470 		case 'r':	/* Ratfor file */
471 		case 'e':	/* EFL file */
472 			if( unreadable(argv[i]) )
473 				{
474 				erred = YES;
475 				break;
476 				}
477 			s = fortfile;
478 			t = lastfield(argv[i]);
479 			while( *s++ = *t++)
480 				;
481 			s[-2] = 'f';
482 
483 			if(macroflag)
484 				{
485 				sprintf(buff, "%s %s >%s", macroname, infname, prepfname);
486 				if( sys(buff) )
487 					{
488 					rmf(prepfname);
489 					erred = YES;
490 					break;
491 					}
492 				infname = prepfname;
493 				}
494 
495 			if(c == 'e')
496 				sprintf(buff, "efl %s %s >%s", eflags, infname, fortfile);
497 			else
498 				sprintf(buff, "ratfor %s %s >%s", rflags, infname, fortfile);
499 			status = sys(buff);
500 			if(macroflag)
501 				rmf(infname);
502 			if(status)
503 				{
504 				erred = YES;
505 				rmf(fortfile);
506 				break;
507 				}
508 
509 			if( ! fortonly )
510 				{
511 				infname = argv[i] = lastfield(argv[i]);
512 				*lastchar(infname) = 'f';
513 
514 				if( dofort(argv[i]) )
515 					erred = YES;
516 				else	{
517 					if( nodup(t = setdoto(argv[i])) )
518 						*loadp++ = t;
519 					rmf(fortfile);
520 					}
521 				}
522 			break;
523 
524 		case 'F':	/* C preprocessor -> Fortran file */
525 			if( unreadable(argv[i]) )
526 				{
527 				erred = YES;
528 				break;
529 				}
530 			s = fortfile;
531 			t = lastfield(argv[i]);
532 			while( *s++ = *t++)
533 				;
534 			s[-2] = 'f';
535 			sprintf(buff,"%s %s %s >%s", cppname, cppflags, infname, fortfile);
536 			status = sys(buff);
537 			if(status)
538 				{
539 				erred = YES;
540 				rmf(fortfile);
541 				break;
542 				}
543 
544 			if( ! fortonly )
545 				{
546 				infname = argv[i] = lastfield(argv[i]);
547 				*lastchar(infname) = 'f';
548 
549 				if ( dofort(argv[i]) )
550 					erred = YES;
551 				else	{
552 					if (nodup(t = setdoto(argv[i])) )
553 						*loadp++ = t;
554 						rmf(fortfile);
555 						}
556 				}
557 			break;
558 
559 		case 'f':	/* Fortran file */
560 			if( unreadable(argv[i]) )
561 				erred = YES;
562 			else if( dofort(argv[i]) )
563 				erred = YES;
564 			else if( nodup(t=setdoto(argv[i])) )
565 				*loadp++ = t;
566 			break;
567 
568 		case 'c':	/* C file */
569 		case 's':	/* Assembler file */
570 			if( unreadable(argv[i]) )
571 				{
572 				erred = YES;
573 				break;
574 				}
575 #if HERE==PDP11 || HERE==VAX
576 			if( namesflag == YES )
577 				fprintf(diagfile, "%s:\n", argv[i]);
578 #endif
579 			sprintf(buff, "cc %s %s", cflags, argv[i] );
580 			if( sys(buff) )
581 				erred = YES;
582 			else
583 				if( nodup(t = setdoto(argv[i])) )
584 					*loadp++ = t;
585 			break;
586 
587 		case 'o':
588 			if( nodup(argv[i]) )
589 				*loadp++ = argv[i];
590 			break;
591 
592 		default:
593 			if( ! strcmp(argv[i], "-o") ) {
594 				aoutname = argv[++i];
595 				new_aoutname = YES;
596 				if( loadflag == NO ){
597 					fprintf(diagfile, "-c prevents loading, -o %s ignored\n", aoutname);
598 					new_aoutname = NO;
599 					}
600 			} else
601 				*loadp++ = argv[i];
602 			break;
603 		}
604 
605 if( loadflag && stupid(aoutname) )
606 	erred = YES;
607 if(loadflag && !erred)
608 	doload(loadargs, loadp);
609 done(erred);
610 }
611 
612 
613 
614 /*
615  * argvtos() copies a list of arguments contained in an array of character
616  * strings to a single dynamically allocated string. Each argument is
617  * separated by one blank space. Returns a pointer to the string or null
618  * if out of memory.
619  */
620 #define SBUFINCR	1024
621 #define SBUFMAX		10240
622 
623 char *
624 argvtos(argc, argv)
625 	char **argv;
626 	int  argc;
627 {
628 	register char *s;		/* string pointer */
629 	register int  i;		/* string buffer pointer */
630 	char *malloc();			/* memory allocator */
631 	char *realloc();		/* increase size of storage */
632 	char *sbuf;			/* string buffer */
633 	int nbytes;			/* bytes of memory required */
634 	int nu;				/* no. of SBUFINCR units required */
635 	int sbufsize;			/* current size of sbuf */
636 	int strlen();			/* string length */
637 
638 	sbufsize = SBUFINCR;
639 	if ((sbuf = malloc((unsigned)sbufsize)) == NULL)
640 		{
641 		fatal("out of memory (argvtos)");
642 		/* NOTREACHED */
643 		}
644 
645 	for (i = 0; argc-- > 0; ++argv)
646 		{
647 		if ((nbytes = (i+strlen(*argv)+1-sbufsize)) > 0)
648 			{
649 			nu = (nbytes+SBUFINCR-1)/SBUFINCR;
650 			sbufsize += nu * SBUFINCR;
651 			if (sbufsize > SBUFMAX)
652 				{
653 				fatal("argument length exceeded (argvtos)");
654 				/* NOTREACHED */
655 				}
656 			if ((sbuf = realloc(sbuf, (unsigned)sbufsize)) == NULL)
657 				{
658 				fatal("out of memory (argvtos)");
659 				/* NOTREACHED */
660 				}
661 			}
662 		for (s = *argv; *s != '\0'; i++, s++)
663 			sbuf[i] = *s;
664 		sbuf[i++] = ' ';
665 		}
666 	sbuf[--i] = '\0';
667 	return(sbuf);
668 }
669 
670 dofort(s)
671 char *s;
672 {
673 int retcode;
674 char buff[200];
675 
676 infname = s;
677 sprintf(buff, "%s %s %s %s %s %s",
678 	pass1name, fflags, s, asmfname, initfname, textfname);
679 switch( sys(buff) )
680 	{
681 	case 1:
682 		goto error;
683 	case 0:
684 		break;
685 	default:
686 		goto comperror;
687 	}
688 
689 if( dopass2() )
690 	goto comperror;
691 doasm(s);
692 retcode = 0;
693 
694 ret:
695 	rmf(asmfname);
696 	rmf(initfname);
697 	rmf(textfname);
698 	return(retcode);
699 
700 error:
701 	fprintf(diagfile, "\nError.  No assembly.\n");
702 	retcode = 1;
703 	goto ret;
704 
705 comperror:
706 	fprintf(diagfile, "\ncompiler error.\n");
707 	retcode = 2;
708 	goto ret;
709 }
710 
711 
712 
713 
714 dopass2()
715 {
716 char buff[100];
717 
718 if(verbose)
719 	fprintf(diagfile, "PASS2.");
720 
721 #if FAMILY==DMR
722 	sprintf(buff, "%s %s - %s", pass2name, textfname, asmpass2);
723 	return( sys(buff) );
724 #endif
725 
726 
727 #if FAMILY == PCC
728 #	if TARGET==INTERDATA
729 	sprintf(buff, "%s -A%s <%s >%s", pass2name, setfname, textfname, asmpass2);
730 #	else
731 	sprintf(buff, "%s %s %s >%s",
732 		pass2name, f2flags, textfname, asmpass2);
733 #	endif
734 	return( sys(buff) );
735 #endif
736 }
737 
738 
739 
740 
741 doasm(s)
742 char *s;
743 {
744 register char *lastc;
745 char *obj;
746 char buff[200];
747 char *lastchar(), *setdoto();
748 
749 if(*s == '\0')
750 	s = objfdefault;
751 lastc = lastchar(s);
752 obj = setdoto(s);
753 
754 #if TARGET==PDP11 || TARGET==VAX
755 #	ifdef PASS2OPT
756 	if(optimflag)
757 		{
758 		sprintf(buff, "%s -f %s %s", pass2opt, asmpass2, optzfname);
759 		if( sys(buff) )
760 			rmf(optzfname);
761 		else
762 			if (rename(optzfname, asmpass2))
763 				fatal("can't rename optimizer output file");
764 		}
765 #	endif
766 #endif
767 
768 if(saveasmflag)
769 	{
770 	*lastc = 's';
771 #if TARGET == INTERDATA
772 	sprintf(buff, "%s %s %s %s %s >%s", CATNAME, asmfname, initfname,
773 		setfname, asmpass2, obj);
774 #else
775 #if TARGET == VAX
776 	if (sdbflag)
777 		sprintf(buff, "%s %s %s %s >%s",
778 			CATNAME, asmfname, asmpass2, initfname, obj);
779 	else
780 		sprintf(buff, "%s %s %s %s >%s",
781 			CATNAME, asmfname, initfname, asmpass2, obj);
782 #else
783 	sprintf(buff, "%s %s %s %s >%s",
784 		CATNAME, asmfname, initfname, asmpass2, obj);
785 #endif
786 #endif
787 	if( sys(buff) )
788 		fatal("can't concatenate assembly files");
789 	*lastc = 'o';
790 	}
791 else
792 	{
793 	if(verbose)
794 		fprintf(diagfile, "  ASM.");
795 #if TARGET == INTERDATA
796 	sprintf(buff, "%s -o %s %s %s %s %s", asmname, obj, asmfname,
797 		initfname, setfname, asmpass2);
798 #endif
799 
800 #if TARGET == VAX
801 	/* vax assembler currently accepts only one input file */
802 	if (sdbflag)
803 		sprintf(buff, "%s %s %s >>%s",
804 			CATNAME, asmpass2, initfname, asmfname);
805 	else
806 		sprintf(buff, "%s %s %s >>%s",
807 			CATNAME, initfname, asmpass2, asmfname);
808 	if( sys(buff) )
809 		fatal("can't concatenate assembly files");
810 #ifdef UCBVAXASM
811 	sprintf(buff, "%s -J -o %s %s", asmname, obj, asmfname);
812 #else
813 	sprintf(buff, "%s -o %s %s", asmname, obj, asmfname);
814 #endif
815 #endif
816 
817 #if TARGET == PDP11
818 	sprintf(buff, "%s -u -o %s %s %s", asmname, obj, asmfname, asmpass2);
819 #endif
820 
821 #if TARGET!=INTERDATA && TARGET!=PDP11 && TARGET!=VAX
822 	sprintf(buff, "%s -o %s %s %s", asmname, obj, asmfname, asmpass2);
823 #endif
824 
825 	if( sys(buff) )
826 		fatal("assembler error");
827 	if(verbose)
828 		fprintf(diagfile, "\n");
829 #if HERE==PDP11 && TARGET!=PDP11
830 	rmf(obj);
831 #endif
832 	}
833 
834 rmf(asmpass2);
835 }
836 
837 
838 
839 doload(v0, v)
840 register char *v0[], *v[];
841 {
842 char **p;
843 int waitpid;
844 
845 if (profileflag)
846 	{
847 	for(p = p_liblist ; *p ; *v++ = *p++)
848 		;
849 	}
850 else	{
851 	for(p = liblist ; *p ; *v++ = *p++)
852 		;
853 	}
854 
855 *v++ = "-o";
856 *v++ = aoutname;
857 *v = NULL;
858 
859 if(verbose)
860 	fprintf(diagfile, "LOAD.");
861 if(debugflag)
862 	{
863 	for(p = v0 ; p<v ; ++p)
864 		fprintf(diagfile, "%s ", *p);
865 	fprintf(diagfile, "\n");
866 	}
867 
868 #if HERE==PDP11 || HERE==INTERDATA || HERE==VAX
869 	if( (waitpid = fork()) == 0)
870 		{
871 		enbint(SIG_DFL);
872 		execv(ldname, v0);
873 		fatalstr("couldn't load %s", ldname);
874 		}
875 	if( await(waitpid) )
876 		erred = YES;
877 #endif
878 
879 #if HERE==INTERDATA
880 	if(optimflag)
881 		{
882 		char buff1[100], buff2[100];
883 		sprintf(buff1, "nopt %s -o junk.%d", aoutname, pid);
884 		sprintf(buff2, "mv junk.%d %s", pid, aoutname);
885 		if( sys(buff1) || sys(buff2) )
886 			err("bad optimization");
887 		}
888 #endif
889 
890 if(verbose)
891 	fprintf(diagfile, "\n");
892 }
893 
894 /* Process control and Shell-simulating routines */
895 
896 sys(str)
897 char *str;
898 {
899 register char *s, *t;
900 char *argv[100];
901 char *inname, *outname;
902 int append;
903 int waitpid;
904 int argc;
905 
906 
907 if(debugflag)
908 	fprintf(diagfile, "%s\n", str);
909 inname  = NULL;
910 outname = NULL;
911 argv[0] = shellname;
912 argc = 1;
913 
914 t = str;
915 while( isspace(*t) )
916 	++t;
917 while(*t)
918 	{
919 	if(*t == '<')
920 		inname = t+1;
921 	else if(*t == '>')
922 		{
923 		if(t[1] == '>')
924 			{
925 			append = YES;
926 			outname = t+2;
927 			}
928 		else	{
929 			append = NO;
930 			outname = t+1;
931 			}
932 		}
933 	else
934 		argv[argc++] = t;
935 	while( !isspace(*t) && *t!='\0' )
936 		++t;
937 	if(*t)
938 		{
939 		*t++ = '\0';
940 		while( isspace(*t) )
941 			++t;
942 		}
943 	}
944 
945 if(argc == 1)   /* no command */
946 	return(-1);
947 argv[argc] = 0;
948 
949 if((waitpid = fork()) == 0)
950 	{
951 	if(inname)
952 		if(freopen(inname, "r", stdin) == NULL)
953 			fatalstr("Cannot open %s", inname);
954 	if(outname)
955 		if(freopen(outname, (append ? "a" : "w"), stdout) == NULL)
956 			fatalstr("Cannot open %s", outname);
957 	enbint(SIG_DFL);
958 
959 	texec(argv[1], argv);
960 
961 	fatalstr("Cannot load %s", argv[1]);
962 	}
963 
964 return( await(waitpid) );
965 }
966 
967 
968 
969 
970 
971 #include "errno.h"
972 
973 /* modified version from the Shell */
974 texec(f, av)
975 char *f;
976 char **av;
977 {
978 extern int errno;
979 
980 execv(f, av+1);
981 
982 if (errno==ENOEXEC)
983 	{
984 	av[1] = f;
985 	execv(shellname, av);
986 	fatal("No shell!");
987 	}
988 if (errno==ENOMEM)
989 	fatalstr("%s: too large", f);
990 }
991 
992 
993 
994 
995 
996 
997 done(k)
998 int k;
999 {
1000 static int recurs	= NO;
1001 
1002 if(recurs == NO)
1003 	{
1004 	recurs = YES;
1005 	rmfiles();
1006 	}
1007 exit(k);
1008 }
1009 
1010 
1011 
1012 
1013 
1014 
1015 enbint(k)
1016 int (*k)();
1017 {
1018 if(sigivalue == 0)
1019 	(void) signal(SIGINT,k);
1020 if(sigqvalue == 0)
1021 	(void) signal(SIGQUIT,k);
1022 if(sighvalue == 0)
1023 	(void) signal(SIGHUP,k);
1024 if(sigtvalue == 0)
1025 	(void) signal(SIGTERM,k);
1026 }
1027 
1028 
1029 
1030 
1031 intrupt()
1032 {
1033 done(2);
1034 }
1035 
1036 
1037 #ifdef PSIGNAL
1038 /*
1039  * Fancy 4.2 BSD signal printing stuff.
1040  */
1041 char harmless[NSIG] = { 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1 };
1042 #endif
1043 
1044 
1045 await(waitpid)
1046 int waitpid;
1047 {
1048 
1049 #ifdef PSIGNAL
1050 extern char *sys_siglist[];
1051 union wait status;
1052 #else PSIGNAL
1053 int status;
1054 #endif PSIGNAL
1055 
1056 int w;
1057 
1058 enbint(SIG_IGN);
1059 while ( (w = wait(&status)) != waitpid)
1060 	if(w == -1)
1061 		fatal("bad wait code");
1062 enbint(intrupt);
1063 
1064 #ifdef PSIGNAL
1065 if(status.w_termsig)
1066 	{
1067 	debugflag = 0;	/* Prevent us from dumping core ourselves */
1068 	if(status.w_termsig != SIGINT && status.w_termsig < NSIG)
1069 		fprintf(diagfile, "%s%s\n", sys_siglist[status.w_termsig],
1070 			status.w_coredump ? " -- core dumped" : "");
1071 	if(status.w_termsig < NSIG && ! harmless[status.w_termsig])
1072 		fatal("see a system manager");
1073 	else
1074 		done(3);
1075 	}
1076 return(status.w_retcode);
1077 #else PSIGNAL
1078 if(status & 0377)
1079 	{
1080 	if(status != SIGINT)
1081 		fprintf(diagfile, "Termination code %d\n", status);
1082 	done(3);
1083 	}
1084 return(status>>8);
1085 #endif PSIGNAL
1086 }
1087 
1088 /* File Name and File Manipulation Routines */
1089 
1090 unreadable(s)
1091 register char *s;
1092 {
1093 register FILE *fp;
1094 
1095 if(fp = fopen(s, "r"))
1096 	{
1097 	fclose(fp);
1098 	return(NO);
1099 	}
1100 
1101 else
1102 	{
1103 	fprintf(diagfile, "Error: Cannot read file %s\n", s);
1104 	return(YES);
1105 	}
1106 }
1107 
1108 
1109 
1110 stupid(s)
1111 char *s;
1112 {
1113 char c;
1114 extern char *index();
1115 
1116 if( (c = dotchar(s))
1117   && index("focsreF", c)
1118   && access(s, 0) == 0 )
1119 	{
1120 	fprintf(diagfile, "Loading on %s would destroy it\n", s);
1121 	return(YES);
1122 	}
1123 return(NO);
1124 }
1125 
1126 
1127 
1128 clf(p)
1129 FILEP *p;
1130 {
1131 if(p!=NULL && *p!=NULL && *p!=stdout)
1132 	{
1133 	if(ferror(*p))
1134 		fatal("writing error");
1135 	fclose(*p);
1136 	}
1137 *p = NULL;
1138 }
1139 
1140 rmfiles()
1141 {
1142 rmf(textfname);
1143 rmf(asmfname);
1144 rmf(initfname);
1145 rmf(asmpass2);
1146 #if TARGET == INTERDATA
1147 	rmf(setfname);
1148 #endif
1149 }
1150 
1151 
1152 
1153 
1154 
1155 
1156 
1157 
1158 /* return -1 if file does not exist, 0 if it is of zero length
1159    and 1 if of positive length
1160 */
1161 content(filename)
1162 char *filename;
1163 {
1164 #ifdef VERSION6
1165 	struct stat
1166 		{
1167 		char cjunk[9];
1168 		char size0;
1169 		int size1;
1170 		int ijunk[12];
1171 		} buf;
1172 #else
1173 	struct stat buf;
1174 #endif
1175 
1176 if(stat(filename,&buf) < 0)
1177 	return(-1);
1178 #ifdef VERSION6
1179 	return(buf.size0 || buf.size1);
1180 #else
1181 	return( buf.st_size > 0 );
1182 #endif
1183 }
1184 
1185 
1186 
1187 
1188 crfnames()
1189 {
1190 fname(textfname, "x");
1191 fname(asmfname, "s");
1192 fname(asmpass2, "a");
1193 fname(initfname, "d");
1194 fname(sortfname, "S");
1195 fname(objfdefault, "o");
1196 fname(prepfname, "p");
1197 fname(optzfname, "z");
1198 fname(setfname, "A");
1199 }
1200 
1201 
1202 
1203 
1204 rmf(fn)
1205 register char *fn;
1206 {
1207 /* if(!debugflag && fn!=NULL && *fn!='\0') */
1208 
1209 if(fn!=NULL && *fn!='\0')
1210 	unlink(fn);
1211 }
1212 
1213 
1214 
1215 
1216 
1217 LOCAL fname(name, suff)
1218 char *name, *suff;
1219 {
1220 sprintf(name, "%s/%s%d.%s", _PATH_TMP, temppref, pid, suff);
1221 }
1222 
1223 
1224 
1225 
1226 dotchar(s)
1227 register char *s;
1228 {
1229 for( ; *s ; ++s)
1230 	if(s[0]=='.' && s[1]!='\0' && s[2]=='\0')
1231 		return( s[1] );
1232 return(NO);
1233 }
1234 
1235 
1236 
1237 char *lastfield(s)
1238 register char *s;
1239 {
1240 register char *t;
1241 for(t = s; *s ; ++s)
1242 	if(*s == '/')
1243 		t = s+1;
1244 return(t);
1245 }
1246 
1247 
1248 
1249 char *lastchar(s)
1250 register char *s;
1251 {
1252 while(*s)
1253 	++s;
1254 return(s-1);
1255 }
1256 
1257 char *setdoto(s)
1258 register char *s;
1259 {
1260 *lastchar(s) = 'o';
1261 return( lastfield(s) );
1262 }
1263 
1264 
1265 
1266 badfile(s)
1267 char *s;
1268 {
1269 fatalstr("cannot open intermediate file %s", s);
1270 }
1271 
1272 
1273 
1274 ptr ckalloc(n)
1275 int n;
1276 {
1277 ptr p;
1278 extern char *calloc();
1279 
1280 if( p = (ptr) calloc(1, (unsigned) n) )
1281 	return(p);
1282 
1283 fatal("out of memory");
1284 /* NOTREACHED */
1285 }
1286 
1287 
1288 
1289 
1290 
1291 char *copyn(n, s)
1292 register int n;
1293 register char *s;
1294 {
1295 register char *p, *q;
1296 
1297 p = q = (char *) ckalloc(n);
1298 while(n-- > 0)
1299 	*q++ = *s++;
1300 return(p);
1301 }
1302 
1303 
1304 
1305 char *copys(s)
1306 char *s;
1307 {
1308 return( copyn( strlen(s)+1 , s) );
1309 }
1310 
1311 
1312 
1313 
1314 
1315 oneof(c,s)
1316 register c;
1317 register char *s;
1318 {
1319 while( *s )
1320 	if(*s++ == c)
1321 		return(YES);
1322 return(NO);
1323 }
1324 
1325 
1326 
1327 nodup(s)
1328 char *s;
1329 {
1330 register char **p;
1331 
1332 for(p = loadargs ; p < loadp ; ++p)
1333 	if( !strcmp(*p, s) )
1334 		return(NO);
1335 
1336 return(YES);
1337 }
1338 
1339 
1340 
1341 static fatal(t)
1342 char *t;
1343 {
1344 fprintf(diagfile, "Compiler error in file %s: %s\n", infname, t);
1345 if(debugflag)
1346 	abort();
1347 done(1);
1348 exit(1);
1349 }
1350 
1351 
1352 
1353 
1354 static fatali(t,d)
1355 char *t;
1356 int d;
1357 {
1358 char buff[100];
1359 sprintf(buff, t, d);
1360 fatal(buff);
1361 }
1362 
1363 
1364 
1365 
1366 static fatalstr(t, s)
1367 char *t, *s;
1368 {
1369 char buff[100];
1370 sprintf(buff, t, s);
1371 fatal(buff);
1372 }
1373 err(s)
1374 char *s;
1375 {
1376 fprintf(diagfile, "Error in file %s: %s\n", infname, s);
1377 }
1378 
1379