home *** CD-ROM | disk | FTP | other *** search
- /* $RCSfile: eval.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 13:20:20 $
- *
- * Copyright (c) 1991, Larry Wall
- *
- * You may distribute under the terms of the Perl Artistic License,
- * as specified in the README file.
- *
- * $Log: eval.c,v $
- * Revision 4.0.1.4 92/06/08 13:20:20 lwall
- * patch20: added explicit time_t support
- * patch20: fixed confusion between a *var's real name and its effective name
- * patch20: added Atari ST portability
- * patch20: new warning for use of x with non-numeric right operand
- * patch20: modulus with highest bit in left operand set didn't always work
- * patch20: dbmclose(%array) didn't work
- * patch20: added ... as variant on ..
- * patch20: O_PIPE conflicted with Atari
- *
- * Revision 4.0.1.3 91/11/05 17:15:21 lwall
- * patch11: prepared for ctype implementations that don't define isascii()
- * patch11: various portability fixes
- * patch11: added sort {} LIST
- * patch11: added eval {}
- * patch11: sysread() in socket was substituting recv()
- * patch11: a last statement outside any block caused occasional core dumps
- * patch11: missing arguments caused core dump in -D8 code
- * patch11: eval 'stuff' now optimized to eval {stuff}
- *
- * Revision 4.0.1.2 91/06/07 11:07:23 lwall
- * patch4: new copyright notice
- * patch4: length($`), length($&), length($') now optimized to avoid string copy
- * patch4: assignment wasn't correctly de-tainting the assigned variable.
- * patch4: default top-of-form format is now FILEHANDLE_TOP
- * patch4: added $^P variable to control calling of perldb routines
- * patch4: taintchecks could improperly modify parent in vfork()
- * patch4: many, many itty-bitty portability fixes
- *
- * Revision 4.0.1.1 91/04/11 17:43:48 lwall
- * patch1: fixed failed fork to return undef as documented
- * patch1: reduced maximum branch distance in eval.c
- *
- * Revision 4.0 91/03/20 01:16:48 lwall
- * 4.0 baseline.
- *
- */
-
- #include "EXTERN.h"
- #include "perl.h"
-
- #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
- #include <signal.h>
- #endif
-
- #ifdef I_FCNTL
- #include <fcntl.h>
- #endif
- #ifdef MSDOS
- /* I_FCNTL *MUST* not be defined for MS-DOS and OS/2
- but fcntl.h is required for O_BINARY */
- #include <fcntl.h>
- #endif
- #ifdef I_SYS_FILE
- #include <sys/file.h>
- #endif
- #ifdef I_VFORK
- # include <vfork.h>
- #endif
-
- #ifdef VOIDSIG
- static void (*ihand)();
- static void (*qhand)();
- #else
- static int (*ihand)();
- static int (*qhand)();
- #endif
-
- ARG *debarg;
- STR str_args;
- static STAB *stab2;
- static STIO *stio;
- static struct lstring *lstr;
- static int old_rschar;
- static int old_rslen;
-
- char *getlogin();
-
- #include <Math.h>
-
- #define SMALLSWITCHES
-
- typedef enum {
- R_nojump,
- R_array_return,
- R_say_no,
- R_re_eval,
- R_badsock,
- R_say_yes,
- R_say_undef,
- R_donumset,
- R_say_zero} EvalResult;
-
- typedef struct {
- ARG * arg;
- int gimme;
- int sp;
- STR * str;
- int anum;
- int optype;
- STR ** st;
- int maxarg;
- double value;
- char * tmps;
- char * tmps2;
- int argflags;
- int argtype;
- union argptr argptr;
- int arglast[8]; /* highest ed->sp for arg--valid only for non-O_LIST args */
- unsigned long tmpulong;
- long tmplong;
- long longo;
- time_t when;
- STRLEN tmplen;
- FILE * fp;
- STR * tmpstr;
- FCMD * form;
- STAB * stab;
- ARRAY * ary;
- bool assigning;
- } EvalData;
-
- char *crypt();
- extern void grow_dlevel();
-
- EvalResult eval1(EvalData * ed)
- {
- switch (ed->optype) {
- case O_RCAT:
- STABSET(ed->str);
- break;
- case O_ITEM:
- if (ed->gimme == G_ARRAY)
- goto array_return;
- /* FALL THROUGH */
- case O_SCALAR:
- STR_SSET(ed->str,ed->st[1]);
- STABSET(ed->str);
- break;
- case O_ITEM2:
- if (ed->gimme == G_ARRAY)
- goto array_return;
- --ed->anum;
- STR_SSET(ed->str,ed->st[ed->arglast[ed->anum]-ed->arglast[0]]);
- STABSET(ed->str);
- break;
- case O_ITEM3:
- if (ed->gimme == G_ARRAY)
- goto array_return;
- --ed->anum;
- STR_SSET(ed->str,ed->st[ed->arglast[ed->anum]-ed->arglast[0]]);
- STABSET(ed->str);
- break;
- case O_CONCAT:
- STR_SSET(ed->str,ed->st[1]);
- str_scat(ed->str,ed->st[2]);
- STABSET(ed->str);
- break;
- case O_REPEAT:
- if (ed->gimme == G_ARRAY && ed->arg[1].arg_flags & AF_ARYOK) {
- ed->sp = do_repeatary(ed->arglast);
- goto array_return;
- }
- STR_SSET(ed->str,ed->st[1]);
- ed->anum = (int)str_gnum(ed->st[2]);
- if (ed->anum >= 1) {
- ed->tmpstr = Str_new(50, 0);
- ed->tmps = str_get(ed->str);
- str_nset(ed->tmpstr,ed->tmps,ed->str->str_cur);
- ed->tmps = str_get(ed->tmpstr); /* force to be string */
- STR_GROW(ed->str, (ed->anum * ed->str->str_cur) + 1);
- repeatcpy(ed->str->str_ptr, ed->tmps, ed->tmpstr->str_cur, ed->anum);
- ed->str->str_cur *= ed->anum;
- ed->str->str_ptr[ed->str->str_cur] = '\0';
- ed->str->str_nok = 0;
- str_free(ed->tmpstr);
- }
- else {
- if (dowarn && ed->st[2]->str_pok && !looks_like_number(ed->st[2]))
- warn("Right operand of x is not numeric");
- str_sset(ed->str,&str_no);
- }
- STABSET(ed->str);
- break;
- case O_MATCH:
- ed->sp = do_match(ed->str,ed->arg,
- ed->gimme,ed->arglast);
- if (ed->gimme == G_ARRAY)
- goto array_return;
- STABSET(ed->str);
- break;
- case O_NMATCH:
- ed->sp = do_match(ed->str,ed->arg,
- G_SCALAR,ed->arglast);
- str_sset(ed->str, str_true(ed->str) ? &str_no : &str_yes);
- STABSET(ed->str);
- break;
- case O_SUBST:
- ed->sp = do_subst(ed->str,ed->arg,ed->arglast[0]);
- goto array_return;
- case O_NSUBST:
- ed->sp = do_subst(ed->str,ed->arg,ed->arglast[0]);
- ed->str = ed->arg->arg_ptr.arg_str;
- str_set(ed->str, str_true(ed->str) ? No : Yes);
- goto array_return;
- case O_ASSIGN:
- if (ed->arg[1].arg_flags & AF_ARYOK) {
- if (ed->arg->arg_len == 1) {
- ed->arg->arg_type = O_LOCAL;
- goto local;
- }
- else {
- ed->arg->arg_type = O_AASSIGN;
- goto aassign;
- }
- }
- else {
- ed->arg->arg_type = O_SASSIGN;
- goto sassign;
- }
- case O_LOCAL:
- local:
- ed->arglast[2] = ed->arglast[1]; /* push a null array */
- /* FALL THROUGH */
- case O_AASSIGN:
- aassign:
- ed->sp = do_assign(ed->arg,
- ed->gimme,ed->arglast);
- goto array_return;
- case O_SASSIGN:
- sassign:
- STR_SSET(ed->str, ed->st[2]);
- STABSET(ed->str);
- break;
- case O_CHOP:
- ed->st -= ed->arglast[0];
- ed->str = ed->arg->arg_ptr.arg_str;
- for (ed->sp = ed->arglast[0] + 1; ed->sp <= ed->arglast[1]; ed->sp++)
- do_chop(ed->str,ed->st[ed->sp]);
- ed->st += ed->arglast[0];
- break;
- case O_DEFINED:
- if (ed->arg[1].arg_type & A_DONT) {
- ed->sp = do_defined(ed->str,ed->arg,
- ed->gimme,ed->arglast);
- goto array_return;
- }
- else if (ed->str->str_pok || ed->str->str_nok)
- goto say_yes;
- goto say_no;
- case O_UNDEF:
- if (ed->arg[1].arg_type & A_DONT) {
- ed->sp = do_undef(ed->str,ed->arg,
- ed->gimme,ed->arglast);
- goto array_return;
- }
- else if (ed->str != stab_val(defstab)) {
- if (ed->str->str_len) {
- if (ed->str->str_state == SS_INCR)
- Str_Grow(ed->str,0);
- Safefree(ed->str->str_ptr);
- ed->str->str_ptr = Nullch;
- ed->str->str_len = 0;
- }
- ed->str->str_pok = ed->str->str_nok = 0;
- STABSET(ed->str);
- }
- goto say_undef;
- case O_STUDY:
- ed->sp = do_study(ed->str,ed->arg,
- ed->gimme,ed->arglast);
- goto array_return;
- case O_POW:
- ed->value = str_gnum(ed->st[1]);
- ed->value = pow(ed->value,str_gnum(ed->st[2]));
- goto donumset;
- case O_MULTIPLY:
- ed->value = str_gnum(ed->st[1]);
- ed->value *= str_gnum(ed->st[2]);
- goto donumset;
- case O_DIVIDE:
- if ((ed->value = str_gnum(ed->st[2])) == 0.0)
- fatal("Illegal division by zero");
- ed->value = str_gnum(ed->st[1]) / ed->value;
- goto donumset;
- case O_MODULO:
- ed->tmpulong = (unsigned long) str_gnum(ed->st[2]);
- if (ed->tmpulong == 0L)
- fatal("Illegal modulus zero");
- ed->value = str_gnum(ed->st[1]);
- if (ed->value >= 0.0)
- ed->value = (double)((unsigned long) ed->value % ed->tmpulong);
- else {
- ed->tmplong = (long) ed->value;
- ed->value = (double)(ed->tmpulong - ((-ed->tmplong - 1) % ed->tmpulong)) - 1;
- }
- goto donumset;
- case O_ADD:
- ed->value = str_gnum(ed->st[1]);
- ed->value += str_gnum(ed->st[2]);
- goto donumset;
- case O_SUBTRACT:
- ed->value = str_gnum(ed->st[1]);
- ed->value -= str_gnum(ed->st[2]);
- goto donumset;
- case O_LEFT_SHIFT:
- ed->value = str_gnum(ed->st[1]);
- ed->anum = (int)str_gnum(ed->st[2]);
- ed->value = (double)(U_L(ed->value) << ed->anum);
- goto donumset;
- case O_RIGHT_SHIFT:
- ed->value = str_gnum(ed->st[1]);
- ed->anum = (int)str_gnum(ed->st[2]);
- ed->value = (double)(U_L(ed->value) >> ed->anum);
- goto donumset;
- case O_LT:
- ed->value = str_gnum(ed->st[1]);
- ed->value = (ed->value < str_gnum(ed->st[2])) ? 1.0 : 0.0;
- goto donumset;
- case O_GT:
- ed->value = str_gnum(ed->st[1]);
- ed->value = (ed->value > str_gnum(ed->st[2])) ? 1.0 : 0.0;
- goto donumset;
- case O_LE:
- ed->value = str_gnum(ed->st[1]);
- ed->value = (ed->value <= str_gnum(ed->st[2])) ? 1.0 : 0.0;
- goto donumset;
- case O_GE:
- ed->value = str_gnum(ed->st[1]);
- ed->value = (ed->value >= str_gnum(ed->st[2])) ? 1.0 : 0.0;
- goto donumset;
- case O_EQ:
- if (dowarn) {
- if ((!ed->st[1]->str_nok && !looks_like_number(ed->st[1])) ||
- (!ed->st[2]->str_nok && !looks_like_number(ed->st[2])) )
- warn("Possible use of == on string ed->value");
- }
- ed->value = str_gnum(ed->st[1]);
- ed->value = (ed->value == str_gnum(ed->st[2])) ? 1.0 : 0.0;
- goto donumset;
- case O_NE:
- ed->value = str_gnum(ed->st[1]);
- ed->value = (ed->value != str_gnum(ed->st[2])) ? 1.0 : 0.0;
- goto donumset;
- case O_NCMP:
- ed->value = str_gnum(ed->st[1]);
- ed->value -= str_gnum(ed->st[2]);
- if (ed->value > 0.0)
- ed->value = 1.0;
- else if (ed->value < 0.0)
- ed->value = -1.0;
- goto donumset;
- case O_BIT_AND:
- if (!sawvec || ed->st[1]->str_nok || ed->st[2]->str_nok) {
- ed->value = str_gnum(ed->st[1]);
- ed->value = (double)(U_L(ed->value) & U_L(str_gnum(ed->st[2])));
- goto donumset;
- }
- else
- do_vop(ed->optype,ed->str,ed->st[1],ed->st[2]);
- break;
- case O_XOR:
- if (!sawvec || ed->st[1]->str_nok || ed->st[2]->str_nok) {
- ed->value = str_gnum(ed->st[1]);
- ed->value = (double)(U_L(ed->value) ^ U_L(str_gnum(ed->st[2])));
- goto donumset;
- }
- else
- do_vop(ed->optype,ed->str,ed->st[1],ed->st[2]);
- break;
- case O_BIT_OR:
- if (!sawvec || ed->st[1]->str_nok || ed->st[2]->str_nok) {
- ed->value = str_gnum(ed->st[1]);
- ed->value = (double)(U_L(ed->value) | U_L(str_gnum(ed->st[2])));
- goto donumset;
- }
- else
- do_vop(ed->optype,ed->str,ed->st[1],ed->st[2]);
- break;
- /* use register in evaluating str_true() */
- case O_AND:
- if (str_true(ed->st[1])) {
- ed->anum = 2;
- ed->optype = O_ITEM2;
- ed->argflags = ed->arg[ed->anum].arg_flags;
- if (ed->gimme == G_ARRAY)
- ed->argflags |= AF_ARYOK;
- ed->argtype = ed->arg[ed->anum].arg_type & A_MASK;
- ed->argptr = ed->arg[ed->anum].arg_ptr;
- ed->maxarg = ed->anum = 1;
- ed->sp = ed->arglast[0];
- ed->st -= ed->sp;
- goto re_eval;
- }
- else {
- if (ed->assigning) {
- str_sset(ed->str, ed->st[1]);
- STABSET(ed->str);
- }
- else
- ed->str = ed->st[1];
- break;
- }
- case O_OR:
- if (str_true(ed->st[1])) {
- if (ed->assigning) {
- str_sset(ed->str, ed->st[1]);
- STABSET(ed->str);
- }
- else
- ed->str = ed->st[1];
- break;
- }
- else {
- ed->anum = 2;
- ed->optype = O_ITEM2;
- ed->argflags = ed->arg[ed->anum].arg_flags;
- if (ed->gimme == G_ARRAY)
- ed->argflags |= AF_ARYOK;
- ed->argtype = ed->arg[ed->anum].arg_type & A_MASK;
- ed->argptr = ed->arg[ed->anum].arg_ptr;
- ed->maxarg = ed->anum = 1;
- ed->sp = ed->arglast[0];
- ed->st -= ed->sp;
- goto re_eval;
- }
- case O_COND_EXPR:
- ed->anum = (str_true(ed->st[1]) ? 2 : 3);
- ed->optype = (ed->anum == 2 ? O_ITEM2 : O_ITEM3);
- ed->argflags = ed->arg[ed->anum].arg_flags;
- if (ed->gimme == G_ARRAY)
- ed->argflags |= AF_ARYOK;
- ed->argtype = ed->arg[ed->anum].arg_type & A_MASK;
- ed->argptr = ed->arg[ed->anum].arg_ptr;
- ed->maxarg = ed->anum = 1;
- ed->sp = ed->arglast[0];
- ed->st -= ed->sp;
- goto re_eval;
- case O_COMMA:
- if (ed->gimme == G_ARRAY)
- goto array_return;
- ed->str = ed->st[2];
- break;
- case O_NEGATE:
- ed->value = -str_gnum(ed->st[1]);
- goto donumset;
- case O_NOT:
- #ifdef NOTNOT
- { char xxx = str_true(st[1]); ed->value = (double) !xxx; }
- #else
- ed->value = (double) !str_true(ed->st[1]);
- #endif
- goto donumset;
- case O_COMPLEMENT:
- if (!sawvec || ed->st[1]->str_nok) {
- ed->value = (double) ~U_L(str_gnum(ed->st[1]));
- goto donumset;
- }
- else {
- STR_SSET(ed->str,ed->st[1]);
- ed->tmps = str_get(ed->str);
- for (ed->anum = ed->str->str_cur; ed->anum; ed->anum--, ed->tmps++)
- *ed->tmps = ~*ed->tmps;
- }
- break;
- case O_SELECT:
- stab_efullname(ed->str,defoutstab);
- if (ed->maxarg > 0) {
- if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- defoutstab = ed->arg[1].arg_ptr.arg_stab;
- else
- defoutstab = stabent(str_get(ed->st[1]),TRUE);
- if (!stab_io(defoutstab))
- stab_io(defoutstab) = stio_new();
- curoutstab = defoutstab;
- }
- STABSET(ed->str);
- break;
- case O_WRITE:
- if (ed->maxarg == 0)
- ed->stab = defoutstab;
- else if ((ed->arg[1].arg_type & A_MASK) == A_WORD) {
- if (!(ed->stab = ed->arg[1].arg_ptr.arg_stab))
- ed->stab = defoutstab;
- }
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- if (!stab_io(ed->stab)) {
- str_set(ed->str, No);
- STABSET(ed->str);
- break;
- }
- curoutstab = ed->stab;
- ed->fp = stab_io(ed->stab)->ofp;
- debarg = ed->arg;
- if (stab_io(ed->stab)->fmt_stab)
- ed->form = stab_form(stab_io(ed->stab)->fmt_stab);
- else
- ed->form = stab_form(ed->stab);
- if (!ed->form || !ed->fp) {
- if (dowarn) {
- if (ed->form)
- warn("No format for filehandle");
- else {
- if (stab_io(ed->stab)->ifp)
- warn("Filehandle only opened for input");
- else
- warn("Write on closed filehandle");
- }
- }
- str_set(ed->str, No);
- STABSET(ed->str);
- break;
- }
- format(&outrec,ed->form,ed->sp);
- do_write(&outrec,ed->stab,ed->sp);
- if (stab_io(ed->stab)->flags & IOF_FLUSH)
- (void)fflush(ed->fp);
- str_set(ed->str, Yes);
- STABSET(ed->str);
- break;
- case O_DBMOPEN:
- #ifdef SOME_DBM
- ed->anum = ed->arg[1].arg_type & A_MASK;
- if (ed->anum == A_WORD || ed->anum == A_STAB)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- if (ed->st[3]->str_nok || ed->st[3]->str_pok)
- ed->anum = (int)str_gnum(ed->st[3]);
- else
- ed->anum = -1;
- ed->value = (double)hdbmopen(stab_hash(ed->stab),str_get(ed->st[2]),ed->anum);
- goto donumset;
- #else
- fatal("No dbm or ndbm on this machine");
- #endif
- case O_DBMCLOSE:
- #ifdef SOME_DBM
- ed->anum = ed->arg[1].arg_type & A_MASK;
- if (ed->anum == A_WORD || ed->anum == A_STAB)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- hdbmclose(stab_hash(ed->stab));
- goto say_yes;
- #else
- fatal("No dbm or ndbm on this machine");
- #endif
- case O_OPEN:
- if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- ed->tmps = str_get(ed->st[2]);
- if (do_open(ed->stab,ed->tmps,ed->st[2]->str_cur)) {
- ed->value = (double)forkprocess;
- stab_io(ed->stab)->lines = 0;
- goto donumset;
- }
- else if (forkprocess == 0) /* we are a new child */
- goto say_zero;
- else
- goto say_undef;
- /* break; */
- case O_TRANS:
- ed->value = (double) do_trans(ed->str,ed->arg);
- ed->str = ed->arg->arg_ptr.arg_str;
- goto donumset;
- case O_NTRANS:
- str_set(ed->arg->arg_ptr.arg_str, do_trans(ed->str,ed->arg) == 0 ? Yes : No);
- ed->str = ed->arg->arg_ptr.arg_str;
- break;
- case O_CLOSE:
- if (ed->maxarg == 0)
- ed->stab = defoutstab;
- else if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- str_set(ed->str, do_close(ed->stab,TRUE) ? Yes : No );
- STABSET(ed->str);
- break;
- case O_EACH:
- ed->sp = do_each(ed->str,stab_hash(ed->arg[1].arg_ptr.arg_stab),
- ed->gimme,ed->arglast);
- goto array_return;
- case O_VALUES:
- case O_KEYS:
- ed->sp = do_kv(ed->str,stab_hash(ed->arg[1].arg_ptr.arg_stab), ed->optype,
- ed->gimme,ed->arglast);
- goto array_return;
- case O_LARRAY:
- ed->str->str_nok = ed->str->str_pok = 0;
- ed->str->str_u.str_stab = ed->arg[1].arg_ptr.arg_stab;
- ed->str->str_state = SS_ARY;
- break;
- case O_ARRAY:
- ed->ary = stab_array(ed->arg[1].arg_ptr.arg_stab);
- ed->maxarg = ed->ary->ary_fill + 1;
- if (ed->gimme == G_ARRAY) { /* array wanted */
- ed->sp = ed->arglast[0];
- ed->st -= ed->sp;
- if (ed->maxarg > 0 && ed->sp + ed->maxarg > stack->ary_max) {
- astore(stack,ed->sp + ed->maxarg, Nullstr);
- ed->st = stack->ary_array;
- }
- ed->st += ed->sp;
- Copy(ed->ary->ary_array, &ed->st[1], ed->maxarg, STR*);
- ed->sp += ed->maxarg;
- goto array_return;
- }
- else {
- ed->value = (double)ed->maxarg;
- goto donumset;
- }
- case O_AELEM:
- ed->anum = ((int)str_gnum(ed->st[2])) - arybase;
- ed->str = afetch(stab_array(ed->arg[1].arg_ptr.arg_stab),ed->anum,FALSE);
- break;
- case O_DELETE:
- tmpstab = ed->arg[1].arg_ptr.arg_stab;
- ed->tmps = str_get(ed->st[2]);
- ed->str = hdelete(stab_hash(tmpstab),ed->tmps,ed->st[2]->str_cur);
- if (tmpstab == envstab)
- my_setenv(ed->tmps,Nullch);
- if (!ed->str)
- goto say_undef;
- break;
- case O_LHASH:
- ed->str->str_nok = ed->str->str_pok = 0;
- ed->str->str_u.str_stab = ed->arg[1].arg_ptr.arg_stab;
- ed->str->str_state = SS_HASH;
- break;
- case O_HASH:
- if (ed->gimme == G_ARRAY) { /* array wanted */
- ed->sp = do_kv(ed->str,stab_hash(ed->arg[1].arg_ptr.arg_stab), ed->optype,
- ed->gimme,ed->arglast);
- goto array_return;
- }
- else {
- tmpstab = ed->arg[1].arg_ptr.arg_stab;
- if (!stab_hash(tmpstab)->tbl_fill)
- goto say_zero;
- sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill,
- stab_hash(tmpstab)->tbl_max+1);
- str_set(ed->str,buf);
- }
- break;
- case O_HELEM:
- tmpstab = ed->arg[1].arg_ptr.arg_stab;
- ed->tmps = str_get(ed->st[2]);
- ed->str = hfetch(stab_hash(tmpstab),ed->tmps,ed->st[2]->str_cur,FALSE);
- break;
- case O_LAELEM:
- ed->anum = ((int)str_gnum(ed->st[2])) - arybase;
- ed->str = afetch(stab_array(ed->arg[1].arg_ptr.arg_stab),ed->anum,TRUE);
- if (!ed->str || ed->str == &str_undef)
- fatal("Assignment to non-creatable ed->value, subscript %d",ed->anum);
- break;
- case O_LHELEM:
- tmpstab = ed->arg[1].arg_ptr.arg_stab;
- ed->tmps = str_get(ed->st[2]);
- ed->anum = ed->st[2]->str_cur;
- ed->str = hfetch(stab_hash(tmpstab),ed->tmps,ed->anum,TRUE);
- if (!ed->str || ed->str == &str_undef)
- fatal("Assignment to non-creatable ed->value, subscript \"%s\"",ed->tmps);
- if (tmpstab == envstab) /* heavy wizardry going on here */
- str_magic(ed->str, tmpstab, 'E', ed->tmps, ed->anum); /* ed->str is now magic */
- /* he threw the brick up into the air */
- else if (tmpstab == sigstab)
- str_magic(ed->str, tmpstab, 'S', ed->tmps, ed->anum);
- #ifdef SOME_DBM
- else if (stab_hash(tmpstab)->tbl_dbm)
- str_magic(ed->str, tmpstab, 'D', ed->tmps, ed->anum);
- #endif
- else if (tmpstab == DBline)
- str_magic(ed->str, tmpstab, 'L', ed->tmps, ed->anum);
- break;
- case O_LSLICE:
- ed->anum = 2;
- ed->argtype = FALSE;
- goto do_slice_already;
- case O_ASLICE:
- ed->anum = 1;
- ed->argtype = FALSE;
- goto do_slice_already;
- case O_HSLICE:
- ed->anum = 0;
- ed->argtype = FALSE;
- goto do_slice_already;
- case O_LASLICE:
- ed->anum = 1;
- ed->argtype = TRUE;
- goto do_slice_already;
- case O_LHSLICE:
- ed->anum = 0;
- ed->argtype = TRUE;
- do_slice_already:
- ed->sp = do_slice(ed->arg[1].arg_ptr.arg_stab,ed->str,ed->anum,ed->argtype,
- ed->gimme,ed->arglast);
- goto array_return;
- case O_SPLICE:
- ed->sp = do_splice(stab_array(ed->arg[1].arg_ptr.arg_stab),ed->gimme,ed->arglast);
- goto array_return;
- case O_PUSH:
- if (ed->arglast[2] - ed->arglast[1] != 1)
- ed->str = do_push(stab_array(ed->arg[1].arg_ptr.arg_stab),ed->arglast);
- else {
- ed->str = Str_new(51,0); /* must copy the ed->str */
- str_sset(ed->str,ed->st[2]);
- (void)apush(stab_array(ed->arg[1].arg_ptr.arg_stab),ed->str);
- }
- break;
- case O_POP:
- ed->str = apop(ed->ary = stab_array(ed->arg[1].arg_ptr.arg_stab));
- goto staticalization;
- case O_SHIFT:
- ed->str = ashift(ed->ary = stab_array(ed->arg[1].arg_ptr.arg_stab));
- staticalization:
- if (!ed->str)
- goto say_undef;
- if (ed->ary->ary_flags & ARF_REAL)
- (void)str_2mortal(ed->str);
- break;
- case O_UNPACK:
- ed->sp = do_unpack(ed->str,ed->gimme,ed->arglast);
- goto array_return;
- case O_SPLIT:
- ed->value = str_gnum(ed->st[3]);
- ed->sp = do_split(ed->str, ed->arg[2].arg_ptr.arg_spat, (int)ed->value,
- ed->gimme,ed->arglast);
- goto array_return;
- case O_LENGTH:
- if (ed->maxarg < 1)
- ed->value = (double)str_len(stab_val(defstab));
- else
- ed->value = (double)str_len(ed->st[1]);
- goto donumset;
- case O_SPRINTF:
- do_sprintf(ed->str, ed->sp-ed->arglast[0], ed->st+1);
- break;
- case O_SUBSTR:
- ed->anum = ((int)str_gnum(ed->st[2])) - arybase; /* ed->anum=where to start*/
- ed->tmps = str_get(ed->st[1]); /* force conversion to string */
- /*SUPPRESS 560*/
- if (ed->argtype = (ed->str == ed->st[1]))
- ed->str = ed->arg->arg_ptr.arg_str;
- if (ed->anum < 0)
- ed->anum += ed->st[1]->str_cur + arybase;
- if (ed->anum < 0 || ed->anum > ed->st[1]->str_cur)
- str_nset(ed->str,"",0);
- else {
- ed->optype = ed->maxarg < 3 ? ed->st[1]->str_cur : (int)str_gnum(ed->st[3]);
- if (ed->optype < 0)
- ed->optype = 0;
- ed->tmps += ed->anum;
- ed->anum = ed->st[1]->str_cur - ed->anum; /* ed->anum=how many bytes left*/
- if (ed->anum > ed->optype)
- ed->anum = ed->optype;
- str_nset(ed->str, ed->tmps, ed->anum);
- if (ed->argtype) { /* it's an lvalue! */
- lstr = (struct lstring*)ed->str;
- ed->str->str_magic = ed->st[1];
- ed->st[1]->str_rare = 's';
- lstr->lstr_offset = ed->tmps - str_get(ed->st[1]);
- lstr->lstr_len = ed->anum;
- }
- }
- break;
- default:
- fatal("eval1 was incorrectly split");
- }
- return R_nojump;
-
- array_return:
- return R_array_return;
- say_no:
- return R_say_no;
- re_eval:
- return R_re_eval;
- say_yes:
- return R_say_yes;
- say_undef:
- return R_say_undef;
- donumset:
- return R_donumset;
- say_zero:
- return R_say_zero;
- }
-
- EvalResult eval2(EvalData * ed)
- {
- switch (ed->optype) {
- case O_PACK:
- /*SUPPRESS 701*/
- (void)do_pack(ed->str,ed->arglast);
- break;
- case O_GREP:
- ed->sp = do_grep(ed->arg,ed->str,ed->gimme,ed->arglast);
- goto array_return;
- case O_JOIN:
- do_join(ed->str,ed->arglast);
- break;
- case O_SLT:
- ed->tmps = str_get(ed->st[1]);
- ed->value = (double) (str_cmp(ed->st[1],ed->st[2]) < 0);
- goto donumset;
- case O_SGT:
- ed->tmps = str_get(ed->st[1]);
- ed->value = (double) (str_cmp(ed->st[1],ed->st[2]) > 0);
- goto donumset;
- case O_SLE:
- ed->tmps = str_get(ed->st[1]);
- ed->value = (double) (str_cmp(ed->st[1],ed->st[2]) <= 0);
- goto donumset;
- case O_SGE:
- ed->tmps = str_get(ed->st[1]);
- ed->value = (double) (str_cmp(ed->st[1],ed->st[2]) >= 0);
- goto donumset;
- case O_SEQ:
- ed->tmps = str_get(ed->st[1]);
- ed->value = (double) str_eq(ed->st[1],ed->st[2]);
- goto donumset;
- case O_SNE:
- ed->tmps = str_get(ed->st[1]);
- ed->value = (double) !str_eq(ed->st[1],ed->st[2]);
- goto donumset;
- case O_SCMP:
- ed->tmps = str_get(ed->st[1]);
- ed->value = (double) str_cmp(ed->st[1],ed->st[2]);
- goto donumset;
- case O_SUBR:
- ed->sp = do_subr(ed->arg,ed->gimme,ed->arglast);
- ed->st = stack->ary_array + ed->arglast[0]; /* maybe realloced */
- goto array_return;
- case O_DBSUBR:
- ed->sp = do_subr(ed->arg,ed->gimme,ed->arglast);
- ed->st = stack->ary_array + ed->arglast[0]; /* maybe realloced */
- goto array_return;
- case O_CALLER:
- ed->sp = do_caller(ed->arg,ed->maxarg,ed->gimme,ed->arglast);
- ed->st = stack->ary_array + ed->arglast[0]; /* maybe realloced */
- goto array_return;
- case O_SORT:
- ed->sp = do_sort(ed->str,ed->arg,
- ed->gimme,ed->arglast);
- goto array_return;
- case O_REVERSE:
- if (ed->gimme == G_ARRAY)
- ed->sp = do_reverse(ed->arglast);
- else
- ed->sp = do_sreverse(ed->str, ed->arglast);
- goto array_return;
- case O_WARN:
- if (ed->arglast[2] - ed->arglast[1] != 1) {
- do_join(ed->str,ed->arglast);
- ed->tmps = str_get(ed->str);
- }
- else {
- ed->str = ed->st[2];
- ed->tmps = str_get(ed->st[2]);
- }
- if (!ed->tmps || !*ed->tmps)
- ed->tmps = "Warning: something's wrong";
- warn("%s",ed->tmps);
- goto say_yes;
- case O_DIE:
- if (ed->arglast[2] - ed->arglast[1] != 1) {
- do_join(ed->str,ed->arglast);
- ed->tmps = str_get(ed->str);
- }
- else {
- ed->str = ed->st[2];
- ed->tmps = str_get(ed->st[2]);
- }
- if (!ed->tmps || !*ed->tmps)
- ed->tmps = "Died";
- fatal("%s",ed->tmps);
- goto say_zero;
- case O_PRTF:
- case O_PRINT:
- if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- if (!ed->stab)
- ed->stab = defoutstab;
- if (!stab_io(ed->stab)) {
- if (dowarn)
- warn("Filehandle never opened");
- goto say_zero;
- }
- if (!(ed->fp = stab_io(ed->stab)->ofp)) {
- if (dowarn) {
- if (stab_io(ed->stab)->ifp)
- warn("Filehandle opened only for input");
- else
- warn("Print on closed filehandle");
- }
- goto say_zero;
- }
- else {
- if (ed->optype == O_PRTF || ed->arglast[2] - ed->arglast[1] != 1)
- ed->value = (double)do_aprint(ed->arg,ed->fp,ed->arglast);
- else {
- ed->value = (double)do_print(ed->st[2],ed->fp);
- if (orslen && ed->optype == O_PRINT)
- if (fwrite(ors, 1, orslen, ed->fp) == 0)
- goto say_zero;
- }
- if (stab_io(ed->stab)->flags & IOF_FLUSH)
- if (fflush(ed->fp) == EOF)
- goto say_zero;
- }
- goto donumset;
- case O_CHDIR:
- if (ed->maxarg < 1)
- ed->tmps = Nullch;
- else
- ed->tmps = str_get(ed->st[1]);
- if (!ed->tmps || !*ed->tmps) {
- ed->tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE);
- ed->tmps = str_get(ed->tmpstr);
- }
- if (!ed->tmps || !*ed->tmps) {
- ed->tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE);
- ed->tmps = str_get(ed->tmpstr);
- }
- ed->value = (double)(chdir(ed->tmps) >= 0);
- goto donumset;
- case O_EXIT:
- if (ed->maxarg < 1)
- ed->anum = 0;
- else
- ed->anum = (int)str_gnum(ed->st[1]);
- exit(ed->anum);
- goto say_zero;
- case O_RESET:
- if (ed->maxarg < 1)
- ed->tmps = "";
- else
- ed->tmps = str_get(ed->st[1]);
- str_reset(ed->tmps,curcmd->c_stash);
- ed->value = 1.0;
- goto donumset;
- case O_LIST:
- if (ed->gimme == G_ARRAY)
- goto array_return;
- if (ed->maxarg > 0)
- ed->str = ed->st[ed->sp - ed->arglast[0]]; /* unwanted list, return last item */
- else
- ed->str = &str_undef;
- break;
- case O_EOF:
- if (ed->maxarg <= 0)
- ed->stab = last_in_stab;
- else if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- str_set(ed->str, do_eof(ed->stab) ? Yes : No);
- STABSET(ed->str);
- break;
- case O_GETC:
- if (ed->maxarg <= 0)
- ed->stab = stdinstab;
- else if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- if (!ed->stab)
- ed->stab = argvstab;
- if (!ed->stab || do_eof(ed->stab)) /* make sure we have ed->fp with something */
- goto say_undef;
- else {
- str_set(ed->str," ");
- *ed->str->str_ptr = getc(stab_io(ed->stab)->ifp); /* should never be EOF */
- }
- STABSET(ed->str);
- break;
- case O_TELL:
- if (ed->maxarg <= 0)
- ed->stab = last_in_stab;
- else if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- ed->value = (double)do_tell(ed->stab);
- goto donumset;
- case O_RECV:
- case O_READ:
- case O_SYSREAD:
- if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- ed->tmps = str_get(ed->st[2]);
- ed->anum = (int)str_gnum(ed->st[3]);
- errno = 0;
- ed->maxarg = ed->sp - ed->arglast[0];
- if (ed->maxarg > 4)
- warn("Too many args on read");
- if (ed->maxarg == 4)
- ed->maxarg = (int)str_gnum(ed->st[4]);
- else
- ed->maxarg = 0;
- if (!stab_io(ed->stab) || !stab_io(ed->stab)->ifp)
- goto say_undef;
- #ifdef HAS_SOCKET
- if (ed->optype == O_RECV) {
- ed->argtype = sizeof buf;
- STR_GROW(ed->st[2], ed->anum+1), (ed->tmps = str_get(ed->st[2])); /* sneaky */
- ed->anum = recvfrom(fileno(stab_io(ed->stab)->ifp), ed->tmps, ed->anum, ed->maxarg,
- buf, &ed->argtype);
- if (ed->anum >= 0) {
- ed->st[2]->str_cur = ed->anum;
- ed->st[2]->str_ptr[ed->anum] = '\0';
- str_nset(ed->str,buf,ed->argtype);
- }
- else
- str_sset(ed->str,&str_undef);
- break;
- }
- #else
- if (ed->optype == O_RECV)
- goto badsock;
- #endif
- STR_GROW(ed->st[2], ed->anum+ed->maxarg+1), (ed->tmps = str_get(ed->st[2])); /* sneaky */
- if (ed->optype == O_SYSREAD) {
- ed->anum = read(fileno(stab_io(ed->stab)->ifp), ed->tmps+ed->maxarg, ed->anum);
- }
- else
- #ifdef HAS_SOCKET
- if (stab_io(ed->stab)->type == 's') {
- ed->argtype = sizeof buf;
- ed->anum = recvfrom(fileno(stab_io(ed->stab)->ifp), ed->tmps+ed->maxarg, ed->anum, 0,
- buf, &ed->argtype);
- }
- else
- #endif
- ed->anum = fread(ed->tmps+ed->maxarg, 1, ed->anum, stab_io(ed->stab)->ifp);
- if (ed->anum < 0)
- goto say_undef;
- ed->st[2]->str_cur = ed->anum+ed->maxarg;
- ed->st[2]->str_ptr[ed->anum+ed->maxarg] = '\0';
- ed->value = (double)ed->anum;
- goto donumset;
- case O_SYSWRITE:
- case O_SEND:
- if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- ed->tmps = str_get(ed->st[2]);
- ed->anum = (int)str_gnum(ed->st[3]);
- errno = 0;
- stio = stab_io(ed->stab);
- ed->maxarg = ed->sp - ed->arglast[0];
- if (!stio || !stio->ifp) {
- ed->anum = -1;
- if (dowarn) {
- if (ed->optype == O_SYSWRITE)
- warn("Syswrite on closed filehandle");
- else
- warn("Send on closed socket");
- }
- }
- else if (ed->optype == O_SYSWRITE) {
- if (ed->maxarg > 4)
- warn("Too many args on syswrite");
- if (ed->maxarg == 4)
- ed->optype = (int)str_gnum(ed->st[4]);
- else
- ed->optype = 0;
- ed->anum = write(fileno(stab_io(ed->stab)->ifp), ed->tmps+ed->optype, ed->anum);
- }
- #ifdef HAS_SOCKET
- else if (ed->maxarg >= 4) {
- if (ed->maxarg > 4)
- warn("Too many args on send");
- ed->tmps2 = str_get(ed->st[4]);
- ed->anum = sendto(fileno(stab_io(ed->stab)->ifp), ed->tmps, ed->st[2]->str_cur,
- ed->anum, ed->tmps2, ed->st[4]->str_cur);
- }
- else
- ed->anum = send(fileno(stab_io(ed->stab)->ifp), ed->tmps, ed->st[2]->str_cur, ed->anum);
- #else
- else
- goto badsock;
- #endif
- if (ed->anum < 0)
- goto say_undef;
- ed->value = (double)ed->anum;
- goto donumset;
- case O_SEEK:
- if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- ed->value = str_gnum(ed->st[2]);
- str_set(ed->str, do_seek(ed->stab,
- (long)ed->value, (int)str_gnum(ed->st[3]) ) ? Yes : No);
- STABSET(ed->str);
- break;
- case O_RETURN:
- ed->tmps = "_SUB_"; /* just fake up a "last _SUB_" */
- ed->optype = O_LAST;
- if (curcsv && curcsv->wantarray == G_ARRAY) {
- lastretstr = Nullstr;
- lastspbase = ed->arglast[1];
- lastsize = ed->arglast[2] - ed->arglast[1];
- }
- else
- lastretstr = str_mortal(ed->st[ed->arglast[2] - ed->arglast[0]]);
- goto dopop;
- case O_REDO:
- case O_NEXT:
- case O_LAST:
- ed->tmps = Nullch;
- if (ed->maxarg > 0) {
- ed->tmps = str_get(ed->arg[1].arg_ptr.arg_str);
- dopop:
- while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
- strNE(ed->tmps,loop_stack[loop_ptr].loop_label) )) {
- #ifdef DEBUGGING
- if (debug & 4) {
- deb("(Skipping label #%d %s)\n",loop_ptr,
- loop_stack[loop_ptr].loop_label);
- }
- #endif
- loop_ptr--;
- }
- #ifdef DEBUGGING
- if (debug & 4) {
- deb("(Found label #%d %s)\n",loop_ptr,
- loop_stack[loop_ptr].loop_label);
- }
- #endif
- }
- if (loop_ptr < 0) {
- if (ed->tmps && strEQ(ed->tmps, "_SUB_"))
- fatal("Can't return outside a subroutine");
- fatal("Bad label: %s", ed->maxarg > 0 ? ed->tmps : "<null>");
- }
- if (!lastretstr && ed->optype == O_LAST && lastsize) {
- ed->st -= ed->arglast[0];
- ed->st += lastspbase + 1;
- ed->optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */
- if (ed->optype) {
- for (ed->anum = lastsize; ed->anum > 0; ed->anum--,ed->st++)
- ed->st[ed->optype] = str_mortal(ed->st[0]);
- }
- longjmp(loop_stack[loop_ptr].loop_env, O_LAST);
- }
- longjmp(loop_stack[loop_ptr].loop_env, ed->optype);
- case O_DUMP:
- case O_GOTO:/* shudder */
- goto_targ = str_get(ed->arg[1].arg_ptr.arg_str);
- if (!*goto_targ)
- goto_targ = Nullch; /* just restart from top */
- if (ed->optype == O_DUMP) {
- do_undump = 1;
- my_unexec();
- }
- longjmp(top_env, 1);
- case O_INDEX:
- ed->tmps = str_get(ed->st[1]);
- if (ed->maxarg < 3)
- ed->anum = 0;
- else {
- ed->anum = (int) str_gnum(ed->st[3]) - arybase;
- if (ed->anum < 0)
- ed->anum = 0;
- else if (ed->anum > ed->st[1]->str_cur)
- ed->anum = ed->st[1]->str_cur;
- }
- if (!(ed->tmps2 = fbminstr((unsigned char*)ed->tmps + ed->anum,
- (unsigned char*)ed->tmps + ed->st[1]->str_cur, ed->st[2])))
- ed->value = (double)(-1 + arybase);
- else
- ed->value = (double)(ed->tmps2 - ed->tmps + arybase);
- goto donumset;
- case O_RINDEX:
- ed->tmps = str_get(ed->st[1]);
- ed->tmps2 = str_get(ed->st[2]);
- if (ed->maxarg < 3)
- ed->anum = ed->st[1]->str_cur;
- else {
- ed->anum = (int) str_gnum(ed->st[3]) - arybase + ed->st[2]->str_cur;
- if (ed->anum < 0)
- ed->anum = 0;
- else if (ed->anum > ed->st[1]->str_cur)
- ed->anum = ed->st[1]->str_cur;
- }
- if (!(ed->tmps2 = rninstr(ed->tmps, ed->tmps + ed->anum,
- ed->tmps2, ed->tmps2 + ed->st[2]->str_cur)))
- ed->value = (double)(-1 + arybase);
- else
- ed->value = (double)(ed->tmps2 - ed->tmps + arybase);
- goto donumset;
- case O_TIME:
- ed->value = (double) time(Null(time_t*));
- goto donumset;
- case O_TMS:
- ed->sp = do_tms(ed->str,ed->gimme,ed->arglast);
- goto array_return;
- case O_LOCALTIME:
- if (ed->maxarg < 1)
- (void)time(&ed->when);
- else
- ed->when = (time_t)str_gnum(ed->st[1]);
- ed->sp = do_time(ed->str,localtime(&ed->when),
- ed->gimme,ed->arglast);
- goto array_return;
- case O_GMTIME:
- if (ed->maxarg < 1)
- (void)time(&ed->when);
- else
- ed->when = (time_t)str_gnum(ed->st[1]);
- ed->sp = do_time(ed->str,gmtime(&ed->when),
- ed->gimme,ed->arglast);
- goto array_return;
- case O_TRUNCATE:
- ed->sp = do_truncate(ed->str,ed->arg,
- ed->gimme,ed->arglast);
- goto array_return;
- case O_LSTAT:
- case O_STAT:
- ed->sp = do_stat(ed->str,ed->arg,
- ed->gimme,ed->arglast);
- goto array_return;
- case O_CRYPT:
- #ifdef HAS_CRYPT
- ed->tmps = str_get(ed->st[1]);
- #ifdef FCRYPT
- str_set(ed->str,fcrypt(ed->tmps,str_get(ed->st[2])));
- #else
- str_set(ed->str,crypt(ed->tmps,str_get(ed->st[2])));
- #endif
- #else
- fatal(
- "The crypt() function is unimplemented due to excessive paranoia.");
- #endif
- break;
- case O_ATAN2:
- ed->value = str_gnum(ed->st[1]);
- ed->value = atan2(ed->value,str_gnum(ed->st[2]));
- goto donumset;
- case O_SIN:
- if (ed->maxarg < 1)
- ed->value = str_gnum(stab_val(defstab));
- else
- ed->value = str_gnum(ed->st[1]);
- ed->value = sin(ed->value);
- goto donumset;
- case O_COS:
- if (ed->maxarg < 1)
- ed->value = str_gnum(stab_val(defstab));
- else
- ed->value = str_gnum(ed->st[1]);
- ed->value = cos(ed->value);
- goto donumset;
- case O_RAND:
- if (ed->maxarg < 1)
- ed->value = 1.0;
- else
- ed->value = str_gnum(ed->st[1]);
- if (ed->value == 0.0)
- ed->value = 1.0;
- #if RANDBITS == 31
- ed->value = rand() * ed->value / 2147483648.0;
- #else
- #if RANDBITS == 16
- ed->value = rand() * ed->value / 65536.0;
- #else
- #if RANDBITS == 15
- ed->value = rand() * ed->value / 32768.0;
- #else
- ed->value = rand() * ed->value / (double)(((unsigned long)1) << RANDBITS);
- #endif
- #endif
- #endif
- goto donumset;
- case O_SRAND:
- if (ed->maxarg < 1) {
- (void)time(&ed->when);
- ed->anum = ed->when;
- }
- else
- ed->anum = (int)str_gnum(ed->st[1]);
- srand(ed->anum);
- goto say_yes;
- case O_EXP:
- if (ed->maxarg < 1)
- ed->value = str_gnum(stab_val(defstab));
- else
- ed->value = str_gnum(ed->st[1]);
- ed->value = exp(ed->value);
- goto donumset;
- case O_LOG:
- if (ed->maxarg < 1)
- ed->value = str_gnum(stab_val(defstab));
- else
- ed->value = str_gnum(ed->st[1]);
- if (ed->value <= 0.0)
- fatal("Can't take log of %g\n", ed->value);
- ed->value = log(ed->value);
- goto donumset;
- case O_SQRT:
- if (ed->maxarg < 1)
- ed->value = str_gnum(stab_val(defstab));
- else
- ed->value = str_gnum(ed->st[1]);
- if (ed->value < 0.0)
- fatal("Can't take sqrt of %g\n", ed->value);
- ed->value = sqrt(ed->value);
- goto donumset;
- case O_INT:
- if (ed->maxarg < 1)
- ed->value = str_gnum(stab_val(defstab));
- else
- ed->value = str_gnum(ed->st[1]);
- {
- #if defined(powerc) || defined(__powerc)
- if (ed->value >= 0.0)
- (void)modf(ed->value,&ed->value);
- else {
- (void)modf(-ed->value,&ed->value);
- ed->value = -ed->value;
- }
- #else
- extended intpart;
-
- if (ed->value >= 0.0)
- (void)modf(ed->value,&intpart);
- else {
- (void)modf(-ed->value,&intpart);
- intpart = -intpart;
- }
-
- ed->value = intpart;
- #endif
- }
- goto donumset;
- case O_ORD:
- if (ed->maxarg < 1)
- ed->tmps = str_get(stab_val(defstab));
- else
- ed->tmps = str_get(ed->st[1]);
- ed->value = (double) (*ed->tmps & 255);
- goto donumset;
- case O_ALARM:
- #ifdef HAS_ALARM
- if (ed->maxarg < 1)
- ed->tmps = str_get(stab_val(defstab));
- else
- ed->tmps = str_get(ed->st[1]);
- if (!ed->tmps)
- ed->tmps = "0";
- ed->anum = alarm((unsigned int)atoi(ed->tmps));
- if (ed->anum < 0)
- goto say_undef;
- ed->value = (double)ed->anum;
- goto donumset;
- #else
- fatal("Unsupported function alarm");
- break;
- #endif
- case O_SLEEP:
- if (ed->maxarg < 1)
- ed->tmps = Nullch;
- else
- ed->tmps = str_get(ed->st[1]);
- (void)time(&ed->when);
- if (!ed->tmps || !*ed->tmps)
- sleep((32767<<16)+32767);
- else
- sleep((unsigned int)atoi(ed->tmps));
- ed->value = (double)ed->when;
- (void)time(&ed->when);
- ed->value = ((double)ed->when) - ed->value;
- goto donumset;
- case O_RANGE:
- ed->sp = do_range(ed->gimme,ed->arglast);
- goto array_return;
- case O_F_OR_R:
- if (ed->gimme == G_ARRAY) { /* it's a range */
- /* can we optimize to constant array? */
- if ((ed->arg[1].arg_type & A_MASK) == A_SINGLE &&
- (ed->arg[2].arg_type & A_MASK) == A_SINGLE) {
- ed->st[2] = ed->arg[2].arg_ptr.arg_str;
- ed->sp = do_range(ed->gimme,ed->arglast);
- ed->st = stack->ary_array;
- ed->maxarg = ed->sp - ed->arglast[0];
- str_free(ed->arg[1].arg_ptr.arg_str);
- ed->arg[1].arg_ptr.arg_str = Nullstr;
- str_free(ed->arg[2].arg_ptr.arg_str);
- ed->arg[2].arg_ptr.arg_str = Nullstr;
- ed->arg->arg_type = O_ARRAY;
- ed->arg[1].arg_type = A_STAB|A_DONT;
- ed->arg->arg_len = 1;
- ed->stab = ed->arg[1].arg_ptr.arg_stab = aadd(genstab());
- ed->ary = stab_array(ed->stab);
- afill(ed->ary,ed->maxarg - 1);
- ed->anum = ed->maxarg;
- ed->st += ed->arglast[0]+1;
- while (ed->maxarg-- > 0)
- ed->ary->ary_array[ed->maxarg] = str_smake(ed->st[ed->maxarg]);
- ed->st -= ed->arglast[0]+1;
- goto array_return;
- }
- ed->arg->arg_type = ed->optype = O_RANGE;
- ed->maxarg = ed->arg->arg_len = 2;
- ed->anum = 2;
- ed->arg[ed->anum].arg_flags &= ~AF_ARYOK;
- ed->argflags = ed->arg[ed->anum].arg_flags;
- ed->argtype = ed->arg[ed->anum].arg_type & A_MASK;
- ed->arg[ed->anum].arg_type = ed->argtype;
- ed->argptr = ed->arg[ed->anum].arg_ptr;
- ed->sp = ed->arglast[0];
- ed->st -= ed->sp;
- ed->sp++;
- goto re_eval;
- }
- ed->arg->arg_type = O_FLIP;
- /* FALL THROUGH */
- case O_FLIP:
- if ((ed->arg[1].arg_type & A_MASK) == A_SINGLE ?
- last_in_stab && (int)str_gnum(ed->st[1]) == stab_io(last_in_stab)->lines
- :
- str_true(ed->st[1]) ) {
- ed->arg[2].arg_type &= ~A_DONT;
- ed->arg[1].arg_type |= A_DONT;
- ed->arg->arg_type = ed->optype = O_FLOP;
- if (ed->arg->arg_flags & AF_COMMON) {
- str_numset(ed->str,0.0);
- ed->anum = 2;
- ed->argflags = ed->arg[2].arg_flags;
- ed->argtype = ed->arg[2].arg_type & A_MASK;
- ed->argptr = ed->arg[2].arg_ptr;
- ed->sp = ed->arglast[0];
- ed->st -= ed->sp++;
- goto re_eval;
- }
- else {
- str_numset(ed->str,1.0);
- break;
- }
- }
- str_set(ed->str,"");
- break;
- case O_FLOP:
- str_inc(ed->str);
- if ((ed->arg[2].arg_type & A_MASK) == A_SINGLE ?
- last_in_stab && (int)str_gnum(ed->st[2]) == stab_io(last_in_stab)->lines
- :
- str_true(ed->st[2]) ) {
- ed->arg->arg_type = O_FLIP;
- ed->arg[1].arg_type &= ~A_DONT;
- ed->arg[2].arg_type |= A_DONT;
- str_cat(ed->str,"E0");
- }
- break;
- case O_FORK:
- fatal("Unsupported function fork");
- break;
- case O_WAIT:
- fatal("Unsupported function wait");
- break;
- case O_WAITPID:
- fatal("Unsupported function wait");
- break;
- case O_SYSTEM:
- if ((ed->arg[1].arg_type & A_MASK) == A_STAB)
- ed->value = (double)do_aspawn(ed->st[1],ed->arglast);
- else if (ed->arglast[2] - ed->arglast[1] != 1)
- ed->value = (double)do_aspawn(Nullstr,ed->arglast);
- else {
- ed->value = (double)do_spawn(str_get(str_mortal(ed->st[2])));
- }
- goto donumset;
- case O_EXEC_OP:
- if ((ed->arg[1].arg_type & A_MASK) == A_STAB)
- ed->value = (double)do_aexec(ed->st[1],ed->arglast);
- else if (ed->arglast[2] - ed->arglast[1] != 1)
- ed->value = (double)do_aexec(Nullstr,ed->arglast);
- else {
- ed->value = (double)do_exec(str_get(str_mortal(ed->st[2])));
- }
- goto donumset;
- case O_HEX:
- if (ed->maxarg < 1)
- ed->tmps = str_get(stab_val(defstab));
- else
- ed->tmps = str_get(ed->st[1]);
- ed->value = (double)scanhex(ed->tmps, 99, &ed->argtype);
- goto donumset;
-
- case O_OCT:
- if (ed->maxarg < 1)
- ed->tmps = str_get(stab_val(defstab));
- else
- ed->tmps = str_get(ed->st[1]);
- while (*ed->tmps && (isSPACE(*ed->tmps) || *ed->tmps == '0'))
- ed->tmps++;
- if (*ed->tmps == 'x')
- ed->value = (double)scanhex(++ed->tmps, 99, &ed->argtype);
- else
- ed->value = (double)scanoct(ed->tmps, 99, &ed->argtype);
- goto donumset;
- default:
- fatal("eval2 was incorrectly split");
- }
- return R_nojump;
-
- array_return:
- return R_array_return;
- re_eval:
- return R_re_eval;
- #ifndef HAS_SOCKET
- badsock:
- return R_badsock;
- #endif
- say_yes:
- return R_say_yes;
- say_undef:
- return R_say_undef;
- donumset:
- return R_donumset;
- say_zero:
- return R_say_zero;
- }
-
- int
- eval(arg,gimme,sp)
- register ARG *arg;
- int gimme;
- register int sp;
- {
- EvalData edt;
- EvalData * ed;
-
- ed = &edt;
- ed->arg = arg;
- ed->gimme = gimme;
- ed->sp = sp;
- ed->assigning = FALSE;
-
- if (!ed->arg)
- goto say_undef;
- ed->optype = ed->arg->arg_type;
- ed->maxarg = ed->arg->arg_len;
- ed->arglast[0] = ed->sp;
- ed->str = ed->arg->arg_ptr.arg_str;
- if (ed->sp + ed->maxarg > stack->ary_max)
- astore(stack, ed->sp + ed->maxarg, Nullstr);
- ed->st = stack->ary_array;
-
- #ifdef DEBUGGING
- if (debug) {
- if (debug & 8) {
- deb("%s (%lx) %d args:\n",opname[ed->optype],ed->arg,ed->maxarg);
- }
- debname[dlevel] = opname[ed->optype][0];
- debdelim[dlevel] = ':';
- if (++dlevel >= dlmax)
- grow_dlevel();
- }
- #endif
-
- for (ed->anum = 1; ed->anum <= ed->maxarg; ed->anum++) {
- ed->argflags = ed->arg[ed->anum].arg_flags;
- ed->argtype = ed->arg[ed->anum].arg_type;
- ed->argptr = ed->arg[ed->anum].arg_ptr;
- re_eval:
- switch (ed->argtype) {
- default:
- ed->st[++ed->sp] = &str_undef;
- #ifdef DEBUGGING
- ed->tmps = "NULL";
- #endif
- break;
- case A_EXPR:
- #ifdef DEBUGGING
- if (debug & 8) {
- ed->tmps = "EXPR";
- deb("%d.EXPR =>\n",ed->anum);
- }
- #endif
- ed->sp = eval(ed->argptr.arg_arg,
- (ed->argflags & AF_ARYOK) ? G_ARRAY : G_SCALAR, ed->sp);
- if (ed->sp + (ed->maxarg - ed->anum) > stack->ary_max)
- astore(stack, ed->sp + (ed->maxarg - ed->anum), Nullstr);
- ed->st = stack->ary_array; /* possibly reallocated */
- break;
- case A_CMD:
- #ifdef DEBUGGING
- if (debug & 8) {
- ed->tmps = "CMD";
- deb("%d.CMD (%lx) =>\n",ed->anum,ed->argptr.arg_cmd);
- }
- #endif
- ed->sp = cmd_exec(ed->argptr.arg_cmd, ed->gimme, ed->sp);
- if (ed->sp + (ed->maxarg - ed->anum) > stack->ary_max)
- astore(stack, ed->sp + (ed->maxarg - ed->anum), Nullstr);
- ed->st = stack->ary_array; /* possibly reallocated */
- break;
- case A_LARYSTAB:
- ++ed->sp;
- switch (ed->optype) {
- case O_ITEM2: ed->argtype = 2; break;
- case O_ITEM3: ed->argtype = 3; break;
- default: ed->argtype = ed->anum; break;
- }
- ed->str = afetch(stab_array(ed->argptr.arg_stab),
- ed->arg[ed->argtype].arg_len - arybase, TRUE);
- #ifdef DEBUGGING
- if (debug & 8) {
- (void)sprintf(buf,"LARYSTAB $%s[%d]",stab_name(ed->argptr.arg_stab),
- ed->arg[ed->argtype].arg_len);
- ed->tmps = buf;
- }
- #endif
- goto do_crement;
- case A_ARYSTAB:
- switch (ed->optype) {
- case O_ITEM2: ed->argtype = 2; break;
- case O_ITEM3: ed->argtype = 3; break;
- default: ed->argtype = ed->anum; break;
- }
- ed->st[++ed->sp] = afetch(stab_array(ed->argptr.arg_stab),
- ed->arg[ed->argtype].arg_len - arybase, FALSE);
- #ifdef DEBUGGING
- if (debug & 8) {
- (void)sprintf(buf,"ARYSTAB $%s[%d]",stab_name(ed->argptr.arg_stab),
- ed->arg[ed->argtype].arg_len);
- ed->tmps = buf;
- }
- #endif
- break;
- case A_STAR:
- ed->stab = ed->argptr.arg_stab;
- ed->st[++ed->sp] = (STR*)ed->stab;
- if (!stab_xarray(ed->stab))
- aadd(ed->stab);
- if (!stab_xhash(ed->stab))
- hadd(ed->stab);
- if (!stab_io(ed->stab))
- stab_io(ed->stab) = stio_new();
- #ifdef DEBUGGING
- if (debug & 8) {
- (void)sprintf(buf,"STAR *%s -> *%s",
- stab_name(ed->argptr.arg_stab), stab_ename(ed->argptr.arg_stab));
- ed->tmps = buf;
- }
- #endif
- break;
- case A_LSTAR:
- ed->str = ed->st[++ed->sp] = (STR*)ed->argptr.arg_stab;
- #ifdef DEBUGGING
- if (debug & 8) {
- (void)sprintf(buf,"LSTAR *%s -> *%s",
- stab_name(ed->argptr.arg_stab), stab_ename(ed->argptr.arg_stab));
- ed->tmps = buf;
- }
- #endif
- break;
- case A_STAB:
- ed->st[++ed->sp] = STAB_STR(ed->argptr.arg_stab);
- #ifdef DEBUGGING
- if (debug & 8) {
- (void)sprintf(buf,"STAB $%s",stab_name(ed->argptr.arg_stab));
- ed->tmps = buf;
- }
- #endif
- break;
- case A_LENSTAB:
- str_numset(ed->str, (double)STAB_LEN(ed->argptr.arg_stab));
- ed->st[++ed->sp] = ed->str;
- #ifdef DEBUGGING
- if (debug & 8) {
- (void)sprintf(buf,"LENSTAB $%s",stab_name(ed->argptr.arg_stab));
- ed->tmps = buf;
- }
- #endif
- break;
- case A_LEXPR:
- #ifdef DEBUGGING
- if (debug & 8) {
- ed->tmps = "LEXPR";
- deb("%d.LEXPR =>\n",ed->anum);
- }
- #endif
- if (ed->argflags & AF_ARYOK) {
- ed->sp = eval(ed->argptr.arg_arg, G_ARRAY, ed->sp);
- if (ed->sp + (ed->maxarg - ed->anum) > stack->ary_max)
- astore(stack, ed->sp + (ed->maxarg - ed->anum), Nullstr);
- ed->st = stack->ary_array; /* possibly reallocated */
- }
- else {
- ed->sp = eval(ed->argptr.arg_arg, G_SCALAR, ed->sp);
- ed->st = stack->ary_array; /* possibly reallocated */
- ed->str = ed->st[ed->sp];
- goto do_crement;
- }
- break;
- case A_LVAL:
- #ifdef DEBUGGING
- if (debug & 8) {
- (void)sprintf(buf,"LVAL $%s",stab_name(ed->argptr.arg_stab));
- ed->tmps = buf;
- }
- #endif
- ++ed->sp;
- ed->str = STAB_STR(ed->argptr.arg_stab);
- if (!ed->str)
- fatal("panic: A_LVAL");
- do_crement:
- ed->assigning = TRUE;
- if (ed->argflags & AF_PRE) {
- if (ed->argflags & AF_UP)
- str_inc(ed->str);
- else
- str_dec(ed->str);
- STABSET(ed->str);
- ed->st[ed->sp] = ed->str;
- ed->str = ed->arg->arg_ptr.arg_str;
- }
- else if (ed->argflags & AF_POST) {
- ed->st[ed->sp] = str_mortal(ed->str);
- if (ed->argflags & AF_UP)
- str_inc(ed->str);
- else
- str_dec(ed->str);
- STABSET(ed->str);
- ed->str = ed->arg->arg_ptr.arg_str;
- }
- else
- ed->st[ed->sp] = ed->str;
- break;
- case A_LARYLEN:
- ++ed->sp;
- ed->stab = ed->argptr.arg_stab;
- ed->str = stab_array(ed->argptr.arg_stab)->ary_magic;
- if (ed->optype != O_SASSIGN || ed->argflags & (AF_PRE|AF_POST))
- str_numset(ed->str,(double)(stab_array(ed->stab)->ary_fill+arybase));
- #ifdef DEBUGGING
- ed->tmps = "LARYLEN";
- #endif
- if (!ed->str)
- fatal("panic: A_LEXPR");
- goto do_crement;
- case A_ARYLEN:
- ed->stab = ed->argptr.arg_stab;
- ed->st[++ed->sp] = stab_array(ed->stab)->ary_magic;
- str_numset(ed->st[ed->sp],(double)(stab_array(ed->stab)->ary_fill+arybase));
- #ifdef DEBUGGING
- ed->tmps = "ARYLEN";
- #endif
- break;
- case A_SINGLE:
- ed->st[++ed->sp] = ed->argptr.arg_str;
- #ifdef DEBUGGING
- ed->tmps = "SINGLE";
- #endif
- break;
- case A_DOUBLE:
- (void) interp(ed->str,ed->argptr.arg_str,ed->sp);
- ed->st = stack->ary_array;
- ed->st[++ed->sp] = ed->str;
- #ifdef DEBUGGING
- ed->tmps = "DOUBLE";
- #endif
- break;
- case A_BACKTICK:
- ed->tmps = str_get(interp(ed->str,ed->argptr.arg_str,ed->sp));
- ed->st = stack->ary_array;
- ed->fp = mypopen(ed->tmps,"r");
- str_set(ed->str,"");
- if (ed->fp) {
- if (ed->gimme == G_SCALAR) {
- while (str_gets(ed->str,ed->fp,ed->str->str_cur) != Nullch)
- /*SUPPRESS 530*/
- ;
- }
- else {
- for (;;) {
- if (++ed->sp > stack->ary_max) {
- astore(stack, ed->sp, Nullstr);
- ed->st = stack->ary_array;
- }
- ed->str = ed->st[ed->sp] = Str_new(56,80);
- if (str_gets(ed->str,ed->fp,0) == Nullch) {
- ed->sp--;
- break;
- }
- if (ed->str->str_len - ed->str->str_cur > 20) {
- ed->str->str_len = ed->str->str_cur+1;
- Renew(ed->str->str_ptr, ed->str->str_len, char);
- }
- str_2mortal(ed->str);
- }
- }
- statusvalue = mypclose(ed->fp);
- }
- else
- statusvalue = -1;
-
- if (ed->gimme == G_SCALAR)
- ed->st[++ed->sp] = ed->str;
- #ifdef DEBUGGING
- ed->tmps = "BACK";
- #endif
- break;
- case A_WANTARRAY:
- {
- if (curcsv->wantarray == G_ARRAY)
- ed->st[++ed->sp] = &str_yes;
- else
- ed->st[++ed->sp] = &str_no;
- }
- #ifdef DEBUGGING
- ed->tmps = "WANTARRAY";
- #endif
- break;
- case A_INDREAD:
- last_in_stab = stabent(str_get(STAB_STR(ed->argptr.arg_stab)),TRUE);
- old_rschar = rschar;
- old_rslen = rslen;
- goto do_read;
- case A_GLOB:
- ed->argflags |= AF_POST; /* enable newline chopping */
- last_in_stab = ed->argptr.arg_stab;
- old_rschar = rschar;
- old_rslen = rslen;
- rslen = 1;
- rschar = '\n';
- goto do_read;
- case A_READ:
- last_in_stab = ed->argptr.arg_stab;
- old_rschar = rschar;
- old_rslen = rslen;
- do_read:
- if (ed->anum > 1) /* assign to scalar */
- ed->gimme = G_SCALAR; /* force context to scalar */
- if (ed->gimme == G_ARRAY)
- ed->str = Str_new(57,0);
- ++ed->sp;
- ed->fp = Nullfp;
- if (stab_io(last_in_stab)) {
- ed->fp = stab_io(last_in_stab)->ifp;
- if (!ed->fp) {
- if (stab_io(last_in_stab)->flags & IOF_ARGV) {
- if (stab_io(last_in_stab)->flags & IOF_START) {
- stab_io(last_in_stab)->flags &= ~IOF_START;
- stab_io(last_in_stab)->lines = 0;
- if (alen(stab_array(last_in_stab)) < 0) {
- ed->tmpstr = str_make("-",1); /* assume stdin */
- (void)apush(stab_array(last_in_stab), ed->tmpstr);
- }
- }
- ed->fp = nextargv(last_in_stab);
- if (!ed->fp) { /* Note: ed->fp != stab_io(last_in_stab)->ifp */
- (void)do_close(last_in_stab,FALSE); /* now it does*/
- stab_io(last_in_stab)->flags |= IOF_START;
- }
- }
- else if (ed->argtype == A_GLOB) {
- (void) interp(ed->str,stab_val(last_in_stab),ed->sp);
- ed->st = stack->ary_array;
- ed->tmpstr = Str_new(55,0);
- str_set(ed->tmpstr, "For i in ");
- str_scat(ed->tmpstr, ed->str);
- str_cat(ed->tmpstr,"; echo \"{i}\"; end |");
- (void)do_open(last_in_stab,ed->tmpstr->str_ptr,
- ed->tmpstr->str_cur);
- ed->fp = stab_io(last_in_stab)->ifp;
- str_free(ed->tmpstr);
- }
- }
- }
- if (!ed->fp && dowarn)
- warn("Read on closed filehandle <%s>",stab_ename(last_in_stab));
- ed->tmplen = ed->str->str_len; /* remember if already alloced */
- if (!ed->tmplen)
- Str_Grow(ed->str,80); /* try short-buffering it */
- keepgoing:
- if (!ed->fp)
- ed->st[ed->sp] = &str_undef;
- else if (!str_gets(ed->str,ed->fp, ed->optype == O_RCAT ? ed->str->str_cur : 0)) {
- clearerr(ed->fp);
- if (stab_io(last_in_stab)->flags & IOF_ARGV) {
- ed->fp = nextargv(last_in_stab);
- if (ed->fp)
- goto keepgoing;
- (void)do_close(last_in_stab,FALSE);
- stab_io(last_in_stab)->flags |= IOF_START;
- }
- else if (ed->argflags & AF_POST) {
- (void)do_close(last_in_stab,FALSE);
- }
- ed->st[ed->sp] = &str_undef;
- rschar = old_rschar;
- rslen = old_rslen;
- if (ed->gimme == G_ARRAY) {
- --ed->sp;
- str_2mortal(ed->str);
- goto array_return;
- }
- break;
- }
- else {
- stab_io(last_in_stab)->lines++;
- ed->st[ed->sp] = ed->str;
- if (ed->argflags & AF_POST) {
- if (ed->str->str_cur > 0)
- ed->str->str_cur--;
- if (ed->str->str_ptr[ed->str->str_cur] == rschar)
- ed->str->str_ptr[ed->str->str_cur] = '\0';
- else
- ed->str->str_cur++;
- for (ed->tmps = ed->str->str_ptr; *ed->tmps; ed->tmps++)
- if (!isALPHA(*ed->tmps) && !isDIGIT(*ed->tmps) &&
- index("$&*(){}[]'\";\\|?<>~`",*ed->tmps))
- break;
- if (*ed->tmps && stat(ed->str->str_ptr,&statbuf) < 0)
- goto keepgoing; /* unmatched wildcard? */
- }
- if (ed->gimme == G_ARRAY) {
- if (ed->str->str_len - ed->str->str_cur > 20) {
- ed->str->str_len = ed->str->str_cur+1;
- Renew(ed->str->str_ptr, ed->str->str_len, char);
- }
- str_2mortal(ed->str);
- if (++ed->sp > stack->ary_max) {
- astore(stack, ed->sp, Nullstr);
- ed->st = stack->ary_array;
- }
- ed->str = Str_new(58,80);
- goto keepgoing;
- }
- else if (!ed->tmplen && ed->str->str_len - ed->str->str_cur > 80) {
- /* try to reclaim a bit of scalar space on 1st alloc */
- if (ed->str->str_cur < 60)
- ed->str->str_len = 80;
- else
- ed->str->str_len = ed->str->str_cur+40; /* allow some slop */
- Renew(ed->str->str_ptr, ed->str->str_len, char);
- }
- }
- rschar = old_rschar;
- rslen = old_rslen;
- #ifdef DEBUGGING
- ed->tmps = "READ";
- #endif
- break;
- }
- #ifdef DEBUGGING
- if (debug & 8)
- deb("%d.%s = '%s'\n",ed->anum,ed->tmps,str_peek(ed->st[ed->sp]));
- #endif
- if (ed->anum < 8)
- ed->arglast[ed->anum] = ed->sp;
- }
-
- ed->st += ed->arglast[0];
- if (ed->optype < O_PACK)
- switch (eval1(ed)) {
- case R_nojump:
- break;
- case R_array_return:
- goto array_return;
- case R_say_no:
- goto say_no;
- case R_re_eval:
- goto re_eval;
- #ifndef HAS_SOCKET
- case R_badsock:
- goto badsock;
- #endif
- case R_say_yes:
- goto say_yes;
- case R_say_undef:
- goto say_undef;
- case R_donumset:
- goto donumset;
- case R_say_zero:
- goto say_zero;
- default:
- fatal("\pOops !");
- }
- else if (ed->optype < O_CHOWN)
- switch (eval2(ed)) {
- case R_nojump:
- break;
- case R_array_return:
- goto array_return;
- case R_say_no:
- goto say_no;
- case R_re_eval:
- goto re_eval;
- #ifndef HAS_SOCKET
- case R_badsock:
- goto badsock;
- #endif
- case R_say_yes:
- goto say_yes;
- case R_say_undef:
- goto say_undef;
- case R_donumset:
- goto donumset;
- case R_say_zero:
- goto say_zero;
- default:
- fatal("\pOops !");
- }
- else
- switch (ed->optype) {
- case O_CHOWN:
- #ifdef HAS_CHOWN
- ed->value = (double)apply(ed->optype,ed->arglast);
- goto donumset;
- #else
- fatal("Unsupported function chown");
- break;
- #endif
- case O_KILL:
- fatal("Unsupported function kill");
- break;
- case O_UNLINK:
- case O_CHMOD:
- case O_UTIME:
- ed->value = (double)apply(ed->optype,ed->arglast);
- goto donumset;
- case O_UMASK:
- fatal("Unsupported function umask");
- break;
- #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
- case O_MSGGET:
- case O_SHMGET:
- case O_SEMGET:
- if ((ed->anum = do_ipcget(ed->optype, ed->arglast)) == -1)
- goto say_undef;
- ed->value = (double)ed->anum;
- goto donumset;
- case O_MSGCTL:
- case O_SHMCTL:
- case O_SEMCTL:
- ed->anum = do_ipcctl(ed->optype, ed->arglast);
- if (ed->anum == -1)
- goto say_undef;
- if (ed->anum != 0) {
- ed->value = (double)ed->anum;
- goto donumset;
- }
- str_set(ed->str,"0 but true");
- STABSET(ed->str);
- break;
- case O_MSGSND:
- ed->value = (double)(do_msgsnd(ed->arglast) >= 0);
- goto donumset;
- case O_MSGRCV:
- ed->value = (double)(do_msgrcv(ed->arglast) >= 0);
- goto donumset;
- case O_SEMOP:
- ed->value = (double)(do_semop(ed->arglast) >= 0);
- goto donumset;
- case O_SHMREAD:
- case O_SHMWRITE:
- ed->value = (double)(do_shmio(ed->optype, ed->arglast) >= 0);
- goto donumset;
- #else /* not SYSVIPC */
- case O_MSGGET:
- case O_MSGCTL:
- case O_MSGSND:
- case O_MSGRCV:
- case O_SEMGET:
- case O_SEMCTL:
- case O_SEMOP:
- case O_SHMGET:
- case O_SHMCTL:
- case O_SHMREAD:
- case O_SHMWRITE:
- fatal("System V IPC is not implemented on this machine");
- #endif /* not SYSVIPC */
- case O_RENAME:
- ed->tmps = str_get(ed->st[1]);
- ed->tmps2 = str_get(ed->st[2]);
- ed->value = (double)(rename(ed->tmps,ed->tmps2) >= 0);
- goto donumset;
- case O_LINK:
- fatal("Unsupported function link");
- break;
- case O_MKDIR:
- ed->tmps = str_get(ed->st[1]);
- ed->anum = (int)str_gnum(ed->st[2]);
- ed->value = (double)(mkdir(ed->tmps) >= 0);
- goto donumset;
- case O_RMDIR:
- if (ed->maxarg < 1)
- ed->tmps = str_get(stab_val(defstab));
- else
- ed->tmps = str_get(ed->st[1]);
- ed->value = (double)(rmdir(ed->tmps) >= 0);
- goto donumset;
- case O_GETPPID:
- fatal("Unsupported function getppid");
- break;
- case O_GETPGRP:
- fatal("The getpgrp() function is unimplemented on this machine");
- break;
- case O_SETPGRP:
- fatal("The setpgrp() function is unimplemented on this machine");
- break;
- case O_GETPRIORITY:
- fatal("The getpriority() function is unimplemented on this machine");
- break;
- case O_SETPRIORITY:
- fatal("The setpriority() function is unimplemented on this machine");
- break;
- case O_CHROOT:
- fatal("Unsupported function chroot");
- break;
- case O_FCNTL:
- case O_IOCTL:
- if (ed->maxarg <= 0)
- ed->stab = last_in_stab;
- else if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- ed->argtype = U_I(str_gnum(ed->st[2]));
- ed->anum = do_ctl(ed->optype,ed->stab,ed->argtype,ed->st[3]);
- if (ed->anum == -1)
- goto say_undef;
- if (ed->anum != 0) {
- ed->value = (double)ed->anum;
- goto donumset;
- }
- str_set(ed->str,"0 but true");
- STABSET(ed->str);
- break;
- case O_FLOCK:
- #ifdef HAS_FLOCK
- if (ed->maxarg <= 0)
- ed->stab = last_in_stab;
- else if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- if (ed->stab && stab_io(ed->stab))
- ed->fp = stab_io(ed->stab)->ifp;
- else
- ed->fp = Nullfp;
- if (ed->fp) {
- ed->argtype = (int)str_gnum(ed->st[2]);
- ed->value = (double)(flock(fileno(ed->fp),ed->argtype) >= 0);
- }
- else
- ed->value = 0;
- goto donumset;
- #else
- fatal("The flock() function is unimplemented on this machine");
- break;
- #endif
- case O_UNSHIFT:
- ed->ary = stab_array(ed->arg[1].arg_ptr.arg_stab);
- if (ed->arglast[2] - ed->arglast[1] != 1)
- do_unshift(ed->ary,ed->arglast);
- else {
- STR * tmpstr = Str_new(52,0); /* must copy the ed->str */
- str_sset(tmpstr,ed->st[2]);
- aunshift(ed->ary,1);
- (void)astore(ed->ary,0,tmpstr);
- }
- ed->value = (double)(ed->ary->ary_fill + 1);
- goto donumset;
-
- case O_TRY:
- sp = do_try(ed->arg[1].arg_ptr.arg_cmd,
- ed->gimme,ed->arglast);
- goto array_return;
-
- case O_EVALONCE:
- sp = do_eval(ed->st[1], O_EVAL, curcmd->c_stash, TRUE,
- ed->gimme,ed->arglast);
- if (eval_root) {
- str_free(ed->arg[1].arg_ptr.arg_str);
- ed->arg[1].arg_ptr.arg_cmd = eval_root;
- ed->arg[1].arg_type = (A_CMD|A_DONT);
- ed->arg[0].arg_type = O_TRY;
- }
- goto array_return;
-
- case O_REQUIRE:
- case O_DOFILE:
- case O_EVAL:
- if (ed->maxarg < 1)
- ed->tmpstr = stab_val(defstab);
- else
- ed->tmpstr =
- (ed->arg[1].arg_type & A_MASK) != A_NULL ? ed->st[1] : stab_val(defstab);
- ed->sp = do_eval(ed->tmpstr, ed->optype, curcmd->c_stash, FALSE,
- ed->gimme,ed->arglast);
- goto array_return;
-
- case O_FTRREAD:
- ed->argtype = 0;
- ed->anum = S_IRUSR;
- goto check_perm;
- case O_FTRWRITE:
- ed->argtype = 0;
- ed->anum = S_IWUSR;
- goto check_perm;
- case O_FTREXEC:
- ed->argtype = 0;
- ed->anum = S_IXUSR;
- goto check_perm;
- case O_FTEREAD:
- ed->argtype = 1;
- ed->anum = S_IRUSR;
- goto check_perm;
- case O_FTEWRITE:
- ed->argtype = 1;
- ed->anum = S_IWUSR;
- goto check_perm;
- case O_FTEEXEC:
- ed->argtype = 1;
- ed->anum = S_IXUSR;
- check_perm:
- if (mystat(ed->arg,ed->st[1]) < 0)
- goto say_undef;
- if (cando(ed->anum,ed->argtype,&statcache))
- goto say_yes;
- goto say_no;
-
- case O_FTIS:
- if (mystat(ed->arg,ed->st[1]) < 0)
- goto say_undef;
- goto say_yes;
- case O_FTEOWNED:
- case O_FTROWNED:
- if (mystat(ed->arg,ed->st[1]) < 0)
- goto say_undef;
- else
- goto say_yes;
- case O_FTZERO:
- if (mystat(ed->arg,ed->st[1]) < 0)
- goto say_undef;
- if (!statcache.st_size)
- goto say_yes;
- goto say_no;
- case O_FTSIZE:
- if (mystat(ed->arg,ed->st[1]) < 0)
- goto say_undef;
- ed->value = (double)statcache.st_size;
- goto donumset;
-
- case O_FTMTIME:
- if (mystat(ed->arg,ed->st[1]) < 0)
- goto say_undef;
- ed->value = (double)(basetime - statcache.st_mtime) / 86400.0;
- goto donumset;
- case O_FTATIME:
- if (mystat(ed->arg,ed->st[1]) < 0)
- goto say_undef;
- ed->value = (double)(basetime - statcache.st_atime) / 86400.0;
- goto donumset;
- case O_FTCTIME:
- if (mystat(ed->arg,ed->st[1]) < 0)
- goto say_undef;
- ed->value = (double)(basetime - statcache.st_ctime) / 86400.0;
- goto donumset;
-
- case O_FTSOCK:
- if (mystat(ed->arg,ed->st[1]) < 0)
- goto say_undef;
- if (S_ISSOCK(statcache.st_mode))
- goto say_yes;
- goto say_no;
- case O_FTCHR:
- if (mystat(ed->arg,ed->st[1]) < 0)
- goto say_undef;
- if (S_ISCHR(statcache.st_mode))
- goto say_yes;
- goto say_no;
- case O_FTBLK:
- if (mystat(ed->arg,ed->st[1]) < 0)
- goto say_undef;
- if (S_ISBLK(statcache.st_mode))
- goto say_yes;
- goto say_no;
- case O_FTFILE:
- if (mystat(ed->arg,ed->st[1]) < 0)
- goto say_undef;
- if (S_ISREG(statcache.st_mode))
- goto say_yes;
- goto say_no;
- case O_FTDIR:
- if (mystat(ed->arg,ed->st[1]) < 0)
- goto say_undef;
- if (S_ISDIR(statcache.st_mode))
- goto say_yes;
- goto say_no;
- case O_FTPIPE:
- if (mystat(ed->arg,ed->st[1]) < 0)
- goto say_undef;
- if (S_ISFIFO(statcache.st_mode))
- goto say_yes;
- goto say_no;
- case O_FTLINK:
- if (mylstat(ed->arg,ed->st[1]) < 0)
- goto say_undef;
- if (S_ISLNK(statcache.st_mode))
- goto say_yes;
- goto say_no;
- case O_SYMLINK:
- #ifdef HAS_SYMLINK
- ed->tmps = str_get(ed->st[1]);
- ed->tmps2 = str_get(ed->st[2]);
- ed->value = (double)(symlink(ed->tmps,ed->tmps2) >= 0);
- goto donumset;
- #else
- fatal("Unsupported function symlink");
- #endif
- case O_READLINK:
- #ifdef HAS_SYMLINK
- if (ed->maxarg < 1)
- ed->tmps = str_get(stab_val(defstab));
- else
- ed->tmps = str_get(ed->st[1]);
- ed->anum = readlink(ed->tmps,buf,sizeof buf);
- if (ed->anum < 0)
- goto say_undef;
- str_nset(ed->str,buf,ed->anum);
- break;
- #else
- goto say_undef; /* just pretend it's a normal file */
- #endif
- case O_FTSUID:
- #ifdef S_ISUID
- ed->anum = S_ISUID;
- goto check_xid;
- #else
- goto say_no;
- #endif
- case O_FTSGID:
- #ifdef S_ISGID
- ed->anum = S_ISGID;
- goto check_xid;
- #else
- goto say_no;
- #endif
- case O_FTSVTX:
- #ifdef S_ISVTX
- ed->anum = S_ISVTX;
- #else
- goto say_no;
- #endif
- check_xid:
- if (mystat(ed->arg,ed->st[1]) < 0)
- goto say_undef;
- if (statcache.st_mode & ed->anum)
- goto say_yes;
- goto say_no;
- case O_FTTTY:
- if (ed->arg[1].arg_type & A_DONT) {
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- ed->tmps = "";
- }
- else
- ed->stab = stabent(ed->tmps = str_get(ed->st[1]),FALSE);
- if (ed->stab && stab_io(ed->stab) && stab_io(ed->stab)->ifp)
- ed->anum = fileno(stab_io(ed->stab)->ifp);
- else if (isDIGIT(*ed->tmps))
- ed->anum = atoi(ed->tmps);
- else
- goto say_undef;
- if (isatty(ed->anum))
- goto say_yes;
- goto say_no;
- case O_FTTEXT:
- case O_FTBINARY:
- ed->str = do_fttext(ed->arg,ed->st[1]);
- break;
- #ifdef HAS_SOCKET
- case O_SOCKET:
- if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- ed->value = (double)do_socket(ed->stab,ed->arglast);
- goto donumset;
- case O_BIND:
- if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- ed->value = (double)do_bind(ed->stab,ed->arglast);
- goto donumset;
- case O_CONNECT:
- if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- ed->value = (double)do_connect(ed->stab,ed->arglast);
- goto donumset;
- case O_LISTEN:
- if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- ed->value = (double)do_listen(ed->stab,ed->arglast);
- goto donumset;
- case O_ACCEPT:
- if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- if ((ed->arg[2].arg_type & A_MASK) == A_WORD)
- stab2 = ed->arg[2].arg_ptr.arg_stab;
- else
- stab2 = stabent(str_get(ed->st[2]),TRUE);
- do_accept(ed->str,ed->stab,stab2);
- STABSET(ed->str);
- break;
- case O_GHBYNAME:
- if (ed->maxarg < 1)
- goto say_undef;
- case O_GHBYADDR:
- case O_GHOSTENT:
- ed->sp = do_ghent(ed->optype,
- ed->gimme,ed->arglast);
- goto array_return;
- #ifndef macintosh
- case O_GNBYNAME:
- if (ed->maxarg < 1)
- goto say_undef;
- case O_GNBYADDR:
- case O_GNETENT:
- ed->sp = do_gnent(ed->optype,
- ed->gimme,ed->arglast);
- goto array_return;
- #else
- case O_GNBYNAME:
- case O_GNBYADDR:
- case O_GNETENT:
- fatal("getnet╔() not implemented");
- #endif
- case O_GPBYNAME:
- if (ed->maxarg < 1)
- goto say_undef;
- case O_GPBYNUMBER:
- case O_GPROTOENT:
- ed->sp = do_gpent(ed->optype,
- ed->gimme,ed->arglast);
- goto array_return;
- case O_GSBYNAME:
- if (ed->maxarg < 1)
- goto say_undef;
- case O_GSBYPORT:
- case O_GSERVENT:
- ed->sp = do_gsent(ed->optype,
- ed->gimme,ed->arglast);
- goto array_return;
- #ifndef macintosh
- case O_SHOSTENT:
- ed->value = (double) sethostent((int)str_gnum(ed->st[1]));
- goto donumset;
- case O_SNETENT:
- ed->value = (double) setnetent((int)str_gnum(ed->st[1]));
- goto donumset;
- case O_SPROTOENT:
- ed->value = (double) setprotoent((int)str_gnum(ed->st[1]));
- goto donumset;
- case O_SSERVENT:
- ed->value = (double) setservent((int)str_gnum(ed->st[1]));
- goto donumset;
- #else
- case O_SHOSTENT:
- case O_SNETENT:
- case O_SPROTOENT:
- case O_SSERVENT:
- fatal("set╔() not implemented");
- #endif
- #ifndef macintosh
- case O_EHOSTENT:
- ed->value = (double) endhostent();
- goto donumset;
- case O_ENETENT:
- ed->value = (double) endnetent();
- goto donumset;
- case O_EPROTOENT:
- ed->value = (double) endprotoent();
- goto donumset;
- case O_ESERVENT:
- ed->value = (double) endservent();
- goto donumset;
- #else
- case O_EHOSTENT:
- case O_ENETENT:
- case O_EPROTOENT:
- case O_ESERVENT:
- fatal("end╔() not implemented");
- #endif
- #ifndef macintosh
- case O_SOCKPAIR:
- if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- if ((ed->arg[2].arg_type & A_MASK) == A_WORD)
- stab2 = ed->arg[2].arg_ptr.arg_stab;
- else
- stab2 = stabent(str_get(ed->st[2]),TRUE);
- ed->value = (double)do_spair(ed->stab,stab2,ed->arglast);
- goto donumset;
- #else
- case O_SOCKPAIR:
- fatal("socketpair() not implemented");
- #endif
- case O_SHUTDOWN:
- if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- ed->value = (double)do_shutdown(ed->stab,ed->arglast);
- goto donumset;
- case O_GSOCKOPT:
- case O_SSOCKOPT:
- if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- ed->sp = do_sopt(ed->optype,ed->stab,ed->arglast);
- goto array_return;
- case O_GETSOCKNAME:
- case O_GETPEERNAME:
- if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- if (!ed->stab)
- goto say_undef;
- ed->sp = do_getsockname(ed->optype,ed->stab,ed->arglast);
- goto array_return;
-
- #ifdef macintosh
- case O_CHOOSE:
- ed->str = do_choose(ed->arglast, ed->maxarg);
- break;
- #endif
-
- #else /* HAS_SOCKET not defined */
- case O_SOCKET:
- case O_BIND:
- case O_CONNECT:
- case O_LISTEN:
- case O_ACCEPT:
- case O_SOCKPAIR:
- case O_GHBYNAME:
- case O_GHBYADDR:
- case O_GHOSTENT:
- case O_GNBYNAME:
- case O_GNBYADDR:
- case O_GNETENT:
- case O_GPBYNAME:
- case O_GPBYNUMBER:
- case O_GPROTOENT:
- case O_GSBYNAME:
- case O_GSBYPORT:
- case O_GSERVENT:
- case O_SHOSTENT:
- case O_SNETENT:
- case O_SPROTOENT:
- case O_SSERVENT:
- case O_EHOSTENT:
- case O_ENETENT:
- case O_EPROTOENT:
- case O_ESERVENT:
- case O_SHUTDOWN:
- case O_GSOCKOPT:
- case O_SSOCKOPT:
- case O_GETSOCKNAME:
- case O_GETPEERNAME:
- badsock:
- fatal("Unsupported socket function");
- #endif /* HAS_SOCKET */
- case O_SSELECT:
- #ifdef HAS_SELECT
- ed->sp = do_select(ed->gimme,ed->arglast);
- goto array_return;
- #else
- fatal("select not implemented");
- #endif
- case O_FILENO:
- if (ed->maxarg < 1)
- goto say_undef;
- if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- if (!ed->stab || !(stio = stab_io(ed->stab)) || !(ed->fp = stio->ifp))
- goto say_undef;
- ed->value = fileno(ed->fp);
- goto donumset;
- case O_BINMODE:
- if (ed->maxarg < 1)
- goto say_undef;
- if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- if (!ed->stab || !(stio = stab_io(ed->stab)) || !(ed->fp = stio->ifp))
- goto say_undef;
- str_set(ed->str, Yes);
- STABSET(ed->str);
- break;
- case O_VEC:
- ed->sp = do_vec(ed->str == ed->st[1], ed->arg->arg_ptr.arg_str, ed->arglast);
- goto array_return;
- case O_GPWNAM:
- case O_GPWUID:
- case O_GPWENT:
- #ifdef HAS_PASSWD
- ed->sp = do_gpwent(ed->optype,
- ed->gimme,ed->arglast);
- goto array_return;
- case O_SPWENT:
- ed->value = (double) setpwent();
- goto donumset;
- case O_EPWENT:
- ed->value = (double) endpwent();
- goto donumset;
- #else
- case O_EPWENT:
- case O_SPWENT:
- fatal("Unsupported password function");
- break;
- #endif
- case O_GGRNAM:
- case O_GGRGID:
- case O_GGRENT:
- #ifdef HAS_GROUP
- ed->sp = do_ggrent(ed->optype,
- ed->gimme,ed->arglast);
- goto array_return;
- case O_SGRENT:
- ed->value = (double) setgrent();
- goto donumset;
- case O_EGRENT:
- ed->value = (double) endgrent();
- goto donumset;
- #else
- case O_EGRENT:
- case O_SGRENT:
- fatal("Unsupported group function");
- break;
- #endif
- case O_GETLOGIN:
- #ifdef HAS_GETLOGIN
- if (!(ed->tmps = getlogin()))
- goto say_undef;
- str_set(ed->str,ed->tmps);
- #else
- fatal("Unsupported function getlogin");
- #endif
- break;
- case O_OPEN_DIR:
- case O_READDIR:
- case O_TELLDIR:
- case O_SEEKDIR:
- case O_REWINDDIR:
- case O_CLOSEDIR:
- if (ed->maxarg < 1)
- goto say_undef;
- if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- if (!ed->stab)
- goto say_undef;
- ed->sp = do_dirop(ed->optype,ed->stab,ed->gimme,ed->arglast);
- goto array_return;
- case O_SYSCALL:
- ed->value = (double)do_syscall(ed->arglast);
- goto donumset;
- case O_PIPE_OP:
- #ifdef HAS_PIPE
- if ((ed->arg[1].arg_type & A_MASK) == A_WORD)
- ed->stab = ed->arg[1].arg_ptr.arg_stab;
- else
- ed->stab = stabent(str_get(ed->st[1]),TRUE);
- if ((ed->arg[2].arg_type & A_MASK) == A_WORD)
- stab2 = ed->arg[2].arg_ptr.arg_stab;
- else
- stab2 = stabent(str_get(ed->st[2]),TRUE);
- do_pipe(ed->str,ed->stab,stab2);
- STABSET(ed->str);
- #else
- fatal("Unsupported function pipe");
- #endif
- break;
- #ifdef macintosh
- case O_ASK:
- ed->str = do_ask(ed->arglast, ed->maxarg);
- break;
- case O_ANSWER:
- ed->value = do_answer(ed->arglast);
- goto donumset;
- case O_PICK:
- ed->str = do_pick(ed->arglast);
- break;
- #endif
- }
-
- normal_return:
- ed->st[1] = ed->str;
- #ifdef DEBUGGING
- if (debug) {
- dlevel--;
- if (debug & 8)
- deb("%s RETURNS \"%s\"\n",opname[ed->optype],str_get(ed->str));
- }
- #endif
- return ed->arglast[0] + 1;
-
- array_return:
- #ifdef DEBUGGING
- if (debug) {
- dlevel--;
- if (debug & 8) {
- ed->anum = ed->sp - ed->arglast[0];
- switch (ed->anum) {
- case 0:
- deb("%s RETURNS ()\n",opname[ed->optype]);
- break;
- case 1:
- deb("%s RETURNS (\"%s\")\n",opname[ed->optype],
- ed->st[1] ? str_get(ed->st[1]) : "");
- break;
- default:
- ed->tmps = ed->st[1] ? str_get(ed->st[1]) : "";
- deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[ed->optype],
- ed->anum,ed->tmps,ed->anum==2?"":"...,",
- ed->st[ed->anum] ? str_get(ed->st[ed->anum]) : "");
- break;
- }
- }
- }
- #endif
- return ed->sp;
-
- say_yes:
- ed->str = &str_yes;
- goto normal_return;
-
- say_no:
- ed->str = &str_no;
- goto normal_return;
-
- say_undef:
- ed->str = &str_undef;
- goto normal_return;
-
- say_zero:
- ed->value = 0.0;
- /* FALL THROUGH */
-
- donumset:
- str_numset(ed->str,ed->value);
- STABSET(ed->str);
- ed->st[1] = ed->str;
- #ifdef DEBUGGING
- if (debug) {
- dlevel--;
- if (debug & 8)
- deb("%s RETURNS \"%f\"\n",opname[ed->optype],ed->value);
- }
- #endif
- return ed->arglast[0] + 1;
- }
-
- #ifdef macintosh
- void reinit_eval()
- {
- debarg = NULL;
- memset(&str_args, 0, sizeof(STR));
- old_rschar = 0;
- old_rslen = 0;
- }
- #endif
-