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
main(argc,argv)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 *
argvtos(argc,argv)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
dofort(s)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
dopass2()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
doasm(s)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
doload(v0,v)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
sys(str)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 */
texec(f,av)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
done(k)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
intrupt()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
await(waitpid)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
unreadable(s)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
stupid(s)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
clf(p)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
rmfiles()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 */
content(filename)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
crfnames()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
rmf(fn)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
fname(name,suff)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
dotchar(s)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
lastfield(s)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
lastchar(s)1256 char *lastchar(s)
1257 register char *s;
1258 {
1259 while(*s)
1260 ++s;
1261 return(s-1);
1262 }
1263
setdoto(s)1264 char *setdoto(s)
1265 register char *s;
1266 {
1267 *lastchar(s) = 'o';
1268 return( lastfield(s) );
1269 }
1270
1271
1272
badfile(s)1273 badfile(s)
1274 char *s;
1275 {
1276 fatalstr("cannot open intermediate file %s", s);
1277 }
1278
1279
1280
ckalloc(n)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
copyn(n,s)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
copys(s)1312 char *copys(s)
1313 char *s;
1314 {
1315 return( copyn( strlen(s)+1 , s) );
1316 }
1317
1318
1319
1320
1321
oneof(c,s)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
nodup(s)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
fatal(t)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
fatali(t,d)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
fatalstr(t,s)1373 static fatalstr(t, s)
1374 char *t, *s;
1375 {
1376 char buff[100];
1377 sprintf(buff, t, s);
1378 fatal(buff);
1379 }
err(s)1380 err(s)
1381 char *s;
1382 {
1383 fprintf(diagfile, "Error in file %s: %s\n", infname, s);
1384 }
1385
1386