path: root/pkg/vocl/builtin.c

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

#define import_spp
#define import_libc
#define import_fset
#define import_error
#define import_ctype
#define import_stdio
#define import_alloc
#define import_ttset
#include <iraf.h>

#include "config.h"
#include "clmodes.h"
#include "mem.h"
#include "operand.h"
#include "opcodes.h"
#include "param.h"
#include "task.h"
#include "errs.h"
#include "proto.h"


/*
 * BUILTIN -- This file contains the functions that perform the built-in
 *   commands of the cl, such as task, set, and package. also here is the
 *   code that adds these functions to the initial set of ltasks within the
 *   cl when it first starts up.
 * Setbuiltins() contains a table of functions and their user names; add
 *   to this table when adding new builtin functions.
 * The first comment line for each of the functions indicates the syntax of
 *   how it should be used by the user.  The grammar allows the arguments
 *   to be optionally surrounded by parentheses.
 *
 * It must be emphasized that these builtin commands do, in fact, run as tasks
 * just as any other task. the currentask pointer is pointing to this task.
 * since most of the commands manipulate the dictionary and these changes were
 * intended for the previous task (the one that did the command) the builtins
 * must modify the topd value saved in the previous task so the effect stays
 * when the builtin's task finishes; thus, the builtins do a kind of "keep".
 *
 * Further, when called, the dictionary contains the fake parameter file
 * manufactured for the builtin, as pointed to by currentask->t_pfp, but topd
 * and parhead have been put back the way they were before the command was
 * started.  Thus, if the builtin adds to the dictionary, it will overwrite its
 * parameters.  This is avoided by using pushxparams() which pushes the value
 * and name fields of the parameters in a pfile as operands.  The builtin may
 * then access these fields of its parameters, by popping them off the stack,
 * yet make dictionary additions.  The number of parameters is given by
 * the function nargs().
 */

extern	int cldebug, cltrace;		/* debug/trace flags		     */
extern	int lastjobno;			/* last background job spawned	     */
extern	int gologout;			/* flag to execute() to cause logout */
extern  int logout_status;      	/* optional arg to logout()          */
extern  int errorline;			/* error recover line		     */
extern  int currentline;		/* line currently being executed     */
extern	char *findexe();

extern	int do_error;			/* for error recovery/trapping 	     */

extern  void cl_Samp (void);		/* SAMP builtins		     */



/* Device Allocation stuff (really should be in a separate package).
 */
#define	SZ_DEVNAME	12
#define	MAX_ALLOCDEV	10

struct d_alloc {
	short	allocated;
	char	devname[SZ_DEVNAME+1];
};

static	int nallocdev = 0;		/* Count of allocated devices	     */
static	int nlogouts = 0;		/* Count of logout attempts	     */
static	struct d_alloc
	allocdev[MAX_ALLOCDEV];		/* Save names of alloc devices	     */



/* BYE -- Called by our parent as the regular "bye" directive when it is
 * finished.  All we need to do is pop the currentask.  The normal handling
 * of builtins does an oneof() which will perform the actions for our parent. 
 * See execnewtask() for builtins.
 */
void 
clbye (void)
{
	currentask = poptask();
}


/* LOGOUT -- Logout from a CL session.  Ignore the first attempts if there
 * are allocated devices, but if the user persists permit the logout with
 * the devices still allocated.
 */
void 
cllogout (void)
{
	register int	n;
	register struct	d_alloc	*dv;
	register struct pfile *pfp;
	struct   operand o;
	char	 owner[SZ_FNAME+1];


        /* Set logout status value.
	 */
        pfp = newtask->t_pfp;
        if ((n = nargs (pfp)) > 0) {
            pushbparams (pfp->pf_pp);   /* push so first popped is 1st param */
            popop();                    /* discard the $n name               */
            o = popop();                /* pop logout status number          */
  
            if ((o.o_type & OT_BASIC) == OT_STRING) {
                eprintf ("Warning: logout status `%s' not a number\n",
                    o.o_val.v_s);
                nlogouts++;
                gologout = 1;           /* LOGOUT on third attempt */
                return;
            }
  
            pushop (&o);
            opcast (OT_INT);
            o = popop();
            logout_status = o.o_val.v_i;
        } else
            logout_status = 0;


        /* Clean up any allocated devices.
	 */
	if (nallocdev > 0) {
	    /* Examine each apparently allocated device to see if it is in
	     * fact still allocated.
	     */
	    for (n=0;  n < MAX_ALLOCDEV;  n++) {
		dv = &allocdev[n];
		if (dv->allocated)
		    if (c_devowner(dv->devname,owner,SZ_FNAME) != DV_DEVALLOC) {
			dv->allocated = NO;
			--nallocdev;
		    }
	    }

	    /* Always print message if devices are allocated.
	     */
	    if (nallocdev) {
		eprintf ("The following devices are still allocated:");
		for (n=0;  n < MAX_ALLOCDEV;  n++)
		    if (allocdev[n].allocated)
			eprintf (" %s", allocdev[n].devname);
		eprintf ("\n");
	    }

	    if (nallocdev <= 0 || nlogouts++ > 1)
		gologout = 1;		/* LOGOUT on third attempt */

	} else
	    gologout = 1;		/* LOGOUT */
}


/* CLBYE -- Like cl(), but sets end of file on the current file.  This is
 * done by the simple expedient of reopening the currentasks t_in as the null
 * file, to ensure that anything which reads from the stream will see EOF.
 * The reopen is performed in exec.c.
 */
void 
clclbye (void)
{
}


/* CACHE ltask [, ltask...]
 * read in and keep pfiles for given ltasks. since they are pre-loaded,
 *   used to avoid reading pfile for each invokation of tasks. since they
 *   will not be above the new topd when the task bye's, they won't get
 *   flushed out either unless an explicit UPDATE is done or until the task
 *   that called us bye's.
 * we check that the pfile is not already loaded and do nothing if it is.
 */
void 
clcache (void)
{
	register struct pfile *pfp;
	char	pfilename[SZ_PATHNAME];
	char	**list, **next;
	struct	operand o;
	int	n, npfile;

	pfp = newtask->t_pfp;
	if ((n = nargs (pfp)) < 1) {
	    static  int first_col=7, maxch=20, ncol=0;
	    int	    last_col;

	    last_col = c_envgeti ("ttyncols");

	    /* List all currently loaded paramfiles.
	     */
	    for (npfile=0, pfp = reference (pfile, parhead);  pfp != NULL;
	    pfp = pfp->pf_npf) {
		if (!(pfp->pf_flags & (PF_FAKE|PF_COPY)))
		    npfile++;
	    }

	    list = next = (char **)memneed (npfile);
	    for (pfp = reference (pfile, parhead);  pfp != NULL;
	    pfp = pfp->pf_npf)
		if (!(pfp->pf_flags & (PF_FAKE|PF_COPY))) {
		    strcpy (pfilename, pfp->pf_ltp->lt_pkp->pk_name);
		    strcat (pfilename, ".");
		    strcat (pfilename, pfp->pf_ltp->lt_lname);
		    *next++ = comdstr (pfilename);
		}
	    strsort (list, npfile);
	    strtable (newtask->t_stdout, list, npfile, first_col, last_col,
		maxch, ncol);

	} else {
	    /* Add listed pfiles to the cache.
	     */
	    pushbparams (pfp->pf_pp);
	    while (n--) {
		popop();			/* discard fake name.	*/
		o = popop();			/* get ltask		*/
		pfilesrch (o.o_val.v_s);
	    }

	    /* Retain the pfiles read in. */
	    keep (prevtask);
	}
}


/* CL_LOCATE -- Locate the named task in the package list.
 */
void 
cl_locate (char *task_spec, int first_only)
{
	char	buf[SZ_LINE];
	char	*pkname, *ltname, *junk;
	struct	package *pkp;
	struct  ltask   *stat;
	int	found = 0;


	strcpy (buf, task_spec);
	breakout (buf, &junk, &pkname, &ltname, &junk);

	if (pkname[0] != '\0') {	/* explicit package named	*/
	    if ((pkp = pacfind (pkname)) == NULL)
		cl_error (E_UERR, e_pcknonexist, pkname);
	    if ((stat = ltaskfind (pkp, ltname, 1)) == (struct ltask *) NULL)
		oprintf ("%s'\n", pkname);

	} else {			/* search all packages		*/
	    pkp = reference (package, pachead);
	    stat = NULL;

	    while (pkp != NULL) {
		stat = ltaskfind (pkp, ltname, 1);
		if (stat == (struct ltask *) ERR)
	    	    cl_error (E_UERR, e_tambig, ltname);
		else if (stat != (struct ltask *) NULL) {
	            oprintf ("%s", pkp->pk_name);
		    found++;
		    if (first_only == YES)
			break;
	            oprintf (" ");
		}
		pkp = pkp->pk_npk;
	    }
	}

	if (found == NULL)
	    oprintf ("%s: task not found.\n", task_spec);
	else
	    oprintf ("\n");
}


/* CLWHICH -- Locate the named task in the package list.
 */
void 
clwhich (void)
{
	register struct pfile *pfp;
	struct	operand o;
	int	n;

	pfp = newtask->t_pfp;
	if ((n = nargs (pfp)) < 1)
	    cl_error (E_UERR, e_geonearg, "which");

	pushbparams (pfp->pf_pp);
	while (n--) {
	    popop();			/* discard fake name.		*/
	    opcast (OT_STRING);
	    o = popop();		/* get ltask			*/

	    cl_locate (o.o_val.v_s, YES);
	}
}



/* CLWHEREIS -- Locate all occurances of named task in the package list.
 */
void 
clwhereis (void)
{
	register struct pfile *pfp;
	struct	operand o;
	int	n;

	pfp = newtask->t_pfp;
	if ((n = nargs (pfp)) < 1)
	    cl_error (E_UERR, e_geonearg, "whereis");

	pushbparams (pfp->pf_pp);
	while (n--) {
	    popop();			/* discard fake name.		*/
	    opcast (OT_STRING);
	    o = popop();		/* get ltask			*/

	    cl_locate (o.o_val.v_s, NO);
	}
}


/* FLPRCACHE -- Flush the process cache.  If no args, flush all but locked
 * processes.  If arg=0, flush all processes and override locks.  If argn=N,
 * flush process N.
 */
void 
clflprcache (void)
{
	register struct pfile *pfp;
	register int n, pid;
	struct	operand o;
	struct	ltask *ltp;
	int	break_locks = 1;

	pfp = newtask->t_pfp;
	if ((n = nargs (pfp)) <= 0) {
	    pr_dumpcache (0, !break_locks);
	    return;
	}

	pushbparams (pfp->pf_pp);    /* push so first popped is first param */
	while (--n >= 0) {
	    popop();			/* discard the $n name		*/
	    o = popop();		/* pop proc name or number	*/

	    if ((o.o_type & OT_BASIC) == OT_STRING) {
		ltp = ltasksrch ("", o.o_val.v_s);
		if (ltp->lt_flags & (LT_SCRIPT|LT_BUILTIN|LT_FOREIGN|LT_PSET))
		    pid = NULL;
		else
		    pid = pr_pnametopid (findexe(ltp->lt_pkp,
			ltp->lt_u.ltu_pname));
		if (pid == NULL) {
		    eprintf ("Warning: task `%s' not in cache\n", o.o_val.v_s);
		    continue;
		}
	    } else {
		pushop (&o);
		opcast (OT_INT);
		o = popop();
		pid = o.o_val.v_i;
	    }

	    pr_dumpcache (pid, break_locks);
	}
}


/* FLPR_TASK -- Flush the named task from the process cache.  
 */
void 
flpr_task (char *task)
{
	register int pid, break_locks = 1;
	struct	ltask *ltp;

	if (strcmp (task, "cl") == 0)
	    return;

	ltp = ltasksrch ("", task);
	if (ltp->lt_flags & (LT_SCRIPT|LT_BUILTIN|LT_FOREIGN|LT_PSET))
	    pid = NULL;
	else
	    pid = pr_pnametopid (findexe(ltp->lt_pkp, ltp->lt_u.ltu_pname));

	if (pid)
	    pr_dumpcache (pid, break_locks);
}


/* CLPRCACHE -- If no args list the contents of the process cache, else lock
 * the named tasks into the cache, connecting the associated process if
 * necessary.
 */
void 
clprcache (void)
{
	register struct pfile *pfp;
	register int n, pid;
	struct	operand o;

	pfp = newtask->t_pfp;
	if ((n = nargs (pfp)) <= 0) {
	    pr_listcache (currentask->t_stdout);
	    return;
	}

	pushbparams (pfp->pf_pp);    /* push so first popped is first param */
	while (--n >= 0) {
	    popop();			/* discard the $n name		*/
	    o = popop();

	    if ((o.o_type & OT_BASIC) == OT_STRING) {
		if ((pid = pr_cachetask (o.o_val.v_s)) == ERR)
		    continue;
	    } else {
		pushop (&o);
		opcast (OT_INT);
		o = popop();
		pid = o.o_val.v_i;
	    }

	    pr_lock (pid);
	}
}


/* CLGFLUSH -- Flush any buffered graphics output.  Output to stdplot is
 * buffered to permit appending to a plot.  We are called to flush this
 * last plot to the plotter.
 */
void 
clgflush (void)
{
	c_gflush (STDGRAPH);
	c_gflush (STDIMAGE);
	c_gflush (STDPLOT);
}


static	char cd_curr[SZ_PATHNAME];	/* current directory	*/
static	char cd_prev[SZ_PATHNAME];	/* previous directory	*/
static	char cd_emsg[] = "Cannot change directory to `%s'";

/* CHDIR -- Change the current working directory.  If the change is successful
 * update the cwd of all child processes as well.
 */
void 
clchdir (void)
{
	register struct pfile *pfp;
	struct	operand o;
	char	*dirname;
	char	*index(), *envget();

	pfp = newtask->t_pfp;
	if (nargs (pfp) <= 0) {
	    o.o_type = OT_STRING;
	    if ((o.o_val.v_s = envget ("home")) == NULL)
		cl_error (E_UERR, "No home directory defined in environment");
	} else {
	    pushbparams (pfp->pf_pp);
	    popop();				/* discard the $1 	*/
	    opcast (OT_STRING);
	    o = popop();			/* get directory spec	*/
	}

	/* Record the current directory the first time we are called.
	 */
	if (cd_curr[0] == EOS)
	    c_fpathname ("", cd_curr, SZ_PATHNAME);

	/* Attempt to change the directory.
	 */
	dirname = o.o_val.v_s;
	if (o.o_type != OT_STRING)
	    cl_error (E_UERR, cd_emsg, "??");
	else if (c_fchdir (dirname) == ERR)
	    cl_error (E_UERR, cd_emsg, dirname);

	/* Update cwd in all connected child processes. */
	pr_chdir (0, dirname);

	/* Update current and previous directory names. */
	strcpy (cd_prev, cd_curr);
	c_fpathname ("", cd_curr, SZ_PATHNAME);
}


/* BACK -- Return to the previous directory.
 */
void 
clback (void)
{
	char	dirname[SZ_PATHNAME];

	if (cd_prev[0] == EOS)
	    cl_error (E_UERR, "no previous directory");
	else
	    strcpy (dirname, cd_prev);

	if (c_fchdir (dirname) == ERR)
	    cl_error (E_UERR, cd_emsg, dirname);

	/* Update cwd in all connected child processes. */
	pr_chdir (0, dirname);

	/* Update current and previous directory names. */
	strcpy (cd_prev, cd_curr);
	strcpy (cd_curr, dirname);

	/* Since we are the source of the directory name, rather than the
	 * user, print new directory name to ensure that there are no
	 * surprises.
	 */
	oprintf ("%s\n", dirname);
}


/* ERROR -- error code, message
 * Print message on our stderr and pop back to a terminal cl task
 * by handling it just like any other abortive type error.
 */
void 
clerror (void)
{
	register struct	param *arg1, *arg2, *pp;
	register struct pfile *pfp;
	int	errcode;
	char	*errmsg;
	extern  char *onerr_handler;
	extern  ErrCom errcom;
	
	erract_init();
	if (currentline < currentask->t_scriptln)
	    errorline = currentline;

	pfp = newtask->t_pfp;
	if (nargs (pfp) != 2)
	    cl_error (E_IERR, e_twoargs, "error()");
	arg1 = pfp->pf_pp;
	arg2 = arg1->p_np;

	if (arg1 && (arg1->p_valo.o_type & OT_BASIC) == OT_INT)
	    errcode = arg1->p_val.v_i;
	else
	    errcode = 1;
	if (arg2 && (arg2->p_valo.o_type & OT_BASIC) == OT_STRING)
	    errmsg = arg2->p_val.v_s;
	else
	    errmsg = "";

	/* Call any posted error handlers.
	 */
	if (onerr_handler) {
	    /* Context:
    	     *    onerr_handler			- handler task
	     *    prevtask->t_ltp->lt_lname	- toplevel task
	     *    currentask->t_ltp->lt_lname	- task that failed
	     *    newtask->t_ltp->lt_lname	- "error()"
	    if (cltrace) 
		eprintf ("clerror: calling '%s' onerr_handler\n",
		    onerr_handler);
	    onerr_spawn (onerr_handler);
	     */
	}

	/* Pop the ERROR task, i.e., us.
	 */
	currentask = poptask();

	/* Log the error message if from a script or an executable.  Also, 
	 * tell the CL error handler that we've already logged the error, by
	 * setting the 'errlog' flag.
	 */
	if (keeplog() && log_errors()) {
	    if (currentask->t_flags & T_SCRIPT || currentask->t_pid != -1) {
	    	char  buf[SZ_LINE];
		extern	int  errlog;			/* see errs.c */

		strcpy (buf, "ERROR: ");
		strcat (buf, errmsg);
	    	putlog (currentask, buf);
		errlog = 1;
	    }
	}

	/* Save the error state. 
	 */
	errcom.errcode = errcode;
	strcpy (errcom.errmsg, errmsg);
	strcpy (errcom.task, currentask->t_ltp->lt_lname);

	pp = paramfind (firstask->t_pfp, "$errno", 0, YES);
	pp->p_val.v_i = errcom.errcode;
	pp = paramfind (firstask->t_pfp, "$errmsg", 0, YES);
	pp->p_val.v_s = errcom.errmsg;
	pp = paramfind (firstask->t_pfp, "$errtask", 0, YES);
	pp->p_val.v_s = errcom.task;


	/* Error Recovery -- If we're in an IFERR and ignoring errors don't
	 * go through with the abort.  Simply clean up, print/save the message,
	 * and return so we can continue execution.
	 */
	if (err_abort == NO || do_error == NO) {
	    /* Note we don't properly check the stack before getting the
	     * calling frame.  Could be a problem if we weren't called in
	     * response to an error from a connected subprocess and using
	     * this trick to get the calling script.
	     */ 
	    struct task *script = (struct task *)&stack[topcs+TASKSIZ];
	    extern ErrCom errcom;

	    iofinish (currentask);
	    if (err_beep)
		clbeep();
	    if (err_flpr)
	 	flpr_task (errcom.task);

	    errcom.errflag++;
	    errcom.errcode = errcode;
	    strcpy (errcom.errmsg, errmsg);
            if (script->t_ltp && script->t_ltp->lt_lname)
                strcpy (errcom.script, script->t_ltp->lt_lname);
            else
                strcpy (errcom.script, "CL");


	    if (err_trace == YES) {
	        eprintf ("Error (%d): on line %d of '%s' from '%s':\n\t'%s'\n", 
		    errcom.errcode, errcom.linenum, errcom.script,
		    errcom.task, errmsg);
	    }

	    return;
	}

	/* ERROR terminates a task like BYE.  Pop the task which issued
	 * the error statement, provided it was not the first task.
	 */
	iofinish (currentask);
	if (err_beep)
	    clbeep();
	if (err_flpr)
	    flpr_task (errcom.task);
	if (currentask != firstask)
	    currentask = poptask();

	/* Now abort.  This will unwind us back to the last interactive
	 * task.  Any external child processes will be interrupted.  If
	 * a child process issued the ERROR it will not be interrupted,
	 * because we already popped it above.
	 */
	cl_error (E_UERR, "%s", errmsg);
}


/* ? and ?? help commands.
 * see listhelp() and listallhelp() in gram.c.
 * note that since these names, ? and ??, do not fall under the ident lex
 * rule, they need a special entry in the lex rule tables.
 */
void 
clhelp (void)
{
	register struct pfile *pfp;
	register struct package *pkp;
	struct	operand o;
	int	n, nleft, show_invis=NO;

	pfp = newtask->t_pfp;
	if ((n = nargs (pfp)) <= 0)
	    listhelp (curpack, show_invis);
	else {
	    pushbparams (pfp->pf_pp);
	    for (nleft=n;  nleft > 0;  nleft--) {
		popop();
		o = popop();
		if ((o.o_type & OT_BASIC) != OT_STRING)
		    cl_error (E_UERR, "non-string argument");
		if (o.o_val.v_s[0] == CH_INVIS) {
		    show_invis = YES;
		    if (n == 1)
			listhelp (curpack, show_invis);
		} else if ((pkp = pacfind (o.o_val.v_s)) == NULL) {
		    eprintf ("Warning: package '%s' not found\n", o.o_val.v_s);
		} else if ((XINT) pkp == ERR) {
		    cl_error (E_UERR, e_pckambig, o.o_val.v_s);
		} else {
		    if (n > 1)
			oprintf ("    %s:\n", pkp->pk_name);
		    listhelp (pkp, show_invis);
		}
	    }
	}
}


void 
clallhelp (void)
{
	int	show_invis = NO;

	listallhelp (show_invis);
}


/* CLHISTORY -- Print the command history.  We keep the number of history
 * blocks to print in static storage, starting with a default of 20.  This
 * number is "learned" if the user calls history with the max_history arg.
 */
void 
clhistory (void)
{
	register struct pfile *pfp;
	struct	operand o;
	static	int default_max_history = 15;
	int	max_history;

	max_history = default_max_history;
	pfp = newtask->t_pfp;

	if (nargs (pfp) > 0) {
	    pushbparams (pfp->pf_pp);
	    popop();				/* discard the $1 	*/
	    o = popop();			/* get max records 	*/
	    if (o.o_type != OT_INT)
		cl_error (E_UERR,
		    "'history' arg is max number of records to print");
	    max_history = o.o_val.v_i;

	    /* Negative valued argument does not permanently change the
	     * default.
	     */
	    if (max_history >= 0)
		default_max_history = max_history;
	    else
		max_history = -max_history;
	}

	show_history (newtask->t_stdout, max_history);
}


/* CLTRACE -- Enable or disable instruction tracing (d_trace).
 */
void 
dotrace (void)
{
	register struct pfile *pfp;
	struct operand o;
	int value = !cltrace;

	pfp = newtask->t_pfp;

	if (nargs (pfp) > 0) {
	    pushbparams (pfp->pf_pp);
	    popop();				/* discard the $1 	*/
	    o = popop();
	    if (o.o_type != OT_INT)
		cl_error (E_UERR, "trace arg should be an integer");
	    value = o.o_val.v_i;
	}

	d_trace (value);
}


/* CLEHISTORY -- Edit command history.  (dummy - see history.c)
 */
void 
clehistory (void)
{
}


/* CLSERVICE -- Service a query from a task in the background.  The argument
 * is the job number, default [1].
 */
void 
clservice (void)
{
	register struct pfile *pfp;
	struct	operand o;
	int	bkgjob;

	pfp = newtask->t_pfp;
	if (nargs (pfp) < 1)
	    bkgjob = lastjobno;
	else {
	    pushbparams (pfp->pf_pp);
	    popop();				/* discard the $1 	*/
	    o = popop();			/* get max records 	*/
	    if (o.o_type != OT_INT)
		cl_error (E_UERR,
		    "'service' arg is ordinal of bkg job to be serviced");
	    bkgjob = o.o_val.v_i;
	}

	service_bkgquery (bkgjob);
}


/* keep
 * this command is used when changes to the dictionary, as with task
 * or package directives for example, are to be saved after the task that
 * issues the "keep" dies. since the keep command itself is handled as a
 * task, this means the t_topd value saved two levels above the current
 * task has to be modified.
 * control stack grows downward so previous tasks are higher than currentask.
 * because it was the very first task, it makes no sense for the initial
 * interactive cl to do a keep.
 */
void 
clkeep (void)
{
	register struct	task *tp, *root_task = (struct task *) NULL;


	if (strncmp ("keep", currentask->t_ltp->lt_lname, 4) == 0) {
	    if (nargs (newtask->t_pfp) > 0)
	        cl_error (E_UERR, "`keep' command has no arguments");
	} else if (prevtask == firstask)
	    return;

	/* If reading from the standard input, keep only the context of our
	 * caller.
	 */
	if (prevtask->t_in == firstask->t_in) {
	    keep (next_task(prevtask));
	    return;
	}

	/* Find the earliest task on the control stack which is reading from
	 * the same command input stream (script file) as our caller, and
	 * keep the context of all tasks from that point up to the present.
	 */
	for (tp=prevtask;  tp != firstask;  tp = next_task(tp)) {
	    if (tp->t_in == prevtask->t_in)
		root_task = tp;
	}

	for (tp=prevtask;  tp != firstask;  tp = next_task(tp)) {
	    keep (next_task(tp));
	    if (tp == root_task)
		break;
	}
}


/* kill job [, job]
 * zap background jobs, as defined by their one-indexed "job number".
 * job zero is a special case that means kill all jobs.
 * see bkg.c for more discussion and bkgkill().
 */
void 
clkill (void)
{
	register struct pfile *pfp;
	register int n, jn;
	struct operand o;

	pfp = newtask->t_pfp;
	if ((n = nargs (pfp)) <= 0)
	    cl_error (E_UERR, "must specify job number(s)");

	pushbparams (pfp->pf_pp);    /* push so first popped is first param */

	while (n--) {
	    popop();		/* discard the $n name		*/
	    opcast (OT_INT);	/* insure we get an integer	*/
	    o = popop();		/* pop job number, as int	*/
	    jn = o.o_val.v_i;

	    bkg_kill (jn);
	}
}


/* EPARAM -- Parameter set editor.
 */
void 
cleparam (void)
{
	register struct pfile *pfp;
	int	n, nleft, quit;
	struct	operand o;

	pfp = newtask->t_pfp;
	if ((n = nargs (pfp)) <= 0)
	    return;

	pushbparams (pfp->pf_pp);    /* push so first popped is first param */
	quit = NO;

	for (nleft=n;  nleft > 0;  nleft--) {
	    popop();		/* discard the $n name			*/
	    o = popop();	/* get task name (value of the param)	*/

	    if (!quit && (o.o_type & OT_BASIC) == OT_STRING)
		quit = (epset (o.o_val.v_s) == ERR);
	    else
		cl_error (E_UERR,
		    "eparam: argument must be taskname or pfilename");
	}
}


/* LPARAM name1, name2, ...
 * go through params for each named task and list their names, current value,
 * and prompt string. go through twice, giving all non-hidden ones first.
 * if a pfile is needed and it is not in core already, it is read in just
 *   long enough to display then discarded. it might be argued that lparam
 *   should have a kind of implied pre-loading cache effect since a task whose
 *   params are being inspected is likely to be used soon. if this effect is
 *   wanted, just add the topd saving line as with task, cache, etc.
 */
void 
cllparam (void)
{
	register struct ltask *ltp;
	register struct pfile *pfp;
	struct	operand o;
	int	n, nleft;

	pfp = newtask->t_pfp;
	if ((n = nargs (pfp)) <= 0)
	    return;

	pushbparams (pfp->pf_pp);    /* push so first popped is first param */

	for (nleft=n;  nleft > 0;  nleft--) {
	    popop();		/* discard the $n name			*/
	    o = popop();	/* get task name (value of the param)	*/
	    if ((o.o_type & OT_BASIC) == OT_STRING) {
		pfp = pfilesrch (o.o_val.v_s);
		ltp = pfp->pf_ltp;
		if (n > 1)
		    oprintf ("    %s:\n", ltp->lt_lname);
		listparams (pfp);
	    } else
		cl_error (E_UERR, "lparam: argument must be a taskname");
	}
}


/* DPARAM name1, name2, ...
 * Dump the parameters for the named tasks to the standard output in the
 * form of a series of `task.param=value' assignments.
 */
void 
cldparam (void)
{
	register struct ltask *ltp;
	register struct pfile *pfp;
	struct	operand o;
	int	n, nleft;

	pfp = newtask->t_pfp;
	if ((n = nargs (pfp)) <= 0)
	    return;

	pushbparams (pfp->pf_pp);    /* push so first popped is first param */

	for (nleft=n;  nleft > 0;  nleft--) {
	    popop();		/* discard the $n name			*/
	    o = popop();	/* get task name (value of the param)	*/

	    if ((o.o_type & OT_BASIC) == OT_STRING) {
		pfp = pfilesrch (o.o_val.v_s);
		ltp = pfp->pf_ltp;
		dumpparams (pfp);
	    } else
		cl_error (E_UERR, "dparam: argument must be a taskname");
	}
}


/* PACKAGE name
 * this function is to create a new package structure off pachead
 *   so that when the previous process continues, it will be its new curpack.
 *   the packages pfile is to be the parent's also.
 * since we want the effect to remain for the parent, we store the new
 *   package pointer in (currentask+1)->t_curpack so restor() will stuff it
 *   into curpack. we also need to "keep" the new topd so that restor doesn't
 *   lob off the new package again. this is a complexity that results from
 *   running builtin functions as tasks in their own right.
 * no point in setting curpack as it will get overwritten by restor() as soon
 *   as this returns.
 * if called without arguments, just give a list of packages, in current 
 *   circular search order.
 * set LT_DEFPCK if the new package name is the same as the task defining it.
 *   used by cmdsrch() to guard against rerunning a script that defines a pkg.
 * call error() and do not return if this would redefine the package.
 */
void 
clpack (void)
{
	register struct pfile	*pfp;
	register struct task	*tp;
	register struct package *pkp;
	char	*paknam, *bindir;
	struct	operand o1, o2;
	int	n;

	pfp = newtask->t_pfp;
	if (nargs (pfp) > 2)
	    cl_error (E_UERR, "too many arguments");

	if ((n = nargs(pfp)) == 0) {
	    pkp = curpack;
	    do {
		oprintf ("    %s\n", pkp->pk_name);
		if ((pkp = pkp->pk_npk) == NULL)
		    pkp = reference (package, pachead);
	    } until (pkp == curpack);
	    return;
	}

	/* Get name of new package. */
	pushbparams (pfp->pf_pp);
	popop();		/* discard param's $n name	*/
	opcast (OT_STRING);
	o1 = popop();
	paknam = o1.o_val.v_s;

	/* Search up the task stack for a script task with the same name as
	 * the new package.  Note that if other packages were loaded before
	 * the PACKAGE statement was executed, the task descriptor for the
	 * package script task will not be the previous task.
	 */
	for (tp = prevtask;  tp != firstask; tp = next_task(tp))
	    if (!strcmp (paknam, tp->t_ltp->lt_lname))
		break;

	/* Determine the bindir for the package.  This may be given on the
	 * command line, otherwise we inherit the bindir of the package to
	 * which the new package being defined belongs.
	 */
	if (n > 1) {
	    opcast (OT_STRING);
	    o2 = popop();
	    opcast (OT_STRING);
	    o2 = popop();
	    bindir = o2.o_val.v_s;
	} else
	    bindir = tp->t_ltp->lt_pkp->pk_bin;

	/* Check for redefinition. */
	if (pacfind (paknam) != NULL)
	    cl_error (E_UERR, "package redefinition: `%s'", paknam);

	/* Enter the new package definition into the dictionary.  */
	pkp = newpac (paknam, bindir);

	/* Set the pfile pointer for the new package to the pfile for the
	 * containing script task of the same name.  Flag the ltask entry
	 * to indicate that the ltask is a package.
	 */
	pkp->pk_pfp = tp->t_pfp;
	tp->t_ltp->lt_flags |= LT_DEFPCK;

	/* Set the current process cache process number (assigned in time
	 * order) for the task immediately preceding the one which called
	 * us.  This causes restor() to prune all recently connected processes
	 * from the process cache when we exit.
	 */
	if (tp != firstask)
	    next_task(tp)->t_pno = pr_getpno();

	/* Patch the saved curpack of the previous task (whatever it was) so
	 * that when we return the newly declared package will become the
	 * current package.  Call KEEP so that the new entry does not go away
	 * when the PACKAGE decl-task exits.
	 */
	prevtask->t_curpack = pkp;
	keep (prevtask);
}


/* _CURPACK -- Print the name of the "current" package, i.e., the name of
 * the first package in the search path for a command.
 */
void 
clcurpack (void)
{
	tprintf ("%s\n", curpack->pk_name);
}


/* clpackage
 * this is just a null function to allow changing the current package to
 * clpackage. it is necessary due to the way cmdsrch() works, which looks
 * for an ltask named clpackage, then checks to see if there is a package
 * of the same name. if there is, it changes to it. thus, we need a fake
 * "task" for cmdsrch() to find so we may change to clpackage.
 */
void 
clpkg (void)
{
}

/* language
 * Fake task for the "language" package.
 */
void 
lapkg (void)
{
}


/* CLPRINT -- Formatted output.  Print arguments on the standard
 * output.
 */
void 
clprint (void)
{
	do_clprint ("stdout");
}


/* CLFPRINT -- Formatted output.  Print arguments 2-N on the stream or
 * in the param named by the first argument.
 */
void 
clfprint (void)
{
	do_clprint ("");
}


void 
do_clprint (char *dest)
{
	/* x1 and x2 are just place holders for the call to breakout.
	 */
	struct	pfile *pfp;
	struct	param *pp;
	FILE	*fout;
	char	*pkname, *ltname, *pname, *field;
	char	outbuf[SZ_LINE];
	struct	operand o, out;
	int	type, op, n, nleft;

	pfp = newtask->t_pfp;
	pushbparams (pfp->pf_pp);  /* push so first popped is first param */

	/* Get the number of the first argument.  If not "$1", i.e. when
	 * calling as "print (,x,y,z)", default dest to the standard output.
	 * Otherwise, get the first parameter (name of the destination
	 * stream or param) and save for later.
	 */

	if ((n = nargs (pfp)) < 1)
	    goto argerr;

	out = popop();		/* get argument number "$n"		*/
	if (strcmp (dest, "stdout") == 0 || strcmp (out.o_val.v_s, "$1") != 0) {
	    /* n == 1 is ok here: syntax "print (,xx)"	*/
	    pushop (&out);
	    out.o_val.v_s = "stdout";
	} else {
	    out = popop();	/* get dest name (param name or stream)	*/
	    if (n == 1)
argerr:		cl_error (E_UERR, "Too few arguments to print or fprint");
	    n = n - 1;
	}

	/* Format the output string.
	 */
	op = 0;
	outbuf[op] = '\0';
	for (nleft = n;  nleft > 0;  nleft--) {
	    popop();		/* discard the $n name			*/
	    o = popop();
	    sprop (&outbuf[op], &o);
	    while (outbuf[op] != '\0')
		op++;
	    /* If operand is a number, add a space after the number.
	     */
	    type = o.o_type & OT_BASIC;
	    if (type == OT_INT || (type == OT_REAL && nleft > 1)) {
		outbuf[op++] = ' ';
		outbuf[op] = '\0';
	    }
	    if (op >= SZ_LINE)
		cl_error (E_UERR, "Output line too long in 'print'");
	}
		
	/* Examine the destination string and output the formatted
	 * string.  Destination may be stdout, stderr, or a parameter.
	 */
	breakout (out.o_val.v_s, &pkname, &ltname, &pname, &field);

	makelower (pname);
	fout = NULL;
	if (pkname[0] == '\0' && ltname[0] == '\0') {
	    if (strcmp (pname, "stdout") == 0 || pname[0] == '\0')
		fout = currentask->t_stdout;
	    else if (strcmp (pname, "stderr") == 0)
		fout = currentask->t_stderr;
	}

	if (fout != NULL) {		/* send to task stdout or err	*/
	    outbuf[op++] = '\n';	/* append newline		*/
	    outbuf[op] = '\0';
	    fputs (outbuf, fout);
	} else {
	    o.o_type = OT_STRING;	/* destination is a param	*/
	    o.o_val.v_s = outbuf;
	    pushop (&o);
	    pp = paramsrch (pkname, ltname, pname);
	    paramset (pp, field[0]);
	}
}


/* CLPRINTF -- Formatted print command (interface to VOS printf).
 */
void 
clprintf (void)
{
	struct	pfile *pfp;
	struct	operand o;
	int	arg, n;

	pfp = newtask->t_pfp;
	pushbpvals (pfp->pf_pp);
	if ((n = nargs (pfp)) < 1)
	    cl_error (E_UERR, "printf: insufficient arguments\n");

	/* Output format. */
	o = popop();
	if ((o.o_type & OT_BASIC) != OT_STRING)
	    cl_error (E_UERR, "printf: bad format string\n");
	c_fprintf (fileno(currentask->t_stdout), o.o_val.v_s);

	/* Pass the operand values. */
	for (arg=2;  arg <= n;  arg++) {
	    o = popop();
	    if (opindef(&o)) {
		c_pargstr ("INDEF");
	    } else if (opundef(&o)) {
		cl_error (E_UERR, "printf: argument %d has undefined value\n",
		    arg);
	    } else {
		switch (o.o_type & OT_BASIC) {
		case OT_BOOL:
		case OT_INT:
		    c_pargi (o.o_val.v_i);
		    break;
		case OT_REAL:
		    c_pargd (o.o_val.v_r);
		    break;
		case OT_STRING:
		    c_pargstr (o.o_val.v_s);
		    break;
		default:
		    cl_error (E_UERR, "printf: bad operand type\n");
		}
	    }
	}
}


/* CLSCAN -- The scan function called as a task to scan from the standard
 * input, e.g. a pipe.  (Name changed to clscans to avoid a name clash
 * with fmtio.clscan).
 */
void 
clscans (void)
{
	struct	pfile *pfp;

	pfp = newtask->t_pfp;
	pushbpvals (pfp->pf_pp);
	cl_scan (nargs(pfp)-1, "stdin");
	popop();
}


/* CLSCANF -- Formatted scan function.
 */
void 
clscanf (void)
{
	struct	pfile *pfp;
	struct	operand o;
	int	n;

	pfp = newtask->t_pfp;
	pushbpvals (pfp->pf_pp);
	if ((n = nargs (pfp)) < 1)
	    cl_error (E_UERR, "scanf: insufficient arguments\n");

	/* Get scan format. */
	o = popop();
	if ((o.o_type & OT_BASIC) != OT_STRING)
	    cl_error (E_UERR, "scanf: bad format string\n");

	cl_scanf (o.o_val.v_s, nargs(pfp)-2, "stdin");
	popop();
}


/* PUTLOG user-msg 
 * Write a user message to the logfile.  The current pkg.task, bkg info, and
 * a time stamp are added by the putlog() function (in history.c).
 */
void 
clputlog (void)
{
	register struct pfile *pfp;
	struct	operand o;
	char	*usermsg;
	int	n;

	pfp = newtask->t_pfp;
	if ((n = nargs (pfp)) < 1)
	    usermsg = "";
	else {
	    pushbparams (pfp->pf_pp);
	    popop();			/* discard fake name.		*/
	    opcast (OT_STRING);
	    o = popop();		/* get user string 		*/
	    usermsg = o.o_val.v_s;
	    while (--n) {		/* get rid of any extra args */
	    	popop();		/* discard fake name	*/
	    	popop();		/* discard extra arg	*/
	    }
	}

	/* Call putlog with the calling task and the user's message.
	 */
	putlog (prevtask, usermsg);
}


/* set [name = value]
 * if (no arguments)
 *   give a list of existing enviroment settings
 * else
 *   add an entry into the environment table name=value.
 *   update environ list in all connected child procs.
 */
void 
clset (void)
{
	register struct pfile *pfp;
	struct	operand onam, oval;
	int	scantemp, n, show_redefs=YES;

	pfp = newtask->t_pfp;
	if ((n = nargs (pfp)) == 0)
	    c_envlist (fileno(currentask->t_stdout), "    ", show_redefs);
	else {
	    pushfparams (pfp->pf_pp);
	    while (n--) {
		opcast (OT_STRING);
		onam = popop();
		if (sscanf (onam.o_val.v_s, "$%d", &scantemp) == 1)
		    cl_error (E_UERR, "set must use name=value pairs");
		opcast (OT_STRING);
		oval = popop();
		c_envputs (onam.o_val.v_s, oval.o_val.v_s);
		pr_envset (0, onam.o_val.v_s, oval.o_val.v_s);
		if (strcmp ("erract", onam.o_val.v_s) == 0)
		    erract_init();
	    }

	    /* Prevent envfree in poptask when SET terminates from discarding
	     * this definition!!
	     */
	    c_envmark (&prevtask->t_envp);
	}
}


/* reset [name = value]
 * if (no arguments)
 *   give a list of existing enviroment settings
 * else
 *   reset (overwrite) the value of the named environment variable.
 *   update environ list in all connected child procs.
 */
void 
clreset (void)
{
	register struct pfile *pfp;
	struct	operand onam, oval;
	int	scantemp, n, show_redefs=YES;

	pfp = newtask->t_pfp;
	if ((n = nargs (pfp)) == 0)
	    c_envlist (fileno(currentask->t_stdout), "    ", show_redefs);
	else {
	    pushfparams (pfp->pf_pp);
	    while (n--) {
		opcast (OT_STRING);
		onam = popop();
		if (sscanf (onam.o_val.v_s, "$%d", &scantemp) == 1)
		    cl_error (E_UERR, "reset must use name=value pairs");
		opcast (OT_STRING);
		oval = popop();
		c_envreset (onam.o_val.v_s, oval.o_val.v_s);
		pr_envset (0, onam.o_val.v_s, oval.o_val.v_s);
		if (strcmp ("erract", onam.o_val.v_s) == 0)
		    erract_init();
	    }

	    /* Prevent envfree in poptask when SET terminates from discarding
	     * this definition!!
	     */
	    c_envmark (&prevtask->t_envp);
	}
}


/* show [name]
 * if (no arguments)
 *   give a list of existing enviroment settings, but do not show redefinitions
 *   as 'set' does.
 * else
 *   show value of specified environment variable(s).
 */
#define  SZ_VALUE  SZ_COMMAND

void 
clshow (void)
{
	register struct pfile *pfp;
	struct	operand onam;
	int	n, show_redefs=NO;
	char	val[SZ_VALUE];

	pfp = newtask->t_pfp;
	if ((n = nargs (pfp)) == 0)
	    c_envlist (fileno(currentask->t_stdout), "    ", show_redefs);
	else {
	    pushbparams (pfp->pf_pp); /* push so first popped is first param */
	    while (n--) {
		popop();			/* discard the $n */
		opcast (OT_STRING);
		onam = popop();
  	        if (c_envfind (onam.o_val.v_s, val, SZ_VALUE) < 0)
		    cl_error (E_UERR, "No such environment variable");
		else
		    oprintf ("%s\n", val);
	    }
	}
}


/* STTY -- Set terminal driver options.  This is merely an interface to the VOS
 * sttyco() procedure, which does all the work.  Our function is merely to
 * collect the arguments into a long string and then call sttyco() to perform
 * the operation.  The dictionary must be "kept" after the call to sttyco since
 * new values of the terminal, ttyncols, and ttynlines variables may be set.
 */
void 
clstty (void)
{
	register struct	pfile *pfp;
	register char	*ip, *op;
	char	sttycmd[2048], args[1024], *argp[100];
	int	argc, i;
	XINT	std_in = STDIN, std_out = STDOUT;


	pfp = newtask->t_pfp;

	/* Construct an array of pointers to the argument strings.  argp[1] is
	 * the first argument; argp[0] is the task name.
	 */
	argc = mkarglist (pfp, args, argp);

	/* Concatenate the stty argument list.  */
	for (op=sttycmd, i=1;  i <= argc;  i++) {
	    for (ip=argp[i];  (*op = *ip++);  op++)
		;
	    if (i < argc)
		*op++ = ' ';
	}
	*op++ = EOS;

	/* Call STTYCO to set the terminal driver options. */
	c_sttyco (sttycmd, std_in, std_out, fileno(newtask->t_stdout));
	keep (prevtask);
}


/* TASK [lname1, lname2, ...,] lnamen = pname
 * Define the one or more logical tasks to be in the given physical file name.
 * The new task defn's will built starting at topd, which has already been
 * reset to what it was before the call to this built started.  Thus, the
 * params pointed to by t_pfp will be overwritten and they must be saved.
 * Also, we need to "keep" the new topd so restor doesn't lob off the new
 * structures when going back to the previous task.  See the disclaimer with
 * clpack().
 *
 * Task names which begin with underscore are invisible to the user and
 * are not shown in menus.  The LT_INVIS flag is set by "addltask" if the
 * first char in the task name is an underscore.
 */
void 
cltask (int redef)
{
	register struct pfile *pfp;
	struct	operand o;
	int	n, scantmp;
	char	*physname, *logname;
	int	foreign_task, flags;


	pfp = newtask->t_pfp;
	if ((n = nargs (pfp)) <= 0)
	    cl_error (E_UERR, e_geonearg, "task");

	pushfparams (pfp->pf_pp);    /* push so first popped is last param  */
	o = popop();
	logname = o.o_val.v_s;
	if (sscanf (logname, "$%d", &scantmp) == 1)
	    cl_error (E_UERR,
		"physical task name must be explicit in last arg");

	opcast (OT_STRING);
	o = popop();
	physname = o.o_val.v_s;

	/* Check for a foreign (host system) task, a type of builtin.
	 */
	if ( (foreign_task = (*physname == '$')) ) {
	    if (strcmp (physname, "$foreign") == 0)
		physname = "";
	    else
		physname++;
	}

	if (foreign_task) {
	    flags = LT_FOREIGN;
	    if (logname[0] == '$') {
		logname++;
		flags &= ~LT_PFILE;
	    }
	    newbuiltin (curpack, logname, clforeign, flags, physname, redef);
	} else
	    addltask (curpack, physname, logname, redef);

	while (--n) {
	    popop();			/* discard $n param name	*/
	    opcast (OT_STRING);
	    o = popop();		/* get logical name		*/
	    logname = o.o_val.v_s;

	    if (foreign_task) {
		flags = LT_FOREIGN;
		if (logname[0] == '$') {
		    logname++;
		    flags &= ~LT_PFILE;
		}
		newbuiltin (curpack, logname,clforeign,flags,physname, redef);
	    } else
		addltask (curpack, physname, o.o_val.v_s, redef);
	}

	keep (prevtask);		/* retain changes for prev task	*/
}

/* these are hooks to cltask that just select whether redefs are to be
 * permitted. they are both used as described for cltask().
 */
void 
clrtask (void)
{
	cltask (YES);
}

void 
clntask (void)
{
	cltask (NO);
}


/* CLFOREIGN -- Execute a foreign task.  A foreign task is a special type of
 * builtin task to the CL.  All foreign tasks vector to CLFOREIGN for
 * execution.  Our function is to build up a command line for the foreign
 * task and submit it to the host system for execution with c_oscmd().
 * The parameters to a foreign task are output as blank separated strings
 * in pfile order.  The name of the foreign task defaults to the same as the
 * name of the ltask.  Commonly foreign tasks have no pfile, hence the
 * parameters are whatever the user entered on the command line.  Note however
 * that a parameter string may be the result of any CL expression; the argument
 * list of a foreign task is parsed by the CL like it is for any task.
 * CL metacharacters must be quoted or escaped to be included as strings in
 * the command line to the host system.  I/O redirection is supported.
 *
 * A foreign task command line is built up by argument substitution, scanning
 * the so-called `ftprefix' command template string for symbolic argument
 * references of the form $1, $2, etc., to match individual arguments, or $*
 * to match the full argument list.  $(N) denotes the host equivalent of
 * virtual filename argument N.  If no $arg references are found the argument
 * list is simply appended to the ftprefix string, in which case it really is
 * a prefix string.
 */
void 
clforeign (void)
{
	register struct	pfile *pfp;
	register char	*ip, *op;
	char	oscmd[1024], args[1024], *argp[100], *ap;
	int	dolseen, mapfname;
	int	argc, n1, n2, ch, n;

	pfp = newtask->t_pfp;

	/* Construct an array of pointers to the argument strings.  argp[1] is
	 * the first argument; argp[0] is the task name.
	 */
	argc = mkarglist (pfp, args, argp);

	/* Build up the host command by inserting the CL command line arguments
	 * into the command template given in the foreign task declaration.
	 */
	dolseen = 0;
	for (ip=newtask->t_ltp->lt_ftprefix, op=oscmd;  (*op = *ip);  op++,ip++)
	    if (*ip == '\\' && *(ip+1) == '$')
		*op = *(++ip);
	    else if (*ip == '$') {
		dolseen++;
		ch = *(++ip);

		/* A $(N) or $(*) causes the argument strings to be treated as
		 * virtual filenames and mapped into their host equivalents for
		 * use in the host command string.
		 */
		mapfname = 0;
		if (ch == '(') {
		    mapfname++;
		    ch = *(++ip);
		    ip++;
		}

		if (isdigit (ch)) {
		    n1 = n2 = ch - '0';
		} else if (ch == '*') {
		    n1 = 1;
		    n2 = argc;
		} else {
		    *(++op) = ch;
		    continue;
		}

		for (n=n1;  n <= n2;  n++) { 
		    char    osfn[SZ_PATHNAME+1];

		    if (n >= 0 && n <= argc) {
			if (n > n1)
			    *op++ = ' ';
			if (mapfname) {
			    c_fmapfn (argp[n], osfn, SZ_PATHNAME);
			    ap = osfn;
			} else
			    ap = argp[n];
			while ( (*op = *ap++) )
			    op++;
		    }
		}

		op--;
	    }

	/* If there were no $arg references in the command template, append
	 * the argument list to the prefix string.
	 */
	if (!dolseen)
	    for (n=1;  n <= argc;  n++) {
		*op++ = ' ';
		for (ap=argp[n];  (*op = *ap++);  op++)
		    ;
	    }

	if (cltrace) {
	    d_fmtmsg (stderr, "\t    ", oscmd, 80 - 13);
	    eprintf ("\t--------------------------------\n");
	}

	/* Call the host system to execute the command.  If i/o redirection
	 * was indicated on the command line pointers to the names of the
	 * referenced files will have been stored in the task structure by
	 * the CL metacode instructions o_redir, o_redirall, etc.  If the
	 * task was called by a parent whose output was redirected then we
	 * must call clsystem, which will spool the output of the OS cmd
	 * in temporary files and then copy it to the parent's output streams.
	 */
	if ((newtask->t_stdout != stdout && newtask->ft_out == NULL) ||
	    (newtask->t_stderr != stderr && newtask->ft_err == NULL)) {

	    clsystem (oscmd, newtask->t_stdout, newtask->t_stderr);

	} else {
	    /* Parents i/o is not redirected, hence we can redirect i/o
	     * directly without a temp file.
	     */
	    char *in, *out, *err;
	    int append_all;

	    in  = newtask->ft_in  ? newtask->ft_in  : "",
	    out = newtask->ft_out ? newtask->ft_out : "",
	    err = newtask->ft_err ? newtask->ft_err : "";
	    append_all = (out == err);

	    if (newtask->t_flags & T_APPEND) {
		register int ch;
		register FILE *fp=NULL, *outfp=NULL;
		char tmpfile[SZ_PATHNAME];

		/* Execute the command spooling the output in a temporary
		 * file (OSCMD cannot directly append to an output file).
		 */
		if (!c_mktemp ("tmp$ft", tmpfile, SZ_PATHNAME))
		    strcpy (tmpfile, "tmp$ft.out");
		c_oscmd (oscmd, in, tmpfile, append_all ? tmpfile : err);

		/* Append the spooled output to the user-specified output
		 * redirection file.
		 */
		if ((fp = fopen (tmpfile, "r")) != NULL &&
			(outfp = fopen (out, "a")) != NULL) {
		    while ((ch = fgetc(fp)) != EOF)
			fputc (ch, outfp);
		}

		if (fp)
		    fclose (fp);
		if (outfp)
		    fclose (outfp);
		c_delete (tmpfile);

	    } else
		c_oscmd (oscmd, in, out, err);
	}
}


/* UNLEARN (ltask|package) [, (ltask|package)...]
 * Restore the package default parameters for each ltask, or for all of
 * the ltasks in the named package.
 */
void 
clunlearn (void)
{
	static	char errfmt[] = "Warning: Cannot unlearn params for `%s'\n";
	register struct pfile *pfp;
	register struct ltask *ltp, *ltt;
	char	*x1, *pk, *t, *x2;
	struct	operand o;
	int	n;

	pfp = newtask->t_pfp;
	if ((n = nargs (pfp)) < 1)
	    cl_error (E_UERR, e_geonearg, "unlearn");

	pushbparams (pfp->pf_pp);
	while (n--) {
	    popop();			/* discard fake name.		*/
	    opcast (OT_STRING);
	    o = popop();		/* get ltask|package name	*/
	    breakout (o.o_val.v_s, &x1, &pk, &t, &x2);
	    if (!(ltp = cmdsrch (pk, t)))
		continue;

	    /* If package, unlearn each task. */
	    if (ltp->lt_flags & LT_PACCL) {
		/* Unlearn each task in the package. */
		for (ltt=ltp->lt_pkp->pk_ltp;  ltt != NULL;  ltt=ltt->lt_nlt)
		    if (pfileinit (ltt) == ERR)
			eprintf (errfmt, ltt->lt_lname);

		/* Unlearn the package parameters. */
		if ( (ltt = ltasksrch (pk, t)) )
		    if (pfileinit(ltt) == ERR)
			eprintf (errfmt, ltt->lt_lname);

	    } else if (pfileinit (ltp) == ERR)
		eprintf (errfmt, ltp->lt_lname);
	}
}


/* UPDATE ltask [, ltask...]
 * force the in-core pfile for the given tasks to be written out.
 * used when the pfile has been pre-loaded with cache but it is to be
 * saved before it would automatically be due to bye'ing task.
 * since the given task might be running, if we were run from it for example,
 * we also force the working copy to get copied back to its original.
 * (the check that it is indeed a copy is in pfcopyback()).
 */
void 
clupdate (void)
{
	/* x1 and x2 are just place holders for the call to breakout.
	 */
	register struct pfile *pfp;
	register struct ltask *ltp;
	char	*x1, *pk, *t, *x2;
	struct	operand o;
	int	n;

	pfp = newtask->t_pfp;
	if ((n = nargs (pfp)) < 1)
	    cl_error (E_UERR, e_geonearg, "update");

	pushbparams (pfp->pf_pp);
	while (n--) {
	    popop();			/* discard fake name.		*/
	    opcast (OT_STRING);
	    o = popop();		/* get ltask			*/
	    breakout (o.o_val.v_s, &x1, &pk, &t, &x2);
	    ltp = ltasksrch (pk, t);
	    if (!(ltp->lt_flags & LT_PFILE))
		cl_error (E_UERR, e_nopfile, ltp->lt_lname);
	    if ((pfp = pfilefind (ltp)) == NULL)
		cl_error (E_UERR, "pfile not loaded for `%s'",
		    ltp->lt_lname);
	    pfcopyback (pfp);		/* IT checks whether pfp is a copy */
	    pfileupdate (pfp);
	}
}

/* HIDETASK ltask [, ltask...]
 * Set the flags for this task to LT_INVIS so that it does not
 * become an active part of the users environment.  This function does
 * not require the underscore to hide the task.
 */
void 
clhidetask (void)
{
	/* x1 and x2 are just place holders for the call to breakout.
	 */
	register struct pfile *pfp;
	register struct ltask *ltp;
	char	*x1, *pk, *t, *x2;
	struct	operand o;
	int	n;

	pfp = newtask->t_pfp;
	if ((n = nargs (pfp)) < 1)
	    cl_error (E_UERR, e_geonearg, "hidetask");

	pushbparams (pfp->pf_pp);
	while (n--) {
	    popop();			/* discard fake name.		*/
	    opcast (OT_STRING);
	    o = popop();		/* get ltask			*/
	    breakout (o.o_val.v_s, &x1, &pk, &t, &x2);
	    ltp = ltasksrch (pk, t);
	    ltp->lt_flags |= LT_INVIS;
	}
}


/* WAIT -- Wait for a job or jobs to terminate.  The default is to wait for
 * all jobs.
 */
void 
clwait (void)
{
	register struct pfile *pfp;
	register int n, jn;
	struct operand o;

	pfp = newtask->t_pfp;
	if ((n = nargs (pfp)) <= 0)
	    jn = 0;

	pushbparams (pfp->pf_pp);    /* push so first popped is first param */

	if (n > 0) {
	    while (n--) {
		popop();		/* discard the $n name		*/
	 	opcast (OT_INT);	/* insure we get an integer	*/
		o = popop();		/* pop job number, as int	*/
		jn = o.o_val.v_i;

		bkg_wait (jn);
	    }
	} else
	    bkg_wait (jn);
}


/* JOBS -- Show status of a job or jobs.  The default is to show the status
 * of all jobs running or that have recently run.
 */
void 
cljobs (void)
{
	register struct pfile *pfp;
	register int n, jn;
	struct operand o;

	pfp = newtask->t_pfp;
	if ((n = nargs (pfp)) <= 0) {
	    bkg_jobstatus (currentask->t_stdout, 0);
	    return;
	}

	pushbparams (pfp->pf_pp);    /* push so first popped is first param */
	while (--n >= 0) {
	    popop();			/* discard the $n name		*/
	    opcast (OT_INT);		/* insure we get an integer	*/
	    o = popop();		/* pop job number, as int	*/
	    jn = o.o_val.v_i;

	    bkg_jobstatus (currentask->t_stdout, jn);
	}
}


/* CLFUNC -- Called when one of the dummy intrinsic functions entered in
 * the language package (to prompt the user) is called as a task.
 */
void 
clfunc (void)
{
	cl_error (E_UERR, "Function `%s' cannot be called as a task",
	    currentask->t_ltp->lt_lname);
}


/* BEEP -- Beep the terminal.
 */
void 
clbeep (void)
{
	putchar ('\007');
}


/* TIME -- Print the current time and date on the standard output.
 */
void 
cltime (void)
{
	char	buf[SZ_LINE];

	c_cnvtime (c_clktime(0L), buf, SZ_LINE);
	oprintf ("%s\n", buf);
}


/* CLEAR -- Clear the terminal screen and home the cursor.  Uses the TTY
 *  package (device independent terminal interface), which requires an entry
 *  in the dev$termcap file for the terminal.  In addition to clearing the
 *  screen, we also turn standout mode and raw mode off, just in case.
 */
void 
clclear (void)
{
	XINT	tty, sout = STDOUT;

	if ((tty = c_ttyodes ("terminal")) == ERR)
	    c_erract (EA_ERROR);

	c_ttyso (sout, tty, NO);
	c_ttyclear (sout, tty);
	c_ttycdes (tty);
	c_fseti (sout, F_RAW, NO);
}


/* SLEEP -- Suspend execution for the specified number of seconds.
 */
void 
clsleep (void)
{
	register struct pfile *pfp;
	struct	operand o;

	pfp = newtask->t_pfp;
	pushbparams (pfp->pf_pp);	/* push sofirst popped is first param */
	if ( nargs (pfp) <= 0)
	    return;
	else {
	    popop();			/* discard the $n name	*/
	    opcast (OT_INT);
	    o = popop();		/* get the number of seconds */
	    c_tsleep (o.o_val.v_i);
	}
}


/* EDIT -- Call up a host system editor to edit a file.  The name of the editor
 * to be used is defined in the IRAF environment.  The command to be sent to
 * the host system to run the editor is defined by an SPRINTF style format
 * string in the EDCAP editor database.  The SPRINTF format is assumed to
 * contain exactly one %s sequence to be replaced by the name of the file(s)
 * to be edited.  If no %s sequence is present in the EDCAP entry, the
 * host_editor() function will add one at the end so that the filenames are
 * concatenated to the string in the EDCAP entry.
 */
void 
cledit (void)
{
	register struct pfile *pfp;
	char	oscmd[SZ_LINE], os_filelist[SZ_LINE];
	char	osfn[SZ_PATHNAME];
	struct	operand o;
	char	*envget();
	int	n;

	pfp = newtask->t_pfp;

	if ((n = nargs(pfp)) > 0) {
	    pushbparams (pfp->pf_pp);

	    /* Process the argument list into a list of files to be edited.
	     */
	    os_filelist[0] = EOS;
	    while (--n >= 0) {
		popop();		/* discard the $1 	*/
		o = popop();
		c_fmapfn (o.o_val.v_s, osfn, SZ_PATHNAME);
		if (os_filelist[0] != EOS)
		    strcat (os_filelist, " ");
		strcat (os_filelist, osfn);
	    }
	}

	/* Format the host editor command, and call the host system editor
	 * to edit the file(s).
	 */
	sprintf (oscmd, host_editor (envget ("editor")), os_filelist);
	c_oscmd (oscmd, "", "", "");
}


/* _ALLOCATE -- Allocate a device.  The parent process (i.e. the CL) allocates
 * (or mounts, depending on the system) the device, rendering it ready for
 * exclusive i/o by any subprocesses.  (Called from the allocate.cl and
 * deallocate.cl scripts in the SYSTEM pkg.)
 */
void 
clallocate (void)
{
	register struct pfile *pfp;
	register int	n;
	static char	noalloc[] = "cannot allocate device %s";
	struct	operand o;
	char	device[SZ_FNAME+1];
	char	owner[SZ_FNAME+1];

	pfp = newtask->t_pfp;
	if ((n = nargs (pfp)) == 0)
	    return;

	pushbparams (pfp->pf_pp);
	popop();			/* throw $1 away	*/
	opcast (OT_STRING);		/* param 1 == device	*/
	o = popop();
	strcpy (device, o.o_val.v_s);

	/* Verify that the device can be allocated.
	 */
	switch (c_devowner (device, owner, SZ_FNAME)) {
	case DV_DEVFREE:
	    break;			/* ok to allocate	*/
	case DV_DEVALLOC:
	    eprintf ("device %s is already allocated\n", device);
	    return;			/* already allocated	*/
	case DV_DEVINUSE:
	    cl_error (E_UERR, "device %s is already allocated to %s\n",
		device, owner);
	default:
	    cl_error (E_UERR, noalloc, device);
	}

	/* Allocate the device. */
	if (c_allocate (device) == ERR)
	    cl_error (E_UERR, noalloc, device);

	/* Keep count and save names of allocated devices.
	 */
	for (n=0;  n < MAX_ALLOCDEV;  n++) {
	    if (!allocdev[n].allocated)
		continue;
	    if (strcmp (allocdev[n].devname, device) == 0)
		return;	/* device already in table */
	}

	/* Find empty slot */
	for (n=0;  n < MAX_ALLOCDEV && allocdev[n].allocated;  n++)
	    ;
	if (n >= MAX_ALLOCDEV)
	    cl_error (E_UERR, "too many allocated devices");

	/* Save name of device */
	strncpy (allocdev[n].devname, device, SZ_DEVNAME);
	allocdev[n].devname[SZ_DEVNAME] = EOS;
	allocdev[n].allocated = 1;
	nallocdev++;
}


/* _DEALLOCATE -- Deallocate a device.
 */
void 
cldeallocate (void)
{
	register struct pfile *pfp;
	register int	n;
	static char	nodealloc[] = "cannot deallocate device %s";
	struct	operand o;
	char	device[SZ_FNAME+1];
	char	owner[SZ_FNAME+1];
	int	rewind=0, n_args;

	pfp = newtask->t_pfp;
	if ((n_args = nargs (pfp)) <= 0)
	    return;

	pushbparams (pfp->pf_pp); 	/* params in correct order	*/
	popop();			/* throw $1 away		*/
	opcast (OT_STRING);		/* param 1 == device name	*/
	o = popop();
	strcpy (device, o.o_val.v_s);

	if (n_args > 1) {
	    popop();			/* throw $2 away		*/
	    opcast (OT_BOOL);		/* param 2 == rewind flag	*/
	    o = popop();
	    rewind = o.o_val.v_i;
	}

	/* Verify that the device can be deallocated.
	 */
	switch (c_devowner (device, owner, SZ_FNAME)) {
	case DV_DEVFREE:
	    eprintf ("device %s is not allocated\n", device);
	    return;
	case DV_DEVALLOC:
	    break;			/* ok to deallocate	*/
	case DV_DEVINUSE:
	    cl_error (E_UERR, "device %s is currently allocated to %s\n",
		device, owner);
	default:
	    cl_error (E_UERR, nodealloc, device);
	}

	/* Deallocate the device. */
	if (c_deallocate (device, rewind) == ERR)
	    cl_error (E_UERR, nodealloc, device);

	/* Keep count and save names of allocated devices.
	 */
	for (n=0;  n < MAX_ALLOCDEV;  n++) {
	    if (!allocdev[n].allocated)
		continue;
	    if (strcmp (allocdev[n].devname, device) == 0) {
		allocdev[n].allocated = 0;
		--nallocdev;
		break;
	    }
	}
}


/* _DEVSTATUS -- Print the status of an allocatable device on the standard
 * output.
 */
void 
cldevstatus (void)
{
	register struct pfile *pfp;
	struct	operand o;
	char	device[SZ_FNAME+1];

	pfp = newtask->t_pfp;
	if (nargs (pfp) <= 0)
	    return;

	pushbparams (pfp->pf_pp); 	/* params in correct order	*/
	popop();			/* throw $1 away		*/
	opcast (OT_STRING);		/* param 1 == device name	*/
	o = popop();
	strcpy (device, o.o_val.v_s);

	/* Print the device status.  */
	c_devstatus (device, STDOUT);
}


/* XERROR -- Runtime error recovery opcode procedures.
 */

void 
clerrpsh (void)
{
        extern int do_error;
	extern ErrCom errcom;

        do_error = NO;
	errcom.nhandlers++;
	errcom.errflag = OK;
	if (cldebug)
	    eprintf ("in cl_errpush: do_error = %d\n", do_error);
}


void 
clerreset (void)
{
	extern ErrCom errcom;

        do_error = NO;
	errcom.errflag = OK;
	errcom.nhandlers = 0;
	if (cldebug)
	    eprintf ("in cl_erreset: do_error = %d\n", do_error);
}


/* CLONERROR -- Post an error handler to be called each time an error
 * is found.  
 *
 * NOTE: The handler posting is implemented but the call from the error
 * recovery itself is not due to complexities in establishing the context.
 * We will leave this in for now but it is effectively a no-op  (5/25/05)
 *
 */
void 
clonerror (void)
{
	struct	operand o;
	struct  pfile *pfp = newtask->t_pfp;
	struct  ltask *ltp;
	struct	package	*pkp;
	static  char handler[SZ_FNAME+1];
	extern  char *onerr_handler;


	handler[0] = NULL;
	pushbparams (pfp->pf_pp);
	if (nargs(pfp) > 0) {
	    popop();			/* discard the $n name		*/
	    o = popop();		/* get the handler arg name	*/
	    strcpy (handler, o.o_val.v_s);

	    /* Search all packages for the named task. _ltasksrch() does not 
	     * call error() and so can be used to check cleanly whether the
	     * task exists.
             */
	    if (handler[0] && (ltp = _ltasksrch ("", handler, &pkp)) == NULL) {
	        onerr_handler = NULL;
		cl_error (E_UERR, "onerr handler '%s' not found", handler);

	    } else {
	        onerr_handler = (handler[0] ? handler : NULL);

	        if (cldebug) {
	          if (onerr_handler)
		    eprintf ("onerror: posting handler '%s'\n", onerr_handler);
	          else
		    eprintf ("onerror: clearing onerr handler\n");
	        }
	    }
	}
}



/* ========================================================
 *
 * End of builtin functions.
 * What follows is their support code.
 *
 * ========================================================*/

/* SETBUILTINS -- Add the builtin functions to package at pkp (this should
 * always just be clpackage).  To add more functions, write the support function
 * and enter it into the builtin table, btbl.  Reverse alpha due to lifo nature
 * of list.  Aliases can be made easily with multiple b_names using the same
 * b_f.  Setting LT_INVIS will keep it from being seen in the menu.
 */
void 
setbuiltins (register struct package *pkp)
{
	/* Debugging functions are in debug.c.
	 */
	extern void d_f(), d_l(), d_d(), d_off(), d_on(), d_p(), d_t();
	extern void d_asmark(), d_assemble(), d_prof(), d_trace();
	extern void pr_listcache();

	static struct builtin {
		char	*b_name;
		void	(*b_f)();
		int	b_flags;
	} btbl[] = {
	  { "d_asmark", d_asmark, LT_INVIS},	/* mark assembler stack pos  */
	  { "d_assemble", d_assemble, LT_INVIS},/* "assemble" a CL script    */
	  { "d_f",      d_f,    LT_INVIS},/* shows available file descr	     */
	  { "d_l",      d_l,    LT_INVIS},/* shows define  ltasks	     */
	  { "d_m",      d_d,    LT_INVIS},/* shows memory usage		     */
	  { "d_off",    d_off,  LT_INVIS},/* disable debugging msgs	     */
	  { "d_on",     d_on,   LT_INVIS},/* enable debugging msgs	     */
	  { "d_p",      d_p,    LT_INVIS},/* show loaded param files	     */
	  { "d_t",      d_t,    LT_INVIS},/* show running tasks		     */
	  { "d_trace",  dotrace,LT_INVIS},/* instruction tracing toggle	     */
	  { "d_prof",   d_prof, LT_INVIS},/* script execution profiling	     */

	  { "prcache",  clprcache, 0},	  /* show process cache		 */
	  { "?",        clhelp, LT_INVIS},/* tasks in current package	 */
	  { "??",       clallhelp, LT_INVIS},/* all tasks in all packs	 */
	  { "wait",     clwait,    0},	  /* wait for all bkg jobs	 */
	  { "jobs",     cljobs,    0},	  /* show status of bkg jobs	 */
	  { "unlearn",  clunlearn, 0},	  /* unlearn params 		 */
	  { "update",   clupdate,  0},	  /* write out a changed pfile	 */
	  { "hidetask", clhidetask,0},    /* make these tasks invisible  */
	  { "task",     clntask,   0},	  /* define new ltask/ptask	 */
	  { "set",      clset,     0},	  /* make environ table entry	 */
	  { "reset",    clreset,   0},	  /* reset value of envvar	 */
	  { "show",     clshow,    0},	  /* show value of environ var	 */
	  { "stty",     clstty,    0},	  /* set terminal driver options */
	  { "redefine", clrtask,   0},	  /* redfine ltasl/ptask	 */
	  { "package",  clpack,    0},	  /* define new package		 */
	  { "_curpack", clcurpack,
		LT_INVIS},		  /* name the current package	 */
	  { "print",    clprint,   0},	  /* formatted output to stdout	 */
	  { "printf",   clprintf,  0},	  /* formatted output to stdout	 */
	  { "fprint",   clfprint,  0},	  /* formatted output		 */
	  { "putlog",   clputlog,  0}, 	  /* put a message to the logfile  */
	  { "dparam",   cldparam,  0},	  /* dump params for tasks	 */
	  { "lparam",   cllparam,  0},	  /* list params for tasks	 */
	  { "eparam",   cleparam,  0},	  /* edit params for tasks	 */
	  { "ehistory", clehistory, 0},	  /* edit command history	 */
	  { "history",  clhistory, 0},	  /* print command history	 */
	  { "service",  clservice, 0},	  /* respond to bkg query	 */
	  { "kill",     clkill,    0},	  /* kill a background job	 */
	  { "keep",     clkeep,    0},	  /* keep new defn's after bye	 */
	  { "error",    clerror,   0},	  /* error msg from child	 */
	  { ROOTPACKAGE, lapkg,
	    	LT_INVIS|LT_DEFPCK},	  /* fake task for language.	 */
	  { CLPACKAGE,  clpkg,
		LT_INVIS|LT_DEFPCK},	  /* fake task for clpackage.	 */
	  { "chdir",    clchdir,   0},	  /* change directory		 */
	  { "cd",       clchdir,   0},	  /* change directory		 */
	  { "back",     clback,    0},	  /* change to previous dir      */
	  { "flprcache",clflprcache, 0},  /* flush the process cache	 */
	  { "gflush",   clgflush,  0},	  /* flush graphics output	 */
	  { "cache",    clcache,   0},	  /* pre-load a tasks pfile	 */
	  { "which",    clwhich,   0},	  /* locate named task		 */
	  { "whereis",  clwhereis, 0},	  /* locate instances of task	 */
	  { "clbye",    clclbye, 	  /* cl() with EOF		 */
		LT_CL|LT_CLEOF},
	  { "bye",      clbye,     0},	  /* restore previous state	 */
	  { "logout",   cllogout,  0},	  /* log out of the CL		 */

	  { "scan",     clscans, 0},	  /* scan from a pipe		 */
	  { "scanf",    clscanf, 0},	  /* formatted scan 		 */
	  { "fscan",    clfunc,  0},	  /* intrinsic function entries	 */
	  { "defpac",   clfunc,  0},	  /* 		"		 */
	  { "defpar",   clfunc,  0},	  /* 		"		 */
	  { "defvar",   clfunc,  0},	  /* 		"		 */
	  { "deftask",  clfunc,  0},	  /* 		"		 */
	  { "access",   clfunc,  0},	  /* 		"		 */
	  { "imaccess", clfunc,  0},	  /* 		"		 */
	  { "mktemp",   clfunc,  0},	  /* 		"		 */
	  { "envget",   clfunc,  0},	  /* 		"		 */
	  { "radix",    clfunc,  0},	  /* 		"		 */
	  { "osfn",     clfunc,  0},	  /* 		"		 */
	  { "beep",     clbeep,  0},	  /* beep the terminal		 */
	  { "time",     cltime,  0},	  /* show the current time	 */
	  { "clear",    clclear, 0},	  /* clear the terminal screen	 */
	  { "edit",     cledit,  0},	  /* edit a file or files        */
	  { "sleep",    clsleep, 0},	  /* suspend process execution	 */

	  { "_allocate",   clallocate,   LT_INVIS},
	  { "_deallocate", cldeallocate, LT_INVIS},
	  { "_devstatus",  cldevstatus,  LT_INVIS},

	  { "_errpsh",  clerrpsh,  LT_INVIS},	/* push error handler	   */
	  { "_erreset", clerreset, LT_INVIS},	/* reset error handler	   */
	  { "onerror",  clonerror, 0},		/* post user error handler */

	  { "samp",         cl_Samp,      0},   /* SAMP master command 	   */

	  { "samp_trace",   clfunc,       0},   /* SAMP tracing toggle	   */
	  { "sampStatus",   clfunc,       0},   /* print/set status	   */
	  { "sampHandler",  clfunc,       0},   /* add a SAMP handler	   */
	  { "sampHubAccess",clfunc,       0},   /* is Hub running          */
	  { "sampAccess",   clfunc,       0},   /* is app running          */
	  { "sampMetadata", clfunc,       0},   /* declare app metadata    */
	};

	register struct builtin *bp;

	for (bp = btbl; bp < &btbl[sizeof(btbl)/sizeof(struct builtin)]; bp++)
	    newbuiltin (pkp, bp->b_name, bp->b_f, bp->b_flags, "", 0);
}


/* NEWBUILTIN -- Make a new ltask off pkp that will serve as a cl directive
 * builtin function.  Link in exactly the same fashion as newltask() but use
 * lt_f rather than lt_pname.  See paramsrch().  FP is a pointer to the function
 * that will perform the directive.  Flags is to be or'd in with lt_flags in
 * the new ltask.  Call error if no more core.
 */
void 
newbuiltin (
    struct package *pkp,		/* package which owns task	*/
    char *lname,			/* ltask name			*/
    void (*fp)(void),		/* pointer to builtin fcn	*/
    int flags,			/* task flags			*/
    char *ftprefix,		/* OSCMD prefix if foreign	*/
    int redef			/* permit redefinitions		*/
)
{
	register struct ltask *newltp;

	newltp = addltask (pkp, NULL, lname, redef);

	/* If no OSCMD prefix string is given use the logical task name,
	 * which must therefore be the same as the host task name.
	 */
	if (*ftprefix)
	    newltp->lt_ftprefix = comdstr (ftprefix);
	else
	    newltp->lt_ftprefix = newltp->lt_lname;

	newltp->lt_f = fp;
	newltp->lt_flags = (flags | LT_BUILTIN);
}


/* MKARGLIST -- Reconstruct the argument list of a task as an array of arg
 * pointers to arg strings of the form "expr" or "keyword=value".  Upon
 * output, argp[0] contains the task name and the function value is the
 * number of arguments, excluding argp[0].
 */
int 
mkarglist (
    register struct pfile *pfp,	/* pfile pointer		*/
    char *args,			/* string buffer for arg chars	*/
    char *argp[]		/* array of arg pointers	*/
)
{
	register char	*ip, *op;
	struct	operand o_v, o_n;
	int	argc, n;


	/* Construct an array of pointers to the argument strings.  argp[1] is
	 * the first argument; argp[0] is the task name.
	 */
	if ((argc = nargs(pfp)) > 0) {
	    pushbparams (pfp->pf_pp);
	    op = args;

	    argp[0] = newtask->t_ltp->lt_lname;

	    for (n=1;  n <= argc;  n++) {
		argp[n] = op;

		/* Get the parameter name.  If this is $N then we have a
		 * positional argument, otherwise we have a keyword=value
		 * argument, and the arg should be encoded in that form.
		 */
		o_n = popop();
		ip = o_n.o_val.v_s;
		if (*ip != '$') {
		    while ( (*op = *ip++) )
			op++;
		    *op++ = '=';
		}

		/* Get the parameter value. */
		opcast (OT_STRING);
		o_v = popop();
		ip = opindef(&o_v) ? "INDEF" : o_v.o_val.v_s;
		while (ip && (*op++ = *ip++))
		    ;
	    }

	    argp[n] = NULL;
	}

	return (argc);
}


/* PUSHFPARAMS -- Push the parameter list starting with pp forwards, that is,
 * push the pp first and work towards the last parameter.  Push two operands
 * per parameter: first the value, then the name.  Used when the parameters for
 * a builtin will be accessed right-to-left.
 */
void 
pushfparams (register struct param *pp)
{
	struct operand onam;

	onam.o_type = OT_STRING;
	for (;  pp;  pp = pp->p_np) {
	    paramget (pp, 'V');
	    onam.o_val.v_s = pp->p_name;
	    pushop (&onam);
	}
}


/* PUSHBPARAMS -- Push the parameter list starting with pp backwards, that is,
 * push the last param in the list first and work back up to pp.  Push two
 * operands per parameter: first the value, then the name.  Used when the
 * parameters for a builtin will be accessed left-to-right.
 */
void 
pushbparams (struct param *pp)
{
	struct operand onam;
	struct param *npp;

	if (pp == NULL)
	    return;		/* just a guard	*/
	npp = pp->p_np;
	if (npp != NULL)
	    pushbparams (npp);

	paramget (pp, 'V');
	onam.o_type = OT_STRING;
	onam.o_val.v_s = pp->p_name;
	pushop (&onam);
}


/* PUSHBPVALS -- Like pushbparams, but only the parameter value is pushed.
 */
void 
pushbpvals (struct param *pp)
{
	struct param *npp;


	if (pp == NULL)
	    return;		/* just a guard	*/
	npp = pp->p_np;
	if (npp != NULL)
	    pushbpvals (npp);

	paramget (pp, 'V');
}


/* NARGS -- Count the number of parameters in a parameter list, and hence
 * the number of command line arguments to a builtin.
 */
int 
nargs (struct pfile *pfp)
{
	struct	param	*pp;
	int	n;

	for (pp=pfp->pf_pp, n=0;  pp != NULL;  pp=pp->p_np)
	    n++;

	return (n);
}


/* KEEP -- Preserve additions to the dictionary and environment when the
 * referenced task terminates.
 */
void 
keep (register struct task *tp)
{
	if (cldebug) {
	    eprintf ("currentask: %d, prevtask: %d\n",currentask,prevtask);
	    eprintf ("keep(): tp: %d\n",tp);
	}
	tp->t_topd = topd;
	c_envmark (&tp->t_envp);
}