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