From:	CSBVAX::CSBVAX::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 24-JAN-1989 00:34
To:	MRGATE::"ARISIA::EVERHART"
Subj:	MAKE.SHAR (part 3 of 5; repackaged)


Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Mon, 23 JAN 89 18:55:13 PDT
Received: from ucbvax.Berkeley.EDU by KL.SRI.COM with TCP; Mon, 23 Jan 89 18:54:22 PST
Received: by ucbvax.Berkeley.EDU (5.61/1.33)
	id AA12913; Mon, 23 Jan 89 18:39:40 -0800
Received: from USENET by ucbvax.Berkeley.EDU with netnews
	for info-vax@kl.sri.com (info-vax@kl.sri.com)
	(contact usenet@ucbvax.Berkeley.EDU if you have questions)
Date: 23 Jan 89 17:38:54 GMT
From: tektronix!gvgpsa!gvgpvd!tony@ucbvax.Berkeley.EDU  (Tony Ivanov)
Organization: Grass Valley Group, Inc., Grass Valley, CA
Subject: MAKE.SHAR (part 3 of 5; repackaged)
Message-Id: <1013@gvgpvd.GVG.TEK.COM>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com


+-+-+-+ Beginning of part 3 +-+-+-+
X`009s1>s2:`009>0
X`009s1==s2:  0
X`009s1<s2:`009<0
X***********************************************************************/
X
X/* toupper() is  supposed to work  for all letters,  but PCC-20 does  it
Xincorrectly if the  argument is not  already lowercase; this  definition
Xfixes that.  PC histogramming of MAKE compiled with KCC-20 revealed that
X45% (!) of the  total execution time  is spent in  this function, and  a
Xfurther 15%  in  toupper().  With  KCC,  toupper() is  a  function,  and
Xislower() and  _toupper()  are in-line.   Putting  in a  conditional  is
Xtherefore  extremely   worthwhile   here,  and   saved   24%.    Further
Xeconomization by rewriting the inner loop to avoid the UC() calls unless
Xnecessary gave a further improvement of only 2%. */
X
Xint
Xstrcm2(s1, s2)
Xregister char *s1;
Xregister char *s2;
X`123
X
X#ifdef KCC_20
X#define UC(c) (islower(c) ? _toupper(c) : c)
X    while (*s1)
X    `123
X`009if (*s1 == *s2)
X`009    /* NO-OP */;
X`009else if (UC(*s1) == UC(*s2))
X`009    /* NO-OP */;
X`009else
X`009    break;
X`009s1++;
X`009s2++;
X    `125
X#else
X#define UC(c) (islower(c) ? toupper(c) : c)
X    while ((*s1) && (UC(*s1) == UC(*s2)))
X    `123
X`009s1++;
X`009s2++;
X    `125
X#endif
X
X    return ((int) (UC(*s1) - UC(*s2)));
X`125
X
X#endif
$ GOSUB UNPACK_FILE
$ FILE_IS = "MAKE.C"
$ CHECKSUM_IS = 122634619
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/*
X *`009Do the actual making for make
X */
X
X#include "h.h"
X
X#ifdef EON
X#include <sys/stat.h>
X#include <sys/err.h>
X#endif
X
X#ifdef KCC_20
X#include <stat.h>
X#include <errno.h>
X#endif
X
X#ifdef MSC
X#include <sys/stat.h>
X#include <errno.h>
X#endif
X
X#ifdef OS9
X#include <time.h>
X#include <os9.h>
X#include <modes.h>
X#include <direct.h>
X#include <errno.h>
X#endif
X
X#ifdef UNIX
X#include <sys/stat.h>
X#include <sys/errno.h>
X#endif
X
X#ifdef VMS
X#include <stat.h>
X#include <errno.h>
X#include <file.h>
Xbool readlibdate();
X#endif
X
X/*
X *`009Exec a shell that returns exit status correctly (/bin/esh).
X *`009The standard EON shell returns the process number of the last
X *`009async command, used by the debugger (ugg).
X *`009[exec on eon is like a fork+exec on unix]
X */
Xint
Xdosh(string, shell)
Xchar *string;
Xchar *shell;
X`123
X
X#ifdef EON
X    int number;
X
X    return ((number = execl(shell, shell, "-c", string, 0)) == -1) ?
X`009-1 :`009`009`009/* couldn't start the shell */
X`009wait(number);`009`009/* return its exit status */
X#endif
X
X#ifdef KCC_20
X    return (system(string));
X#endif
X
X#ifdef MSC
X    return (system(string));
X#endif
X
X#ifdef OS9
X    int number,
X        pid,
X        status;
X
X    strcat(string, "\n");
X    if ((number = os9fork(shell, strlen(string), string, 0, 0, 0)) == -1)
X`009return -1;`009`009/* Couldn't start a shell */
X    do
X    `123
X`009if ((pid = wait(&status)) == -1)
X`009    return -1;`009`009/* child already died!?!? */
X    `125 while (pid != number);
X
X    return status;
X#endif
X
X#ifdef UNIX
X    return (system(string));
X#endif
X
X#ifdef VMS
X    return (system(string));
X#endif
X
X`125
X
X
X/*
X *`009Do commands to make a target
X */
Xvoid
Xdocmd2(np, lp)
XNAMEP np;
XLINEP lp;
X`123
X    bool ssilent;
X    bool signore;
X    int estat;
X    register char *q;
X    register char *p;
X    char *shell;
X    register CMDP cp;
X
X
X    if (*(shell = getmacro("SHELL")) == '\0')
X#ifdef EON
X`009shell = ":bin/esh";
X#endif
X
X#ifdef KCC_20
X    shell = "SYSTEM:EXEC.EXE";
X#endif
X
X#ifdef MSC
X    shell = getenv("COMSPEC");
X    if (shell == (char *) NULL)
X`009shell = "command.com";
X#endif
X
X#ifdef OS9
X    shell = "shell";
X#endif
X
X#ifdef UNIX
X    shell = "/bin/sh";
X#endif
X
X#ifdef VMS
X    shell = "SYS$SYSTEM:DCL.EXE";
X#endif
X
X    for (cp = lp->l_cmd; cp; cp = cp->c_next)
X    `123
X`009strcpy(str1, cp->c_cmd);
X`009expand(str1);
X`009q = str1;
X`009ssilent = silent;
X`009signore = ignore;
X`009while ((*q == '@') `124`124 (*q == '-'))
X`009`123
X`009    if (*q == '@')`009/* Specific silent  */
X`009`009ssilent = TRUE;
X`009    else`009`009/* Specific ignore  */
X`009`009signore = TRUE;
X`009    q++;`009`009/* Not part of the command  */
X`009`125
X
X`009if (!domake)
X`009    ssilent = 0;
X
X#ifdef VMS
X`009if (!ssilent)
X`009`123   fputs("$ ", stdout); /* need $ for output to .COM file */
X`009    fputs(q, stdout);
X`009`125
X#else
X
X`009for (p = q; *p; p++)
X`009`123
X`009    if (*p == '\n' && p[1] != '\0')
X`009    `123
X#ifndef KCC_20
X`009`009/* TOPS-20 MAKE permits newlines to allow multiline system()
X`009`009   calls */
X`009`009*p = ' ';
X#endif
X`009`009if (!ssilent)
X`009`009    fputs(MORE, stdout);
X`009    `125
X`009    else
X`009    if (!ssilent)
X`009`009putchar((char) (*p));
X`009`125
X#endif
X`009if (!ssilent)
X`009    putchar('\n');
X
X`009if (domake)
X`009`123`009`009`009/* Get the shell to execute it  */
X#ifndef VMS
X`009    if ((estat = dosh(q, shell)) != 0)
X#else
V`009    if ((((estat = dosh(q, shell)) & 1) != 1) &&`009/* Check for lsb rese
Xt (even number). */
V`009 `009 ((estat & 6) != 0))`009`009`009`009/* Check for non-warning message
Xs. */
X#endif
X`009    `123
X`009`009if (estat == -1)
X`009`009`123
X`009`009    sprintf(str1, "Couldn't execute %s",
X`009`009`009    shell);
X`009`009    fatal(str1);
X`009`009`125
X`009`009else
X`009`009`123
X`009`009    printf("%s: Error code %d",
X`009`009`009   myname, estat);
X`009`009    if (signore)
X`009`009`009fputs(" (Ignored)\n", stdout);
X`009`009    else
X`009`009    `123
X`009`009`009putchar('\n');
X`009`009`009if (!(np->n_flag & N_PREC))
X`009`009`009    if (unlink(np->n_name) == 0)
X`009`009`009`009printf("%s: `096%s' removed.\n",
X`009`009`009`009       myname, np->n_name);
X`009`009`009EXIT(estat);
X`009`009    `125
X`009`009`125
X`009    `125
X`009`125
X    `125
X`125
X
X
Xvoid
Xdocmds(np)
XNAMEP np;
X`123
X    register LINEP lp;
X
X    for (lp = np->n_line; lp; lp = lp->l_next)
X`009docmd2(np, lp);
X`125
X
X
X#ifdef OS9
X/*
X *`009Some stuffing around to get the modified time of a file
X *`009in an os9 file system
X */
Xgetmdate(fd, tbp)
Xstruct sgtbuf *tbp;
X`123
X    struct registers regs;
X    static struct fildes fdbuf;
X
X
X    regs.rg_a = fd;
X    regs.rg_b = SS_FD;
X    regs.rg_x = &fdbuf;
X    regs.rg_y = sizeof(fdbuf);
X
X    if (_os9(I_GETSTT, &regs) == -1)
X    `123
X`009errno = regs.rg_b & 0xff;
X`009return -1;
X    `125
X    if (tbp)
X    `123
X`009_strass(tbp, fdbuf.fd_date, sizeof(fdbuf.fd_date));
X`009tbp->t_second = 0;`009/* Files are only accurate to mins */
X    `125
X    return 0;
X`125
X
X
X/*
X *`009Kludge routine to return an aproximation of how many
X *`009seconds since 1980.  Dates will be in order, but will not
X *`009be linear
X */
Xtime_t
Xcnvtime(tbp)
Xstruct sgtbuf *tbp;
X`123
X    long acc;
X
X
X    acc = tbp->t_year - 80;`009/* Baseyear is 1980 */
X    acc = acc * 12 + tbp->t_month;
X    acc = acc * 31 + tbp->t_day;
X    acc = acc * 24 + tbp->t_hour;
X    acc = acc * 60 + tbp->t_minute;
X    acc = acc * 60 + tbp->t_second;
X
X    return acc;
X`125
X
X
X/*
X *`009Get the current time in the internal format
X */
Xtime(tp)
Xtime_t *tp;
X`123
X    struct sgtbuf tbuf;
X
X
X    if (getime(&tbuf) < 0)
X`009return -1;
X
X    if (tp)
X`009*tp = cnvtime(&tbuf);
X
X    return 0;
X`125
X
X#endif
X
X
X/*
X *`009Get the modification time of a file.  If the first
X *`009doesn't exist, it's modtime is set to 0.
X */
Xvoid
Xmodtime(np)
XNAMEP np;
X`123
X#ifdef EON
X    struct stat info;
X    int fd;
X
X    errno = 0;`009`009`009/* clear error code in case of left-over
X`009`009`009`009   value */
X    if ((fd = open(np->n_name, 0)) < 0)
X    `123
X`009if (errno != ER_NOTF)
X`009`123
X`009    sprintf(str1, "Can't open %s; error %02x",
X`009`009    np->n_name, errno);
X`009    fatal(str1);
X`009`125
X`009np->n_time = NOTIME;
X    `125
X    else
X    if (getstat(fd, &info) < 0)
X    `123
X`009sprintf(str1, "Can't getstat %s; error %02x", np->n_name, errno);
X`009fatal(str1);
X    `125
X
X    else
X`009np->n_time = info.st_mod;
X
X    close(fd);
X#endif
X
X#ifdef KCC_20
X    struct stat info;
X
X    errno = 0;`009`009`009/* clear error code in case of left-over
X`009`009`009`009   value */
X    if (stat(np->n_name, &info) < 0)
X    `123
X`009if (errno == 0)`009`009/* KCC doesn't set errno if file does not
X`009`009`009`009   exist */
X`009    errno = ENOENT;
X`009if (errno != ENOENT)
X`009`123
X`009    sprintf(str1, "Can't open %s; error %d", np->n_name, errno);
X`009    fatal(str1);
X`009`125
X`009np->n_time = NOTIME;
X    `125
X    else
X`009np->n_time = info.st_mtime;
X#endif
X
X#ifdef MSC
X    struct stat info;
X
X    errno = 0;`009`009`009/* clear error code in case of left-over
X`009`009`009`009   value */
X    if (stat(np->n_name, &info) < 0)
X    `123
X`009if (errno != ENOENT)
X`009`123
X`009    sprintf(str1, "Can't open %s; error %d",
X`009`009    np->n_name, errno);
X`009    fatal(str1);
X`009`125
X`009np->n_time = NOTIME;
X    `125
X    else
X`009np->n_time = info.st_mtime;
X#endif
X
X#ifdef OS9
X    struct sgtbuf info;
X    int fd;
X
X    errno = 0;`009`009`009/* clear error code in case of left-over
X`009`009`009`009   value */
X    if ((fd = open(np->n_name, 0)) < 0)
X    `123
X`009if (errno != E_PNNF)
X`009`123
X`009    sprintf(str1, "Can't open %s; error %02x",
X`009`009    np->n_name, errno);
X`009    fatal(str1);
X`009`125
X`009np->n_time = NOTIME;
X    `125
X    else
X    if (getmdate(fd, &info) < 0)
X    `123
X`009sprintf(str1, "Can't getstat %s; error %02x",
X`009`009np->n_name, errno);
X`009fatal(str1);
X    `125
X
X    else
X`009np->n_time = cnvtime(&info);
X
X    close(fd);
X#endif
X
X#ifdef UNIX
X    struct stat info;
X
X    errno = 0;`009`009`009/* clear error code in case of left-over
X`009`009`009`009   value */
X    if (stat(np->n_name, &info) < 0)
X    `123
X`009if (errno != ENOENT)
X`009`123
X`009    sprintf(str1, "Can't open %s; error %d",
X`009`009    np->n_name, errno);
X`009    fatal(str1);
X`009`125
X`009np->n_time = NOTIME;
X    `125
X    else
X`009np->n_time = info.st_mtime;
X#endif
X
X#ifdef VMS
X    struct stat info;
X    char* rparen;
X    char* libname;
X    char* modname;
X    unsigned long libdate[2];
X
X    errno = 0;`009`009/* clear error code in case of left-over value */
X    np->n_time = NOTIME;
X
X    if (index(np->n_name,'(') != (char*)NULL)
X    `123`009`009`009/* should have "libname.xlb(modulename)" */
X`009libname = malloc(strlen(np->n_name)+1);
X`009(void)strcpy(libname,np->n_name);
X`009modname = index(libname,'(');
X`009*modname++ = '\0';
X`009rparen = index(modname,')');
X`009if (rparen != (char*)NULL)
X`009`123
X`009    *rparen = '\0';
X`009    (void) setmacro("@", libname, TEMPORARY);
X`009    (void) setmacro("%", modname, TEMPORARY);
X`009    if (readlibdate(libname,modname,libdate))
X`009`009np->n_time = SHELL$FIX_TIME(libdate);
X`009`125
X`009(void)free(libname);
X    `125
X    else if (stat(np->n_name, &info) < 0)
X    `123`009`009`009`009/* stat() in VMS C 2.0 (VMS 4.4) does not set
X`009`009`009`009   errno, sigh... */
X`009if (errno && (errno != ENOENT))
X`009`123
X`009    sprintf(str1, "Can't open %s; error %d", np->n_name, errno);
X`009    fatal(str1);
X`009`125
X    `125
X    else
X`009np->n_time = info.st_mtime;
X#endif
X
X    if (debug)
X    `123
X`009fprintf(stderr, "TIME[%s] = %ld\n", np->n_name, (long) np->n_time);
X    `125
X`125
X
X
X/*
X *`009Update the mod time of a file to now.
X */
Xvoid
Xtouch(np)
XNAMEP np;
X`123
X    if (!domake `124`124 !silent)
X`009printf("    touch(%s)\n", np->n_name);
X
X    if (domake)
X    `123
X
X#ifdef EON
X`009char c;
X`009int fd;
X
X`009if ((fd = open(np->n_name, 0)) < 0)
X`009    printf("%s: `096%s' not touched - non-existant\n",
X`009`009   myname, np->n_name);
X`009else
X`009`123
X`009    uread(fd, &c, 1, 0);
X`009    uwrite(fd, &c, 1);
X`009`125
X`009close(fd);
X#endif
X
X#ifdef KCC_20
X`009static int first = 1;
X
X`009if (first)
X`009    printf("touch not implemented for KCC-20 (no utime())\n");
X`009first = 0;
X#endif
X
X#ifdef MSC
X`009struct utimbuf a[2];
X
X`009a[0].modtime = a[1].modtime = time((time_t *) NULL);
X`009if (utime(np->n_name, &a[0]) < 0)
X`009    printf("%s: `096%s' not touched - non-existant\n",
X`009`009   myname, np->n_name);
X#endif
X
X#ifdef OS9
X`009int fd;
X
X`009/* Strange that something almost as totally useless as this is easy
X`009   to do in os9! */
X`009if ((fd = open(np->n_name, S_IWRITE)) < 0)
X`009    printf("%s: `096%s' not touched - non-existant\n",
X`009`009   myname, np->n_name);
X`009close(fd);
X#endif
X
X#ifdef UNIX
X`009long a[2];
X
X`009a[0] = a[1] = time((time_t *) NULL);
X`009if (utime(np->n_name, &a[0]) < 0)
X`009    printf("%s: `096%s' not touched - non-existant\n",
X`009`009   myname, np->n_name);
X#endif
X
X#ifdef VMS
X`009int`009fd;
X
X`009if ((fd = open (np->n_name, O_RDWR `124 O_CREAT, 0)) < 0)
X`009`009fprintf (stderr, "touch: cannot access '%s'.\n", np->n_name);
X`009else
X`009`009close (fd);
X#endif
X
X    `125
X`125
X
X
X/*
X *`009Recursive routine to make a target.
X */
Xint
Xmake(np, level)
Xregister NAMEP np;
Xint level;
X`123
X    register DEPENDP dp;
X    register LINEP lp;
X    register DEPENDP qdp;
X    time_t dtime = (time_t)1;
X    char* dname = "";
X    bool didsomething = 0;
X
X
X    if (np->n_flag & N_DONE)
X`009return 0;
X
X    if (!np->n_time)
X`009modtime(np);`009`009/* get modtime of this file */
X
X    if (debug)
X    `123
X`009fprintf(stderr, "MAKE[%s,%d]:%cTIME[%ld]\n", np->n_name, (int) level,
X`009`009TAB, (long) np->n_time);
X`009prtname(np, level + 1);`009/* use level+1 for print indentation */
X    `125
X
X    for (lp = np->n_line; lp; lp = lp->l_next)
X`009if (lp->l_cmd)
X`009    break;
X    if (!lp)
X`009(void) dyndep(np);
X
X    if (!(np->n_flag & N_TARG) && np->n_time == NOTIME)
X    `123
X`009sprintf(str1, "Don't know how to make %s", np->n_name);
X`009fatal(str1);
X    `125
X
X
X    for (qdp = NULL_DEPENDP, lp = np->n_line; lp; lp = lp->l_next)
X    `123
X`009for (dp = lp->l_dep; dp; dp = dp->d_next)
X`009`123
X`009    (void) make(dp->d_name, level + 1);
X`009    if (np->n_time < dp->d_name->n_time)
X`009`009qdp = newdep(dp->d_name, qdp);
X`009    if (dtime < dp->d_name->n_time)
X`009    `123
X`009        dtime = dp->d_name->n_time;
X`009`009dname = dp->d_name->n_name;
X`009    `125
X
X`009`125
X`009if (!quest && (np->n_flag & N_DOUBLE) && (np->n_time < dtime))
X`009`123
X`009    make1(np, lp, qdp);`009/* free()'s qdp */
X`009    dtime = (time_t)1;
X`009    dname = "";
X`009    qdp = NULL_DEPENDP;
X`009    didsomething++;
X`009`125
X    `125
X
X    np->n_flag `124= N_DONE;
X
X    if (quest)
X    `123
X`009long t;
X
X`009t = np->n_time;
X`009time(&np->n_time);
X`009return (t < dtime);
X    `125
X    else if ((np->n_time < dtime) && !(np->n_flag & N_DOUBLE))
X    `123
X`009if (debug)
X`009`123
X`009    fprintf(stderr,
X`009    "%cFILE[%s]: TIME[%ld] older than dependent FILE[%s]: TIME[%ld]\n",
X`009`009    TAB, np->n_name, (long)np->n_time, dname, (long)dtime);
X`009`125
X`009make1(np, NULL_LINEP, qdp);`009/* free()'s qdp */
X
X#ifdef MAYBE_REVERT
X/* WRONG!! Must not change dependent time to current time.   Otherwise target
X   will always be found older than its dependents.
X`009`009time(&np->n_time);
X   Get real modification time instead!! */
X
X`009modtime(np);
X#else
X`009time(&np->n_time);
X#endif
X    `125
X    else
X    if (level == 0 && !didsomething)
X`009printf("%s: `096%s' is up to date\n", myname, np->n_name);
X    return 0;
X`125
X
Xvoid
Xmake1(np, lp, qdp)
Xregister DEPENDP qdp;
XLINEP lp;
XNAMEP np;
X`123
X    register DEPENDP dp;
X
X
X    if (debug)
X    `123
X`009fprintf(stderr, "MAKE1[%s]:%cTIME[%ld]",
X`009`009np->n_name, TAB, (long) np->n_time);
X`009if ((lp != NULL_LINEP) && (lp->l_cmd != NULL_CMDP))
X`009    fprintf(stderr, "%cCMD[%s%s]", TAB,
X`009`009    (lp->l_cmd->c_cmd != NULL_CHARP) ? lp->l_cmd->c_cmd : "",
X`009`009    (lp->l_cmd->c_next != NULL_CMDP) ? " etc." : "");
X`009fprintf(stderr, "\n");
X    `125
X
X    if (dotouch)
X`009touch(np);
X    else
X    `123
X`009strcpy(str1, "");
X`009for (dp = qdp; dp; dp = qdp)
X`009`123
X`009    if (strlen(str1))
X`009`009strcat(str1, " ");
X`009    strcat(str1, dp->d_name->n_name);
X`009    qdp = dp->d_next;
X`009    free((char *) dp);
X`009`125
X`009(void) setmacro("?", str1, TEMPORARY);
X`009(void) setmacro("@", np->n_name, TEMPORARY);
X`009if (lp)`009`009`009/* lp set if doing a :: rule */
X`009    docmd2(np, lp);
X`009else
X`009    docmds(np);
X    `125
X`125
X
Xvoid
Xprtcmd(cp, level)`009`009/* print entire CMD list headed by cp */
XCMDP cp;
Xint level;
X`123
X    register CMDP fcp;
X    register CMDP tcp;
X
X    if (level > debug)
X`009return;
X    fcp = NULL_CMDP;
X    for (tcp = cp; tcp && (tcp != fcp); tcp = tcp->c_next)
X    `123
X`009prtlevel(level);
X`009fprintf(stderr, "CMD[%lo]: c_next: %lo; c_cmd: %lo \"%s\"\n",
X`009`009(long) tcp, (long) tcp->c_next, (long) tcp->c_cmd,
X`009`009(tcp->c_cmd != NULL_CHARP) ? tcp->c_cmd : "");
X`009fcp = cp;
X    `125
X`125
X
X
Xvoid
Xprtdepend(dp, level)`009`009/* print entire DEPEND list headed by dp */
XDEPENDP dp;
Xint level;
X`123
X    register DEPENDP fdp;
X    register DEPENDP tdp;
X
X    if (level > debug)
X`009return;
X    fdp = NULL_DEPENDP;
X    for (tdp = dp; tdp && (tdp != fdp); tdp = tdp->d_next)
X    `123
X`009prtlevel(level);
X`009fprintf(stderr, "DEPEND[%lo]: d_next: %lo; d_name: %lo\n",
X`009`009(long) tdp, (long) tdp->d_next, (long) tdp->d_name);
X`009prtname(tdp->d_name, level + 1);
X`009fdp = dp;
X    `125
X`125
X
X
Xvoid
Xprtlevel(level)
Xint level;
X`123
X    register int k;
X
X    if (level > debug)
X`009return;
X    else
X    if (level == 0)
X`009fprintf(stderr, "\n\n");
X    else
X`009for (k = 0; k < level; ++k)
X`009    fprintf(stderr, "  ");
X`125
X
X
Xvoid
Xprtline(lp, level)`009`009/* print entire LINE list headed by lp */
XLINEP lp;
Xint level;
X`123
X    register LINEP flp;
X    register LINEP tlp;
X
X    if (level > debug)
X`009return;
X    flp = NULL_LINEP;
X    for (tlp = lp; tlp && (tlp != flp); tlp = tlp->l_next)
X    `123
X`009prtlevel(level);
X`009fprintf(stderr,
X`009`009"LINE[%lo]: l_next: %lo; l_dep: %lo; l_cmd: %lo\n",
X`009`009(long) tlp, (long) tlp->l_next, (long) tlp->l_dep,
X`009`009(long) tlp->l_cmd);
X`009prtdepend(tlp->l_dep, level + 1);
X`009prtcmd(tlp->l_cmd, level + 1);
X`009flp = lp;
X    `125
X`125
X
Xvoid
Xprtname(np, level)`009`009/* print **single** NAME entry np */
XNAMEP np;
Xint level;
X`123
X    if (level > debug)
X`009return;
X    prtlevel(level);
X    fprintf(stderr,
X`009    "NAME[%lo]: n_next: %lo; n_name: %lo \"%s\"; n_line: %lo; \
Xn_time: %ld; n_flag: %03o",
X`009    (long) np, (long) np->n_next, (long) np->n_name,
X`009    (np->n_name != NULL_CHARP) ? np->n_name : "",
X`009    (long) np->n_line, (long) np->n_time, (int) np->n_flag);
X    if (np->n_flag)
X`009fprintf(stderr, "[%s%s%s%s%s ]",
X`009`009(np->n_flag & N_MARK) ? " N_MARK" : "",
X`009`009(np->n_flag & N_DONE) ? " N_DONE" : "",
X`009`009(np->n_flag & N_TARG) ? " N_TARG" : "",
X`009`009(np->n_flag & N_PREC) ? " N_PREC" : "",
X`009`009(np->n_flag & N_DOUBLE) ? " N_DOUBLE" : "");
X    fprintf(stderr, "\n");
X    prtline(np->n_line, level + 1);
X`125
X
X
X#ifdef VMS
X/* readlibdate
X *
X *`009Read the date of the specified module from the specified library
X *`009and return the date of the module into "date".
X *
X *`009This function was written and placed in the public domain by
X *
X *`009Todd Aven
X *`009The Softwear Sweatshop
X *`0097833 Walker Drive, Suite 308
X *`009Greenbelt, MD 20770
X *`009Tel: (301) 345-1692
X*/
X
Xstatic void upcase();
X
Xbool
Xreadlibdate(library, module, libdate)
Xchar *library;
Xchar *module;
Xunsigned long libdate[2];
X`123
X    static unsigned long index = 0;
X    static unsigned long readop = 1;
X    static unsigned long buffer[50];
X    static int initflag = TRUE;
X    static struct
X    `123
X`009short int len;
X`009short int typeclass;
X`009char *addr;
X    `125   d =
X    `123
X`009    0, 0x010e, 0
X    `125  ,
X        key =
X    `123
X`009    0, 0x010e, 0
X    `125  ,
X        buf =
X    `123
X`009    200, 0x010e, &buffer
X    `125;
X    int buflen;
X    int k;
X    int k2;
X    char *l2;
X    char *l;
X    unsigned long rfa[2];
X    unsigned long s1;
X    unsigned long s2;
X
X    k = strlen(library);
X    l = malloc(k+1);
X    if (l == (char*)NULL)
X`009fatal("No memory for name");
X    else
X`009(void)strcpy(l,library);
X
X    upcase(l);
X/*`009`009Always re-open and close it to avoid file access conflicts later.
X    if (initflag)
X    `123
X */
X`009d.addr = l;
X`009d.len = k;
X`009initflag = FALSE;
X`009s1 = lbr$ini_control(&index, &readop, 0, 0);
X`009s2 = lbr$open(&index, &d);
X`009if (!(s1 & s2 & 0x01))
X`009`123
X`009    free(l);
X`009    initflag = TRUE;
X`009    return FALSE;
X`009`125
X/*    `125
X    else
X    if (!strcmp(l, d.addr))
X    `123
X`009lbr$close(&index);
X`009free(d.addr);
X`009d.addr = l;
X`009d.len = k;
X`009s1 = lbr$ini_control(&index, &readop, 0, 0);
X`009s2 = lbr$open(&index, &d);
X`009if (!(s1 & s2 & 0x01))
X`009`123
X`009    free(l);
X`009    initflag = TRUE;
X`009    return FALSE;
X`009`125
X    `125
X */
X    k2 = strlen(module);
X    l2 = malloc(k2+1);
X    if (l2 == (char*)NULL)
X`009fatal("No memory for name");
X    else
X`009(void)strcpy(l2,module);
X
X    upcase(l2);
X    key.len = k2;
X    key.addr = l2;
X    s1 = lbr$lookup_key(&index, &key, rfa);
X    if (s1 & 0x01)
X`009s2 = lbr$set_module(&index, rfa, &buf, &buflen, 0);
X    free(l2);
X`009/* --- This stuff added to avoid file access conflicts later --- */
X    free(l);
X    lbr$close(&index);
X`009/* --- end of stuff --- */
X    if (!(s1 & 0x01) `124`124 !(s2 & 0x01) `124`124 (buflen < 16))
X`009return FALSE;
X    libdate[0] = buffer[2];
X    libdate[1] = buffer[3];
X    return TRUE;
X`125
X
Xstatic void
Xupcase(string)
Xchar *string;
X`123
X    char *point = string;
X    while (*point)
X    `123
X`009*point = toupper(*point);
X`009point++;
X    `125
X`125
X
X#endif
$ GOSUB UNPACK_FILE
$ FILE_IS = "READER.C"
$ CHECKSUM_IS = 1331659007
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/*
X *`009Read in makefile
X */
X
X
X#include "h.h"
X
X
Xint lineno;
X
X
X/*
X *`009Syntax error handler.  Print message, with line number, and exits.
X */
Xvoid
Xerror(msg)
Xchar *msg;
X`123
X    static bool entered = FALSE;
X
X    if (entered)`009`009/* unexpected recursive entry */
X`009EXIT(1);
X    entered = TRUE;
X
X    fprintf(stderr, "%s: ", myname);
X    fprintf(stderr, msg);
X    if (lineno)
X`009fprintf(stderr, " near line %d", lineno);
X    fputc('\n', stderr);
X    if (debug)
X    `123
X`009NAMEP tnp;
X
X`009prt();
X`009for (tnp = namehead.n_next; tnp; tnp = tnp->n_next)
X`009    prtname(tnp, 0);
X    `125
X    EXIT(1);
X`125
X
X
X/*
X *`009Read a line into the supplied string of length MAXSTRING.  Remove
X *`009comments, ignore blank lines. Deal with`009quoted (\) #, and
X *`009quoted newlines.  If EOF return TRUE.
X */
Xbool
Xgetline(str, fd)
Xchar *str;
XFILE *fd;
X`123
X    register char *p;
X    char *q;
X    int pos = 0;
X    bool trim;
X
X    trim = FALSE;
X    for (;;)
X    `123
X`009if (fgets(str + pos, MAXSTRING - pos, fd) == NULL_CHARP)
X`009    return TRUE;`009/* EOF  */
X
X`009lineno++;
X
X`009if ((p = index(str + pos, '\n')) == NULL_CHARP)
X`009`123
X`009    p = index(str + pos, '\0');
X`009    if ((int)(p - (str + pos)) < (MAXSTRING - pos))
X`009    `123
X`009        fprintf(stderr, "%s: ", myname);
X`009`009fprintf(stderr,
X`009`009    "Warning: Line %d is missing a final newline character\n",
X`009`009    lineno);
X`009`009fprintf(stderr,"An implicit newline has been assumed\n");
X`009`009*p++ = '\n';
X`009`009*p = '\0';
X`009    `125
X`009    else
X`009        error("Line too long");
X`009`125
X
X
X`009if (trim)
X`009`123`009`009`009/* strip leading space from continued line */
X`009    p = str + pos;
X`009    while (*p && isspace(*p))
X`009`009++p;
X`009    if (str + pos != p)
X`009`009strcpy(str + pos, p);
X`009    p = index(str + pos, '\n');
X`009`125
X
X`009trim = (bool) (p[-1] == '\\');
X`009if (trim)
X`009`123`009`009`009/* <backslash><newline><whitespace> become
-+-+-+-+-+ End of part 3 +-+-+-+-+-
-- 
/* My opinions...             *  Tony Ivanov   MS-4B       *  ...ucbvax!   */
/* shared by my company?!...  *  Grass Valley Group, Inc.  *  tektronix!   */
/* you've got to be kidding!  *  P.O. Box 1114             *  gvgpsa!      */
/* "tony@gvgpvd.GVG.TEK.COM"  *  Grass Valley, CA  95945   *  gvgpvd!tony  */

