diff options
Diffstat (limited to 'pkg/ecl/opcodes.c')
| -rw-r--r-- | pkg/ecl/opcodes.c | 1400 |
1 files changed, 1400 insertions, 0 deletions
diff --git a/pkg/ecl/opcodes.c b/pkg/ecl/opcodes.c new file mode 100644 index 00000000..bbc2126d --- /dev/null +++ b/pkg/ecl/opcodes.c @@ -0,0 +1,1400 @@ +/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + */ + +#define import_spp +#define import_libc +#define import_stdio +#include <iraf.h> + +#include "config.h" +#include "mem.h" +#include "operand.h" +#include "param.h" +#include "grammar.h" +#include "task.h" +#include "opcodes.h" +#include "errs.h" +#include "construct.h" +#include "proto.h" + +/* + * OPCODES -- This is the instruction set that forms the internal language of + * the CL. The runtime interpreter (in runtime.c) executes these functions + * as they are discovered in the compiled code. The code is generated + * incrementally as the grammar is recognized in grammar.y by calls to + * compile(). The argument, argp, if needed, is the true addr of the start + * of the instruction arguments. + * If anything goes wrong, error() is called but DOES NOT RETURN; see errs.c. + * + * Comments indicate stack usage. expected operands are before the `.' + * (rightmost being on "top" of stack), resulting operands are after. + * + * At the end of this file is the opcode jumptable. The order of the entries + * must agree with the definitions of the opcode constants in operand.h. + * see runtime.c. + */ + +extern int cldebug; +extern char *nullstr; +int binpipe; /* last pipe binary or text ? */ +char *comdstr(); +extern struct param *ppfind(); /* search task psets for param */ +extern int currentline; + + +void +o_undefined (void) +{ + cl_error (E_IERR, e_uopcode, 0); +} + +/* <new value for named argument> . + * Assign the top operand to the named parameter. Also, make the type of the + * fake parameter the same as the type of the operand. + */ +void +o_absargset (memel *argp) +{ + char *argname = (char *) argp; + char *pk, *t, *p, *f; + struct pfile *pfp; + struct param *pp; + + pfp = newtask->t_pfp; + if (pfp->pf_flags & PF_FAKE) { + /* use full argname and always assign to value field. + */ + struct operand o; + int string_len=0; + o = popop(); + if ((o.o_type & OT_BASIC) == OT_STRING) + string_len = strlen (o.o_val.v_s); + pp = newfakeparam (pfp, argname, 0, o.o_type, string_len); + pushop (&o); + f = argname; + *f = FN_NULL; + + } else { + breakout (argname, &pk, &t, &p, &f); + if (*pk) + cl_error (E_UERR, e_simplep, p); + pp = ppfind (pfp, t, p, 0, NO); + if (pp == NULL) + cl_error (E_UERR, e_pnonexist, p); + if ((XINT)pp == ERR) + cl_error (E_UERR, e_pambig, p, pfp->pf_ltp->lt_lname); + } + + paramset (pp, *f); + if (pp->p_type & PT_PSET) + psetreload (pfp, pp); + pp->p_flags |= P_CLSET; +} + +/* <op1> <op2> . <op2 + op1> + */ +void +o_add (void) +{ + binop (OP_ADD); +} + +/* <increment to be added to named parameter> . + */ +void +o_addassign (memel *argp) +{ + /* order of operands will be incorrect. + * strictly speaking, only strings are not commutative but we need + * to pop both operands anyway to check. + */ + char *pname = (char *) argp; + char *pk, *t, *p, *f; + struct param *pp; + struct operand o1, o2; + + breakout (pname, &pk, &t, &p, &f); + pp = paramsrch (pk, t, p); + validparamget (pp, *f); + o1 = popop(); + o2 = popop(); + + if ((o2.o_type & OT_BASIC) == OT_STRING) { + /* copy o2 onto dictionary to avoid overwriting it on stack + * when o1 is pushed. we can get by with not worrying about o1 + * as long as whatever code copies the string works when the + * strings overlap. + */ + XINT oldtopd = topd; + char *s2 = memneed (btoi (strlen (o2.o_val.v_s) + 1)); + strcpy (s2, o2.o_val.v_s); + o2.o_val.v_s = s2; + pushop (&o1); + pushop (&o2); + topd = oldtopd; /* discard temp string area */ + + } else { + pushop (&o1); + pushop (&o2); + } + + binop (OP_ADD); + paramset (pp, *f); + pp->p_flags |= P_SET; +} + +/* <name of file to be appended> . + * includes stdout as well as stderr. + */ +void +o_allappend (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); + 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_stderr = newtask->t_stdout; + newtask->t_flags |= (T_MYOUT|T_MYERR); + } +} + + +/* <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); + } +} + + +/* <op1> <op2> . <op1 && op2> + */ +void +o_and (void) +{ + binexp (OP_AND); +} + +/* <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; + } +} + + +/* <new value for named parameter> . + */ +void +o_assign (memel *argp) +{ + char *pname = (char *) argp; + char *pk, *t, *p, *f; + struct param *pp; + + breakout (pname, &pk, &t, &p, &f); + pp = paramsrch (pk, t, p); + paramset (pp, *f); + pp->p_flags |= P_SET; +} + +/* <truth value> . + * branch if false (or INDEF). + */ +void +o_biff (memel *argp) +{ + extern XINT pc; + struct operand o; + + opcast (OT_BOOL); + o = popop(); + if (!o.o_val.v_i || opindef (&o)) + pc += (int)*argp; +} + +/* . + * arrange to start a new task. set newtask. + * see runtime.c + */ +void +o_call (memel *argp) +{ + callnewtask ((char *) argp); +} + +/* <op> . <- op> + */ +void +o_chsign (void) +{ + unop (OP_MINUS); +} + +/* <op> // <op> + * string concatenation + */ +void +o_concat (void) +{ + binop (OP_CONCAT); +} + +/* <op1> <op2> . <op1 / op2> + */ +void +o_div (void) +{ + binop (OP_DIV); +} + +void +o_doend (void) +{ +} + +/* <value to be divided into named parameter> . + */ +void +o_divassign (memel *argp) +{ + char *pname = (char *) argp; + char *pk, *t, *p, *f; + struct param *pp; + struct operand o1, o2; + + breakout (pname, &pk, &t, &p, &f); + pp = paramsrch (pk, t, p); + + validparamget (pp, *f); /* get param value on stack */ + o1 = popop(); /* swap operands */ + o2 = popop(); + pushop (&o1); + pushop (&o2); + binop (OP_DIV); /* perform the division */ + paramset (pp, *f); + pp->p_flags |= P_SET; +} + +/* <value to be concatenated onto named parameter> . + */ +void +o_catassign (memel *argp) +{ + char *pname = (char *) argp; + char *pk, *t, *p, *f; + char s1[1024+1]; + struct operand o1, o2; + struct param *pp; + + breakout (pname, &pk, &t, &p, &f); + pp = paramsrch (pk, t, p); + paramget (pp, *f); + + /* If param value is undefined merely assign into it, otherwise + * concatenate operand to current value. + */ + o1 = popop(); + if (!opundef(&o1)) { + /* Must copy string value off of operand stack or the next + * pushop below will reuse the space! + */ + o2 = popop(); + strncpy (s1, o2.o_val.v_s, 1024); + s1[1024] = EOS; + o2.o_val.v_s = s1; + + pushop (&o1); + pushop (&o2); + binop (OP_CONCAT); + } + + paramset (pp, *f); + pp->p_flags |= P_SET; +} + +/* <op1> <op2> . <op1 == op2> + */ +void +o_eq (void) +{ + binexp (OP_EQ); +} + +/* run the newtask. see exec.c. + */ +void +o_exec (void) +{ + execnewtask (); +} + +/* <op1> <op2> . <op1 > op2> + */ +void +o_ge (void) +{ + binexp (OP_GE); +} + +/* unconditional goto. + * *argp is the SIGNED increment to be added to pc. + */ +void +o_dogoto (memel *argp) +{ + extern XINT pc; + pc += (int)*argp; + if (pc >= STACKSIZ) + cl_error (E_IERR, "pc set wildly to %d during goto", pc); +} + +/* <op1> <op2> . <op1 > op2> + */ +void +o_gt (void) +{ + binexp (OP_GT); +} + +/* <string operand> . + * if argument to which we are assigning is a simple string or filename (or + * list, since assigning to a list sets a filename too), set it to o_val.v_s, + * else use o_val.v_s as the name of a parameter and use its value as the name + * of the variable, that is, do an indirect through o_val.v_s. + * compiled when the parser sees a simple identifier, not in an expression. + * this avoids quotes around simple strings and filenames. + * if the parameter is to be fake, make it type string and do not do the + * indirection. + */ +void +o_indirabsset (memel *argp) +{ + char *argname = (char *) argp; + char *pk, *t, *p, *f; + struct pfile *pfp; + struct param *pp; + int type, string_len; + + pfp = newtask->t_pfp; + if (pfp->pf_flags & PF_FAKE) { + struct operand o; + o = popop(); + string_len = strlen (o.o_val.v_s); + pp = newfakeparam (pfp, argname, 0, OT_STRING, string_len); + f = argname; + *f = FN_NULL; + pushop (&o); + + } else { + breakout (argname, &pk, &t, &p, &f); + if (*pk) + cl_error (E_UERR, e_simplep, p); + pp = ppfind (pfp, t, p, 0, NO); + if (pp == NULL) + cl_error (E_UERR, e_pnonexist, p); + if ((XINT)pp == ERR) + cl_error (E_UERR, e_pambig, p, pfp->pf_ltp->lt_lname); + } + + /* lone identifiers are treated as strings, rather than variables, + * if the corresponding parameter is a simple string, filename or list. + * note that fakeparams are made as strings. + */ + type = pp->p_type; + if (type & (PT_FILNAM|PT_LIST|PT_PSET)) { + struct operand o; + o = popop(); + pushop (&o); + } else if ((type & OT_BASIC) != OT_STRING || + type & (PT_STRUCT|PT_IMCUR|PT_GCUR|PT_UKEY)) { + + opindir(); /* replace top op with value of o_val.v_s */ + } + + paramset (pp, *f); + if (pp->p_type & PT_PSET) + psetreload (pfp, pp); + pp->p_flags |= P_CLSET; +} + +/* <string operand> . + * if argument to which we are assigning is a simple string or filename (or + * list, since assigning to a list sets a filename too), set it to o_val.v_s, + * else use o_val.v_s as the name of a parameter and use its value as the name + * of the variable, that is, do an indirect through o_val.v_s. + * compiled when the parser sees a simple identifier, not in an expression. + * this avoids quotes around simple strings and filenames. + */ +void +o_indirposset (memel *argp) +{ + int pos = (int) *argp; + struct pfile *pfp; + struct param *pp; + int type, string_len; + + pfp = newtask->t_pfp; + if (pfp->pf_flags & PF_FAKE) { + struct operand o; + o = popop(); + string_len = strlen (o.o_val.v_s); + pp = newfakeparam (pfp, (char *) NULL, pos, OT_STRING, string_len); + pushop (&o); + } else { + pp = paramfind (pfp, (char *) NULL, pos, NO); + if (pp == NULL) + cl_error (E_UERR, e_posargs, newtask->t_ltp->lt_lname); + } + + /* lone identifiers are treated as strings, rather than variables, + * if the corresponding parameter is a simple string, filename or list. + * note that fakeparams are made as strings. + */ + type = pp->p_type; + if (type & (PT_FILNAM|PT_LIST|PT_PSET)) { + struct operand o; + o = popop(); + pushop (&o); + } else if ((type & OT_BASIC) != OT_STRING || + type & (PT_STRUCT|PT_IMCUR|PT_GCUR|PT_UKEY)) { + + opindir(); /* replace top op with value of o_val.v_s */ + } + + paramset (pp, FN_NULL); + pfp->pf_n++; + pp->p_flags |= P_CLSET; +} + +/* Increment the loop counters for an implicit loop. + */ +void +o_indxincr (memel *argp) +{ + int i; + i = 0; + while (i < n_oarr) { + if (oarr_curr[i] < oarr_end[i] ) { + oarr_curr[i] ++; + i_oarr = 0; + pc += argp[0]; /* Branch to beginning of statement. */ + return; + } else { + oarr_curr[i] = oarr_beg[i]; + i++; + } + } + + /* Finished loop, branch around stored data. */ + pc += argp[1]; + + /* Clear flag for next implicit loop. */ + imloopset = 0; +} + + +/* . + * given the name of a parameter, print it on t_out, the task pipe channel. + */ +void +o_inspect (memel *argp) +{ + char *pname = (char *) argp; + char *pk, *t, *p, *f; + struct param *pp; + struct operand o; + + breakout (pname, &pk, &t, &p, &f); + pp = paramsrch (pk, t, p); + + if (*f == FN_NULL && (pp->p_type & PT_LIST)) { + /* Hitting EOF from a list is ok during an inspect stmt so + * avoid using paramget() with its EOF error. + * readlist() may set P_LEOF. + */ + o = readlist (pp); + if ((pp->p_flags & P_LEOF) || inrange (pp, &o)) + pushop (&o); + else + query (pp); + } else + validparamget (pp, *f); + + o = popop(); + + if (cldebug && (o.o_type & OT_BASIC) == OT_STRING) + eprintf ("Inspect--%s\n", o.o_val.v_s); + + prop (&o); + tprintf ("\n"); +} + + +/* [<op1> <op2> ... <opn>] <nops> . <result> + * intrinsic functions, like sin, cos, mod, etc. + * argp is the name of the function to run and the top operand (we guarantee + * at least one) is the number of remaining operands to be used. + * all the defines are in operand.h. the function names and running them is + * done by intrfunc() in gram.c. + */ +void +o_intrinsic (memel *argp) +{ + char *funcname = (char *) argp; + struct operand o; + int nargs; + + o = popop(); + nargs = o.o_val.v_i; + + intrfunc (funcname, nargs); +} + +/* <op1> <op2> . <op1 <= op2> + */ +void +o_le (void) +{ + binexp (OP_LE); +} + +/* <op1> <op2> . <op1 < op2> + */ +void +o_lt (void) +{ + binexp (OP_LT); +} + +/* <op1> <op2> . <op2 * op1> + */ +void +o_mul (void) +{ + binop (OP_MUL); +} + +/* <value to be multiplied into named parameter> . + */ +void +o_mulassign (memel *argp) +{ + char *pname = (char *) argp; + char *pk, *t, *p, *f; + struct param *pp; + + breakout (pname, &pk, &t, &p, &f); + pp = paramsrch (pk, t, p); + + validparamget (pp, *f); + binop (OP_MUL); + paramset (pp, *f); + pp->p_flags |= P_SET; +} + +/* <op1> <op2> . <op1 != op2> + */ +void +o_ne (void) +{ + binexp (OP_NE); +} + +/* <op> . <!op> + */ +void +o_not (void) +{ + unexp (OP_NOT); +} + +/* <op1> <op2> . <op1 || op2> + */ +void +o_or (void) +{ + binexp (OP_OR); +} + + +/* OSESC -- Send a command to the host system. Command is a string pointed + * to by argp. Try to run it so its stdout and stderr will go to out t_stdout + * and t_stderr of the current task. + */ +void +o_osesc (memel *argp) +{ + char *command = (char *)argp; + + clsystem (command, currentask->t_stdout, currentask->t_stderr); +} + + +/* <new value for argument at command position *argp> . + */ +void +o_posargset (memel *argp) +{ + int pos = (int) *argp; + struct pfile *pfp; + struct param *pp; + struct operand o; + int string_len=0; + + pfp = newtask->t_pfp; + + if (pos < 0) { + /* Lone comma in arg list, merely bump nargs counter */ + pfp->pf_n++; + return; + } + + if (pfp->pf_flags & PF_FAKE) { + o = popop(); + if ((o.o_type & OT_BASIC) == OT_STRING) + string_len = strlen (o.o_val.v_s); + pp = newfakeparam (pfp, (char *) NULL, pos, o.o_type, string_len); + pushop (&o); + } else { + pp = paramfind (pfp, (char *) NULL, pos, NO); + if (pp == NULL) + cl_error (E_UERR, e_posargs, newtask->t_ltp->lt_lname); + } + + paramset (pp, FN_NULL); + pfp->pf_n++; + pp->p_flags |= P_CLSET; +} + + +/* <op1> <op2> . <op1 ** op2> + */ +void +o_dopow (void) +{ + binop (OP_POW); +} + + +/* <exprn-1> ... <expr1> <dest> <n> . + * Do the print task. First op on stack is number of operands to follow. + * Next one is the name of the destination parameter, rest are values to + * be printed. + */ +void +o_doprint (void) +{ + /* This is not used -- print is imp. as a builtin task. + struct operand o; + + o = popop(); + print (o.o_val.v_i - 1); + */ +} + +/* <value to be printed> . + * used to print an operand on the stack. not to be confused with doprint. + */ +void +o_immed (void) +{ + struct operand o; + + o = popop(); + prop (&o); + tprintf ("\n"); +} + +/* . <new constant> + * The "illegal constant" business comes from the possibility of syntactically + * correct but valuely wrong sexagesimal constants, such as 1:222:1. + * We don't want to abort in sexa() because it may be used to digest a query + * response and producing a quiet undefined op there is correct. + */ +void +o_pushconst (memel *argp) +{ + /* argument is pointer to an operand */ + struct operand *op; + + op = (struct operand *) argp; + if (opundef (op)) + cl_error (E_UERR, "illegal constant"); + pushop (op); +} + +/* Push an index value onto the control stack for later use + * when the parameter is accessed. + */ +void +o_pushindex (int *mode) +{ + struct operand op; + + if (cldebug) + printf ("PUSHINDEX: mode=%d loopset=%d\n", *mode, imloopset); + + if (*mode == 0) { /* Normal array index reference. */ + opcast(OT_INT); + op = popop(); + push (op.o_val.v_i); + } else if (*mode == -1 || imloopset) { + /* Array reference in implicit loop. */ + push (oarr_curr[i_oarr]); + i_oarr++; + if (i_oarr >= n_oarr) + i_oarr = 0; + } else { + /* This is the first array reference in an implicit loop. + * It must initialize the loop parameters. The argument + * is an offset to the initialization info. + */ + int stk; + + stk = pc + *mode; + + n_oarr = stack[stk++]; + for (i_oarr=0; i_oarr<n_oarr; i_oarr++) { + oarr_beg[i_oarr] = stack[stk++]; + oarr_curr[i_oarr] = oarr_beg[i_oarr]; + oarr_end[i_oarr] = stack[stk++]; + } + /* Set flag so that we don't do this again. */ + imloopset++; + + /* And we still have to push a value. */ + push (oarr_curr[0]); + i_oarr = 1; + if (i_oarr >= n_oarr) + i_oarr = 0; + } + + /* Increment counter of number of indexes pushed. + */ + n_indexes++; +} + +/* . <value of parameter> + */ +void +o_pushparam (memel *argp) +{ + char *pname = (char *) argp; + char *pk, *t, *p, *f; + struct param *pp; + + breakout (pname, &pk, &t, &p, &f); + pp = paramsrch (pk, t, p); + validparamget (pp, *f); +} + + +/* <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 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; + } +} + + +/* GSREDIR -- Graphics stream redirection. + * <filename> . + */ +void +o_gsredir (memel *argp) +{ + register char *ip; + register FILE *fp; + char *streams = (char *)argp; + struct operand o; + char *fname; + int count; + + /* Get the filename. + */ + opcast (OT_STRING); + o = popop(); + fname = o.o_val.v_s; + + /* Scan the redir token to determine the file access mode, e.g., if + * ">G", create a new file, and if ">>G", append to a file. + */ + for (count=0, ip=streams; *ip; ip++) + if (*ip == '>') + count++; + + if ((fp = fopen (fname, count > 1 ? "ab" : "wb")) == NULL) + cl_error (E_UERR, e_wopen, fname); + + /* The first string operand on the stack is some combination of the + * characters GIP, listing the streams (stdgraph, stdimage, stdplot) + * to be redirected to the named file. The lexical analyzer guarantees + * that we will not be called unless the string consists of some + * combination of the characters >GIP, hence error checking for other + * char, no chars, etc., is not needed. + */ + for (ip=streams; *ip; ip++) + if (*ip == 'G') { + newtask->t_flags |= T_MYSTDGRAPH; + newtask->t_stdgraph = fp; + } else if (*ip == 'I') { + newtask->t_flags |= T_MYSTDIMAGE; + newtask->t_stdimage = fp; + } else if (*ip == 'P') { + newtask->t_flags |= T_MYSTDPLOT; + newtask->t_stdplot = fp; + } +} + + +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); +} + + +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); +} + + +void +o_rmpipes (memel *argp) +{ + delpipes ((int)*argp); +} + + +void +o_doreturn (void) +{ + eprintf ("return not implemented\n"); +} + +/* <paramn> ... <param1> <source> <n> . + * do the scan function. first op on stack is number of string ops to + * follow, rest are names of destination params. SCAN scans the standard + * input. + */ +void +o_doscan (void) +{ + struct operand o; + + o = popop(); + cl_scan (o.o_val.v_i - 1, "stdin"); +} + +void +o_doscanf (void) +{ + struct operand o; + struct operand o_sv[64]; + char format[SZ_LINE]; + int nargs, i; + + /* Get number of arguments. */ + o = popop(); + nargs = o.o_val.v_i; + + /* Get scan format. Unfortunately the way the parser works this + * is the last operand on the stack. We need to pop and save the + * first nargs-1 operands and restore them when done. + */ + for (i=0; i < nargs-1; i++) + o_sv[i] = popop(); + + o = popop(); + if ((o.o_type & OT_BASIC) != OT_STRING) + cl_error (E_UERR, "scanf: bad format string\n"); + strcpy (format, o.o_val.v_s); + + for (--i; i >= 0; i--) + pushop (&o_sv[i]); + + /* Do the scan. */ + cl_scanf (format, nargs-2, "stdin"); +} + +/* <paramn> ... <param1> <source> <n> . + * Do the fscan function. First op on stack is number of string ops to + * follow. Next one is the name of the source parameter, rest are names of + * destination params. + */ +void +o_dofscan (void) +{ + struct operand o; + + o = popop(); + cl_scan (o.o_val.v_i - 1, ""); +} + +void +o_dofscanf (void) +{ + struct operand o, o_sv[64]; + char format[SZ_LINE]; + char pname[SZ_FNAME]; + int nargs, i; + + /* Get number of arguments. */ + o = popop(); + nargs = o.o_val.v_i; + + /* Get scan format and input parameter name. The arguments on the + * stack are pushed in the order input param name, format string, + * and then the output arguments. + */ + + /* Get output arguments. */ + for (i=0; i < nargs-2; i++) + o_sv[i] = popop(); + + /* Get format string. */ + o = popop(); + if ((o.o_type & OT_BASIC) != OT_STRING) + cl_error (E_UERR, "fscanf: bad format string\n"); + strcpy (format, o.o_val.v_s); + + /* Get parameter name. */ + o = popop(); + if ((o.o_type & OT_BASIC) != OT_STRING) + cl_error (E_UERR, "fscanf: bad input parameter specification\n"); + strcpy (pname, o.o_val.v_s); + + /* Restore the output argument operands. */ + for (--i; i >= 0; i--) + pushop (&o_sv[i]); + + /* Restore the input parameter name operand. */ + o.o_type = OT_STRING; + o.o_val.v_s = pname; + pushop (&o); + + /* Do the scan. */ + cl_scanf (format, nargs-2, ""); +} + +/* <op1> <op2> . <op1 - op2> + */ +void +o_sub (void) +{ + binop (OP_SUB); +} + +/* <value to be subtracted from named parameter> . + */ +void +o_subassign (memel *argp) +{ + /* operands are backwards on stack, so negate and add. can get by + * with this as long as subtraction is never defined for strings. + * if it is someday, will have to do something like in addassign. + */ + char *pname = (char *) argp; + char *pk, *t, *p, *f; + struct param *pp; + + breakout (pname, &pk, &t, &p, &f); + pp = paramsrch (pk, t, p); + + unop (OP_MINUS); + validparamget (pp, *f); + binop (OP_ADD); + paramset (pp, *f); + pp->p_flags |= P_SET; +} + +/* Doswitch finds the appropriate location to jump to in the + * jump table and goes there. + */ +void +o_doswitch (int *jmpdelta) + +{ + int pdft, icase, jmptable; + int value=0; + struct operand o; + memel delta; + /* Remember to subtract SZ_CE 'cuz PC has already been incremented. */ + jmptable = *jmpdelta + pc - SZ_CE; + + o = popop(); + if (o.o_type == OT_INT) + value = o.o_val.v_i; + else if (o.o_type == OT_STRING) { + if (*o.o_val.v_s != '\0' && *(o.o_val.v_s+1) == '\0') + value = (int) *o.o_val.v_s; + else + cl_error(E_UERR, "Illegal switch value."); + } else + cl_error (E_UERR, "Illegal switch value."); + + pdft = stack[jmptable]; + + if (cldebug) + eprintf ("doswitch: pdft=%d\n", pdft); + + /* Loop over cases. + */ + for (icase= jmptable + 1; stack[icase] != 0; icase++) { + int nval, ival, pcase; + memel *val; + + pcase = stack[icase] + pc - SZ_CE; + nval = coderef(pcase)->c_length - (SZ_CE - 1); + currentline = coderef(pcase)->c_scriptln; + + /* Loop over all values for a particular case. + */ + val = & (coderef(pcase)->c_args); + for (ival=0; ival<nval; ival++, val++) { + if (*val == value) { + /* Remember to skip over the CASE operand itself. */ + delta = pcase + (nval+(SZ_CE-1)) - (pc-SZ_CE) - SZ_CE; + o_dogoto (&delta); + return; + } + } + } + + /* Default? */ + if (pdft != 0) { + pdft = pdft + pc - SZ_CE; + /* Skipping over DEFAULT block takes 2 ints. + */ + delta = (pdft+(SZ_CE-1)) - (pc-SZ_CE) - SZ_CE; + o_dogoto (&delta); + return; + } + + /* If there is no default we just drop through to the + * next statement which is a branch beyond the SWITCH. + */ +} + + +void +o_swoff (memel *argp) +{ + register char *pname = (char *)argp; + register struct param *pp; + struct operand o; + struct pfile *pfp; + char *pk, *t, *p, *f; + + breakout (pname, &pk, &t, &p, &f); + if (*pk) + cl_error (E_UERR, e_simplep, p); + pfp = newtask->t_pfp; + pp = ppfind (pfp, t, p, 0, NO); + if (pp == NULL) + cl_error (E_UERR, e_pnonexist, p); + if ((XINT)pp == ERR) + cl_error (E_UERR, e_pambig, p, newtask->t_ltp->lt_lname); + + o.o_type = OT_BOOL; + o.o_val.v_i = NO; + pushop (&o); + paramset (pp, FN_VALUE); + if (pp->p_type & PT_PSET) + psetreload (pfp, pp); + + pp->p_flags |= P_CLSET; +} + +void +o_swon (memel *argp) +{ + register char *pname = (char *)argp; + register struct param *pp; + struct pfile *pfp; + struct operand o; + char *pk, *t, *p, *f; + + breakout (pname, &pk, &t, &p, &f); + if (*pk) + cl_error (E_UERR, e_simplep, p); + + pfp = newtask->t_pfp; + pp = ppfind (pfp, t, p, 0, NO); + if (pp == NULL) + cl_error (E_UERR, e_pnonexist, p); + if ((XINT)pp == ERR) + cl_error (E_UERR, e_pambig, p, newtask->t_ltp->lt_lname); + + o.o_type = OT_BOOL; + o.o_val.v_i = YES; + pushop (&o); + paramset (pp, FN_VALUE); + if (pp->p_type & PT_PSET) + psetreload (pfp, pp); + + pp->p_flags |= P_CLSET; +} + + +/* FIXLANGUAGE -- Called only once, during startup after processing the + * cl startup file (clpackage.cl) to set the PKCCL flag for task LANGUAGE + * in the package CLPACKAGE. Thereafter, when language is executed it + * will merely cause the current package to be changed. This cannot be + * done in the conventional way since clpackage.language() is never + * executed to load the language package, since it is the root package. + */ +void +o_fixlanguage (void) +{ + register struct ltask *ltp; + + ltp = ltasksrch (CLPACKAGE, ROOTPACKAGE); + ltp->lt_flags |= (LT_PACCL|LT_CL); + ltp->lt_pkp = pacfind (ROOTPACKAGE); +} + + +/* the opcode jump table. + * + * order of the entries here must agree with constants in opcodes.h. + * if the name is a keyword in C or a common library entry point, + * then precede it with "do" but alphabetize it according to its intended name. + */ + +void (*opcodetbl[])() = { +/* 0 */ o_undefined, + +/* 1 */ o_absargset, +/* 2 */ o_add, +/* 3 */ o_addassign, +/* 4 */ o_doaddpipe, +/* 5 */ o_allappend, + +/* 6 */ o_allredir, +/* 7 */ o_and, +/* 8 */ o_append, +/* 9 */ o_assign, +/* 10 */ o_biff, + +/* 11 */ o_call, +/* 12 */ 0, /* The CASE operand is never executed.*/ +/* 13 */ o_chsign, +/* 14 */ o_concat, +/* 15 */ 0, /* The DEFAULT operand is never executed. */ + +/* 16 */ o_div, +/* 17 */ o_divassign, +/* 18 */ o_doend, +/* 19 */ o_eq, +/* 20 */ o_exec, + +/* 21 */ o_dofscan, +/* 22 */ o_dofscanf, +/* 23 */ o_ge, +/* 24 */ o_dogoto, +/* 25 */ o_dogetpipe, + +/* 26 */ o_gt, +/* 27 */ o_immed, +/* 28 */ o_indirabsset, +/* 29 */ o_indirposset, +/* 30 */ o_indxincr, + +/* 31 */ o_inspect, +/* 32 */ o_intrinsic, +/* 33 */ o_le, +/* 34 */ o_lt, +/* 35 */ o_mul, + +/* 36 */ o_mulassign, +/* 37 */ o_ne, +/* 38 */ o_not, +/* 39 */ o_or, +/* 40 */ o_osesc, + +/* 41 */ o_posargset, +/* 42 */ o_dopow, +/* 43 */ o_doprint, +/* 44 */ o_pushconst, +/* 45 */ o_pushindex, + +/* 46 */ o_pushparam, +/* 47 */ o_redir, +/* 48 */ o_redirin, +/* 49 */ o_rmpipes, +/* 50 */ o_doreturn, + +/* 51 */ o_doscan, +/* 52 */ o_doscanf, +/* 53 */ o_sub, +/* 54 */ o_subassign, +/* 55 */ o_doswitch, + +/* 56 */ o_swoff, +/* 57 */ o_swon, +/* 58 */ o_fixlanguage, +/* 59 */ o_gsredir, +/* 60 */ o_catassign, +}; |