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