BSD 4 release
[unix-history] / usr / src / cmd / f77 / driver.c
CommitLineData
31cef89c 1char *xxxvers[] = "\n@(#) FORTRAN 77 DRIVER, VERSION 2.03.5, 7 NOVEMBER 1980\n";
47621762
BJ
2#include <stdio.h>
3#include <ctype.h>
4#include "defines"
5#include "machdefs"
6#include "drivedefs"
7#include "ftypes"
8#include <signal.h>
9
10static FILEP diagfile = {stderr} ;
11static int pid;
12static int sigivalue = 0;
13static int sigqvalue = 0;
14static int sighvalue = 0;
15static int sigtvalue = 0;
16
17static char *pass1name = PASS1NAME ;
18static char *pass2name = PASS2NAME ;
19static char *asmname = ASMNAME ;
20static char *ldname = LDNAME ;
21static char *footname = FOOTNAME;
22static char *proffoot = PROFFOOT;
23static char *macroname = "m4";
24static char *shellname = "/bin/sh";
25static char *aoutname = "a.out" ;
31cef89c 26static char *temppref = TEMPPREF;
47621762
BJ
27
28static char *infname;
31cef89c
BJ
29static char textfname[40];
30static char asmfname[40];
31static char asmpass2[40];
32static char initfname[40];
33static char sortfname[40];
34static char prepfname[40];
35static char objfdefault[40];
36static char optzfname[40];
37static char setfname[40];
47621762
BJ
38
39static char fflags[50] = "-";
31cef89c
BJ
40static char cflags[50] = "-c";
41#if TARGET == GCOS
42 static char eflags[30] = "system=gcos ";
43#else
44 static char eflags[30] = "system=unix ";
45#endif
47621762
BJ
46static char rflags[30] = "";
47static char lflag[3] = "-x";
48static char *fflagp = fflags+1;
49static char *cflagp = cflags+2;
31cef89c 50static char *eflagp = eflags+12;
47621762
BJ
51static char *rflagp = rflags;
52static char **loadargs;
53static char **loadp;
54
55static flag erred = NO;
56static flag loadflag = YES;
57static flag saveasmflag = NO;
58static flag profileflag = NO;
59static flag optimflag = NO;
60static flag debugflag = NO;
61static flag verbose = NO;
62static flag nofloating = NO;
63static flag fortonly = NO;
64static flag macroflag = NO;
31cef89c
BJ
65static flag sdbflag = NO;
66
47621762
BJ
67
68\f
69main(argc, argv)
70int argc;
71char **argv;
72{
73int i, c, status;
31cef89c 74char *setdoto(), *lastchar(), *lastfield(), *copys();
47621762
BJ
75ptr ckalloc();
76register char *s;
77char fortfile[20], *t;
78char buff[100];
79int intrupt();
80
81sigivalue = (int) signal(SIGINT, SIG_IGN) & 01;
82sigqvalue = (int) signal(SIGQUIT,SIG_IGN) & 01;
83sighvalue = (int) signal(SIGHUP, SIG_IGN) & 01;
84sigtvalue = (int) signal(SIGTERM,SIG_IGN) & 01;
85enbint(intrupt);
86
87pid = getpid();
88crfnames();
89
90loadargs = (char **) ckalloc( (argc+20) * sizeof(*loadargs) );
91loadargs[1] = "-X";
92loadargs[2] = "-u";
93#if HERE==PDP11 || HERE==VAX
94 loadargs[3] = "_MAIN__";
95#endif
96#if HERE == INTERDATA
97 loadargs[3] = "main";
98#endif
99loadp = loadargs + 4;
100
101--argc;
102++argv;
103
104while(argc>0 && argv[0][0]=='-' && argv[0][1]!='\0')
105 {
106 for(s = argv[0]+1 ; *s ; ++s) switch(*s)
107 {
108 case 'T': /* use special passes */
109 switch(*++s)
110 {
111 case '1':
112 pass1name = s+1; goto endfor;
113 case '2':
114 pass2name = s+1; goto endfor;
115 case 'a':
116 asmname = s+1; goto endfor;
117 case 'l':
118 ldname = s+1; goto endfor;
119 case 'F':
120 footname = s+1; goto endfor;
121 case 'm':
122 macroname = s+1; goto endfor;
31cef89c
BJ
123 case 't':
124 temppref = s+1; goto endfor;
47621762
BJ
125 default:
126 fatali("bad option -T%c", *s);
127 }
128 break;
129
130 case '6':
131 if(s[1]=='6')
132 {
133 *fflagp++ = *s++;
134 goto copyfflag;
135 }
136 else {
137 fprintf(diagfile, "invalid flag 6%c\n", s[1]);
138 done(1);
139 }
140
141 case 'w':
142 if(s[1]=='6' && s[2]=='6')
143 {
144 *fflagp++ = *s++;
145 *fflagp++ = *s++;
146 }
147
148 copyfflag:
149 case 'u':
150 case 'U':
47621762
BJ
151 case '1':
152 case 'C':
47621762
BJ
153 *fflagp++ = *s;
154 break;
155
156 case 'O':
157 optimflag = YES;
158#if TARGET == INTERDATA
159 *loadp++ = "-r";
160 *loadp++ = "-d";
161#endif
162 *fflagp++ = 'O';
163 if( isdigit(s[1]) )
164 *fflagp++ = *++s;
165 break;
166
167 case 'N':
168 *fflagp++ = 'N';
169 if( oneof(*++s, "qxscn") )
170 *fflagp++ = *s++;
171 else {
172 fprintf(diagfile, "invalid flag -N%c\n", *s);
173 done(1);
174 }
175 while( isdigit(*s) )
176 *fflagp++ = *s++;
177 *fflagp++ = 'X';
178 goto endfor;
179
180 case 'm':
181 if(s[1] == '4')
182 ++s;
183 macroflag = YES;
184 break;
185
186 case 'S':
31cef89c 187 strcat(cflags, " -S");
47621762
BJ
188 saveasmflag = YES;
189
190 case 'c':
191 loadflag = NO;
192 break;
193
194 case 'v':
195 verbose = YES;
196 break;
197
198 case 'd':
199 debugflag = YES;
200 goto copyfflag;
201
31cef89c
BJ
202 case 'M':
203 *loadp++ = "-M";
204 break;
205
206 case 'g':
207 strcat(cflags," -g");
208 sdbflag = YES;
209 goto copyfflag;
210
47621762
BJ
211 case 'p':
212 profileflag = YES;
31cef89c 213 strcat(cflags," -p");
47621762
BJ
214 goto copyfflag;
215
216 case 'o':
217 if( ! strcmp(s, "onetrip") )
218 {
219 *fflagp++ = '1';
220 goto endfor;
221 }
222 aoutname = *++argv;
223 --argc;
224 break;
225
226#if TARGET == PDP11
227 case 'f':
228 nofloating = YES;
229 pass2name = NOFLPASS2;
230 break;
231#endif
232
233 case 'F':
234 fortonly = YES;
235 loadflag = NO;
236 break;
237
238 case 'I':
239 if(s[1]=='2' || s[1]=='4' || s[1]=='s')
240 {
241 *fflagp++ = *s++;
242 goto copyfflag;
243 }
244 fprintf(diagfile, "invalid flag -I%c\n", s[1]);
245 done(1);
246
247 case 'l': /* letter ell--library */
248 s[-1] = '-';
249 *loadp++ = s-1;
250 goto endfor;
251
252 case 'E': /* EFL flag argument */
253 while( *eflagp++ = *++s)
254 ;
255 *eflagp++ = ' ';
256 goto endfor;
257 case 'R':
258 while( *rflagp++ = *++s )
259 ;
260 *rflagp++ = ' ';
261 goto endfor;
262 default:
263 lflag[1] = *s;
264 *loadp++ = copys(lflag);
265 break;
266 }
267endfor:
268 --argc;
269 ++argv;
270 }
271
272*fflagp = '\0';
273
274loadargs[0] = ldname;
275#if TARGET == PDP11
276 if(nofloating)
277 *loadp++ = (profileflag ? NOFLPROF : NOFLFOOT);
278 else
279#endif
280*loadp++ = (profileflag ? proffoot : footname);
281
282for(i = 0 ; i<argc ; ++i)
283 switch(c = dotchar(infname = argv[i]) )
284 {
285 case 'r': /* Ratfor file */
286 case 'e': /* EFL file */
287 if( unreadable(argv[i]) )
288 {
289 erred = YES;
290 break;
291 }
292 s = fortfile;
293 t = lastfield(argv[i]);
294 while( *s++ = *t++)
295 ;
296 s[-2] = 'f';
297
298 if(macroflag)
299 {
300 sprintf(buff, "%s %s >%s", macroname, infname, prepfname);
301 if( sys(buff) )
302 {
303 rmf(prepfname);
304 erred = YES;
305 break;
306 }
307 infname = prepfname;
308 }
309
310 if(c == 'e')
311 sprintf(buff, "efl %s %s >%s", eflags, infname, fortfile);
312 else
313 sprintf(buff, "ratfor %s %s >%s", rflags, infname, fortfile);
314 status = sys(buff);
315 if(macroflag)
316 rmf(infname);
317 if(status)
318 {
319 erred = YES;
320 rmf(fortfile);
321 break;
322 }
323
324 if( ! fortonly )
325 {
326 infname = argv[i] = lastfield(argv[i]);
327 *lastchar(infname) = 'f';
328
329 if( dofort(argv[i]) )
330 erred = YES;
331 else {
332 if( nodup(t = setdoto(argv[i])) )
333 *loadp++ = t;
334 rmf(fortfile);
335 }
336 }
337 break;
338
339 case 'f': /* Fortran file */
340 case 'F':
341 if( unreadable(argv[i]) )
342 erred = YES;
343 else if( dofort(argv[i]) )
344 erred = YES;
345 else if( nodup(t=setdoto(argv[i])) )
346 *loadp++ = t;
347 break;
348
349 case 'c': /* C file */
350 case 's': /* Assembler file */
351 if( unreadable(argv[i]) )
352 {
353 erred = YES;
354 break;
355 }
356#if HERE==PDP11 || HERE==VAX
357 fprintf(diagfile, "%s:\n", argv[i]);
358#endif
31cef89c 359 sprintf(buff, "cc %s %s", cflags, argv[i] );
47621762
BJ
360 if( sys(buff) )
361 erred = YES;
362 else
363 if( nodup(t = setdoto(argv[i])) )
364 *loadp++ = t;
365 break;
366
367 case 'o':
368 if( nodup(argv[i]) )
369 *loadp++ = argv[i];
370 break;
371
372 default:
373 if( ! strcmp(argv[i], "-o") )
374 aoutname = argv[++i];
375 else
376 *loadp++ = argv[i];
377 break;
378 }
379
380if(loadflag && !erred)
381 doload(loadargs, loadp);
382done(erred);
383}
384\f
385dofort(s)
386char *s;
387{
388int retcode;
389char buff[200];
390
391infname = s;
392sprintf(buff, "%s %s %s %s %s %s",
393 pass1name, fflags, s, asmfname, initfname, textfname);
394switch( sys(buff) )
395 {
396 case 1:
397 goto error;
398 case 0:
399 break;
400 default:
401 goto comperror;
402 }
403
404if(content(initfname) > 0)
405 if( dodata() )
406 goto error;
407if( dopass2() )
408 goto comperror;
409doasm(s);
410retcode = 0;
411
412ret:
413 rmf(asmfname);
414 rmf(initfname);
415 rmf(textfname);
416 return(retcode);
417
418error:
419 fprintf(diagfile, "\nError. No assembly.\n");
420 retcode = 1;
421 goto ret;
422
423comperror:
424 fprintf(diagfile, "\ncompiler error.\n");
425 retcode = 2;
426 goto ret;
427}
428
429
430
431
432dopass2()
433{
434char buff[100];
435
436if(verbose)
437 fprintf(diagfile, "PASS2.");
438
439#if FAMILY==DMR
440 sprintf(buff, "%s %s - %s", pass2name, textfname, asmpass2);
441 return( sys(buff) );
442#endif
443
444#if FAMILY == PCC
445# if TARGET==INTERDATA
446 sprintf(buff, "%s -A%s <%s >%s", pass2name, setfname, textfname, asmpass2);
447# else
31cef89c 448 sprintf(buff, "%s %s >%s", pass2name, textfname, asmpass2);
47621762
BJ
449# endif
450 return( sys(buff) );
451#endif
452}
453
454
455
456
457doasm(s)
458char *s;
459{
460register char *lastc;
461char *obj;
462char buff[200];
31cef89c 463char *lastchar(), *setdoto();
47621762
BJ
464
465if(*s == '\0')
466 s = objfdefault;
467lastc = lastchar(s);
468obj = setdoto(s);
469
470#if TARGET==PDP11 || TARGET==VAX
471# ifdef PASS2OPT
472 if(optimflag)
473 {
474 sprintf(buff, "%s %s %s", PASS2OPT, asmpass2, optzfname);
475 if( sys(buff) )
476 rmf(optzfname);
477 else
478 {
479 sprintf(buff,"mv %s %s", optzfname, asmpass2);
480 sys(buff);
481 }
482 }
483# endif
484#endif
485
486if(saveasmflag)
487 {
488 *lastc = 's';
489#if TARGET == INTERDATA
490 sprintf(buff, "cat %s %s %s >%s",asmfname, setfname, asmpass2, obj);
491#else
492 sprintf(buff, "cat %s %s >%s", asmfname, asmpass2, obj);
493#endif
494 sys(buff);
495 *lastc = 'o';
496 }
497else
498 {
499 if(verbose)
500 fprintf(diagfile, " ASM.");
501#if TARGET == INTERDATA
502 sprintf(buff, "%s -o %s %s %s %s", asmname, obj, asmfname, setfname, asmpass2);
503#endif
504
505#if TARGET == VAX
506 /* vax assembler currently accepts only one input file */
507 sprintf(buff, "cat %s >>%s", asmpass2, asmfname);
508 sys(buff);
509 sprintf(buff, "%s -o %s %s", asmname, obj, asmfname);
510#endif
511
512#if TARGET == PDP11
513 sprintf(buff, "%s -u -o %s %s %s", asmname, obj, asmfname, asmpass2);
514#endif
515
516#if TARGET!=INTERDATA && TARGET!=PDP11 && TARGET!=VAX
517 sprintf(buff, "%s -o %s %s %s", asmname, obj, asmfname, asmpass2);
518#endif
519
520 if( sys(buff) )
521 fatal("assembler error");
522 if(verbose)
523 fprintf(diagfile, "\n");
524#if HERE==PDP11 && TARGET!=PDP11
525 rmf(obj);
526#endif
527 }
528
529rmf(asmpass2);
530}
531
532
533
534doload(v0, v)
535register char *v0[], *v[];
536{
537char **p;
538int waitpid;
539
31cef89c
BJ
540if(sdbflag)
541 *v++ = "-lg";
47621762
BJ
542for(p = liblist ; *p ; *v++ = *p++)
543 ;
544
545*v++ = "-o";
546*v++ = aoutname;
547*v = NULL;
548
549if(verbose)
550 fprintf(diagfile, "LOAD.");
551if(debugflag)
552 {
553 for(p = v0 ; p<v ; ++p)
554 fprintf(diagfile, "%s ", *p);
555 fprintf(diagfile, "\n");
556 }
557
558#if HERE==PDP11 || HERE==INTERDATA || HERE==VAX
559 if( (waitpid = fork()) == 0)
560 {
561 enbint(SIG_DFL);
562 execv(ldname, v0);
563 fatalstr("couldn't load %s", ldname);
564 }
565 await(waitpid);
566#endif
567
568#if HERE==INTERDATA
569 if(optimflag)
570 {
571 char buff1[100], buff2[100];
572 sprintf(buff1, "nopt %s -o junk.%d", aoutname, pid);
573 sprintf(buff2, "mv junk.%d %s", pid, aoutname);
574 if( sys(buff1) || sys(buff2) )
575 err("bad optimization");
576 }
577#endif
578
579if(verbose)
580 fprintf(diagfile, "\n");
581}
582\f
583/* Process control and Shell-simulating routines */
584
585sys(str)
586char *str;
587{
588register char *s, *t;
589char *argv[100], path[100];
590char *inname, *outname;
591int append;
592int waitpid;
593int argc;
594
595
596if(debugflag)
597 fprintf(diagfile, "%s\n", str);
598inname = NULL;
599outname = NULL;
600argv[0] = shellname;
601argc = 1;
602
603t = str;
604while( isspace(*t) )
605 ++t;
606while(*t)
607 {
608 if(*t == '<')
609 inname = t+1;
610 else if(*t == '>')
611 {
612 if(t[1] == '>')
613 {
614 append = YES;
615 outname = t+2;
616 }
617 else {
618 append = NO;
619 outname = t+1;
620 }
621 }
622 else
623 argv[argc++] = t;
624 while( !isspace(*t) && *t!='\0' )
625 ++t;
626 if(*t)
627 {
628 *t++ = '\0';
629 while( isspace(*t) )
630 ++t;
631 }
632 }
633
634if(argc == 1) /* no command */
635 return(-1);
636argv[argc] = 0;
637
638s = path;
639t = "/usr/bin/";
640while(*t)
641 *s++ = *t++;
642for(t = argv[1] ; *s++ = *t++ ; )
643 ;
644if((waitpid = fork()) == 0)
645 {
646 if(inname)
647 freopen(inname, "r", stdin);
648 if(outname)
649 freopen(outname, (append ? "a" : "w"), stdout);
650 enbint(SIG_DFL);
651
652 texec(path+9, argv); /* command */
653 texec(path+4, argv); /* /bin/command */
654 texec(path , argv); /* /usr/bin/command */
655
656 fatalstr("Cannot load %s",path+9);
657 }
658
659return( await(waitpid) );
660}
661
662
663
664
665
666#include "errno.h"
667
668/* modified version from the Shell */
669texec(f, av)
670char *f;
671char **av;
672{
673extern int errno;
674
675execv(f, av+1);
676
677if (errno==ENOEXEC)
678 {
679 av[1] = f;
680 execv(shellname, av);
681 fatal("No shell!");
682 }
683if (errno==ENOMEM)
684 fatalstr("%s: too large", f);
685}
686
687
688
689
690
691
692done(k)
693int k;
694{
695static int recurs = NO;
696
697if(recurs == NO)
698 {
699 recurs = YES;
700 rmfiles();
701 }
702exit(k);
703}
704
705
706
707
708
709
710enbint(k)
711int (*k)();
712{
713if(sigivalue == 0)
714 signal(SIGINT,k);
715if(sigqvalue == 0)
716 signal(SIGQUIT,k);
717if(sighvalue == 0)
718 signal(SIGHUP,k);
719if(sigtvalue == 0)
720 signal(SIGTERM,k);
721}
722
723
724
725
726intrupt()
727{
728done(2);
729}
730
731
732
733await(waitpid)
734int waitpid;
735{
736int w, status;
737
738enbint(SIG_IGN);
739while ( (w = wait(&status)) != waitpid)
740 if(w == -1)
741 fatal("bad wait code");
742enbint(intrupt);
743if(status & 0377)
744 {
745 if(status != SIGINT)
746 fprintf(diagfile, "Termination code %d", status);
747 done(3);
748 }
749return(status>>8);
750}
751\f
752/* File Name and File Manipulation Routines */
753
754unreadable(s)
755register char *s;
756{
757register FILE *fp;
758
759if(fp = fopen(s, "r"))
760 {
761 fclose(fp);
762 return(NO);
763 }
764
765else
766 {
767 fprintf(diagfile, "Error: Cannot read file %s\n", s);
768 return(YES);
769 }
770}
771
772
773
774clf(p)
775FILEP *p;
776{
777if(p!=NULL && *p!=NULL && *p!=stdout)
778 {
779 if(ferror(*p))
780 fatal("writing error");
781 fclose(*p);
782 }
783*p = NULL;
784}
785
786rmfiles()
787{
788rmf(textfname);
789rmf(asmfname);
790rmf(initfname);
791rmf(asmpass2);
792#if TARGET == INTERDATA
793 rmf(setfname);
794#endif
795}
796
797
798
799
800
801
802
803
804/* return -1 if file does not exist, 0 if it is of zero length
805 and 1 if of positive length
806*/
807content(filename)
808char *filename;
809{
810#ifdef VERSION6
811 struct stat
812 {
813 char cjunk[9];
814 char size0;
815 int size1;
816 int ijunk[12];
817 } buf;
818#else
819# include <sys/types.h>
820# include <sys/stat.h>
821 struct stat buf;
822#endif
823
824if(stat(filename,&buf) < 0)
825 return(-1);
826#ifdef VERSION6
827 return(buf.size0 || buf.size1);
828#else
829 return( buf.st_size > 0 );
830#endif
831}
832
833
834
835
836crfnames()
837{
838fname(textfname, "x");
839fname(asmfname, "s");
840fname(asmpass2, "a");
841fname(initfname, "d");
842fname(sortfname, "S");
843fname(objfdefault, "o");
844fname(prepfname, "p");
845fname(optzfname, "z");
846fname(setfname, "A");
847}
848
849
850
851
852rmf(fn)
853register char *fn;
854{
855if(!debugflag && fn!=NULL && *fn!='\0')
856 unlink(fn);
857}
858
859
860
861
862
863LOCAL fname(name, suff)
864char *name, *suff;
865{
31cef89c 866sprintf(name, "%s%d.%s", temppref, pid, suff);
47621762
BJ
867}
868
869
870
871
872dotchar(s)
873register char *s;
874{
875for( ; *s ; ++s)
876 if(s[0]=='.' && s[1]!='\0' && s[2]=='\0')
877 return( s[1] );
878return(NO);
879}
880
881
882
883char *lastfield(s)
884register char *s;
885{
886register char *t;
887for(t = s; *s ; ++s)
888 if(*s == '/')
889 t = s+1;
890return(t);
891}
892
893
894
895char *lastchar(s)
896register char *s;
897{
898while(*s)
899 ++s;
900return(s-1);
901}
902
903char *setdoto(s)
904register char *s;
905{
906*lastchar(s) = 'o';
907return( lastfield(s) );
908}
909
910
911
912badfile(s)
913char *s;
914{
915fatalstr("cannot open intermediate file %s", s);
916}
917
918
919
920ptr ckalloc(n)
921int n;
922{
923ptr p, calloc();
924
925if( p = calloc(1, (unsigned) n) )
926 return(p);
927
928fatal("out of memory");
929/* NOTREACHED */
930}
931
932
933
934
935
31cef89c 936char *copyn(n, s)
47621762
BJ
937register int n;
938register char *s;
939{
940register char *p, *q;
941
942p = q = (char *) ckalloc(n);
943while(n-- > 0)
944 *q++ = *s++;
945return(p);
946}
947
948
949
31cef89c 950char *copys(s)
47621762
BJ
951char *s;
952{
953return( copyn( strlen(s)+1 , s) );
954}
955
956
957
958
959
960oneof(c,s)
961register c;
962register char *s;
963{
964while( *s )
965 if(*s++ == c)
966 return(YES);
967return(NO);
968}
969
970
971
972nodup(s)
973char *s;
974{
975register char **p;
976
977for(p = loadargs ; p < loadp ; ++p)
978 if( !strcmp(*p, s) )
979 return(NO);
980
981return(YES);
982}
983
984
985
986static fatal(t)
987char *t;
988{
989fprintf(diagfile, "Compiler error in file %s: %s\n", infname, t);
990if(debugflag)
991 abort();
992done(1);
993exit(1);
994}
995
996
997
998
999static fatali(t,d)
1000char *t;
1001int d;
1002{
1003char buff[100];
1004sprintf(buff, t, d);
1005fatal(buff);
1006}
1007
1008
1009
1010
1011static fatalstr(t, s)
1012char *t, *s;
1013{
1014char buff[100];
1015sprintf(buff, t, s);
1016fatal(buff);
1017}
1018err(s)
1019char *s;
1020{
1021fprintf(diagfile, "Error in file %s: %s\n", infname, s);
1022}
1023\f
31cef89c
BJ
1024/* Code to generate initializations for DATA statements */
1025
47621762
BJ
1026LOCAL int nch = 0;
1027LOCAL FILEP asmfile;
1028LOCAL FILEP sortfile;
1029
1030#include "ftypes"
1031
1032static ftnint typesize[NTYPES]
1033 = { 1, SZADDR, SZSHORT, SZLONG, SZLONG, 2*SZLONG,
1034 2*SZLONG, 4*SZLONG, SZLONG, 1, 1, 1};
1035static int typealign[NTYPES]
1036 = { 1, ALIADDR, ALISHORT, ALILONG, ALILONG, ALIDOUBLE,
1037 ALILONG, ALIDOUBLE, ALILONG, 1, 1, 1};
1038
1039dodata()
1040{
1041char buff[50];
1042char varname[XL+1], ovarname[XL+1];
1043int status;
1044flag erred;
1045ftnint offset, vlen, type;
1046register ftnint ooffset, ovlen;
1047ftnint nblank, vchar;
1048int size, align;
1049int vargroup;
1050ftnint totlen, doeven();
1051
1052erred = NO;
1053ovarname[0] = '\0';
1054ooffset = 0;
1055ovlen = 0;
1056totlen = 0;
1057nch = 0;
1058
1059sprintf(buff, "sort %s >%s", initfname, sortfname);
1060if(status = sys(buff))
1061 fatali("call sort status = %d", status);
1062if( (sortfile = fopen(sortfname, "r")) == NULL)
1063 badfile(sortfname);
1064if( (asmfile = fopen(asmfname, "a")) == NULL)
1065 badfile(asmfname);
1066pruse(asmfile, USEINIT);
1067
1068while( rdname(&vargroup, varname) && rdlong(&offset) && rdlong(&vlen) && rdlong(&type) )
1069 {
1070 size = typesize[type];
1071 if( strcmp(varname, ovarname) )
1072 {
1073 prspace(ovlen-ooffset);
1074 strcpy(ovarname, varname);
1075 ooffset = 0;
1076 totlen += ovlen;
1077 ovlen = vlen;
1078 if(vargroup == 0)
1079 align = (type==TYCHAR || type==TYBLANK ?
1080 SZLONG : typealign[type]);
1081 else align = ALIDOUBLE;
1082 totlen = doeven(totlen, align);
1083 if(vargroup == 2)
1084 prcomblock(asmfile, varname);
1085 else
1086 fprintf(asmfile, LABELFMT, varname);
1087 }
1088 if(offset < ooffset)
1089 {
1090 erred = YES;
1091 err("overlapping initializations");
31cef89c 1092 ooffset = offset;
47621762
BJ
1093 }
1094 if(offset > ooffset)
1095 {
1096 prspace(offset-ooffset);
1097 ooffset = offset;
1098 }
1099 if(type == TYCHAR)
1100 {
1101 if( rdlong(&vchar) )
1102 prch( (int) vchar );
1103 else
1104 fatal("bad intermediate file format");
1105 }
1106 else if(type == TYBLANK)
1107 {
1108 if( rdlong(&nblank) )
1109 {
1110 size = nblank;
1111 while( --nblank >= 0)
1112 prch( ' ' );
1113 }
1114 else
1115 fatal("bad intermediate file format");
1116 }
1117 else
1118 {
1119 putc('\t', asmfile);
1120 while ( putc( getc(sortfile), asmfile) != '\n')
1121 ;
1122 }
1123 if( (ooffset += size) > ovlen)
1124 {
1125 erred = YES;
1126 err("initialization out of bounds");
1127 }
1128 }
1129
1130prspace(ovlen-ooffset);
1131totlen = doeven(totlen+ovlen, (ALIDOUBLE>SZLONG ? ALIDOUBLE : SZLONG) );
1132clf(&sortfile);
1133clf(&asmfile);
1134clf(&sortfile);
1135rmf(sortfname);
1136return(erred);
1137}
1138
1139
1140
1141
1142prspace(n)
1143register ftnint n;
1144{
1145register ftnint m;
1146
1147while(nch>0 && n>0)
1148 {
1149 --n;
1150 prch(0);
1151 }
1152m = SZSHORT * (n/SZSHORT);
1153if(m > 0)
1154 prskip(asmfile, m);
1155for(n -= m ; n>0 ; --n)
1156 prch(0);
1157}
1158
1159
1160
1161
1162ftnint doeven(tot, align)
1163register ftnint tot;
1164int align;
1165{
1166ftnint new;
1167new = roundup(tot, align);
1168prspace(new - tot);
1169return(new);
1170}
1171
1172
1173
1174rdname(vargroupp, name)
1175int *vargroupp;
1176register char *name;
1177{
1178register int i, c;
1179
1180if( (c = getc(sortfile)) == EOF)
1181 return(NO);
1182*vargroupp = c - '0';
1183
1184for(i = 0 ; i<XL ; ++i)
1185 {
1186 if( (c = getc(sortfile)) == EOF)
1187 return(NO);
1188 if(c != ' ')
1189 *name++ = c;
1190 }
1191*name = '\0';
1192return(YES);
1193}
1194
1195
1196
1197rdlong(n)
1198register ftnint *n;
1199{
1200register int c;
1201
1202for(c = getc(sortfile) ; c!=EOF && isspace(c) ; c = getc(sortfile) );
1203 ;
1204if(c == EOF)
1205 return(NO);
1206
1207for(*n = 0 ; isdigit(c) ; c = getc(sortfile) )
1208 *n = 10* (*n) + c - '0';
1209return(YES);
1210}
1211
1212
1213
1214
1215prch(c)
1216register int c;
1217{
1218static int buff[SZSHORT];
1219
1220buff[nch++] = c;
1221if(nch == SZSHORT)
1222 {
1223 prchars(asmfile, buff);
1224 nch = 0;
1225 }
1226}