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
main(argc,argv)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 *
argvtos(argc,argv)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
dofort(s)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
dopass2()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
doasm(s)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
doload(v0,v)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
sys(str)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 */
texec(f,av)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
done(k)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
intrupt()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
await(waitpid)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
unreadable(s)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
stupid(s)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
clf(p)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
rmfiles()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 */
content(filename)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
crfnames()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
rmf(fn)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
fname(name,suff)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
dotchar(s)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
lastfield(s)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
lastchar(s)1221 char *lastchar(s)
1222 register char *s;
1223 {
1224 while(*s)
1225 ++s;
1226 return(s-1);
1227 }
1228
setdoto(s)1229 char *setdoto(s)
1230 register char *s;
1231 {
1232 *lastchar(s) = 'o';
1233 return( lastfield(s) );
1234 }
1235
1236
1237
badfile(s)1238 badfile(s)
1239 char *s;
1240 {
1241 fatalstr("cannot open intermediate file %s", s);
1242 }
1243
1244
1245
ckalloc(n)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
copyn(n,s)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
copys(s)1276 char *copys(s)
1277 char *s;
1278 {
1279 return( copyn( strlen(s)+1 , s) );
1280 }
1281
1282
1283
1284
1285
oneof(c,s)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
nodup(s)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
fatal(t)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
fatali(t,d)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
fatalstr(t,s)1337 static fatalstr(t, s)
1338 char *t, *s;
1339 {
1340 char buff[100];
1341 sprintf(buff, t, s);
1342 fatal(buff);
1343 }
err(s)1344 err(s)
1345 char *s;
1346 {
1347 fprintf(diagfile, "Error in file %s: %s\n", infname, s);
1348 }
1349
1350