void
o_doaddpipe (memel *argp)
{
XINT getpipe_pc = *argp;
char *x1, *pk, *t, *x2;
char *ltname;
struct operand o;
struct ltask *ltp;
char *addpipe();
/* ADDPIPE is called immediately before REDIR and before EXEC so we
* do not have to worry about storing the pipefile name in the dict.
* Our argument is the PC of the GETPIPE instruction, the args field
* of which is the taskname of the second task in the pipe. If either
* the new task (first task in the pipe) or the second task is a
* FOREIGN task, the pipe must be created as a text file.
*/
ltname = (char *)&(coderef(getpipe_pc)->c_args);
if (*ltname == '$')
ltname++;
breakout (ltname, &x1, &pk, &t, &x2);
ltp = cmdsrch (pk, t);
binpipe = ((ltp == NULL || !(ltp->lt_flags & LT_FOREIGN)) &&
!(newtask->t_flags & T_FOREIGN));
if (binpipe)
newtask->t_flags |= T_STDOUTB;
o.o_type = OT_STRING;
o.o_val.v_s = comdstr (addpipe());
pushop (&o);
}
/* <name of file to be used as stdout> .
*/
void
o_redir (void)
{
struct operand o;
char *fname, *mode;
opcast (OT_STRING);
o = popop();
fname = (o.o_val.v_s);
if (newtask->t_flags & T_FOREIGN && newtask->t_stdout == stdout) {
/* If foreign task let ZOSCMD open the spool file.
*/
newtask->ft_out = comdstr (fname);
} else if (strcmp (fname, IPCOUT) == 0) {
/* Redirect the task stdout via IPC to a subprocess. */
newtask->t_stdout = newtask->t_out;
newtask->t_flags |= T_IPCIO;
} else {
mode = (newtask->t_flags & T_STDOUTB) ? "wb" : "w";
if ((newtask->t_stdout = fopen (fname, mode)) == NULL)
cl_error (E_UERR, e_wopen, fname);
newtask->t_flags |= T_MYOUT;
}
}
/* <name of file to be used as stderr> .
* redirect everything, including the stderr channel.
*/
void
o_allredir (void)
{
struct operand o;
char *fname, *mode;
opcast (OT_STRING);
o = popop();
fname = (o.o_val.v_s);
if (newtask->t_flags & T_FOREIGN &&
newtask->t_stdout == stdout && newtask->t_stderr == stderr) {
/* If foreign task and i/o has not already been redirected by
* the parent, let ZOSCMD open the spool file.
*/
newtask->ft_out = newtask->ft_err = comdstr (fname);
} else {
mode = (newtask->t_flags & T_STDOUTB) ? "wb" : "w";
if ((newtask->t_stderr = fopen (fname, mode)) == NULL)
cl_error (E_UERR, e_wopen, fname);
newtask->t_stdout = newtask->t_stderr;
newtask->t_flags |= (T_MYOUT|T_MYERR);
}
}
/* SETLABEL -- called when a label is first seen. It allocates
* space for the label on the dictionary and also copies the
* label name onto the dictionary. The label is placed at the
* top of a linked list.
*/
struct label *
setlabel (struct operand *name)
{
struct label *p;
p = (struct label *) memneed (sizeof(struct label));
p->l_name = comdstr (name->o_val.v_s);
if (label1 == NULL)
p->l_next = NULL;
else
p->l_next = label1;
label1 = p;
return (p);
}
void
o_dogetpipe (
memel *argp /* name of ltask (not used) */
)
{
struct operand o;
char *getpipe(), *comdstr();
/* GETPIPE is called immediately before REDIRIN and before EXEC so we
* do not have to worry about storing the pipefile name in the dict.
* The flag binpipe is set by the last ADDPIPE if the pipe is a binary
* file.
*/
if (binpipe)
newtask->t_flags |= T_STDINB;
o.o_type = OT_STRING;
o.o_val.v_s = comdstr (getpipe());
pushop (&o);
}
/* ADDCONST -- Called during parsing to convert string s into operand of
* type t and push it as an operand onto the dictionary (NOT the operand
* stack).
* Use dictionary because this routine is called at compile time and the
* operand stack is being filled with compiled code; use dictionary as
* a quiet workspace.
* Convert as per makeop().
* Return dictionary index of new operand entry so that it may be used as
* ((struct operand *)&dictionary[$1])->o_... in yacc specs.
*/
XINT
addconst (char *s, int t)
{
register struct operand *op;
XINT lasttopd;
lasttopd = topd; /* could just derefenece op */
op = (struct operand *) memneed (OPSIZ);
if (t == OT_STRING) {
/* makeop with an OT_STRING type will reuse the
* string pointer but we want to compile into the dictionary.
* fortunately, it's easy because lex has already removed any
* surrounding quotes.
*/
op->o_type = t;
op->o_val.v_s = comdstr (s);
} else
*op = makeop (s, t);
return (lasttopd);
}
/* <name of file to be used as stdin> .
*/
void
o_redirin (void)
{
struct operand o;
char *fname, *mode;
opcast (OT_STRING);
o = popop();
fname = (o.o_val.v_s);
if (newtask->t_flags & T_FOREIGN && newtask->t_stdin == stdin) {
/* If foreign task let ZOSCMD open the command file.
*/
newtask->ft_in = comdstr (fname);
} else {
mode = (newtask->t_flags & T_STDINB) ? "rb" : "r";
if ((newtask->t_stdin = fopen (fname, mode)) == NULL)
cl_error (E_UERR, e_ropen, fname);
newtask->t_flags |= T_MYIN;
}
}
/* <name of file to be appended> .
*/
void
o_append (void)
{
struct operand o;
char *fname, *mode;
opcast (OT_STRING);
o = popop();
fname = (o.o_val.v_s);
if (newtask->t_flags & T_FOREIGN && newtask->t_stdout == stdout) {
/* If foreign task let ZOSCMD open the spool file.
*/
newtask->ft_out = comdstr (fname);
newtask->t_flags |= T_APPEND;
} else {
mode = (newtask->t_flags & T_STDOUTB) ? "ab" : "a";
if ((newtask->t_stdout = fopen (fname, mode)) == NULL)
cl_error (E_UERR, e_appopen, fname);
newtask->t_flags |= T_MYOUT;
}
}
int
crackident (char *s)
{
struct keywords {
char *k_name; /* the keyword string itself. */
short k_token; /* yacc %token for the keyword */
short k_yylval; /* the value associated with token.*/
};
static struct keywords kw[] = {
/* Control flow keywords.
*/
{ "while", Y_WHILE, 0 }, { "if", Y_IF, 0 },
{ "else", Y_ELSE, 0 }, { "switch", Y_SWITCH, 0 },
{ "case", Y_CASE, 0 }, { "default", Y_DEFAULT, 0 },
{ "break", Y_BREAK, 0 }, { "next", Y_NEXT, 0 },
{ "return", Y_RETURN, 0 }, { "goto", Y_GOTO, 0 },
{ "for", Y_FOR, 0 }, { "procedure", Y_PROCEDURE, 0 },
{ "begin", Y_BEGIN, 0 }, { "end", Y_END, 0 },
{ "iferr", Y_IFERR, 0 }, { "ifnoerr", Y_IFNOERR, 0 },
{ "then", Y_THEN, 0 },
/* Parameter and variable types.
*/
{ "int", Y_INT, 0 }, { "char", Y_STRING, 0 },
{ "real", Y_REAL, 0 }, { "string", Y_STRING, 0 },
{ "file", Y_FILE, 0 }, { "gcur", Y_GCUR, 0 },
{ "imcur", Y_IMCUR, 0 }, { "ukey", Y_UKEY, 0 },
{ "pset", Y_PSET, 0 }, { "bool", Y_BOOL, 0 },
{ "struct", Y_STRUCT, 0 },
/* debugging commands.
*/
{ "d_d", D_D, 0 },
{ "d_peek", D_PEEK, 0 },
{ "", 0, 0 } /* sentinel; leave it here... */
};
static struct keywords kf[] = {
/* Keywords of intrinsic functions that get built into
* the grammar. Most intrinsics handled by intrinsic().
*/
{ "scan", Y_SCAN, 0 },
{ "scanf", Y_SCANF, 0 },
{ "fscan", Y_FSCAN, 0 },
{ "fscanf", Y_FSCANF, 0 },
/* sentinel; leave it here... */
{ "", 0, 0 }
};
register struct keywords *kp;
XINT oldtopd;
static char sch, kch; /* static storage is faster here */
char *scopy; /* non-makelower'd copy */
char sb[REALWIDTH];
oldtopd = topd; /* save topd */
scopy = comdstr(s); /* make a copy in the dictionary */
makelower (scopy); /* make it lower case for compares */
topd = oldtopd; /*restore topd but scopy still there!*/
/* Put the first character of the identifier we are searching for
* in local storage to permit fast rejection of keywords without all
* the overhead involved in a call to strcmp. This is an easy way
* to speed things up several times w/o coding fancy data structures.
*/
sch = *scopy;
kch = *s; /* save original string */
/* Check for and handle special-case keywords first.
*/
if (sch == *truestr && !strcmp (scopy, truestr)) {
yylval = addconst (truestr, OT_BOOL);
return (Y_CONSTANT);
} else if (sch == *falsestr && !strcmp (scopy, falsestr)) {
yylval = addconst (falsestr, OT_BOOL);
return (Y_CONSTANT);
} else if (sch == *indeflc && !strcmp (scopy, indeflc)) {
yylval = addconst (scopy, OT_INT);
return (Y_CONSTANT);
} else if (sch == *eoflc && !strcmp (scopy, eoflc)) {
yylval = addconst (CL_EOFSTR, OT_INT);
return (Y_CONSTANT);
} else if (sch == *errorstr && !strcmp (scopy, errorstr)) {
yylval = addconst (errorstr, OT_STRING);
return (Y_IDENT);
/* Check for defined numerical constants. For backwards compatability
* we match 'epsilon', however this particular value is deprecated by
* the fp_equal() builtin and we assume CL constants will be upper
* case strings.
*/
} else if ((sch == *epsilonstr && !strcmp (scopy, epsilonstr)) ||
(kch == *epsilonuc && !strcmp (s, epsilonuc))) {
sprintf (sb, "%e", EPSILON);
yylval = addconst (sb, OT_REAL);
return (Y_CONSTANT);
} else if (const_str (pistr)) { retconst (PI);
} else if (const_str (twopistr)) { retconst (TWOPI);
} else if (const_str (fourpistr)) { retconst (FOURPI);
} else if (const_str (halfpistr)) { retconst (HALFPI);
} else if (const_str (sqrtpistr)) { retconst (SQRTOFPI);
} else if (const_str (sqrttwostr)) { retconst (SQRTOF2);
} else if (const_str (baseestr)) { retconst (BASE_E);
} else if (const_str (ln2str)) { retconst (LN_2);
} else if (const_str (ln10str)) { retconst (LN_10);
} else if (const_str (lnpistr)) { retconst (LN_PI);
} else if (const_str (logestr)) { retconst (LOG_E);
} else if (const_str (gammastr)) { retconst (GAMMA);
} else if (const_str (radianstr)) { retconst (RADIAN);
} else if (const_str (austr)) { retconst (AU);
} else if (const_str (gaccelstr)) { retconst (GRAV_ACCEL);
} else if (const_str (gconststr)) { retconst (GRAV_CONST);
} else if (const_str (lystr)) { retconst (LIGHT_YEAR);
} else if (const_str (parsecstr)) { retconst (PARSEC);
} else if (const_str (lightstr)) { retconst (SPEED_OF_LIGHT);
} else if (const_str (solmassstr)) { retconst (SOLAR_MASS);
} else if (!inarglist && parenlevel == 0) {
/* Search the keyword list; kewords are not recognized in argument
* lists and expressions, else unquoted strings like "for" and
* "file" will cause syntax errors.
*/
for (kp=kw; (kch = *kp->k_name); kp++)
if (kch == sch)
if (strcmp (scopy, kp->k_name) == 0) {
yylval = kp->k_yylval;
return (kp->k_token);
}
} else {
/* Search the list of intrinsic functions.
*/
for (kp=kf; (kch = *kp->k_name); kp++)
if (kch == sch)
if (strcmp (scopy, kp->k_name) == 0) {
yylval = kp->k_yylval;
return (kp->k_token);
}
}
/* S not a keyword, so it's just an identifier.
*/
yylval = addconst (s, OT_STRING); /* use original */
return (Y_IDENT);
}
/* 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);
}