/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
 */

#include <stdio.h>
#include <ctype.h>
#include <string.h>
#include <stdlib.h>
#include <unistd.h>

#define	import_spp
#define	import_error
#include <iraf.h>

#include "mkpkg.h"
#include "extern.h"
#include "../bootProto.h"




/*
 * TOK.C -- Preprocessor functions.
 */

/* GETTOK -- Get the next token from the make file currently being scanned.
 * Conditional interpretation is provided via the $IFxxx directives.
 */
int
gettok (
  register struct context *cx,		/* current context	*/
  char	*outstr,			/* receives token	*/
  int	maxch 
)
{
	register int	ch;
	register char	*op;
	char	tokbuf[SZ_COMMAND+1];
	int	token, delim;

	if (debug > 1) {
	    printf ("gettok:\n");
	    fflush (stdout);
	}

again:
	/* Skip whitespace */
	for (ch = m_getc(cx);  ch == ' ';  ch = m_getc(cx))
	    ;
	if (ch == EOF) {
	    outstr[0] = EOS;
	    return (TOK_END);
	}
	outstr[0] = ch;
	outstr[1] = EOS;

	/* First nonwhite character identifies each token.
	 */
	switch (ch) {
	case COMMENT:
	    /* Ignore a comment.
	     */
	    while ((ch = m_rawgetc(cx)) != '\n' && ch != EOF)
		;
	    m_ungetc ('\n', cx);
	    goto again;

	case PREPROCESSOR:
	    /* Preprocessor directive.
	     */
	    for (op=tokbuf, *op++ = ch;  (ch = m_getc(cx)) != EOF;  )
		if (islower (ch))
		    *op++ = ch;
		else if (isupper (ch))
		    *op++ = tolower (ch);
		else {
		    m_ungetc (ch, cx);
		    break;
		}

	    *op = EOS;
	    if (strncmp (tokbuf, "$exit", 5) == 0)
		return (TOK_END);

	    do_ppdir (cx, tokbuf);
	    goto again;

	case SYSCMD:
	    /* Send a command to host system.
	     */
	    do_osescape (cx);
	    goto again;

	case BEGIN_CHAR:
	    /* Start of program.
	     */
	    token = TOK_BEGIN;
	    break;

	case END_CHAR:
	    /* End of program.
	     */
	    token = TOK_END;
	    break;

	case '\n':
	    token = TOK_NEWLINE;
	    break;

	case SYSFILE_BEGIN:
	    /* Replace '<' by system library pathname, concatentate
	     * filename and exit.
	     */
	    getstr (cx, tokbuf, SZ_COMMAND, SYSFILE_END);
	    if (m_sysfile (tokbuf, outstr, maxch) <= 0)
		sprintf (outstr, "<%s>", tokbuf);

	    if (debug) {
		/* Don't print diagnostic if the file was found to be
		 * in the usual place, i.e., the system library lib$.
		 */
		if (strncmp (outstr, "iraf$lib/", 9) != 0) {
		    printf ("<%s> matched with `%s'\n", tokbuf, outstr);
		    fflush (stdout);
		}
	    }

	    token = TOK_FNAME;
	    break;

	case '\'':
	case '"':
	    /* Quoted strings are treated as fname tokens, permitting
	     * optional quoting of filenames in module lists.
	     */
	    getstr (cx, outstr, maxch, delim = ch);
	    token = TOK_FNAME;
	    break;

	case '\\':
	    if ((ch = m_getc(cx)) == '\n')
		goto again;
	    /* fall through */

	default:
	    /* Unquoted filename token.
	     */
	    m_ungetc (ch, cx);
	    getstr (cx, outstr, maxch, delim = ' ');
	    token = TOK_FNAME;
	    break;
	}

	/* Discard token? */
	if (ifstate[iflev] == STOP)
	    goto again;

	if (debug > 1) {
	    if (outstr[0] <= 040)
		printf ("token = char 0%o\n", outstr[0]);
	    else
		printf ("token = `%s'\n", outstr);
	    fflush (stdout);
	}

	return (token);
}


/* DO_OSESCAPE -- Send a command to host system.  If the first char after
 * the ! is a left paren or quote then the matching char is taken to terminate
 * the command, otherwise an (unescaped) newline terminates the command.
 * The parenthesized form permits additional directives on the same line.
 */
void
do_osescape (register struct context *cx)
{
	register int	ch;
	char	cmd[SZ_CMD+1];

	if (debug > 1) {
	    printf ("do_osescape:\n");
	    fflush (stdout);
	}

	ch = m_getc (cx);
	if (ch == '(' || ch == '\'' || ch == '"') {
	    getstr (cx, cmd, SZ_CMD, (ch == '(' ? ')' : ch));
	} else if (ch == '\n') {
	    return;

	} else {
	    char    *op, *otop;

	    op    = cmd;
	    *op++ = ch;
	    otop  = &cmd[SZ_CMD];

	    while (op < otop && (ch = m_getc(cx)) != EOF)
		if (ch == ESCAPE) {
		    ch = m_getc (cx);
		    if (ch != '\n') {
			*op++ = ESCAPE;
			*op++ = ch;
		    }
		} else if (ch == '\n') {
		    break;
		} else
		    *op++ = ch;

	    *op = EOS;
	}

	if (ifstate[iflev] == STOP)
	    return;
	if (verbose) {
	    printf ("!%s\n", cmd);
	    fflush (stdout);
	}

	if (execute)
	    exit_status = os_cmd (cmd);
	if (exit_status == INTERRUPT)
	    fatals ("<ctrl/c> interrupt %s", cx->library);
	if (exit_status != OK)
	    errors ("Command '%s' returned error", cmd);
}


/* DO_PPDIR -- Execute a preprocessor directive.  A hash table would be more
 * efficient, but the complexity is not warranted since this is only called
 * when a $ prefixed preprocessor directive has already been recognized in
 * the input.
 */
void
do_ppdir (
    struct context *cx,		/* current context		*/
    char	*token		/* directive to be executed	*/
)
{
	int	islib;

	if (debug > 1) {
	    printf ("do_ppdir: %s\n", token);
	    fflush (stdout);
	}

	if (     strncmp (token, "$if",		3) == 0)
	    do_if (cx, token);
	else if (strncmp (token, "$else",	5) == 0)
	    do_else ();
	else if (strncmp (token, "$endif",	6) == 0)
	    do_endif ();
	else if (strncmp (token, "$end",	4) == 0)
	    do_end (cx);

	else if (strncmp (token, "$call",	5) == 0)
	    do_call (cx, getargs(cx), islib=NO);
	else if (strncmp (token, "$echo",	5) == 0)
	    do_echo (getargs(cx));
	else if (strncmp (token, "$goto",	5) == 0)
	    do_goto (cx, getargs(cx));
	else if (strncmp (token, "$include",	8) == 0)
	    do_include (cx, getargs(cx));
	else if (strncmp (token, "$set",	4) == 0)
	    do_set (cx);
	else if (strncmp (token, "$special",	8) == 0)
	    sf_scanlist (cx);
	else if (strncmp (token, "$update",	7) == 0)
	    do_call (cx, getargs(cx), islib=YES);

	else if (strncmp (token, "$checkin",	8) == 0)
	    do_incheck (cx);
	else if (strncmp (token, "$checkout",	9) == 0)
	    do_outcheck (cx);
	else if (strncmp (token, "$copy",	5) == 0)
	    do_copyfile (cx);
	else if (strncmp (token, "$delete",	7) == 0)
	    do_delete (cx);
	else if (strncmp (token, "$generic",	8) == 0)
	    do_generic (cx);
	else if (strncmp (token, "$xyacc",	6) == 0)
	    do_xyacc (cx);
	else if (strncmp (token, "$link",	5) == 0)
	    do_link (cx);
	else if (strncmp (token, "$move",	5) == 0)
	    do_movefile (cx);
	else if (strncmp (token, "$omake",	6) == 0)
	    do_omake (cx, getargs(cx));
	else if (strncmp (token, "$purge",	6) == 0)
	    do_purge (getargs(cx));
	else if (strncmp (token, "$xc",		3) == 0)
	    do_xc (cx);

	else if (strncmp (token, "$debug",	6) == 0) {
	    if ((debug = (strcmp (getargs(cx), "off")) != 0))
		verbose++; }
	else if (strncmp (token, "$verbose",	8) == 0)
	    verbose = (strcmp (getargs(cx), "off") != 0);

	else
	    errors ("illegal preprocessor directive `%s'", token);
}


/* DO_IF -- Called when a "$if.." token is seen in the input stream.  Read in
 * the predicate and set the state of the ifcode accordingly.
 */
void
do_if (struct context *cx, char	*keyword)
{
	register int	ch;
	register char	*op;
	char	tokbuf[SZ_COMMAND+1];
	char	buf[SZ_PREDBUF], *argv[MAX_ARGS];
	long    fdate, altdate, os_fdate(char *);
	int	argc, negate, bval, i;
	char	*key;
 
	if (debug > 1) {
	    printf ("do_if: %s\n", keyword);
	    fflush (stdout);
	}

	/* Set the negate flag for the "$ifn" form of the if.  Leave key
	 * pointing to the first char of whatever follows.  Watch out for
	 * "$ifnewer".
	 */
	key = &keyword[3];	/* "$if^" */
	negate = (*key == 'n' && strncmp(key,"newer",5) != 0);
	if (negate)
	    key++;

	/* Extract the paren delimited list of predicate strings.  This may
	 * extend over multiple lines if the newlines are escaped.
	 */
	while ((ch = m_getc(cx)) != '(')
	    if (ch == '\n')
		errors ("illegal `%s' predicate", keyword);
	    else if (ch == EOF)
		errors ("unexpected EOF in `%s'", keyword);

	argv[0] = buf;
	op      = buf;
	argc    = 0;

	while ((ch = m_getc(cx)) != ')') {
	    if (ch == ESCAPE) {
		ch = m_getc (cx);
		if (ch == '\n')
		    continue;
		else
		    *op++ = ch;
	    } else if (ch == '\n') {
		errors ("missing right paren in `%s'", keyword);
	    } else if (ch == EOF) {
		errors ("unexpected EOF in `%s'", keyword);
	    } else if (ch == ' ') {
		continue;
	    } else if (ch == SYSFILE_BEGIN && op == argv[argc]) {
		getstr (cx, tokbuf, SZ_COMMAND, SYSFILE_END);
		if (m_sysfile (tokbuf, op, SZ_PREDBUF+buf-op) <= 0)
		    sprintf (op, "<%s>", tokbuf);
		while (*op)
		    op++;
		continue;
	    } else if (ch == ':' || ch == ',') {
		*op++ = EOS;
		if (op - buf >= SZ_PREDBUF)
		    errors ("predicate too large in `%s'", keyword);
		if (++argc >= MAX_ARGS)
		    errors ("too many arguments in `%s' predicate", keyword);
		argv[argc] = op;
	    } else
		*op++ = ch;
	}

	*op = EOS;
	argc++;

	if (++iflev > SZ_IFSTACK)
	    errors ("$IFs nested too deeply (%s)", keyword);

	/* If the $IF is encountered while scanning the tokens in a false-IF
	 * clause, do not "execute" the $IF.  We still have to push the IF
	 * onto the control stack, because the matching $ENDIF is going to
	 * pop the stack.
	 */
	if (ifstate[iflev-1] == STOP) {
	    ifstate[iflev] = STOP;
	    return;
	}

	/* Execute the $IF statement.
	 */
	bval = 0;
	if (strcmp (key, "def") == 0) {
	    /* $IFDEF.  If the named symbol exists execute the true clause,
	     * else go to the else clause.
	     */
	    if (argc > 0) {
		bval = (getsym (argv[0]) != NULL);
		if (!bval)
		    bval = (os_getenv (argv[0]) != NULL);
	    }

	} else if (strcmp (key, "eq") == 0) {
	    /* $IFEQ.  Test if the named environment variable has one of the
	     * indicated values.
	     */
	    char   *valstr;

	    if (argc > 0) {
		if ((valstr = getsym (argv[0])) == NULL &&
		    (valstr = os_getenv (argv[0])) == NULL) {

		    errors ("symbol `%s' not found", argv[0]);
		    bval = 0;

		} else {
		    if (argc == 1)
			bval = 1;
		    else {
			for (i=1;  i < argc;  i++)
			    if (strcmp (valstr, argv[i]) == 0) {
				bval = 1;
				break;
			    }
		    }
		}
	    }

	} else if (strcmp (key, "file") == 0) {
	    /* $IFFILE.  Check for the existence of any of the named files.
	     */
	    for (i=0;  i < argc;  i++)
		if (os_access (argv[i], 0,0) == YES) {
		    bval = 1;
		    break;
		}

	} else if (strcmp (key, "older") == 0) {
	    /* $IFOLDER.  Check if the named file is older than any of the
	     * listed files.  If the named file does not exist the result
	     * is true.  If the named file do not exist a warning
	     * is printed.
	     */
	    if (os_access (argv[1], 0,0) == NO) {
		warns ("file `%s' not found", argv[1]);
		bval = 1;
	    } else if ((fdate = os_fdate(argv[0])) <= 0) {
		bval = 1;
	    } else {
		for (i=1;  i < argc;  i++) {
		    altdate = m_fdate (argv[i]);
		    if (altdate <= 0) {
			warns ("file `%s' not found", argv[i]);
			bval = 1;
			break;
		    } else if (fdate < altdate) {
			bval = 1;
			break;
		    }
		}
	    }

	} else if (strcmp (key, "newer") == 0) {
	    /* $IFNEWER.  Check if the named file is newer than any of the
	     * listed files.  If the named file does not exist the result
	     * is false.  If any of the listed files do not exist a warning
	     * is printed.
	     */
	    if (os_access (argv[1], 0,0) == NO) {
		bval = 1;
	    } else if ((fdate = os_fdate(argv[0])) <= 0) {
		warns ("file `%s' not found", argv[0]);
		bval = 1;
	    } else {
		for (i=1;  i < argc;  i++) {
		    altdate = m_fdate (argv[i]);
		    if (altdate <= 0)
			warns ("file `%s' not found", argv[i]);
		    else if (fdate > altdate) {
			bval = 1;
			break;
		    }
		}
	    }
	    
	} else if (strcmp (key, "err") == 0) {
	    /* $IFERR.  Test the exit status of the last command executed.
	     */
	    bval = (exit_status != OK);

	} else
	    errors ("unrecognized $if statement `%s'", keyword);

	if (negate)
	    bval = !bval;
	ifstate[iflev] = bval;

	if (debug) {
	    printf ("%s (", keyword);
	    if (argc > 0)
		printf ("%s", argv[0]);
	    for (i=1;  i < argc;  i++)
		printf (", %s", argv[i]);
	    printf (") -> %s\n", bval ? "YES" : "NO");
	    fflush (stdout);
	}
}


/* DO_ELSE -- Called when the token "$else" is seen in the input stream.
 * Toggle the if state.  Do nothing if the state one level down in STOP,
 * indicating that this $ELSE is nested inside the false clause of an
 * outer $IF.
 */
void
do_else (void)
{
	if (debug > 1) {
	    printf ("do_else:\n");
	    fflush (stdout);
	}

	if (iflev < 1)
	    errors ("%s with no matching $if", "$else");
	else if (iflev > 1 && ifstate[iflev-1] == STOP)
	    return;
	else
	    ifstate[iflev] = (ifstate[iflev] == PASS) ? STOP : PASS;
}


/* DO_ENDIF -- Called when the token "$endif" is seen in the input stream.
 * Pop the if stack.
 */
void
do_endif (void)
{
	if (debug > 1) {
	    printf ("do_endif:\n");
	    fflush (stdout);
	}

	if (--iflev < 0)
	    errors ("unmatched %s", "$endif");
}


/* DO_END -- Called when the token "$end" is seen in the input stream.
 * Clear the if stack and reenable pass-token.
 */
void
do_end (struct context *cx)
{
	if (debug > 1) {
	    printf ("do_end:\n");
	    fflush (stdout);
	}

	if (cx->prev && cx->prev->old_iflev >= 0)
	    iflev = cx->prev->old_iflev;
	else
	    iflev = 0;
}


/* DO_CALL -- Call a "subroutine", i.e., named entry in a mkpkg file.  The call
 * may include definitions for any temporary symbols (arguments) to be passed
 * to the subroutine.  The subroutine is assumed to be in the current mkpkg
 * file unless otherwise indicated.
 *
 * Syntax:
 *	$call module
 *	$call module (sym1=value, sym2=value, ...)
 *	$call module@subdir/file
 *	$call module@subdir/file (sym1=value, ...)
 *		(etc.)
 *
 * Note that the statements are interpreted (as is everything in mkpkg), hence
 * mkpkg subroutines should not be used for trivial things.
 */
void
do_call (
  struct context *cx,		/* current context		*/
  char	*program,		/* module to be called		*/
  int	 islib 			/* module list for a library	*/
)
{
	struct	context *ncx;
	char	module[SZ_FNAME+1], subdir[SZ_FNAME+1], fname[SZ_FNAME+1];
	char	symbol[SZ_FNAME+1], value[SZ_COMMAND+1];
	char	modspec[SZ_FNAME+1];
	char	*old_cp;
	int	old_nsymbols;

	strcpy (modspec, program);
	if (ifstate[iflev] == PASS) {
	    printf ("$call %s\n", modspec);
	    fflush (stdout);
	}

	old_cp = cp;
	old_nsymbols = nsymbols;

	/* Process the argument list, if any, into the symbol table.
	 */
	while (getkwvpair (cx, symbol, value) != ERR)
	    if (ifstate[iflev] == PASS)
		putsym (symbol, value);

	if (ifstate[iflev] == STOP)
	    return;

	/* Parse the module name, push a new context, and execute the
	 * subroutine.
	 */
	parse_modname (modspec, module, subdir, fname);
	if ((ncx = push_context (cx, module, subdir, fname)) == NULL)
	    exit_status = ERR;
	else {
	    exit_status = do_mkpkg (ncx, islib);
	    cx = pop_context (ncx);
	}

	/* Restore the old context and discard the argument temporaries.
	 */
	if (exit_status != OK)
	    errors ("module `%s' not found or returned error", modspec);

	cp = old_cp;
	nsymbols = old_nsymbols;
}


/* DO_ECHO -- Print a message on the standard output.
 */
void
do_echo (char *msg)
{
	if (ifstate[iflev] == PASS) {
	    printf ("%s\n", msg);
	    fflush (stdout);
	}
}


/* DO_GOTO -- Advance the file pointer to the named symbol in the current
 * file, without changing the current context.
 */
int
do_goto (struct context *cx, char *symbol)
{
	register char	*ip;
	char	match[SZ_FNAME+1];
	char	lbuf[SZ_LINE+1];
	int	len_matchstr;
	long	fpos;

	if (ifstate[iflev] == STOP)
	    return (OK);

	if (debug) {
	    printf ("goto %s\n", symbol);
	    fflush (stdout);
	}

	sprintf (match, "%s:", symbol);
	len_matchstr = strlen (match);

	fpos = k_ftell (cx);
	if (cx->fp != stdin)
	    k_fseek (cx, 0L, 0);

	while (k_fgets (lbuf, SZ_LINE, cx) != NULL) {
	    cx->lineno++;
	    for (ip=lbuf;  isspace (*ip);  ip++)
		;
	    if (strncmp (ip, match, len_matchstr) == 0) {
		/* GOTO clears the IF stack back to where it whatever it was
		 * upon entry to the module.
		 */
		if (cx->prev && cx->prev->old_iflev >= 0)
		    iflev = cx->prev->old_iflev;
		return (OK);
	    }
	}

	errors ("could not find mkpkg module or label `%s'", symbol);
	if (cx->fp != stdin)
	    k_fseek (cx, fpos, 0);

	return (ERR);
}


/* DO_INCLUDE -- Open a file and execute any preprocessor directives therein.
 * Macros defined in an include are retained after the context of the include
 * is popped.
 */
int
do_include (
  struct context *cx,		/* current context	*/
  char *fname 			/* include file name	*/
)
{
	struct	context *ncx;
	int	islib;

	if (ifstate[iflev] == STOP)
	    return (OK);

	if (debug > 1) {
	    printf ("do_include: %s\n", fname);
	    fflush (stdout);
	}

	ncx = push_context (cx, "BOF", "", fname);
	do_mkpkg (ncx, islib=NO);
	cx->old_cp = cp;			/* keep symbols */
	cx->old_nsymbols = nsymbols;
	cx = pop_context (ncx);

	return (OK);
}


/* DO_OMAKE -- Generate the object module for the named source module, if
 * the object does not exist or is older than the source module.
 */
void
do_omake (
  struct context *cx,
  char	*fname
)
{
	char	cmd[SZ_COMMAND+1];
	char	xflags[SZ_LINE+1];
	char	*dflist[MAX_DEPFILES+1];
	char	*s_xflags, *dfile;
	long	sourcedate, objdate, date;
	int	recompile, i;
	static  char xc_path[SZ_PATHNAME+1];

        if (!xc_path[0])
            if (os_sysfile (XC, xc_path, SZ_PATHNAME) <= 0)
                strcpy (xc_path, XC);


	if (ifstate[iflev] == STOP)
	    return;

	if (debug) {
	    printf ("omake %s\n", fname);
	    fflush (stdout);
	}

	if ((sourcedate = os_fdate (fname)) <= 0) {
	    errors ("file `%s' not found", fname);
	    exit_status = ERR;
	    return;

	} else {
	    get_dependency_list (cx, fname, dflist, MAX_DEPFILES);
	    objdate = os_fdate (makeobj (fname));
	    recompile = 0;

	    if (sourcedate > objdate)
		recompile++;
	    else {
		for (i=0;  (dfile = dflist[i]) != NULL;  i++)
		    if ((date = m_fdate (dfile)) == 0)
			warns ("dependency file `%s' not found", dfile);
		    else if (date > objdate) {
			recompile++;
			break;
		    }
	    }
	}

	if (recompile) {
	    /* Get XFLAGS. */
	    s_xflags = getsym (XFLAGS);
	    xflags[0] = EOS;
	    if (debug)
		strcat (xflags, "-d ");
	    if (dbgout)
		strcat (xflags, "-x ");
	    strcat (xflags, s_xflags);

	    sprintf (cmd, "%s %s %s", xc_path, xflags, fname);

	    if (verbose) {
		printf ("%s\n", cmd);
		fflush (stdout);
	    }

	    if (execute)
		exit_status = h_xc (cmd);
	    if (exit_status == INTERRUPT)
		fatals ("<ctrl/c> interrupt %s", cx->library);
	    if (exit_status != OK)
	        errors ("Command '%s' returned error", cmd);

	} else if (verbose) {
	    printf ("Object %s is up to date\n", makeobj(fname));
	    fflush (stdout);
	}
}


/* DO_XC -- Call XC.  Note that the current default xflags are not
 * automatically included in the generated command.
 */
int
do_xc (struct context *cx)
{
	char	cmd[SZ_CMD+1];
	static  char xc_path[SZ_PATHNAME+1];

        if (!xc_path[0])
            if (os_sysfile (XC, xc_path, SZ_PATHNAME) <= 0)
                strcpy (xc_path, XC);


	if (debug > 1) {
	    printf ("do_xc:\n");
	    fflush (stdout);
	}

	sprintf (cmd, "%s", xc_path);

	if (debug)
	    strcat (cmd, " -d");
	if (dbgout)
	    strcat (cmd, " -x");

	getcmd (cx, cmd, cmd, SZ_CMD);

	if (ifstate[iflev] == STOP)
	    return 0;

	if (verbose) {
	    printf ("%s\n", cmd);
	    fflush (stdout);
	}

	if (execute)
	    exit_status = h_xc (cmd);
	if (exit_status == INTERRUPT)
	    fatals ("<ctrl/c> interrupt %s", cx->library);
	if (exit_status != OK)
	    errors ("Command '%s' returned error", cmd);

	return (exit_status);
}


/* DO_LINK -- Call XC to link a list of objects and/or libraries.  This is
 * equivalent to $XC, except that the LFLAGS are used instead of the XFLAGS.
 */
int
do_link (struct context *cx)
{
	register struct sfile *sflist, *sfp=NULL;
	static int skip_sf = 0;
	char *ip, token[SZ_FNAME+1];
	char linkline[SZ_CMD+1];
	char cmdbuf[SZ_CMD+1];
	char *cmd = cmdbuf;
	int lflags_set = 0;
	char *lflags;
	static  char xc_path[SZ_PATHNAME+1];

        if (!xc_path[0])
            if (os_sysfile (XC, xc_path, SZ_PATHNAME) <= 0)
                strcpy (xc_path, XC);


	if (debug > 1) {
	    printf ("do_link:\n");
	    fflush (stdout);
	}

	/* Get the link command from the input stream. */
	getcmd (cx, "", linkline, SZ_CMD);

	/* Check whether the executable being generated is on the special
	 * file list.
	 */
	if (!skip_sf && (sflist = sf_dirsearch (cx->dirpath))) {
	    for (ip=linkline;  getword(&ip,token,SZ_FNAME);  )
		if (strcmp (token, "-o") == 0)
		    if (getword (&ip, token, SZ_FNAME))
			if ((sfp = sf_filesearch (sflist, token)))
			    break;
	}

	/* Check if LFLAGS is being substituted for this file. */
	if (sfp && strncmp (sfp->sf_mkobj, "LFLAGS", 6) == 0) {
	    for (ip=sfp->sf_mkobj;  *ip && *ip != '=';  ip++)
		;
	    lflags = (*ip == '=') ? ip + 1 : ip;
	    lflags_set++;
	} else
	    lflags = getsym (LFLAGS);

	sprintf (cmd, "%s %s", xc_path, lflags);

	if (debug)
	    strcat (cmd, " -d");
	if (dbgout)
	    strcat (cmd, " -x");

	strcat (cmd, linkline);

	if (ifstate[iflev] == STOP)
	    return 0;

	/* Check whether a special $link command or other build command
	 * should be executed.
	 */
	if (sfp && !lflags_set) {
	    /* Push back the special link command. */
	    m_pushstr (cx, "\n");
	    m_pushstr (cx, sfp->sf_mkobj);

	    /* Avoid recursion if $link is pushed back. */
	    if (strncmp (sfp->sf_mkobj, "$link", 5) == 0)
		skip_sf++;
	    return (OK);
	}

	if (verbose) {
	    printf ("%s\n", cmd);
	    fflush (stdout);
	}

	if (execute)
	    exit_status = h_xc (cmd);
	if (exit_status == INTERRUPT)
	    fatals ("<ctrl/c> interrupt %s", cx->library);
	if (exit_status != OK)
	    errors ("Command '%s' returned error", cmd);

	skip_sf = 0;
	return (exit_status);
}


/* DO_GENERIC -- Call the generic preprocessor.
 */
int
do_generic (struct context *cx)
{
	char	cmd[SZ_CMD+1];
	static  char generic_path[SZ_PATHNAME+1];

        if (!generic_path[0])
            if (os_sysfile (GENERIC, generic_path, SZ_PATHNAME) <= 0)
                strcpy (generic_path, GENERIC);

	if (debug > 1) {
	    printf ("do_generic:\n");
	    fflush (stdout);
	}

	getcmd (cx, generic_path, cmd, SZ_CMD);

	if (ifstate[iflev] == STOP)
	    return 0;

	if (verbose) {
	    printf ("%s\n", cmd);
	    fflush (stdout);
	}

	if (execute)
	    exit_status = os_cmd (cmd);
	if (exit_status == INTERRUPT)
	    fatals ("<ctrl/c> interrupt %s", cx->library);
	if (exit_status != OK)
	    errors ("Command '%s' returned error", cmd);

	return (exit_status);
}


/* DO_XYACC -- Call the xyacc parser generator
 */
int
do_xyacc (struct context *cx)
{
	char	cmd[SZ_CMD+1];
	static  char xyacc_path[SZ_PATHNAME+1];

        if (!xyacc_path[0])
            if (os_sysfile (XYACC, xyacc_path, SZ_PATHNAME) <= 0)
                strcpy (xyacc_path, XYACC);

	if (debug > 1) {
	    printf ("do_xyacc:\n");
	    fflush (stdout);
	}

	getcmd (cx, xyacc_path, cmd, SZ_CMD);

	if (ifstate[iflev] == STOP)
	    return 0;

	if (verbose) {
	    printf ("%s\n", cmd);
	    fflush (stdout);
	}

	if (execute)
	    exit_status = os_cmd (cmd);
	if (exit_status == INTERRUPT)
	    fatals ("<ctrl/c> interrupt %s", cx->library);
	if (exit_status != OK)
	    errors ("Command '%s' returned error", cmd);

	return (exit_status);
}


/* DO_SET -- Enter the name and value of a symbol (macro) into the symbol
 * table.
 */
void
do_set (struct context *cx)
{
	char	symbol[SZ_FNAME+1];
	char	value[SZ_PBBUF+1];

	if (debug > 1) {
	    printf ("do_set:\n");
	    fflush (stdout);
	}

	if (getkwvpair (cx, symbol, value) != ERR) {
	    if (ifstate[iflev] == STOP)
		return;

	    if (debug) {
		printf ("set %s = `%s'\n", symbol, value);
		fflush (stdout);
	    }
	    putsym (symbol, value);
	}
}


/* DO_INCHECK -- Check a file (e.g, library) back into the named directory.
 * (the "in" is first to make the external function name unique on systems
 * which truncate external names).
 */
int
do_incheck (struct context *cx)
{
	char	fname[SZ_FNAME+1];
	char	dname[SZ_FNAME+1];

	if (debug > 1) {
	    printf ("do_checkin:\n");
	    fflush (stdout);
	}

	strcpy (fname, getargs (cx));
	strcpy (dname, getargs (cx));

	exit_status = h_incheck (fname, dname);
	if (exit_status != OK)
	    errors ("error during checkin of %s", fname);

	return (exit_status);
}


/* DO_OUTCHECK -- Check a file (e.g, library) out of the named directory.
 */
int
do_outcheck (struct context *cx)
{
	char	fname[SZ_FNAME+1];
	char	dname[SZ_FNAME+1];
	int	clobber;

	if (debug > 1) {
	    printf ("do_checkout:\n");
	    fflush (stdout);
	}

	strcpy (fname, getargs (cx));
	strcpy (dname, getargs (cx));

	exit_status = h_outcheck (fname, dname, clobber=YES);
	if (exit_status != OK)
	    errors ("error during checkout of %s", fname);

	return (exit_status);
}


/* DO_COPYFILE -- Copy a file.
 */
int
do_copyfile (struct context *cx)
{
	char	old[SZ_FNAME+1];
	char	new[SZ_FNAME+1];

	if (debug > 1) {
	    printf ("do_copyfile:\n");
	    fflush (stdout);
	}

	strcpy (old, getargs (cx));
	strcpy (new, getargs (cx));

	if (ifstate[iflev] == STOP)
	    return 0;

	if (verbose) {
	    printf ("copy `%s' to `%s'\n", old, new);
	    fflush (stdout);
	}
	
	exit_status = h_copyfile (old, new);
	if (exit_status != OK)
	    errors ("error making copy of %s", old);

	return (exit_status);
}


/* DO_MOVEFILE -- Move a file to another directory, or rename the file in the
 * current directory.
 */
int
do_movefile (struct context *cx)
{
	register char *ip, *op;
	char	old[SZ_FNAME+1];
	char	new[SZ_PATHNAME+1];

	if (debug > 1) {
	    printf ("do_movefile:\n");
	    fflush (stdout);
	}

	strcpy (old, getargs (cx));
	strcpy (new, getargs (cx));

	if (ifstate[iflev] == STOP)
	    return 0;

	/* If NEW is a directory, concatenate the filename.  Always pass a
	 * filename to h_movefile.
	 */
	for (op=new;  *op;  op++)
	    ;
	if (*(op-1) == '$' || *(op-1) == '/')
	    for (ip=old;  (*op++ = *ip++);  )
		;

	if (verbose) {
	    printf ("move `%s' to `%s'\n", old, new);
	    fflush (stdout);
	}
	
	exit_status = h_movefile (old, new);
	if (exit_status != OK)
	    errors ("error moving file %s", old);

	return (exit_status);
}


/* DO_DELETE -- Delete a file or list of files.
 */
void
do_delete (struct context *cx)
{
	char	fname[SZ_PATHNAME+1];


	if (debug > 1) {
	    printf ("do_delete:\n");
	    fflush (stdout);
	}

	for (;;) {
	    strcpy (fname, getargs (cx));
	    if (fname[0] == EOS)
		return;

	    if (ifstate[iflev] == STOP)
		return;

	    if (execute) {
		if (verbose) {
		    printf ("delete file %s\n", vfn2osfn(fname,0));
		    fflush (stdout);
		}

		exit_status = os_delete (fname);
		if (exit_status != OK)
		    errors ("cannot delete file %s", fname);
	    }
	}
}


/* DO_PURGE -- Purge all files in a directory.  This is a no-op on systems
 * that do not support multiple file versions.
 */
void
do_purge (
  char	*dname			/* logical directory name	*/
)
{
	if (debug > 1) {
	    printf ("do_purge: %s\n", dname);
	    fflush (stdout);
	}

	if (ifstate[iflev] == STOP)
	    return;

	exit_status = h_purge (dname);
	if (exit_status != OK)
	    errors ("error during purge of %s", dname);
}


/* GETCMD -- Extract a possibly multiline command from the input stream
 * into a buffer, with macro replacement in the process.
 */
int
getcmd (
  register struct context *cx,
  char	*prefix,		/* first part of command	*/
  char	*cmd,			/* receives the command		*/
  int	maxch
)
{
	register char	*op, *otop;
	register int	ch;


	otop = &cmd[maxch];

	if (cmd != prefix)
	    strcpy (cmd, prefix);
	
	for (op=cmd;  *op;  op++)
	    ;

	while (op < otop && (ch = m_getc(cx)) != EOF)
	    if (ch == ESCAPE) {
		ch = m_getc (cx);
		if (ch != '\n') {
		    *op++ = ESCAPE;
		    *op++ = ch;
		}
	    } else if (ch == '\n') {
		*op = EOS;
		break;
	    } else if (ch == PREPROCESSOR && *(op-1) == ' ') {
		/* $ is only recognized as a command delimiter if it occurs
		 * at the start of a new token.
		 */
		m_ungetc (ch, cx);
		*op = EOS;
		break;
	    } else
		*op++ = ch;

	return (op - cmd);
}


/* GETARGS -- Accumulate the argument list of a preprocessor macro.
 * The argument list may optionally be enclosed in parens or quotes,
 * otherwise we look for whitespace or newline as the delimiter.
 */
char *
getargs (
  register struct context *cx	/* current context	*/
)
{
	register int	ch;
	static	char	args[SZ_PBBUF+3];
	char	tokbuf[SZ_COMMAND+1];
	int	delim;


	while ((ch = m_getc(cx)) == ' ')
	    ;

	if (ch == '(')
	    delim = ')';
	else if (ch == '"' || ch == '\'')
	    delim = ch;
	else if (ch == SYSFILE_BEGIN)
	    delim = SYSFILE_END;
	else {
	    delim = ' ';
	    m_ungetc (ch, cx);
	}

	getstr (cx, tokbuf, SZ_COMMAND, delim);
	strcpy (args, tokbuf);

	if (delim == SYSFILE_END)
	    if (m_sysfile (tokbuf, args, SZ_PBBUF) <= 0)
		sprintf (args, "<%s>", tokbuf);

	return (args);
}


/* GETSTR -- Accumulate a string from the input stream, stopping when the
 * specified delimiter character is seen.  Note that macros are expanded
 * even within quoted strings, as in MAKE (macros are defined at the character
 * level, rather than at the token level).
 */
int
getstr (
  register struct context *cx,	/* current context	*/
  char	*outstr,		/* receives string	*/
  int	maxch,			/* max chars out	*/
  int	delim 			/* delimiter character	*/
)
{
	register char	*op;
	register int	ch, n;

	for (op=outstr, n=maxch;  --n >= 0 && (ch = m_getc(cx)) != delim;  )
	    if (ch == '\\') {
		ch = m_getc(cx);
		if (ch == '\n')
		    ;
		else if (ch == delim)
		    *op++ = ch;
		else {
		    *op++ = '\\';
		    *op++ = ch;
		}
	    } else if (ch == '\n' || ch == EOF) {
		*op = EOS;
		if (delim != ' ')
		    errors ("missing closing quote in string `%s'", outstr);
		m_ungetc ('\n', cx);
		break;
	    } else
		*op++ = ch;

	*op = EOS;
	return (op - outstr);
}


/* GETKWVPAIR -- Extract the keyword and value fields from a "keyword=value"
 * construct in the input stream.
 */
int
getkwvpair (
  register struct context *cx,	/* current context		*/
  char	*symbol,		/* receives name of symbol	*/
  char	*value			/* receives value of symbol	*/
)
{
	register char	*op;
	register int	ch;

	while ((ch = m_getc(cx)) == ' ')
	    ;
	if (!isalpha(ch)) {
	    m_ungetc (ch, cx);
	    return (ERR);
	}

	/* Extract module name */
	for (op=symbol, *op++ = ch;  (ch = m_getc(cx)) != '=';  ) {
	    if (ch == ' ') {
		continue;
	    } else if (ch == '\n') {
		errors ("missing `=' in $set statement `%s'", symbol);
		m_ungetc ('\n', cx);
		return (ERR);
	    } else
		*op++ = ch;
	}
	*op = EOS;

	/* Extract symbol value */
	strcpy (value, getargs(cx));
	return (OK);
}


/* GETWORD -- Extract a whitespace delimited substring from a string.
 * The input pointer is left pointing to the first character following
 * the extracted string.
 */
int
getword (
  char **str,
  char *outstr,
  int maxch
)
{
	register char *ip=(*str), *op=outstr;
	register char *otop = outstr + maxch;
	register int ch;

	while (*ip && isspace (*ip))
	    ip++;

	while (op < otop && (ch = *ip++))
	    if (isspace (ch))
		break;
	    else
		*op++ = ch;

	*op = EOS;
	*str = ip;

	return (op - outstr);
}


/* PUTSYM -- Add a symbol (macro definition) to the symbol table.  Symbol
 * storage is in the string buffer, with all symbols defined local to a
 * module being discarded when the module exits.  All symbols are globally
 * accessible, with local symbols possibly redefining (temporarily) existing
 * external symbols (e.g., the value of "xflags" might be reset locally,
 * but should not affect outer level code once the module has exited).
 * Symbol names are treated in a case insensitive fashion to simplify use
 * on systems that do not preserve case, e.g., in the MKPKG argument list.
 */
void
putsym (
  char	*name,		/* symbol name		*/
  char	*value		/* symbol value		*/
)
{
	char	*symbol;

	if (debug) {
	    printf ("put symbol %s = `%s'\n", name, value);
	    fflush (stdout);
	}

	symbol = mklower (name);
	symtab[nsymbols].s_name  = putstr (symbol);
	symtab[nsymbols].s_value = putstr (value);

	if (++nsymbols >= MAX_SYMBOLS)
	    fatals ("too many symbols (`%s')", name);
}


/* GETSYM -- Lookup a symbol in the symbol table.  Return the symbol value
 * as the function value if the symbol is found, else return NULL.  The symbol
 * table is searched most-recently-defined symbols first, permitting symbols
 * to be redefined locally.  Note that the full table is searched, hence the
 * outer symbols are globally accessible.  The number of symbols tends to be
 * quite small and symbol lookup only occurs when a macro is explicitly
 * referenced as $(NAME), hence a simple linear search is best.
 */
char *
getsym (
  char	*name		/* symbol name		*/
)
{
	register struct	symbol *sp, *stop;
	register int	ch;
	char	*symbol;

	symbol = mklower (name);
	stop = &symtab[0];
	sp   = &symtab[nsymbols];
	ch   = symbol[0];

	/* Search the symbol table.
	 */
	while (--sp >= stop)
	    if (sp->s_name[0] == ch)
		if (strcmp (sp->s_name, symbol) == 0)
		    return (sp->s_value);
	
	return (NULL);
}


/* MKLOWER -- Convert a small string to lower case and return a pointer to
 * a local copy of the new string.
 */
char *
mklower (char *s)
{
	register char	*ip, *op;
	register int	n, ch;
	static	char lstr[SZ_FNAME+1];

	for (ip=s, op=lstr, n=SZ_FNAME;  --n >= 0 && (ch = *ip++);  )
	    if (isupper (ch))
		*op++ = tolower (ch);
	    else
		*op++ = ch;
	*op = EOS;

	return (lstr);
}
