/* CL_VOCINIT -- Initialize the VO Client interface.
*/
void
cl_vocinit (void)
{
register struct pfile *pfp;
struct operand o;
int n, status;
if (VOClient_initialized == 0) {
c_xwhen (X_IPC, voc_onipc, &old_onipc);
pfp = newtask->t_pfp;
if ((n = nargs (pfp)) > 1) {
cl_error (E_UERR, e_posargs, "vocinit");
return;
} else if (n < 1) {
status = voc_initVOClient (envget("vo_runid"));
} else {
pushbparams (pfp->pf_pp);
popop(); /* discard fake name. */
opcast (OT_STRING);
o = popop(); /* get ltask */
status = voc_initVOClient (o.o_val.v_s);
}
if (status) {
cl_error (E_UERR, "Can't init VOClient", "vocinit");
} else
VOClient_initialized = 1;
}
}
/* CL_VOCRESET -- Restart the VO Client interface.
*/
void
cl_vocreset ()
{
int status;
voc_closeVOClient (1);
status = voc_initVOClient (envget("vo_runid"));
}
void
erract_init (void)
{
char *act, *envget();
char opt[SZ_LINE];
/* Parse the erract string to pick up new options.
*/
if ((act = envget ("erract"))) {
while (*act) {
NEXT_TOKEN;
if (strncmp (act, "abort", 3) == 0)
err_abort = YES;
else if (strncmp (act, "noabort", 3) == 0)
err_abort = NO;
else if (strncmp (act, "beep", 3) == 0)
err_beep = YES;
else if (strncmp (act, "nobeep", 3) == 0)
err_beep = NO;
else if (strncmp (act, "trace", 3) == 0)
err_trace = YES;
else if (strncmp (act, "notrace", 3) == 0)
err_trace = NO;
else if (strncmp (act, "flpr", 3) == 0)
err_flpr = YES;
else if (strncmp (act, "noflpr", 4) == 0)
err_flpr = NO;
else if (strncmp (act, "clear", 3) == 0)
err_clear = YES;
else if (strncmp (act, "noclear", 3) == 0)
err_clear = NO;
else if (strncmp (act, "full", 3) == 0)
err_full = YES;
else if (strncmp (act, "nofull", 4) == 0)
err_full = NO;
else if (*act != '\0')
eprintf ("unrecognized erract set-option `%s'\n", act);
NEXT_WHITE;
}
}
/* Now restore the environment variable to define all the options.
*/
sprintf (opt, "%s %s %s %s %s",
(err_abort ? "abort" : "noabort"),
(err_beep ? "beep" : "nobeep"),
(err_trace ? "trace" : "notrace"),
(err_flpr ? "flpr" : "noflpr"),
(err_clear ? "clear" : "noclear"),
(err_full ? "full" : "nofull") );
c_envreset ("erract", opt);
}
/* PIPEFILE -- Given the pipecode, format a pipefile name in static internal
* buffer and return pointer to pipefile name to caller.
*/
char *
pipefile (int pipecode)
{
static char fname[SZ_PIPEFILENAME+1];
char *dir;
char *envget();
/* Put pipefiles in 'pipes' or 'uparm' if defined, else use tmp. Do
* not put pipe files in current directory or pipe commands will fail
* when used in someone elses directory.
*/
if (envget ("pipes") != NULL)
dir = "pipes$";
else if (envget ("uparm") != NULL)
dir = "uparm$";
else
dir = "tmp$";
sprintf (fname, "%spipe%d", dir, pipecode);
return (fname);
}
/* FINDEXE -- Search a set of standard places for an executable file to be
* run. Currently, we check first in the logical directory BIN for the
* "installed" version of the executable, and if that is not found, use
* the pathname given, which is the pathname specified in the TASK declaration.
*/
char *
findexe (
struct package *pkg, /* package in which task resides */
char *pkg_path /* pathname of exe file given in TASK statement */
)
{
static char bin_path[SZ_PATHNAME+1], loc_path[SZ_PATHNAME+1];
char root[SZ_FNAME+1], root_path[SZ_PATHNAME+1];
char bindir[SZ_FNAME+1], *ip = NULL, *arch = NULL;
char bin_root[SZ_PATHNAME+1];
char *envget();
memset (root, 0, SZ_FNAME);
memset (bindir, 0, SZ_FNAME);
memset (bin_path, 0, SZ_PATHNAME);
memset (loc_path, 0, SZ_PATHNAME);
memset (bin_root, 0, SZ_PATHNAME);
memset (root_path, 0, SZ_PATHNAME);
c_fnroot (pkg_path, root, SZ_FNAME);
c_fpathname ((pkg ? pkg->pk_bin : BINDIR), root_path, SZ_PATHNAME);
sprintf (bin_path, "%s%s.e", pkg ? pkg->pk_bin : BINDIR, root);
sprintf (loc_path, "./%s.e", root);
arch = envget ("arch");
if (c_access (bin_path, 0, 0) == YES) {
return (bin_path);
} else {
/* The binary wasn't found in the expected bin directory, but
* on certain platforms look for alternate binaries that may
* work. This supports backward compatability with older
* packages that may not have been upgraded to architecture
* conventions in this release but which may contain usable
* binaries (e.g. 32-bit 'linux' binaries on 64-bit systems
* or older 'redhat' binaries where the core arch is 'linux').
*/
memset (bin_root, 0, SZ_PATHNAME);
strcpy (bin_root, root_path);
if ((ip = strstr (bin_root, arch)))
*ip = '\0';
else {
int len = strlen (bin_root);
if (bin_root[len-1] == '/')
bin_root[len-1] = '\0';
}
if (strcmp (arch, ".linux64") == 0) {
/* On 64-bit Linux systems we can use either of the
* available 32-bit binaries if needed. In v2.15 and
* later, 'linux' is the preferred arch but look for
* 'redhat' in case it's a package that hasn't been
* updated.
*/
sprintf (bin_path, "%s.linux/%s.e", bin_root, root);
if (c_access (bin_path, 0, 0) == YES)
return (bin_path);
sprintf (bin_path, "%s.redhat/%s.e", bin_root, root);
if (c_access (bin_path, 0, 0) == YES)
return (bin_path);
} else if (strcmp (arch, ".linux") == 0) {
/* On 32-bit Linux systems, check for older 'redhat' binaries.
*/
sprintf (bin_path, "%s.redhat/%s.e", bin_root, root);
if (c_access (bin_path, 0, 0) == YES)
return (bin_path);
} else if (strcmp (arch, ".macintel") == 0) {
/* On 64-bit Mac systems, check for older 32-bin binaries.
*/
sprintf (bin_path, "%s.macosx/%s.e", bin_root, root);
if (c_access (bin_path, 0, 0) == YES)
return (bin_path);
} else if (strcmp (arch, ".macosx") == 0) {
/* On 32-bit Mac systems, check for older 'macintel' binaries.
*/
sprintf (bin_path, "%s.macintel/%s.e", bin_root, root);
if (c_access (bin_path, 0, 0) == YES)
return (bin_path);
}
}
if (c_access (pkg_path, 0, 0) == YES)
return (pkg_path);
else
return (loc_path);
}
/* LOGIN -- Hand-craft the first cl process. Push the first task to become
* currentask, set up clpackage at pachead and set cl as its first ltask.
* Add the builtin function ltasks. Run the startup file as the stdin of cl.
* If any of this fails, we die.
*/
static void
login (char *cmd)
{
register struct task *tp;
register char *ip, *op;
struct ltask *ltp;
struct operand o;
char *loginfile = LOGINFILE;
char alt_loginfile[SZ_PATHNAME];
char clstartup[SZ_PATHNAME];
char clprocess[SZ_PATHNAME];
char *arglist;
strcpy (clstartup, HOSTLIB);
strcat (clstartup, CLSTARTUP);
strcpy (clprocess, CLDIR);
strcat (clprocess, CLPROCESS);
tp = firstask = currentask = pushtask();
tp->t_in = tp->t_stdin = stdin;
tp->t_out = tp->t_stdout = stdout;
tp->t_stderr = stderr;
tp->t_stdgraph = fdopen (STDGRAPH, "w");
tp->t_stdimage = fdopen (STDIMAGE, "w");
tp->t_stdplot = fdopen (STDPLOT, "w");
tp->t_pid = -1;
tp->t_flags |= (T_INTERACTIVE|T_CL);
/* Make root package. Avoid use of newpac() since pointers are not
* yet set right.
*/
pachead = topd;
curpack = (struct package *) memneed (PACKAGESIZ);
curpack->pk_name = comdstr (ROOTPACKAGE);
curpack->pk_ltp = NULL;
curpack->pk_pfp = NULL;
curpack->pk_npk = NULL;
curpack->pk_flags = 0;
/* Make first ltask.
*/
ltp = newltask (curpack, "cl", clprocess, (struct ltask *) NULL);
tp->t_ltp = ltp;
ltp->lt_flags |= (LT_PFILE|LT_CL);
tp->t_pfp = pfileload (ltp); /* call newpfile(), read cl.par */
tp->t_pfp->pf_npf = NULL;
setclmodes (tp); /* uses cl's params */
setbuiltins (curpack); /* add more ltasks off clpackage*/
/* Define the second package, the "clpackage", and make it the
* current package (default package at startup). Tasks subsequently
* defined by the startup script will get put in clpackage.
*/
curpack = newpac (CLPACKAGE, "bin$");
/* Compile code that will run the startup script then, if it exists
* in the current directory, a login.cl script. We need to do as
* much by hand here as the forever loop in main would have if this
* code came from calling yyparse().
*/
if (c_access (clstartup,0,0) == NO)
cl_error (E_FERR, "Cannot find startup file `%s'", clstartup);
currentask->t_bascode = 0;
pc = 0;
o.o_type = OT_STRING;
o.o_val.v_s = clstartup;
compile (CALL, "cl");
compile (PUSHCONST, &o);
compile (REDIRIN);
compile (EXEC);
compile (FIXLANGUAGE);
/* The following is to permit error recovery in the event that an
* error occurs while reading the user's LOGIN.CL file.
*/
validerrenv = 1;
if (setjmp (errenv)) {
eprintf ("Error while reading login.cl file");
eprintf (" - may need to rebuild with mkiraf\n");
eprintf ("Fatal startup error. CL dies.\n");
clexit();
}
ninterrupts = 0;
if (setjmp (jumpcom))
onerr();
/* Nondestructively decompose the host command line into the startup
* filename and/or the argument string.
*/
if (strncmp (cmd, "-f", 2) == 0) {
for (ip=cmd+2; *ip && isspace(*ip); ip++)
;
for (op=alt_loginfile; *ip && ! isspace(*ip); *op++ = *ip++)
;
*op = EOS;
for ( ; *ip && isspace(*ip); ip++)
;
arglist = ip;
} else {
*alt_loginfile = EOS;
arglist = cmd;
}
/* Copy any user supplied host command line arguments into the
* CL parameter $args to use in the startup script (for instance).
*/
o.o_type = OT_STRING;
strcpy (o.o_val.v_s, arglist);
compile (PUSHCONST, &o);
compile (ASSIGN, "args");
if (alt_loginfile[0]) {
if (c_access (alt_loginfile,0,0) == NO)
printf ("Warning: script file %s not found\n", alt_loginfile);
else {
o.o_val.v_s = alt_loginfile;
compile (CALL, "cl");
compile (PUSHCONST, &o);
compile (REDIRIN);
compile (EXEC);
}
} else if (c_access (loginfile,0,0) == NO) {
char *home = envget ("HOME");
char global[SZ_LINE];
memset (global, 0, SZ_LINE);
sprintf (global, "%s/.iraf/login.cl", home);
if (c_access (global, 0, 0) == YES) {
o.o_val.v_s = global;
compile (CALL, "cl");
compile (PUSHCONST, &o);
compile (REDIRIN);
compile (EXEC);
} else {
printf ("Warning: no login.cl found in login directory\n");
}
} else {
o.o_val.v_s = loginfile;
compile (CALL, "cl");
compile (PUSHCONST, &o);
compile (REDIRIN);
compile (EXEC);
}
compile (END);
topos = basos = pc - 1;
pc = 0;
run(); /* returns after doing the first EXEC */
/* Add nothing here that will effect the dictionary or the stacks.
*/
if (cldebug)
printf ("topd, pachead, parhead: %u, %u, %u\n",
topd, pachead, parhead);
}
