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