path: root/pkg/vocl/task.c

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

#define import_spp
#define import_libc
#define import_stdio
#include <iraf.h>

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


/*
 * TASK -- Operators for tasks.
 */

extern int cldebug;
extern char *nullstr;
extern struct param *clabbrev;	/* used to inhibit abbrevs in addltask	*/

extern	int errorline, currentline;

struct task *firstask;		/* ptr to original cl task		*/
struct task *newtask;		/* ptr to new, but unlinked, task	*/
struct task *currentask;	/* ptr to ltask currently running	*/
struct package *curpack;	/* current package in effect		*/

XINT pachead;			/* dict index of first package		*/


/* CMDSRCH -- Used by callnewtask() to find the ltask to be run.  Ltname is
 *   the name of the logical task to be run.  pkname is the name of an
 *   explicit package.  If pkname is set, just look through its ltasks,
 *   otherwise circularly search through all packages starting at curpack.
 * Once we have found an ltask, we see if there is a package with the same
 *   (full) name.  If there is, we return a pointer to the special pacltask
 *   with LT_PACCL flag set to signal callnewtask() to just change packages.
 *   if there isn't, just return a pointer to the ltask.
 * Ltasksrch() should be used if you don't want all this package checking...
 * Call error() and don't return on any kind of error.
 * We need a fake rootpackage entry to be able to change the current package
 *   to clpackage; see clpkg().
 */
struct ltask *
cmdsrch (char *pkname, char *ltname)
{
	register struct ltask *ltp = (struct ltask *) NULL;
	register struct package *pkp, *pkcand;
	static	struct ltask pacltask;	/* used to signal a package change */
	struct	ltask *temptaskset();
	char	*name;

	if (*pkname != '\0') {      /* package name included; just search it.*/
	    pkp = pacfind (pkname);
	    if (pkp == NULL)
		cl_error (E_UERR, e_pcknonexist, pkname);
	    else if ((XINT)pkp == ERR)
		cl_error (E_UERR, e_pckambig, pkname);
	    else
		ltp = ltaskfind (pkp, ltname, 1);

	    if (ltp == NULL) { 
		errorline = currentline; 
		cl_error (E_UERR, e_tnonexist, ltname);
	    }

	    if ((XINT)ltp == ERR)
		cl_error (E_UERR, e_tambig, ltname);

	} else
	    /* Search all packages. ltasksrch() does not return if it has
	     * problems so we can count on ltp being set here.
	     */
	    ltp = ltasksrch ("", ltname);

	/* If this task did not define a package, just go with it.
 	 * Otherwise, search around for package with same name and use it.
	 * Don't use pacfind() since always want exact matches only.
	 * If can't find the package now, it must have been existed so we
	 * should run the task again.
	 */
	if (!(ltp->lt_flags & LT_DEFPCK))
	    return (ltp);

	name = ltp->lt_lname;
	pkcand = NULL;

	for (pkp = reference(package,pachead);  pkp;  pkp = pkp->pk_npk)
	    if (!strcmp (name, pkp->pk_name)) {
		if (pkcand == NULL)
		    pkcand = pkp;
		else
		    pkcand = (struct package *) ERR;
	    }

	if (pkcand == (struct package *) ERR)
	    cl_error (E_UERR, e_pckambig, name);

	if (pkcand == NULL)
	    return (ltp);
	else {
	    /* Just change to the given package.
	     * If unions could be inited, we could set lt_flags once in
	     *   its declaration above. phooey.
	     * Use lt_pkp to return new package. see callnewtask().
	     */
	    pacltask.lt_flags = (LT_PACCL|LT_CL);
	    pacltask.lt_pkp = pkcand;
	    return (&pacltask);
	}
}


/* LTASKSRCH -- Find ltask of given name along standard path, ie, circularly
 *   through all packages starting with curpack.  If name included package name
 *   explicitly, it will be in pkname and then just look down it.
 * Use abbreviations if enabled. always accept an exact match, even if it
 *   happened to match more than one longer name as an abbreviation.
 * Use cmdsrch() if want to include packages themselves in search path.
 * Always return a valid pointer; call error() and don't return on any kind of
 *   error.
 */
struct ltask *
ltasksrch (char *pkname, char *ltname)
{
	struct	ltask *ltp;
	struct	package *pkp;

	ltp = _ltasksrch (pkname, ltname, &pkp);

	if (*pkname != EOS) {
	    if (pkp == NULL)
		cl_error (E_UERR, e_pcknonexist, pkname);
	    if ((XINT)pkp == ERR)
		cl_error (E_UERR, e_pckambig, pkname);
	}

	if (ltp == NULL)
	    cl_error (E_UERR, e_tnonexist, ltname);
	if (ltp == (struct ltask *) ERR)
	    cl_error (E_UERR, e_tambig, ltname);

	return (ltp);
}


/* _LTASKSRCH -- Same as ltasksrch(), except that cl_error is not called.
 */
struct ltask *
_ltasksrch (char *pkname, char *ltname, struct package **o_pkp)
{
	register struct ltask *ltp, *ltcand;
	register struct package *pkp;
	register char first_char = ltname[0];

	ltcand = NULL;
	if (*pkname != '\0') {
	    /* Package name included; just search it. */
	    pkp = pacfind (pkname);
	    if (pkp != NULL && (XINT)pkp != ERR)
		ltcand = ltaskfind (pkp, ltname, 1);

	} else if (abbrev()) {
	    /* Settle for abbreviation. */
	    int     n = strlen (ltname);
	    int     hit_in_curpack = 0;

	    pkp = curpack;
	    do {
		for (ltp = pkp->pk_ltp;  ltp;  ltp = ltp->lt_nlt) {
		    if (*ltp->lt_lname == first_char) {
			if (!strncmp (ltp->lt_lname, ltname, n)) {
			    if (ltp->lt_lname[n] == '\0') {	/* exact hit */
				*o_pkp = pkp;
				return (ltp);
			    }
			    /* Only accept exact hits for hidden tasks.
			     */
			    if (ltp->lt_flags & LT_INVIS)
				continue;
			    if (ltcand == NULL)
				ltcand = ltp;
			    else if (!hit_in_curpack)
				ltcand = (struct ltask *) ERR;
			}
		    }
		}

		/* If an acceptable abbreviation was found in the current
		 * package, use it, unless an exact match is found in some
		 * other package.
		 */
		if (ltcand && pkp == curpack)
		    hit_in_curpack++;

		/* Circular search. */
		if ((pkp = pkp->pk_npk) == NULL)
		    pkp = reference (package, pachead);

	    } until (pkp == curpack);

	} else {
	    /* Require exact match */
	    pkp = curpack;
	    do {
		for (ltp = pkp->pk_ltp;  ltp;  ltp = ltp->lt_nlt)
		   if (*ltp->lt_lname == first_char)
		       if (!strcmp (ltp->lt_lname, ltname))
		           return (ltp);
		if ((pkp = pkp->pk_npk) == NULL)
		    pkp = reference (package, pachead);
	    } until (pkp == curpack);
	}

	*o_pkp = pkp;
	return (ltcand);
}


/* PACFIND -- Start at pachead and look for package with given name.  Allow
 * abbreviations if enabled. return ERR if ambiguous.  Return its pointer or
 * NULL if not found.
 */
struct package *
pacfind (char *name)
{
	struct	package *pkp;
	struct	package *candidate;
	int	n;

	if (abbrev()) {
	    /* Settle for abbreviation of name.
	     * Check whole list in we can find an exact match.
	     */
	    candidate = NULL;
	    n = strlen (name);
	    for (pkp = reference(package,pachead);  pkp;  pkp = pkp->pk_npk)
		if (!strncmp (pkp->pk_name, name, n)) {
		    if (pkp->pk_name[n] == '\0')
			return (pkp);   /* exact hit */
		    if (candidate == NULL)
			candidate = pkp;
		    else
			candidate = (struct package *) ERR;
		}

	    return (candidate);

	} else for (pkp = reference(package,pachead);  pkp;  pkp = pkp->pk_npk)
	    if (!strcmp (pkp->pk_name, name))
		return (pkp);
	return (NULL);
}


/* DEFPAC -- Return true/false if the named package is/isnot loaded.
 * Call error if an ambiguous abbreviation is given.
 */
int 
defpac (char *pkname)
{
	switch ((XINT) pacfind (pkname)) {
	case NULL:
	    return (NO);
	case ERR:
	    cl_error (E_UERR, e_pckambig, pkname);
	default:
	    return (YES);
	}
}


/* LTASKFIND -- Start at given package and look for ltask with given name.
 * Return NULL if not found, ERR if ambiguous or pointer if found.
 */
struct ltask *
ltaskfind (
    struct package *pkp,			/* package to be searched	*/
    char *name,				/* ltask name			*/
    int enable_abbreviations		/* enable abbrev. in search	*/
)
{
	register struct ltask *ltp;
	struct	ltask *candidate;
	int	n;

	if (enable_abbreviations && abbrev()) {
	    /* Settle for abbreviation of nam.
	     * Check whole list in case we can find an exact match.
	     */
	    candidate = NULL;
	    n = strlen (name);
	    for (ltp = pkp->pk_ltp;  ltp;  ltp = ltp->lt_nlt)
		if (!strncmp (ltp->lt_lname, name, n)) {
		    if (ltp->lt_lname[n] == '\0')
			return (ltp);		/* exact hit */
		    if (candidate == NULL)
			candidate = ltp;
		    else
			candidate = (struct ltask *) ERR;
		}

	    return (candidate);

	} else {
	    /* Accept exact match only. */
	    for (ltp = pkp->pk_ltp;  ltp;  ltp = ltp->lt_nlt)
		if (!strcmp (ltp->lt_lname, name))
		    return (ltp);
	}

	return (NULL);
}


/* DEFTASK -- Return true/false if the named ltask is/is not defined.
 * If a specific package is named, look only there; otherwise search
 * the usual path.  Call error if an ambiguous abbreviation is given.
 */
int 
deftask (char *task_spec)
{
	char	buf[SZ_LINE];
	char	*pkname, *ltname, *junk;
	struct	package *pkp;
	int	stat;

	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 = (XINT) ltaskfind (pkp, ltname, 1)) == NULL)
		return (NO);

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

	    while (pkp != NULL) {
		stat = (XINT) ltaskfind (pkp, ltname, 1);
		if (stat == ERR)
		    break;
		else if (stat != NULL)
		    return (YES);
		pkp = pkp->pk_npk;
	    }
	}

	if (stat == ERR)
	    cl_error (E_UERR, e_tambig, ltname);
	if (stat != NULL)
	    return (YES);
	return (NO);
}


/* TASKUNWIND -- Used when aborting from an error or on interrupt, NOT on bye
 *   or eof.  Starting with top task state, keep popping and killing tasks
 *   until find one that is T_INTERACTIVE, closing files and pipes along the
 *   way.
 * Restore dictionary and stack to what they were when the new (now
 *   current) task last started compiling with yyparse().  See runtask().
 * Do NOT update parameter files when a task dies abnormally, just from
 *   a proper "bye" command or eof.
 */

int unwind_level = 0;

void 
taskunwind (void)
{
	struct task *lastask = currentask;

	unwind_level = 0;
	while (!(currentask->t_flags & T_INTERACTIVE)) {
	    if (cldebug)
		eprintf ("taskunwind: %d  current='%s'/'%s' status=%d\n",
		    currentask,
		    currentask->t_ltp->lt_lname, currentask->t_ltp->lt_pname,
		    currentask->t_call->status);

	    killtask (currentask);
	    currentask = poptask();
	    if (lastask == currentask)
		break;
	}

	restor (currentask);
}


/* ADDLTASK -- Make a new ltask off curpack with given ltname/ptname.
 * Check through whole list and warn about redefs unless redef flag is set.
 * Look for .cl (script task) or .par (pset task) specs in ptname, and $
 *   (no pfile) and trailing .bt (io file type) specs in ltname and set
 *   lt_flags accordingly.
 * Actual new ltask entry made with newltask() and it re-uses dictionary space
 *   for the ptask name if possible.
 * Write error messages here and return ERR if problems, else OK.  Be sure they
 *   use the same format as error() for consistency.
 * Do not use abbreviations when checking for possible redefs.
 * Newltask() may call error() if it can not get enough core.
 * N.B. ptname and ltname may be changed IN PLACE to simplify suffix tests.
 */
struct ltask *
addltask (struct package *pkp, char *ptname, char *ltname, int redef)
{
	register char *cp;
	register struct ltask *ltp;
	char	*rindex();
	char	*ltbase;
	int	flags;

	flags = 0;
	ltbase = ltname;
	if (*ltbase == '$')
	    ltbase++;
	else
	    flags |= LT_PFILE;

	/* A leading underscore signifies that the task is not part of the
	 * user interface, and hence should not appear in menus etc.  Set
	 * the LT_INVIS flag, but leave the underscore in the name.
	 */
	if (*ltbase == CH_INVIS)
	    flags |= LT_INVIS;

	/* Check for trailing .bt etc. specs on logical task name.
	 */
	if ((cp = rindex (ltbase, '.')) != NULL) {
	    /* replace '.' with '\0' in hopes of finding valid specs.
	     * if invalid, put back before giving error diagnostic.
	     */
	    *cp++ = '\0';
	    if (!strcmp (cp, "pkg"))
		flags |= LT_DEFPCK;
	    else if (!strcmp (cp, "bt"))
		flags |= LT_STDINB;
	    else if (!strcmp (cp, "tb"))
		flags |= LT_STDOUTB;
	    else if (!strcmp (cp, "bb") || !strcmp (cp, "b"))
		flags |= (LT_STDOUTB|LT_STDINB);
	    else if (strcmp (cp, "tt") && strcmp (cp, "t")) {
		*--cp = '.';
		eprintf ("ERROR: bad binary io spec in `%s'\n", ltbase);
		return (NULL);
	    }
	}

	/* Check to see if this is a redefined task.  Inhibit ltaskfind()
	 * from using abbreviations during redef check.
	 */
	ltp = ltaskfind (pkp, ltbase, 0);
	if (ltp != NULL) {
	    if (!redef)
		eprintf ("WARNING: `%s' is a task redefinition.\n", ltbase);
	} else if (redef)
	    eprintf ("WARNING: `%s' is not a defined task.\n", ltbase);

	/* Check for trailing .cl spec in physical task name to indicate
	 * a script task, or a .par to indicate a pset task.
	 */
	if (ptname && (cp = rindex (ptname, '.')) != NULL) {
	    cp++;
	    if (!strcmp (cp, "cl"))
		flags |= LT_SCRIPT;
	    else if (!strcmp (cp, "par"))
		flags |= (LT_SCRIPT|LT_PSET);
	}

	ltp = newltask (pkp, ltbase, ptname, ltp);
	ltp->lt_flags = flags;

	return (ltp);
}


/* NEWLTASK -- Allocate a new ltask on the dictionary and link in off package
 *   *pkp.  Compile logical name, lname, immediately after.
 * Look for and reuse physical name, pname, if possible else compile next.
 *   this is more than a simple savings of core. all ltasks within a ptask will
 *   have the same lt_pname pointer so, for example, we can test
 *   newtask->t_ltp->lt_pname == currentask->t_ltp->lt_pname to decide if the
 *   next ltask is part of the current ptask.
 * Don't do anything with lt_pname if LT_BUILTIN is set since it uses the
 *   field (in a union) as a pointer to the built-in function. see task.h.
 * Link the new ltask immediately off the package at pkp->pk_ltp. this is so
 *   in a linear search the most recently added task will be seen first.
 * For task redefinitions don't allocate a new logical task.  Re-use the
 *   old block and don't change any of the links to the package and other
 *   tasks.
 * Null out all unused fields.
 */
struct ltask *
newltask (register struct package *pkp, char *lname, char *pname, struct ltask *oldltp)
{
	register struct ltask *ltp, *newltp;

	if (oldltp == NULL) {
	    newltp = (struct ltask *) memneed (LTASKSIZ);
	    newltp->lt_lname = comdstr (lname);
	} else
	    newltp = oldltp;

	/* Look for another ltask with same pname; use it again if find else
	 * compile in a new pname.  Don't do anything, however, if LT_BUILTIN
	 * is set as it does not use this union member this way.
	 */
	if (pname) {
	    for (ltp = pkp->pk_ltp;  ltp != NULL;  ltp = ltp->lt_nlt) {
		if (!(ltp->lt_flags & LT_BUILTIN)) {
		    if (strcmp (ltp->lt_pname, pname) == 0) {
			newltp->lt_pname = ltp->lt_pname;
			goto link;
		    } 
		}
	    }
	    newltp->lt_pname = comdstr (pname);
	} else
	    newltp->lt_pname = "";

link:
	if (oldltp == NULL) {
	    /* Link in as first ltask off this package.
	     */
	    newltp->lt_nlt = pkp->pk_ltp;
	    pkp->pk_ltp = newltp;
	    newltp->lt_pkp = pkp;	/* set the back-link		*/
	}

	newltp->lt_flags = 0;
	return (newltp);
}


/* NEWPAC -- Allocate a new package with given name on the dictionary and
 * link in at pachead. compile name in-line immediately after.
 * null out all unused fields.
 * call error() if no core or if name already exists.
 */
struct package *
newpac (char *name, char *bin)
{
	register struct package *pkp;

	if (pacfind (name) != NULL)
	    cl_error (E_UERR, "package `%s' already exists", name);

	pkp = (struct package *) memneed (PACKAGESIZ);
	pkp->pk_name = comdstr (name);
	pkp->pk_bin = bin ? comdstr(bin) : curpack->pk_bin;

	pkp->pk_npk = reference (package, pachead);
	pachead = dereference (pkp);

	pkp->pk_ltp = NULL;
	pkp->pk_pfp = NULL;
	pkp->pk_flags = 0;

	return (pkp);
}