/* BKG_WFSERVICE -- Determine if a bkg job is waiting for service (for the
* user to answer a query).
*/
int
bkg_wfservice (int job)
{
char bkg_query_file[SZ_PATHNAME];
char query_response_file[SZ_PATHNAME];
get_bkgqfiles (job, c_getpid(), bkg_query_file, query_response_file);
return (c_access (bkg_query_file,0,0));
}
/* ADDPIPE -- Generate a new pipe file name and push it onto the pipe stack.
* The strategy is to generate a unique pipefile name of the form "pipeXXX",
* where XXX is an integer of 5 digits or less which is what is saved on the
* pipe stack. Return a pointer to the name of the new pipefile.
*/
char *
addpipe (void)
{
static int pipecode = 0;
char *pipefile();
if (pipecode == 0)
pipecode = c_getpid();
/* Get unique pipefile name described by a simple integer.
*/
do {
/*
* There seems to be a problem with this code in the VMS compiler.
* It has been changed to a form which will work for UNIX and VMS.
*
* pipecode = (pipecode++ % MAX_PIPECODE);
*/
pipecode %= MAX_PIPECODE;
/* There can be applications where multiple CL are spawned in
* relatively short order so that the PIDs are close. Incrementing
* the least significant digits can result in duplications. So
* instead we use the lower digits as the "unique" part and
* increment the higer digits.
*
* pipecode++;
*/
pipecode += 1000;
} while (c_access (pipefile(pipecode),0,0) == YES);
pipetable[nextpipe++] = pipecode;
if (nextpipe >= MAXPIPES)
cl_error (E_UERR, "Too many pipes");
return (pipefile (pipecode));
}
/* WBKGFILE -- Create a unique file, write and close the background file.
* Jobno is the job number the new cl is to think its running for.
* We don't use the global bkgno because that's OUR number, if we ourselves
* are background.
* Return pointer to the new name.
* No error return, but we may call error() and never return.
*/
char *
wbkgfile (
int jobno, /* ordinal jobnumber of child */
char *cmd, /* command to be run in bkg */
char *fname /* filename for env file */
)
{
static char *bkgwerr = "error writing background job file";
static char bkgfile[SZ_PATHNAME];
struct bkgfilehdr bh;
int n, show_redefs=NO;
FILE *fp;
/* If we're a normal background job no name was specified so
* create a unique uparm file. Otherwise, use the specified
* filename (e.g. for special onerr handling).
*/
if (fname == (char *)NULL)
c_mktemp ("uparm$bkg", bkgfile, SZ_PATHNAME);
else {
if (c_access (fname,0,0) == YES)
c_delete (fname);
strncpy (bkgfile, fname, strlen(fname));
}
/* Open the file. */
if ((fp = fopen (bkgfile, "wb")) == NULL)
cl_error (E_IERR, "unable to create background job file `%s'",
bkgfile);
for (n=0; n < MAXPIPES; n++)
bh.b_pipetable[n] = pipetable[n];
bh.b_nextpipe = nextpipe;
strncpy (bh.b_cmd, cmd, SZ_BKCMD);
bh.b_magic = BKG_MAGIC;
bh.b_bkgno = jobno;
bh.b_ppid = c_getpid();
bh.b_szstack = STACKSIZ * BPI;
bh.b_szdict = topd * BPI;
bh.b_dict = dictionary;
bh.b_topd = topd;
bh.b_maxd = maxd;
bh.b_parhead = parhead;
bh.b_pachead = pachead;
bh.b_pc = pc;
bh.b_topos = topos;
bh.b_basos = basos;
bh.b_topcs = topcs;
bh.b_firstask = firstask;
bh.b_currentask = currentask;
bh.b_curpack = curpack;
/* Write the header structure, followed by the stack area and the
* dictionary.
*/
if (fwrite ((char *)&bh, BKGHDRSIZ, 1, fp) == NULL)
cl_error (E_IERR|E_P, bkgwerr);
if (fwrite ((char *)stack, STACKSIZ, BPI, fp) == NULL)
cl_error (E_IERR|E_P, bkgwerr);
if (fwrite ((char *)dictionary, topd, BPI, fp) == NULL)
cl_error (E_IERR|E_P, bkgwerr);
/* Write the environment as a sequence of SET statements in binary.
* Append a blank line as a terminator.
*/
c_envlist (fileno(fp), "set ", show_redefs);
fputs ("\n", fp);
fclose (fp);
return (bkgfile);
}
/* 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);
}
