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