/* 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 #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, <name, &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, <name, &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); }