awp8101@ritcv.UUCP (Andrew W. Potter) (02/09/88)
$Part8:
$ File_is="MKSHOW.C"
$ Check_Sum_is=2050559717
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X/*
XMAKE version 1.1, April 1987
XCopyright (C) 1987 by Jesse Perry.
XMAKE is in the public domain and may be freely distributed,
Xused, and modified, provided this notice is not removed.
X
Xmkshow.c
XThis file contains various routines to print MAKE data structures.
X*/
X
X#include "make.h"
X
X/* Print the contents of a list of MAKE_TARGETs. */
X
Xshow_target(tgptr, tgtype)
Xregister MAKE_TARGET *tgptr;
Xint tgtype;
X{
X`009static char *stmt_type[] = {
X`009`009"named macros",
X`009`009"default rules",
X`009`009"dependency statements"
X`009};
X
X`009if (tgptr == NULL) {
X`009`009printf("%c No %s.%c%c", OPEN_COMMENT, stmt_type[tgtype],
X`009`009 CLOSE_COMMENT, (CLOSE_COMMENT == '\n' ? '\0' : '\n'));
X`009`009return;
X`009}
X
X`009do {
X`009`009show_token(tgptr->tg_name, FALSE);
X`009`009printf(" %c ",
X`009`009 (tgtype == STMT_MACRO ? DEFINE_MACRO : DEPENDENCY));
X`009`009show_token(tgptr->tg_dep, FALSE);
X`009`009putchar('\n');
X`009`009show_command(tgptr->tg_cmd);
X`009} while ((tgptr = tgptr->tg_next) != NULL);
X}
X
X/* Print a list of command lines as they might appear in a makefile. */
X
Xshow_command(cmdptr)
Xregister MAKE_COMMAND *cmdptr;
X{
X`009while (cmdptr != NULL) {
X`009`009putchar('\t');
X`009`009if (cmdptr->cmd_flag & CMD_NO_ECHO) {
X`009`009`009putchar(MC_NO_ECHO);
X`009`009}
X`009`009if (cmdptr->cmd_flag & CMD_IGN_ERROR) {
X`009`009`009putchar(MC_IGN_ERROR);
X`009`009}
X`009`009show_token(cmdptr->cmd_word, FALSE);
X`009`009putchar('\n');
X`009`009cmdptr = cmdptr->cmd_next;
X`009}
X}
X
X/* Print a MAKE_TOKEN list. */
X
Xshow_token(mtptr, show_line_num)
Xregister MAKE_TOKEN *mtptr;
Xint show_line_num;
X{
X`009int start_of_line;
X
X`009start_of_line = TRUE;
X`009while (mtptr != NULL) {
X`009`009if (start_of_line && show_line_num) {
X`009`009`009printf("Line_%d:", mtptr->mt_line);
X`009`009}
X`009`009if (mtptr->mt_text[0] == '\n') {
X`009`009`009start_of_line = TRUE;
X`009`009`009putchar('\n');
X`009`009} else {
X`009`009`009if (start_of_line) {
X`009`009`009`009start_of_line = FALSE;
X`009`009`009} else {
X`009`009`009`009putchar(' ');
X`009`009`009}
X`009`009`009printf((mtptr->mt_simple ? "%s" : "<%s>"),
X`009`009`009 mtptr->mt_text);
X`009`009}
X`009`009mtptr = mtptr->mt_next;
X`009}
X}
X
Xshowstr(str, len)
Xregister char *str;
Xregister int len;
X{
X`009register int c;
X
X`009while (len-- != 0 && (c = *str++ & 0xFF)) {
X`009`009if (c >= ' ' && c < 0x7F || c == '\n') {
X`009`009`009if (c == '\\') {
X`009`009`009`009putchar(c);
X`009`009`009}
X`009`009`009putchar(c);
X`009`009} else {
X`009`009`009printf("\\%02X", c);
X`009`009}
X`009}
X}
$ GoSub Convert_File
$ File_is="MKSUB.C"
$ Check_Sum_is=205494427
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X/*
XMAKE version 1.1, April 1987
XCopyright (C) 1987 by Jesse Perry.
XMAKE is in the public domain and may be freely distributed,
Xused, and modified, provided this notice is not removed.
X
Xmksub.c
XThis file contains the routines which control the sub-process that
Xmake uses to execute commands. If the symbol SUB_STAND_ALONE is
Xdefined at compilation time, this file will compile into a remote
XCLI -- commands typed by the user are sent to a sub-process for
Xexecution. This is for testing purposes.
X*/
X
X/* This code makes heavy use of VMS system calls for mailbox and
Xsubprocess control. The goal is to ensure that no message (i.e.,
XDCL command line) will ever be written to the mailbox unless the
Xsubprocess is trying to read one. By default, a process which
Xwrites a message to a mailbox will block until that message is
Xread from the mailbox. This is the desired behavior here. But
Xif the subprocess exits for any reason, the main program should
Xalso exit. This is accomplished by an AST routine in the main
Xprogram which is called when the subprocess dies. Unfortunately,
Xthe AST is necessarily in user mode. When the main program has
Xwritten a message to the mailbox and is blocking until that message
Xis read, it is in supervisor mode -- no user mode ASTs can be
Xdelivered. The result is that the main program blocks forever.
XIf the main program is trapping CTRL/C and CTRL/Y, as MAKE does,
Xit cannot be interrupted while blocking in supervisor mode, so
Xit completely locks up the user's terminal. To avoid this, the
Xsub_write() routine checks a boolean to see if there is a read
Xrequest pending on the mailbox. If there is, it immediately
Xwrites the string it is given to the mailbox. Otherwise, it
Xhibernates until a wake-up is scheduled by the same AST routine
Xwhich sets the read request boolean. */
X
X#include <iodef.h>
X#include <dvidef.h>
X#include <jpidef.h>
X#include <ssdef.h>
X
X#define TERM_INFO_LEN`00984`009/* length of termination information message */
X
X#ifdef SUB_STAND_ALONE
X
X#define ___`009`0090
X#define NULL`009`0090
X#define FALSE`009`0090
X#define TRUE`009`0091
X#define NORMAL_EXIT`0091
X#define ERRSTAT(stat)`009(~(stat) & 1)
X#define ENDLIST(list)`009*(int *)&list[sizeof(list) / sizeof(list[0]) - 1] = 0
Xtypedef struct {
X`009int sd_len;
X`009char *sd_str;
X} STR_DESC;
Xint Sub_ign_err, Num_cmd_sent;
X
X#else
X
X#include "make.h"
X
X#endif
X
X#define SET_RD_ATTN()`009set_attn_ast(Mbx_chan, IO$M_READATTN, save_rd_req, 0)
Xint save_rd_req();`009/* AST routine called for mailbox read attention */
X
Xstatic int Mbx_chan;
Xstatic int Sub_pid;
Xstatic char Opened = FALSE;
Xstatic char Closed = FALSE;
Xstatic char Got_read_request = FALSE;
X
X#ifdef SUB_STAND_ALONE
Xmain()
X{
X`009char *strend();
X`009static char prompt[] = "Remote> ";
X`009char str[260];
X
X`009sub_write("on severe_error then continue");
X`009for (printf(prompt); gets(str); printf("\n%s", prompt)) {
X
X`009`009/* Write user's command to mailbox. */
X
X`009`009sub_write(str);
X
X`009`009/* If this command is not continued on next line,
X`009`009write a blank line to wait for it to complete. */
X
X`009`009if (str[strlen(str) - 1] != '-') {
X`009`009`009sub_write("");
X`009`009}
X`009}
X`009sub_close();
X}
X#endif
X
X/* Write a line to the subprocess. */
X
Xsub_write(string)
Xchar *string;
X{
X`009int stat;
X
X`009/* Make sure the subprocess exists. */
X
X`009if (!Opened || Closed) {
X`009`009sub_open();
X`009}
X
X`009/* Wait for a read request from the mailbox. */
X
X`009while (!Got_read_request) {
X`009`009sys$hiber();
X`009}
X`009Got_read_request = FALSE;
X
X`009/* Do the write. Note that this write will block until the
X`009message being written is read from the mailbox. This should
X`009happen immediately, since a read request is pending. */
X
X`009stat = sys$qiow(
X`009 ___,`009`009`009/* default event flag */
X`009 Mbx_chan,`009`009`009/* mailbox channel */
X`009 IO$_WRITEVBLK | IO$M_NOW,`009/* write to mailbox */
X`009 ___,`009`009`009/* no iosb */
X`009 ___, ___,`009`009`009/* no completion AST */
X`009 string,`009`009`009/* P1; pointer to line to write */
X`009 strlen(string),`009`009/* P2; length of line */
X`009 ___,`009`009`009/* P3; no disk address needed */
X`009 ___, ___, ___);`009`009/* P4, P5, P6; not used by this QIO */
X`009if (ERRSTAT(stat)) {
X#ifdef VMS_ERROR
X`009`009lib$signal(&Mak_errwrtsub);
X#else
X`009`009printf(" ** Unable to write to subprocess.\n");
X#endif
X`009`009sub_zap();
X`009`009lib$stop(stat);
X`009}
X`009SET_RD_ATTN();
X`009Num_cmd_sent++;
X}
X
X/* Create the subprocess. */
X
Xstatic
Xsub_open()
X{
X`009int sub_died();
X`009int stat, make_pid;
X`009char *username;
X`009STR_DESC name, indesc, outdesc, errdesc, imgdesc;
X`009char namestr[16];
X
X`009/* Get information about current process. */
X
X`009stat = proc_info(&make_pid, namestr, sizeof(namestr) - 1);
X`009if (ERRSTAT(stat)) {
X`009`009lib$stop(stat);
X`009}
X
X`009/* Create mailbox. */
X
X`009sprintf(&namestr[strlen(namestr)], "_MAK%04X", make_pid & 0xFFFF);
X#ifndef SUB_STAND_ALONE
X`009if (Verbose) {
X`009`009print_prefix();
X`009`009printf("Creating subprocess \"%s\"\n", namestr);
X`009}
X#endif
X`009name.sd_len = strlen(name.sd_str = namestr);
X`009stat = sys$crembx(
X`009 0,`009`009/* temporary mailbox */
X`009 &Mbx_chan,`009/* mailbox communication channel */
X`009 ___,`009/* default max message */
X`009 ___,`009/* default quota */
X`009 0xFF0F,`009/* full access for owner, no access for others */
X`009 ___,`009/* default access mode */
X`009 &name);`009/* mailbox logical name */
X`009if (ERRSTAT(stat)) {
X#ifdef VMS_ERROR
X`009`009lib$signal(&Mak_errcrembx);
X#else
X`009`009printf(" ** Unable to create mailbox, status %d\n", stat);
X#endif
X`009`009lib$stop(stat);
X`009}
X
X`009/* Create subprocess. */
X
X`009errdesc.sd_len = strlen(errdesc.sd_str = "SYS$ERROR");
X`009sys$setast(0);
X`009stat = lib$spawn(
X`009 ___,`009`009/* no command */
X`009 &name,`009`009/* read from the mailbox */
X`009 &errdesc,`009`009/* write to sys$error */
X`009 &1,`009`009`009/* NOWAIT flag set */
X`009 &name,`009`009/* process name */
X`009 &Sub_pid,`009`009/* get process ID for later use */
X`009 ___, ___,`009`009/* no completion status, EF */
X`009 sub_died, ___);`009/* call sub_died() on exit */
X`009sys$setast(1);
X`009Opened = !ERRSTAT(stat);
X
X`009/* Check on subprocess creation. If the process already
X`009exists, put out a warning, and assume we can use it. */
X
X`009if (stat == SS$_DUPLNAM) {
X`009`009printf("WARNING: Subprocess exists. Will try to use it.\n");
X`009} else if (ERRSTAT(stat)) {
X#ifdef VMS_ERROR
X`009`009lib$signal(&Mak_errcresub);
X#else
X`009`009printf("\n ** Unable to create subprocess, status: %d\n",
X`009`009 stat);
X#endif
X`009`009lib$stop(stat);
X`009}
X`009SET_RD_ATTN();
X`009sub_write("on warning then stop/id=0");
X`009Sub_ign_err = FALSE;
X`009Num_cmd_sent = 0;
X}
X
X/* Kill the subprocess, whatever it's doing. */
X
Xsub_zap()
X{
X`009int stat;
X
X`009if (Opened && !Closed) {
X`009`009if (Sub_pid) {
X`009`009`009stat = sys$delprc(&Sub_pid, ___);
X`009`009`009if (ERRSTAT(stat)) {
X`009`009`009`009printf("[sub_zap] Can't kill subprocess.\n");
X`009`009`009`009lib$stop(stat);
X`009`009`009}
X`009`009`009Opened = FALSE;
X`009`009`009Closed = TRUE;
X`009`009} else {
X`009`009`009printf("[sub_zap] Subprocess pid is zero; can't kill.\n");
X`009`009}
X`009}
X#ifndef SUB_STAND_ALONE
X`009del_curr();
X#endif
X}
X
X/* Called by an AST when the subprocess dies. */
X
Xstatic
Xsub_died()
X{
X`009if (Opened && !Closed) {
X`009`009Sub_pid = 0;
X#ifdef SUB_STAND_ALONE
X`009`009printf("\nSubprocess died.\n");
X#else
X`009`009del_curr();
X`009`009if (Verbose) {
X`009`009`009putchar('\n');
X`009`009`009print_prefix();
X`009`009`009printf("\nSubprocess died.\n");
X`009`009}
X#endif
X`009`009Opened = FALSE;
X`009`009Closed = TRUE;
X`009`009exit(NORMAL_EXIT);
X`009}
X}
X
X/* Gracefully close the subprocess. */
X
Xsub_close()
X{
X`009if (!Opened || Closed) {
X`009`009return;
X`009}
X
X`009/* Send the suicide command. */
X
X`009sub_write("stop/id=0");
X`009Closed = TRUE;
X`009Opened = FALSE;
X`009Sub_pid = 0;
X}
X
Xsave_rd_req(arg)
Xint arg;`009/* AST parameter, currently unused */
X{
X`009int abstime[2];
X
X`009Got_read_request = TRUE;
X`009abstime[0] = abstime[1] = 0;
X`009arg = sys$schdwk(___, ___, abstime, ___);
X}
X
X/* Enable AST for delivery when a read or write request is sent to the
Xindicated mailbox. The attnmask value can be either IO$M_READATTN or
XIO$M_WRTATTN. NOTE: this is a one-time enable -- the AST must be
Xexplicitly re-enabled after each delivery. */
X
Xstatic
Xset_attn_ast(chan, attnmask, astadr, astprm)
Xint chan;`009`009/* mailbox channel */
Xint attnmask;`009`009/* read attention or write attention */
Xint (*astadr)();`009/* address of AST routine */
Xint astprm;`009`009/* argument to AST routine */
X{
X`009int stat;
X
X`009stat = sys$qiow(
X`009 ___,`009`009/* default event flag */
X`009 chan,`009`009/* which mailbox to watch */
X`009 IO$_SETMODE | attnmask,`009/* watch for read request */
X`009 ___,`009`009/* no iosb */
X`009 ___, ___,`009`009/* no completion AST */
X`009 astadr,`009`009/* P1; AST routine to call when a read occurs */
X`009 astprm,`009`009/* P2; parameter for AST routine */
X`009 1,`009`009`009/* P3; AST access mode */
X`009 ___, ___, ___);`009/* P4, P5, P6; not used by this QIO */
X`009if (ERRSTAT(stat)) {
X#ifdef VMS_ERROR
X`009`009lib$signal(&Mak_errmbxast);
X#else
X`009`009printf(" ** Can't enable mailbox %s attention AST.\n",
X`009`009 (attnmask == IO$M_READATTN ? "read" : "write"));
X#endif
X`009`009lib$stop(stat);
X`009}
X}
X
X#ifndef SUB_STAND_ALONE
X/* Delete current target, if any. */
X
Xdel_curr()
X{
X`009if (Curr_targ != NULL && !precious(Curr_targ)) {
X`009`009delete_file(Curr_targ);
X`009`009Curr_targ = NULL;
X`009}
X}
X#endif
X
X/* Get information about current process for use in creating subprocess. */
X
Xproc_info(pidptr, namebuf, nmbuflen)
Xint *pidptr;`009`009/* id number of current process */
Xchar *namebuf;`009`009/* user name */
Xint nmbuflen;`009`009/* size of user name buffer */
X{
X`009register char *trimptr;
X`009int stat, unamelen,ucount;
X`009struct jpi_item {
X`009`009short jp_buflen;`009/* size of buffer to return item in */
X`009`009short jp_itemcode;`009/* which item to return */
X`009`009char *jp_buffer;`009/* where to return item */
X`009`009int *jp_retlen;`009`009/* where to return item length */
X`009} itmlst[3];
X
X`009/* Set up item list to get needed items. */
X
X`009itmlst[0].jp_itemcode = JPI$_USERNAME;
X`009itmlst[0].jp_buflen = nmbuflen;
X`009itmlst[0].jp_buffer = namebuf;
X`009itmlst[0].jp_retlen = &unamelen;
X`009unamelen = 0;`009/* sys$getjpi() ADDS the length to this value */
X
X`009itmlst[1].jp_itemcode = JPI$_PID;
X`009itmlst[1].jp_buflen = sizeof(int);
X`009itmlst[1].jp_buffer = pidptr;
X`009itmlst[1].jp_retlen = NULL;
X
X`009/* Terminate item list. */
X
X`009ENDLIST(itmlst);
X
X`009/* Get information about current process. */
X
X`009stat = sys$getjpiw(
X`009 ___,`009`009/* default event flag */
X`009 ___, ___,`009`009/* default (i.e., current) process */
X`009 itmlst,`009`009/* list of things to get */
X`009 ___,`009`009/* no iosb */
X`009 ___, ___);`009`009/* no completion AST */
X`009if (ERRSTAT(stat)) {
X`009`009return (stat);
X`009}
X
X`009/* Fix: AWP - ensure username is no more than 7 chars */
X
X for (ucount = 7; ucount <= unamelen; ucount++) {
X namebuf[ucount] = ' ';
X }
X
X`009/* Terminate user name string. */
X`009namebuf[unamelen] = '\0';
X`009for (trimptr = namebuf; *trimptr && *trimptr != ' '; trimptr++)
X`009`009;
X`009*trimptr = '\0';
X
X`009/* Return sys$getjpi() status. */
X
X`009return (stat);
X}
$ GoSub Convert_File
$ File_is="MKUTIL.C"
$ Check_Sum_is=1595691228
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X/*
XMAKE version 1.1, April 1987
XCopyright (C) 1987 by Jesse Perry.
XMAKE is in the public domain and may be freely distributed,
Xused, and modified, provided this notice is not removed.
X
Xmkutil.c
XThis file contains all the miscellaneous utility routines used by
Xother parts of the program. If you can't find something in the
Xfile where it is called, odds are it's in here.
X*/
X
X#include <climsgdef.h>
X#include <fab.h>
X#include <nam.h>
X#include <rmsdef.h>
X#include <iodef.h>
X#include <atrdef.h>
X#include <fibdef.h>
X#include "make.h"
X
Xprint_prefix()
X{
X`009int i;
X
X`009printf(Verbose_prefix);
X`009for (i = 0; i < Update_level; i++) {
X`009`009putchar(' ');
X`009}
X}
X
X/* Translate a logical name. */
X
Xtranslate(str, buf, bufsize)
Xchar *str, *buf;
Xint bufsize;
X{
X`009int stat, length;
X`009STR_DESC src, dst;
X
X`009if (str == NULL || *str == '\0') {
X`009`009*buf == '\0';
X`009`009return (0);
X`009}
X`009src.sd_len = strlen(src.sd_str = str);
X`009dst.sd_len = bufsize;
X`009dst.sd_str = buf;
X`009length = 0;
X`009lib$sys_trnlog(&src, &length, &dst, ___, ___, ___);
X`009buf[length] = '\0';
X`009return (length);
X}
X
X/* Copy the given file name into the space pointed to by buffer, setting
Xthe file type to ftype. If buffer is NULL, allocate space for the new
Xfile name string. Return pointer to start of new name. */
X
Xchar *
Xset_file_type(fname, ftype, buffer)
Xchar *fname, *ftype, *buffer;
X{
X`009int length;
X
X`009/* Make sure file name given. */
X
X`009if (fname == NULL) {
X`009`009return (NULL);
X`009}
X
X`009/* Get length of file name, excluding file type string. */
X
X`009length = find_file_type(fname) - fname;
X
X`009/* If no buffer given, allocate space. */
X
X`009if (buffer == NULL) {
X`009`009buffer = err_alloc(length + strlen(ftype) + 2);
X`009}
X
X`009/* Create new file name string. */
X
X`009if (buffer != fname) {
X#ifdef VAXVMS
X`009`009lib$movc3(length, fname, buffer);
X#else
X`009`009byte_copy(fname, buffer, length);
X#endif
X`009}
X`009buffer[length] = FILE_TYPE_CHAR;
X`009strecpy(ftype, &buffer[length + 1]);
X`009return (buffer);
X}
X
X/* Terminate a file name at the start of its type, if any. */
X
Xchar *
Xrm_file_type(fname, buffer)
Xchar *fname;
X{
X`009if (fname != NULL) {
X`009`009if (buffer == NULL) {
X`009`009`009buffer = newstr(fname, -1);
X`009`009}
X`009`009*find_file_type(buffer) = '\0';
X`009}
X`009return (buffer);
X}
X
X/* Return pointer to FILE_TYPE_CHAR, if any; otherwise pointer
Xto end of string. This routine is for VMS filenames. */
X
Xchar *
Xfind_file_type(fname)
Xregister char *fname;
X{
X`009int in_dir_spec;
X
X`009in_dir_spec = FALSE;
X`009while (*fname) {
X`009`009switch (*fname) {
X`009`009case '[':
X`009`009`009in_dir_spec = TRUE;
X`009`009`009break;
X`009`009case ']':
X`009`009`009in_dir_spec = FALSE;
X`009`009`009break;
X`009`009case FILE_TYPE_CHAR:
X`009`009`009if (!in_dir_spec) {
X`009`009`009`009return (fname);
X`009`009`009}
X`009`009`009break;
X`009`009}
X`009`009fname++;
X`009}
X`009return (fname);
X}
X
X/* Delete the named file. */
X
Xdelete_file(filename)
Xchar *filename;
X{
X`009STR_DESC fnmdesc;
X
X`009fnmdesc.sd_len = strlen(fnmdesc.sd_str = filename);
X`009lib$delete_file(&fnmdesc);
X}
X
X/* Allocate the indicated number of bytes. Exit on error. */
X
Xchar *
Xerr_alloc(nbyte)
Xint nbyte;
X{
X`009char *ptr;
X
X`009if ((ptr = malloc(nbyte)) == NULL) {
X#ifdef VMS_ERROR
X`009`009lib$stop(&Mak_alloc, 1, nbyte);
X#else
X`009`009printf(" ** Fatal error, can't allocate %d bytes.\n", nbyte);
X`009`009make_exit(NORMAL_EXIT);
X#endif
X`009}
X`009return (ptr);
X}
X
X/* This function returns TRUE if the named file exists. */
X
Xfile_exists(fname)
Xchar *fname;
X{
X`009FILE *fptr;
X
X`009if ((fptr = fopen(fname, "r")) == NULL) {
X`009`009return (FALSE);
X`009}
X`009fclose(fptr);
X`009return (TRUE);
X}
X
X/* Run-time initialization of ctype characters which are defined constants. */
X
Xinit_ctype()
X{
X`009Ctype[DEPENDENCY] |= T_;
X`009Ctype[DEFINE_MACRO] |= T_;
X`009Ctype[CURR_TARG_NO_EXT] |= S_;
X`009Ctype[CURRENT_TARGET] |= S_;
X`009Ctype[DEPENDENCY_LIST] |= S_;
X`009Ctype[OUT_OF_DATE_DEPS] |= S_;
X`009Ctype[UP_TO_DATE_DEPS] |= S_;
X}
X
X/* Copy next token from source string into tokbuf. A token consists of
Xall characters in source string up to either a null or a token separator
X(sepchr). Return pointer to first character after token separator, or
Xto end of source string if there are no more tokens. */
X
Xchar *
Xmake_tokstr(str, tokbuf, sepchr)
Xregister char *str, *tokbuf;
Xregister int sepchr;
X{
X`009register int c;
X
X`009while ((c = *str++) != '\0' && c != sepchr) {
X`009`009*tokbuf++ = c;
X`009}
X`009*tokbuf = '\0';
X`009return (c ? str : str - 1);
X}
X
X/* Create a new copy of the given string. Return pointer to copy. */
X
Xchar *
Xnewstr(string, length)
Xchar *string;
Xint length;
X{
X`009char *newptr;
X
X`009if (length < 0) {
X`009`009length = strlen(string);
X`009}
X`009newptr = err_alloc(length + 1);
X`009strecpy(string, newptr);
X`009return (newptr);
X}
X
X/* Free a MAKE_TARGET and any associated data. */
X
Xfree_target(tgptr)
Xregister MAKE_TARGET *tgptr;
X{
X`009register MAKE_COMMAND *cmdptr, *oldcmd;
X`009register MAKE_TARGET *oldtptr;
X
X`009while (tgptr != NULL) {
X`009`009oldtptr = tgptr;
X`009`009tgptr = tgptr->tg_next;
X`009`009free_token(oldtptr->tg_name);
X`009`009free_token(oldtptr->tg_dep);
X`009`009cmdptr = oldtptr->tg_cmd;
X`009`009while (cmdptr != NULL) {
X`009`009`009oldcmd = cmdptr;
X`009`009`009cmdptr = cmdptr->cmd_next;
X`009`009`009if (oldcmd->cmd_word != NULL) {
X`009`009`009`009free_token(oldcmd->cmd_word);
X`009`009`009}
X`009`009`009free(oldcmd);
X`009`009}
X`009`009free(oldtptr);
X`009}
X}
X
X/* Free the first MAKE_TOKEN in a list. Return pointer to rest of list. */
X
XMAKE_TOKEN *
Xfree_first_token(tokptr)
Xregister MAKE_TOKEN *tokptr;
X{
X`009register MAKE_TOKEN *nextptr;
X
X`009if (tokptr == NULL) {
X`009`009return (NULL);
X`009}
X
X`009nextptr = tokptr->mt_next;
X`009tokptr->mt_next = NULL;
X`009free_token(tokptr);
X`009return (nextptr);
X}
X
X/* Free a list of MAKE_TOKENs. */
X
Xfree_token(tokptr)
Xregister MAKE_TOKEN *tokptr;
X{
X`009register MAKE_TOKEN *old_tok;
X
X`009while (tokptr != NULL) {
X`009`009old_tok = tokptr;
X`009`009tokptr = tokptr->mt_next;
X`009`009if (old_tok->mt_text != NULL) {
X`009`009`009free(old_tok->mt_text);
X`009`009}
X`009`009free(old_tok);
X`009}
X}
X
X#ifndef VAXVMS
X/* Copy count bytes from source to dest. */
X
Xbyte_copy(source, dest, count)
Xregister char *source, *dest;
Xregister int count;
X{
X`009/* Check for possible buffer overlap. */
X
X`009if (source + count > dest) {
X`009`009source += count;
X`009`009dest += count;
X`009`009while (count-- > 0) {
X`009`009`009*--dest = *--source;
X`009`009}
X`009} else {
X`009`009while (count-- > 0) {
X`009`009`009*dest++ = *source++;
X`009`009}
X`009}
X}
X#endif
X
X/* Copy character chr to the nbyte bytes pointed to by ptr. */
X
Xbyte_fill(ptr, chr, nbyte)
Xregister char *ptr;
Xregister int chr, nbyte;
X{
X`009while (nbyte-- > 0) {
X`009`009*ptr++ = chr;
X`009}
X}
X
X/* Copy the null-terminated string pointed to by source into the buffer
Xpointed to by dest. Return a pointer to the null-terminator of the copy. */
X
Xchar *
Xstrecpy(source, dest)
Xregister char *source, *dest;
X{
X`009while (*dest++ = *source++)
X`009`009;
X`009return (dest - 1);
X}
X
X/* Return 1 if the parameter or qualifier whose name (as a
Xnull-terminated string) is pointed to by nmptr was specified
Xon the command line which invoked this program. Return 0 if
Xit was not specified, and -1 if it was negated (/NOxxx). */
X
Xcli_present(nmptr)
Xchar *nmptr;
X{
X`009int clistat;
X`009STR_DESC nmdesc;
X
X`009nmdesc.sd_len = strlen(nmdesc.sd_str = nmptr);
X`009clistat = cli$present(&nmdesc);
X`009if (clistat == CLI$_NEGATED) {
X`009`009return (-1);
X`009}
X`009return (clistat & 1);
X}
X
X/* Attempt to read the value of the command line parameter whose name (as
Xgiven in the .CLD file) is in the null-terminated string pointed to by
Xnmptr. If the parameter was specified, its value is returned in the
Xbuffer of length valsize which is pointed to by valptr. Return the
Xlength of the parameter value string, or -1 if the named parameter
Xwas not specified on the command line. */
X
Xcli_get_value(nmptr, valptr, valsize)
Xchar *nmptr, *valptr;
Xint valsize;
X{
X`009int val_len;
X`009STR_DESC nmdesc, valdesc;
X
X`009val_len = 0;
X`009valdesc.sd_len = valsize - 1;`009/* leave room for terminating null */
X`009valdesc.sd_str = valptr;
X`009nmdesc.sd_len = strlen(nmdesc.sd_str = nmptr);
X
X`009if (!(cli$get_value(&nmdesc, &valdesc, &val_len) & 1)) {
X`009`009*valptr = '\0';
X`009`009return (-1);
X`009}
X
X`009valptr[val_len] = '\0';
X`009return (val_len);
X}
X
X/* Based on code by Joe Meadows, Jr. */
X
Xsetfdate(fdscptr, cretm, revtm, baktm, exptm)
Xint *fdscptr;`009`009/* address of file name string descriptor */
Xint *cretm, *revtm, *baktm, *exptm;
X{
X`009register int *fidptr;
X`009short chan;
X`009int status;
X`009int fibd[2];
X`009int atr[4*2 + 1];
X`009struct FAB fab;
X`009struct NAM nam;
X`009struct fibdef fib;
X`009char es[NAM$C_MAXRSS], rs[NAM$C_MAXRSS];
X
X`009if (~(status = date_init(1, fdscptr, &cretm, &fab, &nam, atr,
X`009 es, rs, &fib, fibd, &chan)) & 1) {
X`009`009return (status);
X`009}
X
X`009/* This loop processes each file matched by the file name
X`009string (which may contain wild-cards). */
X
X`009while ((status = sys$search(&fab, ___, ___)) != RMS$_NMF) {
X`009`009if (status == RMS$_PRV) {
X`009`009`009continue;
X`009`009}
X`009`009if (status & 1) {
X
X`009`009`009/* Copy file ID from NAM to FIB. */
X
X`009`009`009fidptr = &fib.fib$r_fid_overlay.fib$w_fid;
X`009`009`009*fidptr++ = *(int *)nam.nam$w_fid;
X`009`009`009*(short *)fidptr = nam.nam$w_fid[2];
X
X`009`009`009/* Set date(s). */
X
X `009`009`009status = sys$qiow(
X`009`009`009 ___, `009`009/* default event flag */
X`009`009`009 chan,`009`009/* channel to device */
X`009`009`009 IO$_MODIFY,`009`009/* function code */
X`009`009`009 ___,`009`009/* no I/O status block */
X`009`009`009 ___, ___,`009`009/* no completion AST */
X`009 `009`009 fibd,`009`009/* P1, FIB descriptor */
X`009`009`009 ___, ___, ___,`009/* P2-P4, unused */
X`009`009`009 atr,`009`009/* P5, attribute list */
X`009`009`009 ___);`009`009/* P6, unused */
X`009`009}
X`009`009if (~status & 1) {
X`009`009`009sys$dassgn(chan);
X `009`009`009return (status);
X`009`009}
X`009}
X`009sys$dassgn(chan);
X`009return (1);
X}
X
X/* Copy the requested file times into the buffers provided. */
X
Xgetfdate(fdscptr, cretm, revtm, baktm, exptm)
Xint *fdscptr;`009`009/* address of file name string descriptor */
Xint *cretm, *revtm, *baktm, *exptm;
X{
X`009register int *fidptr;
X`009short chan;
X`009int status;
X`009int fibd[2];
X`009int atr[4*2 + 1];
X`009struct FAB fab;
X`009struct NAM nam;
X`009struct fibdef fib;
X`009char es[NAM$C_MAXRSS], rs[NAM$C_MAXRSS];
X
X`009if (~(status = date_init(0, fdscptr, &cretm, &fab, &nam, atr,
X`009 es, rs, &fib, fibd, &chan)) & 1) {
X`009`009return (status);
X`009}
X`009if (~(status = sys$search(&fab, ___, ___)) & 1) {
X`009`009sys$dassgn(chan);
X`009`009return (status);
X`009}
X
X`009/* Copy file ID from NAM to FIB. */
X
X`009fidptr = &fib.fib$r_fid_overlay.fib$w_fid;
X`009*fidptr++ = *(int *)nam.nam$w_fid;
X`009*(short *)fidptr = nam.nam$w_fid[2];
X
X`009/* Get date(s). */
X
X`009status = sys$qiow(
X`009 ___, `009`009/* default event flag */
X`009 chan,`009`009/* channel to device */
X`009 IO$_ACCESS,`009`009/* function code */
X`009 ___,`009`009/* no I/O status block */
X`009 ___, ___,`009`009/* no completion AST */
X`009 fibd,`009`009/* P1, FIB descriptor */
X`009 ___, ___, ___,`009/* P2-P4, unused */
X`009 atr,`009`009/* P5, attribute list */
X`009 ___);`009`009/* P6, unused */
X`009sys$dassgn(chan);
X`009return (status);
X}
X
X/* Perform initialization required by both setfdate() and getfdate(). */
X
Xstatic
Vdate_init(setting, fdscptr, tmptr, fabp, namp, atrp, es, rs, fibp, fibdp, chanp
X)
Xint setting;`009`009/* non-zero if dates are to be set */
Xint *fdscptr;`009`009/* pointer to file name string descriptor */
Vregister int **tmptr;`009/* pointer to array of four pointers to date buffers *
X/
Xregister struct FAB *fabp;`009/* FAB to initialize */
Xregister struct NAM *namp;`009/* NAM for FAB to use */
Xregister int *atrp;`009/* address of file attribute list */
Xchar *es, *rs;`009`009/* buffers for NAM block */
Xstruct fibdef *fibp;`009/* FIB to get/set dates */
Xint *fibdp;`009`009/* FIB descriptor */
Xint *chanp;`009`009/* address of word to hold channel assigned to device */
X{
X`009register int datenum;
X`009int devnmdsc[2];
X`009static int atrcode[4] = {
X`009`009ATR$S_CREDATE | (ATR$C_CREDATE << 16),
X`009`009ATR$S_REVDATE | (ATR$C_REVDATE << 16),
X`009`009ATR$S_BAKDATE | (ATR$C_BAKDATE << 16),
X`009`009ATR$S_EXPDATE | (ATR$C_EXPDATE << 16),
X`009};
X
X`009/* Create file attribute list. */
X
X`009for (datenum = 0; datenum < 4; datenum++) {
X`009`009if (*tmptr != NULL) {
X`009`009`009*atrp++ = atrcode[datenum];
X`009`009`009*atrp++ = *tmptr;
X`009`009`009if (setting && datenum != 2
X`009`009`009 && (**tmptr | (*tmptr)[1]) == 0) {
X`009`009`009`009sys$gettim(*tmptr);
X`009`009`009}
X`009`009}
X`009`009tmptr++;
X`009}
X`009*atrp = 0;
X
X`009/* Initialize FAB. */
X
X`009lib$movc5(&0, 0, &'\0', &sizeof(struct FAB), fabp);
X `009fabp->fab$b_bln = FAB$C_BLN;
X`009fabp->fab$b_bid = FAB$C_BID;
X`009fabp->fab$l_nam = namp;
X`009fabp->fab$b_fns = *fdscptr & 0xFF;
X`009fabp->fab$l_fna = fdscptr[1];
X
X`009/* Initialize NAM. */
X
X`009lib$movc5(&0, 0, &'\0', &sizeof(struct NAM), namp);
X`009namp->nam$b_bln = NAM$C_BLN;
X`009namp->nam$b_bid = NAM$C_BID;
X`009namp->nam$b_ess = NAM$C_MAXRSS;
X`009namp->nam$b_rss = NAM$C_MAXRSS;
X`009namp->nam$l_esa = es;
X`009namp->nam$l_rsa = rs;
X
X`009/* Initialize FIB. */
X
X`009lib$movc5(&0, 0, &'\0', &sizeof(struct fibdef), fibp);
X`009*fibdp = sizeof(struct fibdef);
X`009fibdp[1] = (int)fibp;
X
X`009if (~(datenum = sys$parse(fabp, ___, ___)) & 1) {
X`009`009return (datenum);
X`009}
X`009devnmdsc[0] = namp->nam$t_dvi[0] & 0xFF;
X`009devnmdsc[1] = (int)&namp->nam$t_dvi[1];
X`009return (sys$assign(devnmdsc, chanp, ___, ___));
X}
X
X#ifdef NO_CASE
X/* Return -1 if the string pointed to by str1 is less than that pointed
Xto by str2, 0 if the strings are the same, or 1 if string 1 > string 2.
XPerform the comparison considering uppercase the same as lowercase. */
X
Xcasecmp(str1, str2)
Xregister char *str1, *str2;
X{
X`009register int c1, c2;
X
X`009do {
X`009`009c1 = *str1++ & 0xFF;
X`009`009if (IS_LOWER(c1)) {
X`009`009`009c1 += 'A' - 'a';
X`009`009}
X`009`009c2 = *str2++ & 0xFF;
X`009`009if (IS_LOWER(c2)) {
X`009`009`009c2 += 'A' - 'a';
X`009`009}
X`009} while (c1 && c1 == c2);
X
X`009if (c1 < c2) {
X`009`009return (-1);
X`009} else if (c1 == c2) {
X`009`009return (0);
X`009} else {
X`009`009return (1);
X`009}
X}
X#endif
$ GoSub Convert_File
$ Exit