Commit | Line | Data |
---|---|---|
31cef89c | 1 | char *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 | ||
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" ; | |
31cef89c | 26 | static char *temppref = TEMPPREF; |
47621762 BJ |
27 | |
28 | static char *infname; | |
31cef89c BJ |
29 | static char textfname[40]; |
30 | static char asmfname[40]; | |
31 | static char asmpass2[40]; | |
32 | static char initfname[40]; | |
33 | static char sortfname[40]; | |
34 | static char prepfname[40]; | |
35 | static char objfdefault[40]; | |
36 | static char optzfname[40]; | |
37 | static char setfname[40]; | |
47621762 BJ |
38 | |
39 | static char fflags[50] = "-"; | |
31cef89c BJ |
40 | static 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 |
46 | static char rflags[30] = ""; |
47 | static char lflag[3] = "-x"; | |
48 | static char *fflagp = fflags+1; | |
49 | static char *cflagp = cflags+2; | |
31cef89c | 50 | static char *eflagp = eflags+12; |
47621762 BJ |
51 | static char *rflagp = rflags; |
52 | static char **loadargs; | |
53 | static char **loadp; | |
54 | ||
55 | static flag erred = NO; | |
56 | static flag loadflag = YES; | |
57 | static flag saveasmflag = NO; | |
58 | static flag profileflag = NO; | |
59 | static flag optimflag = NO; | |
60 | static flag debugflag = NO; | |
61 | static flag verbose = NO; | |
62 | static flag nofloating = NO; | |
63 | static flag fortonly = NO; | |
64 | static flag macroflag = NO; | |
31cef89c BJ |
65 | static flag sdbflag = NO; |
66 | ||
47621762 BJ |
67 | |
68 | \f | |
69 | main(argc, argv) | |
70 | int argc; | |
71 | char **argv; | |
72 | { | |
73 | int i, c, status; | |
31cef89c | 74 | char *setdoto(), *lastchar(), *lastfield(), *copys(); |
47621762 BJ |
75 | ptr ckalloc(); |
76 | register char *s; | |
77 | char fortfile[20], *t; | |
78 | char buff[100]; | |
79 | int intrupt(); | |
80 | ||
81 | sigivalue = (int) signal(SIGINT, SIG_IGN) & 01; | |
82 | sigqvalue = (int) signal(SIGQUIT,SIG_IGN) & 01; | |
83 | sighvalue = (int) signal(SIGHUP, SIG_IGN) & 01; | |
84 | sigtvalue = (int) signal(SIGTERM,SIG_IGN) & 01; | |
85 | enbint(intrupt); | |
86 | ||
87 | pid = getpid(); | |
88 | crfnames(); | |
89 | ||
90 | loadargs = (char **) ckalloc( (argc+20) * sizeof(*loadargs) ); | |
91 | loadargs[1] = "-X"; | |
92 | loadargs[2] = "-u"; | |
93 | #if HERE==PDP11 || HERE==VAX | |
94 | loadargs[3] = "_MAIN__"; | |
95 | #endif | |
96 | #if HERE == INTERDATA | |
97 | loadargs[3] = "main"; | |
98 | #endif | |
99 | loadp = loadargs + 4; | |
100 | ||
101 | --argc; | |
102 | ++argv; | |
103 | ||
104 | while(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 | } | |
267 | endfor: | |
268 | --argc; | |
269 | ++argv; | |
270 | } | |
271 | ||
272 | *fflagp = '\0'; | |
273 | ||
274 | loadargs[0] = ldname; | |
275 | #if TARGET == PDP11 | |
276 | if(nofloating) | |
277 | *loadp++ = (profileflag ? NOFLPROF : NOFLFOOT); | |
278 | else | |
279 | #endif | |
280 | *loadp++ = (profileflag ? proffoot : footname); | |
281 | ||
282 | for(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 | ||
380 | if(loadflag && !erred) | |
381 | doload(loadargs, loadp); | |
382 | done(erred); | |
383 | } | |
384 | \f | |
385 | dofort(s) | |
386 | char *s; | |
387 | { | |
388 | int retcode; | |
389 | char buff[200]; | |
390 | ||
391 | infname = s; | |
392 | sprintf(buff, "%s %s %s %s %s %s", | |
393 | pass1name, fflags, s, asmfname, initfname, textfname); | |
394 | switch( sys(buff) ) | |
395 | { | |
396 | case 1: | |
397 | goto error; | |
398 | case 0: | |
399 | break; | |
400 | default: | |
401 | goto comperror; | |
402 | } | |
403 | ||
404 | if(content(initfname) > 0) | |
405 | if( dodata() ) | |
406 | goto error; | |
407 | if( dopass2() ) | |
408 | goto comperror; | |
409 | doasm(s); | |
410 | retcode = 0; | |
411 | ||
412 | ret: | |
413 | rmf(asmfname); | |
414 | rmf(initfname); | |
415 | rmf(textfname); | |
416 | return(retcode); | |
417 | ||
418 | error: | |
419 | fprintf(diagfile, "\nError. No assembly.\n"); | |
420 | retcode = 1; | |
421 | goto ret; | |
422 | ||
423 | comperror: | |
424 | fprintf(diagfile, "\ncompiler error.\n"); | |
425 | retcode = 2; | |
426 | goto ret; | |
427 | } | |
428 | ||
429 | ||
430 | ||
431 | ||
432 | dopass2() | |
433 | { | |
434 | char buff[100]; | |
435 | ||
436 | if(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 | ||
457 | doasm(s) | |
458 | char *s; | |
459 | { | |
460 | register char *lastc; | |
461 | char *obj; | |
462 | char buff[200]; | |
31cef89c | 463 | char *lastchar(), *setdoto(); |
47621762 BJ |
464 | |
465 | if(*s == '\0') | |
466 | s = objfdefault; | |
467 | lastc = lastchar(s); | |
468 | obj = 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 | ||
486 | if(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 | } | |
497 | else | |
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 | ||
529 | rmf(asmpass2); | |
530 | } | |
531 | ||
532 | ||
533 | ||
534 | doload(v0, v) | |
535 | register char *v0[], *v[]; | |
536 | { | |
537 | char **p; | |
538 | int waitpid; | |
539 | ||
31cef89c BJ |
540 | if(sdbflag) |
541 | *v++ = "-lg"; | |
47621762 BJ |
542 | for(p = liblist ; *p ; *v++ = *p++) |
543 | ; | |
544 | ||
545 | *v++ = "-o"; | |
546 | *v++ = aoutname; | |
547 | *v = NULL; | |
548 | ||
549 | if(verbose) | |
550 | fprintf(diagfile, "LOAD."); | |
551 | if(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 | ||
579 | if(verbose) | |
580 | fprintf(diagfile, "\n"); | |
581 | } | |
582 | \f | |
583 | /* Process control and Shell-simulating routines */ | |
584 | ||
585 | sys(str) | |
586 | char *str; | |
587 | { | |
588 | register char *s, *t; | |
589 | char *argv[100], path[100]; | |
590 | char *inname, *outname; | |
591 | int append; | |
592 | int waitpid; | |
593 | int argc; | |
594 | ||
595 | ||
596 | if(debugflag) | |
597 | fprintf(diagfile, "%s\n", str); | |
598 | inname = NULL; | |
599 | outname = NULL; | |
600 | argv[0] = shellname; | |
601 | argc = 1; | |
602 | ||
603 | t = str; | |
604 | while( isspace(*t) ) | |
605 | ++t; | |
606 | while(*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 | ||
634 | if(argc == 1) /* no command */ | |
635 | return(-1); | |
636 | argv[argc] = 0; | |
637 | ||
638 | s = path; | |
639 | t = "/usr/bin/"; | |
640 | while(*t) | |
641 | *s++ = *t++; | |
642 | for(t = argv[1] ; *s++ = *t++ ; ) | |
643 | ; | |
644 | if((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 | ||
659 | return( await(waitpid) ); | |
660 | } | |
661 | ||
662 | ||
663 | ||
664 | ||
665 | ||
666 | #include "errno.h" | |
667 | ||
668 | /* modified version from the Shell */ | |
669 | texec(f, av) | |
670 | char *f; | |
671 | char **av; | |
672 | { | |
673 | extern int errno; | |
674 | ||
675 | execv(f, av+1); | |
676 | ||
677 | if (errno==ENOEXEC) | |
678 | { | |
679 | av[1] = f; | |
680 | execv(shellname, av); | |
681 | fatal("No shell!"); | |
682 | } | |
683 | if (errno==ENOMEM) | |
684 | fatalstr("%s: too large", f); | |
685 | } | |
686 | ||
687 | ||
688 | ||
689 | ||
690 | ||
691 | ||
692 | done(k) | |
693 | int k; | |
694 | { | |
695 | static int recurs = NO; | |
696 | ||
697 | if(recurs == NO) | |
698 | { | |
699 | recurs = YES; | |
700 | rmfiles(); | |
701 | } | |
702 | exit(k); | |
703 | } | |
704 | ||
705 | ||
706 | ||
707 | ||
708 | ||
709 | ||
710 | enbint(k) | |
711 | int (*k)(); | |
712 | { | |
713 | if(sigivalue == 0) | |
714 | signal(SIGINT,k); | |
715 | if(sigqvalue == 0) | |
716 | signal(SIGQUIT,k); | |
717 | if(sighvalue == 0) | |
718 | signal(SIGHUP,k); | |
719 | if(sigtvalue == 0) | |
720 | signal(SIGTERM,k); | |
721 | } | |
722 | ||
723 | ||
724 | ||
725 | ||
726 | intrupt() | |
727 | { | |
728 | done(2); | |
729 | } | |
730 | ||
731 | ||
732 | ||
733 | await(waitpid) | |
734 | int waitpid; | |
735 | { | |
736 | int w, status; | |
737 | ||
738 | enbint(SIG_IGN); | |
739 | while ( (w = wait(&status)) != waitpid) | |
740 | if(w == -1) | |
741 | fatal("bad wait code"); | |
742 | enbint(intrupt); | |
743 | if(status & 0377) | |
744 | { | |
745 | if(status != SIGINT) | |
746 | fprintf(diagfile, "Termination code %d", status); | |
747 | done(3); | |
748 | } | |
749 | return(status>>8); | |
750 | } | |
751 | \f | |
752 | /* File Name and File Manipulation Routines */ | |
753 | ||
754 | unreadable(s) | |
755 | register char *s; | |
756 | { | |
757 | register FILE *fp; | |
758 | ||
759 | if(fp = fopen(s, "r")) | |
760 | { | |
761 | fclose(fp); | |
762 | return(NO); | |
763 | } | |
764 | ||
765 | else | |
766 | { | |
767 | fprintf(diagfile, "Error: Cannot read file %s\n", s); | |
768 | return(YES); | |
769 | } | |
770 | } | |
771 | ||
772 | ||
773 | ||
774 | clf(p) | |
775 | FILEP *p; | |
776 | { | |
777 | if(p!=NULL && *p!=NULL && *p!=stdout) | |
778 | { | |
779 | if(ferror(*p)) | |
780 | fatal("writing error"); | |
781 | fclose(*p); | |
782 | } | |
783 | *p = NULL; | |
784 | } | |
785 | ||
786 | rmfiles() | |
787 | { | |
788 | rmf(textfname); | |
789 | rmf(asmfname); | |
790 | rmf(initfname); | |
791 | rmf(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 | */ | |
807 | content(filename) | |
808 | char *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 | ||
824 | if(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 | ||
836 | crfnames() | |
837 | { | |
838 | fname(textfname, "x"); | |
839 | fname(asmfname, "s"); | |
840 | fname(asmpass2, "a"); | |
841 | fname(initfname, "d"); | |
842 | fname(sortfname, "S"); | |
843 | fname(objfdefault, "o"); | |
844 | fname(prepfname, "p"); | |
845 | fname(optzfname, "z"); | |
846 | fname(setfname, "A"); | |
847 | } | |
848 | ||
849 | ||
850 | ||
851 | ||
852 | rmf(fn) | |
853 | register char *fn; | |
854 | { | |
855 | if(!debugflag && fn!=NULL && *fn!='\0') | |
856 | unlink(fn); | |
857 | } | |
858 | ||
859 | ||
860 | ||
861 | ||
862 | ||
863 | LOCAL fname(name, suff) | |
864 | char *name, *suff; | |
865 | { | |
31cef89c | 866 | sprintf(name, "%s%d.%s", temppref, pid, suff); |
47621762 BJ |
867 | } |
868 | ||
869 | ||
870 | ||
871 | ||
872 | dotchar(s) | |
873 | register char *s; | |
874 | { | |
875 | for( ; *s ; ++s) | |
876 | if(s[0]=='.' && s[1]!='\0' && s[2]=='\0') | |
877 | return( s[1] ); | |
878 | return(NO); | |
879 | } | |
880 | ||
881 | ||
882 | ||
883 | char *lastfield(s) | |
884 | register char *s; | |
885 | { | |
886 | register char *t; | |
887 | for(t = s; *s ; ++s) | |
888 | if(*s == '/') | |
889 | t = s+1; | |
890 | return(t); | |
891 | } | |
892 | ||
893 | ||
894 | ||
895 | char *lastchar(s) | |
896 | register char *s; | |
897 | { | |
898 | while(*s) | |
899 | ++s; | |
900 | return(s-1); | |
901 | } | |
902 | ||
903 | char *setdoto(s) | |
904 | register char *s; | |
905 | { | |
906 | *lastchar(s) = 'o'; | |
907 | return( lastfield(s) ); | |
908 | } | |
909 | ||
910 | ||
911 | ||
912 | badfile(s) | |
913 | char *s; | |
914 | { | |
915 | fatalstr("cannot open intermediate file %s", s); | |
916 | } | |
917 | ||
918 | ||
919 | ||
920 | ptr ckalloc(n) | |
921 | int n; | |
922 | { | |
923 | ptr p, calloc(); | |
924 | ||
925 | if( p = calloc(1, (unsigned) n) ) | |
926 | return(p); | |
927 | ||
928 | fatal("out of memory"); | |
929 | /* NOTREACHED */ | |
930 | } | |
931 | ||
932 | ||
933 | ||
934 | ||
935 | ||
31cef89c | 936 | char *copyn(n, s) |
47621762 BJ |
937 | register int n; |
938 | register char *s; | |
939 | { | |
940 | register char *p, *q; | |
941 | ||
942 | p = q = (char *) ckalloc(n); | |
943 | while(n-- > 0) | |
944 | *q++ = *s++; | |
945 | return(p); | |
946 | } | |
947 | ||
948 | ||
949 | ||
31cef89c | 950 | char *copys(s) |
47621762 BJ |
951 | char *s; |
952 | { | |
953 | return( copyn( strlen(s)+1 , s) ); | |
954 | } | |
955 | ||
956 | ||
957 | ||
958 | ||
959 | ||
960 | oneof(c,s) | |
961 | register c; | |
962 | register char *s; | |
963 | { | |
964 | while( *s ) | |
965 | if(*s++ == c) | |
966 | return(YES); | |
967 | return(NO); | |
968 | } | |
969 | ||
970 | ||
971 | ||
972 | nodup(s) | |
973 | char *s; | |
974 | { | |
975 | register char **p; | |
976 | ||
977 | for(p = loadargs ; p < loadp ; ++p) | |
978 | if( !strcmp(*p, s) ) | |
979 | return(NO); | |
980 | ||
981 | return(YES); | |
982 | } | |
983 | ||
984 | ||
985 | ||
986 | static fatal(t) | |
987 | char *t; | |
988 | { | |
989 | fprintf(diagfile, "Compiler error in file %s: %s\n", infname, t); | |
990 | if(debugflag) | |
991 | abort(); | |
992 | done(1); | |
993 | exit(1); | |
994 | } | |
995 | ||
996 | ||
997 | ||
998 | ||
999 | static fatali(t,d) | |
1000 | char *t; | |
1001 | int d; | |
1002 | { | |
1003 | char buff[100]; | |
1004 | sprintf(buff, t, d); | |
1005 | fatal(buff); | |
1006 | } | |
1007 | ||
1008 | ||
1009 | ||
1010 | ||
1011 | static fatalstr(t, s) | |
1012 | char *t, *s; | |
1013 | { | |
1014 | char buff[100]; | |
1015 | sprintf(buff, t, s); | |
1016 | fatal(buff); | |
1017 | } | |
1018 | err(s) | |
1019 | char *s; | |
1020 | { | |
1021 | fprintf(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 |
1026 | LOCAL int nch = 0; |
1027 | LOCAL FILEP asmfile; | |
1028 | LOCAL FILEP sortfile; | |
1029 | ||
1030 | #include "ftypes" | |
1031 | ||
1032 | static ftnint typesize[NTYPES] | |
1033 | = { 1, SZADDR, SZSHORT, SZLONG, SZLONG, 2*SZLONG, | |
1034 | 2*SZLONG, 4*SZLONG, SZLONG, 1, 1, 1}; | |
1035 | static int typealign[NTYPES] | |
1036 | = { 1, ALIADDR, ALISHORT, ALILONG, ALILONG, ALIDOUBLE, | |
1037 | ALILONG, ALIDOUBLE, ALILONG, 1, 1, 1}; | |
1038 | ||
1039 | dodata() | |
1040 | { | |
1041 | char buff[50]; | |
1042 | char varname[XL+1], ovarname[XL+1]; | |
1043 | int status; | |
1044 | flag erred; | |
1045 | ftnint offset, vlen, type; | |
1046 | register ftnint ooffset, ovlen; | |
1047 | ftnint nblank, vchar; | |
1048 | int size, align; | |
1049 | int vargroup; | |
1050 | ftnint totlen, doeven(); | |
1051 | ||
1052 | erred = NO; | |
1053 | ovarname[0] = '\0'; | |
1054 | ooffset = 0; | |
1055 | ovlen = 0; | |
1056 | totlen = 0; | |
1057 | nch = 0; | |
1058 | ||
1059 | sprintf(buff, "sort %s >%s", initfname, sortfname); | |
1060 | if(status = sys(buff)) | |
1061 | fatali("call sort status = %d", status); | |
1062 | if( (sortfile = fopen(sortfname, "r")) == NULL) | |
1063 | badfile(sortfname); | |
1064 | if( (asmfile = fopen(asmfname, "a")) == NULL) | |
1065 | badfile(asmfname); | |
1066 | pruse(asmfile, USEINIT); | |
1067 | ||
1068 | while( 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 | ||
1130 | prspace(ovlen-ooffset); | |
1131 | totlen = doeven(totlen+ovlen, (ALIDOUBLE>SZLONG ? ALIDOUBLE : SZLONG) ); | |
1132 | clf(&sortfile); | |
1133 | clf(&asmfile); | |
1134 | clf(&sortfile); | |
1135 | rmf(sortfname); | |
1136 | return(erred); | |
1137 | } | |
1138 | ||
1139 | ||
1140 | ||
1141 | ||
1142 | prspace(n) | |
1143 | register ftnint n; | |
1144 | { | |
1145 | register ftnint m; | |
1146 | ||
1147 | while(nch>0 && n>0) | |
1148 | { | |
1149 | --n; | |
1150 | prch(0); | |
1151 | } | |
1152 | m = SZSHORT * (n/SZSHORT); | |
1153 | if(m > 0) | |
1154 | prskip(asmfile, m); | |
1155 | for(n -= m ; n>0 ; --n) | |
1156 | prch(0); | |
1157 | } | |
1158 | ||
1159 | ||
1160 | ||
1161 | ||
1162 | ftnint doeven(tot, align) | |
1163 | register ftnint tot; | |
1164 | int align; | |
1165 | { | |
1166 | ftnint new; | |
1167 | new = roundup(tot, align); | |
1168 | prspace(new - tot); | |
1169 | return(new); | |
1170 | } | |
1171 | ||
1172 | ||
1173 | ||
1174 | rdname(vargroupp, name) | |
1175 | int *vargroupp; | |
1176 | register char *name; | |
1177 | { | |
1178 | register int i, c; | |
1179 | ||
1180 | if( (c = getc(sortfile)) == EOF) | |
1181 | return(NO); | |
1182 | *vargroupp = c - '0'; | |
1183 | ||
1184 | for(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'; | |
1192 | return(YES); | |
1193 | } | |
1194 | ||
1195 | ||
1196 | ||
1197 | rdlong(n) | |
1198 | register ftnint *n; | |
1199 | { | |
1200 | register int c; | |
1201 | ||
1202 | for(c = getc(sortfile) ; c!=EOF && isspace(c) ; c = getc(sortfile) ); | |
1203 | ; | |
1204 | if(c == EOF) | |
1205 | return(NO); | |
1206 | ||
1207 | for(*n = 0 ; isdigit(c) ; c = getc(sortfile) ) | |
1208 | *n = 10* (*n) + c - '0'; | |
1209 | return(YES); | |
1210 | } | |
1211 | ||
1212 | ||
1213 | ||
1214 | ||
1215 | prch(c) | |
1216 | register int c; | |
1217 | { | |
1218 | static int buff[SZSHORT]; | |
1219 | ||
1220 | buff[nch++] = c; | |
1221 | if(nch == SZSHORT) | |
1222 | { | |
1223 | prchars(asmfile, buff); | |
1224 | nch = 0; | |
1225 | } | |
1226 | } |