Usenet 1994 October/usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso/unix/volume20/perl3.0/part03

Internet Message Format | 1989-10-29 | 50.3 KB

Subject:  v20i086:  Perl, a language with features of C/sed/awk/shell/etc, Part03/24
Newsgroups: comp.sources.unix
Sender: sources
Approved: [e-mail]

Submitted-by: Larry Wall <[e-mail]>
Posting-number: Volume 20, Issue 86
Archive-name: perl3.0/part03

#! /bin/sh

# Make a new directory for the perl sources, cd to it, and run kits 1
# thru 24 through sh.  When all 24 kits have been run, read README.

echo "This is perl 3.0 kit 3 (of 24).  If kit 3 is complete, the line"
echo '"'"End of kit 3 (of 24)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir  2>/dev/null
echo Extracting eval.c
sed >eval.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: eval.c,v 3.0 89/10/18 15:17:04 lwall Locked $
X *
X *    Copyright (c) 1989, Larry Wall
X *
X *    You may distribute under the terms of the GNU General Public License
X *    as specified in the README file that comes with the perl 3.0 kit.
X *
X * $Log:    eval.c,v $
X * Revision 3.0  89/10/18  15:17:04  lwall
X * 3.0 baseline
X *
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X
X#include <signal.h>
X#include <errno.h>
X
X#ifdef I_VFORK
X#   include <vfork.h>
X#endif
X
Xextern int errno;
X
X#ifdef VOIDSIG
Xstatic void (*ihand)();
Xstatic void (*qhand)();
X#else
Xstatic int (*ihand)();
Xstatic int (*qhand)();
X#endif
X
XARG *debarg;
XSTR str_args;
Xstatic STAB *stab2;
Xstatic STIO *stio;
Xstatic struct lstring *lstr;
Xstatic char old_record_separator;
X
Xdouble sin(), cos(), atan2(), pow();
X
Xchar *getlogin();
X
Xextern int sys_nerr;
Xextern char *sys_errlist[];
X
Xint
Xeval(arg,gimme,sp)
Xregister ARG *arg;
Xint gimme;
Xregister int sp;
X{
X    register STR *str;
X    register int anum;
X    register int optype;
X    register STR **st;
X    int maxarg;
X    double value;
X    register char *tmps;
X    char *tmps2;
X    int argflags;
X    int argtype;
X    union argptr argptr;
X    int arglast[8];    /* highest sp for arg--valid only for non-O_LIST args */
X    unsigned long tmplong;
X    long when;
X    FILE *fp;
X    STR *tmpstr;
X    FCMD *form;
X    STAB *stab;
X    ARRAY *ary;
X    bool assigning = FALSE;
X    double exp(), log(), sqrt(), modf();
X    char *crypt(), *getenv();
X    extern void grow_dlevel();
X
X    if (!arg)
X    goto say_undef;
X    optype = arg->arg_type;
X    maxarg = arg->arg_len;
X    arglast[0] = sp;
X    str = arg->arg_ptr.arg_str;
X    if (sp + maxarg > stack->ary_max)
X    astore(stack, sp + maxarg, Nullstr);
X    st = stack->ary_array;
X
X#ifdef DEBUGGING
X    if (debug) {
X    if (debug & 8) {
X        deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
X    }
X    debname[dlevel] = opname[optype][0];
X    debdelim[dlevel] = ':';
X    if (++dlevel >= dlmax)
X        grow_dlevel();
X    }
X#endif
X
X#include "evalargs.xc"
X
X    st += arglast[0];
X    switch (optype) {
X    case O_RCAT:
X    STABSET(str);
X    break;
X    case O_ITEM:
X    if (gimme == G_ARRAY)
X        goto array_return;
X    STR_SSET(str,st[1]);
X    STABSET(str);
X    break;
X    case O_ITEM2:
X    if (gimme == G_ARRAY)
X        goto array_return;
X    --anum;
X    STR_SSET(str,st[arglast[anum]-arglast[0]]);
X    STABSET(str);
X    break;
X    case O_ITEM3:
X    if (gimme == G_ARRAY)
X    goto array_return;
X    --anum;
X    STR_SSET(str,st[arglast[anum]-arglast[0]]);
X    STABSET(str);
X    break;
X    case O_CONCAT:
X    STR_SSET(str,st[1]);
X    str_scat(str,st[2]);
X    STABSET(str);
X    break;
X    case O_REPEAT:
X    STR_SSET(str,st[1]);
X    anum = (int)str_gnum(st[2]);
X    if (anum >= 1) {
X        tmpstr = Str_new(50,0);
X        str_sset(tmpstr,str);
X        while (--anum > 0)
X        str_scat(str,tmpstr);
X    }
X    else
X        str_sset(str,&str_no);
X    STABSET(str);
X    break;
X    case O_MATCH:
X    sp = do_match(str,arg,
X      gimme,arglast);
X    if (gimme == G_ARRAY)
X        goto array_return;
X    STABSET(str);
X    break;
X    case O_NMATCH:
X    sp = do_match(str,arg,
X      gimme,arglast);
X    if (gimme == G_ARRAY)
X        goto array_return;
X    str_sset(str, str_true(str) ? &str_no : &str_yes);
X    STABSET(str);
X    break;
X    case O_SUBST:
X    sp = do_subst(str,arg,arglast[0]);
X    goto array_return;
X    case O_NSUBST:
X    sp = do_subst(str,arg,arglast[0]);
X    str = arg->arg_ptr.arg_str;
X    str_set(str, str_true(str) ? No : Yes);
X    goto array_return;
X    case O_ASSIGN:
X    if (arg[1].arg_flags & AF_ARYOK) {
X        if (arg->arg_len == 1) {
X        arg->arg_type = O_LOCAL;
X        arg->arg_flags |= AF_LOCAL;
X        goto local;
X        }
X        else {
X        arg->arg_type = O_AASSIGN;
X        goto aassign;
X        }
X    }
X    else {
X        arg->arg_type = O_SASSIGN;
X        goto sassign;
X    }
X    case O_LOCAL:
X      local:
X    arglast[2] = arglast[1];    /* push a null array */
X    /* FALL THROUGH */
X    case O_AASSIGN:
X      aassign:
X    sp = do_assign(arg,
X      gimme,arglast);
X    goto array_return;
X    case O_SASSIGN:
X      sassign:
X    STR_SSET(str, st[2]);
X    STABSET(str);
X    break;
X    case O_CHOP:
X    st -= arglast[0];
X    str = arg->arg_ptr.arg_str;
X    for (sp = arglast[0] + 1; sp <= arglast[1]; sp++)
X        do_chop(str,st[sp]);
X    st += arglast[0];
X    break;
X    case O_DEFINED:
X    if (arg[1].arg_type & A_DONT) {
X        sp = do_defined(str,arg,
X          gimme,arglast);
X        goto array_return;
X    }
X    else if (str->str_pok || str->str_nok)
X        goto say_yes;
X    goto say_no;
X    case O_UNDEF:
X    if (arg[1].arg_type & A_DONT) {
X        sp = do_undef(str,arg,
X          gimme,arglast);
X        goto array_return;
X    }
X    else if (str != stab_val(defstab)) {
X        str->str_pok = str->str_nok = 0;
X        STABSET(str);
X    }
X    goto say_undef;
X    case O_STUDY:
X    sp = do_study(str,arg,
X      gimme,arglast);
X    goto array_return;
X    case O_POW:
X    value = str_gnum(st[1]);
X    value = pow(value,str_gnum(st[2]));
X    goto donumset;
X    case O_MULTIPLY:
X    value = str_gnum(st[1]);
X    value *= str_gnum(st[2]);
X    goto donumset;
X    case O_DIVIDE:
X        if ((value = str_gnum(st[2])) == 0.0)
X            fatal("Illegal division by zero");
X    value = str_gnum(st[1]) / value;
X    goto donumset;
X    case O_MODULO:
X    tmplong = (long) str_gnum(st[2]);
X        if (tmplong == 0L)
X            fatal("Illegal modulus zero");
X    when = (long)str_gnum(st[1]);
X#ifndef lint
X    if (when >= 0)
X        value = (double)(when % tmplong);
X    else
X        value = (double)(tmplong - (-when % tmplong));
X#endif
X    goto donumset;
X    case O_ADD:
X    value = str_gnum(st[1]);
X    value += str_gnum(st[2]);
X    goto donumset;
X    case O_SUBTRACT:
X    value = str_gnum(st[1]);
X    value -= str_gnum(st[2]);
X    goto donumset;
X    case O_LEFT_SHIFT:
X    value = str_gnum(st[1]);
X    anum = (int)str_gnum(st[2]);
X#ifndef lint
X    value = (double)(((long)value) << anum);
X#endif
X    goto donumset;
X    case O_RIGHT_SHIFT:
X    value = str_gnum(st[1]);
X    anum = (int)str_gnum(st[2]);
X#ifndef lint
X    value = (double)(((long)value) >> anum);
X#endif
X    goto donumset;
X    case O_LT:
X    value = str_gnum(st[1]);
X    value = (value < str_gnum(st[2])) ? 1.0 : 0.0;
X    goto donumset;
X    case O_GT:
X    value = str_gnum(st[1]);
X    value = (value > str_gnum(st[2])) ? 1.0 : 0.0;
X    goto donumset;
X    case O_LE:
X    value = str_gnum(st[1]);
X    value = (value <= str_gnum(st[2])) ? 1.0 : 0.0;
X    goto donumset;
X    case O_GE:
X    value = str_gnum(st[1]);
X    value = (value >= str_gnum(st[2])) ? 1.0 : 0.0;
X    goto donumset;
X    case O_EQ:
X    if (dowarn) {
X        if ((!st[1]->str_nok && !looks_like_number(st[1])) ||
X        (!st[2]->str_nok && !looks_like_number(st[2])) )
X        warn("Possible use of == on string value");
X    }
X    value = str_gnum(st[1]);
X    value = (value == str_gnum(st[2])) ? 1.0 : 0.0;
X    goto donumset;
X    case O_NE:
X    value = str_gnum(st[1]);
X    value = (value != str_gnum(st[2])) ? 1.0 : 0.0;
X    goto donumset;
X    case O_BIT_AND:
X    if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
X        value = str_gnum(st[1]);
X#ifndef lint
X        value = (double)(((long)value) & (long)str_gnum(st[2]));
X#endif
X        goto donumset;
X    }
X    else
X        do_vop(optype,str,st[1],st[2]);
X    break;
X    case O_XOR:
X    if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
X        value = str_gnum(st[1]);
X#ifndef lint
X        value = (double)(((long)value) ^ (long)str_gnum(st[2]));
X#endif
X        goto donumset;
X    }
X    else
X        do_vop(optype,str,st[1],st[2]);
X    break;
X    case O_BIT_OR:
X    if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
X        value = str_gnum(st[1]);
X#ifndef lint
X        value = (double)(((long)value) | (long)str_gnum(st[2]));
X#endif
X        goto donumset;
X    }
X    else
X        do_vop(optype,str,st[1],st[2]);
X    break;
X/* use register in evaluating str_true() */
X    case O_AND:
X    if (str_true(st[1])) {
X        anum = 2;
X        optype = O_ITEM2;
X        argflags = arg[anum].arg_flags;
X        if (gimme == G_ARRAY)
X        argflags |= AF_ARYOK;
X        argtype = arg[anum].arg_type & A_MASK;
X        argptr = arg[anum].arg_ptr;
X        maxarg = anum = 1;
X        sp = arglast[0];
X        st -= sp;
X        goto re_eval;
X    }
X    else {
X        if (assigning) {
X        str_sset(str, st[1]);
X        STABSET(str);
X        }
X        else
X        str = st[1];
X        break;
X    }
X    case O_OR:
X    if (str_true(st[1])) {
X        if (assigning) {
X        str_sset(str, st[1]);
X        STABSET(str);
X        }
X        else
X        str = st[1];
X        break;
X    }
X    else {
X        anum = 2;
X        optype = O_ITEM2;
X        argflags = arg[anum].arg_flags;
X        if (gimme == G_ARRAY)
X        argflags |= AF_ARYOK;
X        argtype = arg[anum].arg_type & A_MASK;
X        argptr = arg[anum].arg_ptr;
X        maxarg = anum = 1;
X        sp = arglast[0];
X        st -= sp;
X        goto re_eval;
X    }
X    case O_COND_EXPR:
X    anum = (str_true(st[1]) ? 2 : 3);
X    optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
X    argflags = arg[anum].arg_flags;
X    if (gimme == G_ARRAY)
X        argflags |= AF_ARYOK;
X    argtype = arg[anum].arg_type & A_MASK;
X    argptr = arg[anum].arg_ptr;
X    maxarg = anum = 1;
X    sp = arglast[0];
X    st -= sp;
X    goto re_eval;
X    case O_COMMA:
X    if (gimme == G_ARRAY)
X        goto array_return;
X    str = st[2];
X    break;
X    case O_NEGATE:
X    value = -str_gnum(st[1]);
X    goto donumset;
X    case O_NOT:
X    value = (double) !str_true(st[1]);
X    goto donumset;
X    case O_COMPLEMENT:
X#ifndef lint
X    value = (double) ~(long)str_gnum(st[1]);
X#endif
X    goto donumset;
X    case O_SELECT:
X    tmps = stab_name(defoutstab);
X    if (maxarg > 0) {
X        if ((arg[1].arg_type & A_MASK) == A_WORD)
X        defoutstab = arg[1].arg_ptr.arg_stab;
X        else
X        defoutstab = stabent(str_get(st[1]),TRUE);
X        if (!stab_io(defoutstab))
X        stab_io(defoutstab) = stio_new();
X        curoutstab = defoutstab;
X    }
X    str_set(str, tmps);
X    STABSET(str);
X    break;
X    case O_WRITE:
X    if (maxarg == 0)
X        stab = defoutstab;
X    else if ((arg[1].arg_type & A_MASK) == A_WORD) {
X        if (!(stab = arg[1].arg_ptr.arg_stab))
X        stab = defoutstab;
X    }
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X    if (!stab_io(stab)) {
X        str_set(str, No);
X        STABSET(str);
X        break;
X    }
X    curoutstab = stab;
X    fp = stab_io(stab)->ofp;
X    debarg = arg;
X    if (stab_io(stab)->fmt_stab)
X        form = stab_form(stab_io(stab)->fmt_stab);
X    else
X        form = stab_form(stab);
X    if (!form || !fp) {
X        if (dowarn) {
X        if (form)
X            warn("No format for filehandle");
X        else {
X            if (stab_io(stab)->ifp)
X            warn("Filehandle only opened for input");
X            else
X            warn("Write on closed filehandle");
X        }
X        }
X        str_set(str, No);
X        STABSET(str);
X        break;
X    }
X    format(&outrec,form,sp);
X    do_write(&outrec,stab_io(stab),sp);
X    if (stab_io(stab)->flags & IOF_FLUSH)
X        (void)fflush(fp);
X    str_set(str, Yes);
X    STABSET(str);
X    break;
X    case O_DBMOPEN:
X#ifdef SOME_DBM
X    if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X    anum = (int)str_gnum(st[3]);
X    value = (double)hdbmopen(stab_hash(stab),str_get(st[2]),anum);
X    goto donumset;
X#else
X    fatal("No dbm or ndbm on this machine");
X#endif
X    case O_DBMCLOSE:
X#ifdef SOME_DBM
X    if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X    hdbmclose(stab_hash(stab));
X    goto say_yes;
X#else
X    fatal("No dbm or ndbm on this machine");
X#endif
X    case O_OPEN:
X    if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X    if (do_open(stab,str_get(st[2]))) {
X        value = (double)forkprocess;
X        stab_io(stab)->lines = 0;
X        goto donumset;
X    }
X    else
X        goto say_undef;
X    break;
X    case O_TRANS:
X    value = (double) do_trans(str,arg);
X    str = arg->arg_ptr.arg_str;
X    goto donumset;
X    case O_NTRANS:
X    str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
X    str = arg->arg_ptr.arg_str;
X    break;
X    case O_CLOSE:
X    if (maxarg == 0)
X        stab = defoutstab;
X    else if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X    str_set(str, do_close(stab,TRUE) ? Yes : No );
X    STABSET(str);
X    break;
X    case O_EACH:
X    sp = do_each(str,stab_hash(arg[1].arg_ptr.arg_stab),
X      gimme,arglast);
X    goto array_return;
X    case O_VALUES:
X    case O_KEYS:
X    sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
X      gimme,arglast);
X    goto array_return;
X    case O_LARRAY:
X    str->str_nok = str->str_pok = 0;
X    str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
X    str->str_state = SS_ARY;
X    break;
X    case O_ARRAY:
X    ary = stab_array(arg[1].arg_ptr.arg_stab);
X    maxarg = ary->ary_fill + 1;
X    if (gimme == G_ARRAY) { /* array wanted */
X        sp = arglast[0];
X        st -= sp;
X        if (maxarg > 0 && sp + maxarg > stack->ary_max) {
X        astore(stack,sp + maxarg, Nullstr);
X        st = stack->ary_array;
X        }
X        Copy(ary->ary_array, &st[sp+1], maxarg, STR*);
X        sp += maxarg;
X        goto array_return;
X    }
X    else
X        str = afetch(ary,maxarg - 1,FALSE);
X    break;
X    case O_AELEM:
X    str = afetch(stab_array(arg[1].arg_ptr.arg_stab),
X        ((int)str_gnum(st[2])) - arybase,FALSE);
X    if (!str)
X        goto say_undef;
X    break;
X    case O_DELETE:
X    tmpstab = arg[1].arg_ptr.arg_stab;
X    tmps = str_get(st[2]);
X    str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur);
X    if (tmpstab == envstab)
X        setenv(tmps,Nullch);
X    if (!str)
X        goto say_undef;
X    break;
X    case O_LHASH:
X    str->str_nok = str->str_pok = 0;
X    str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
X    str->str_state = SS_HASH;
X    break;
X    case O_HASH:
X    if (gimme == G_ARRAY) { /* array wanted */
X        sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
X        gimme,arglast);
X        goto array_return;
X    }
X    else {
X        tmpstab = arg[1].arg_ptr.arg_stab;
X        sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill,
X        stab_hash(tmpstab)->tbl_max+1);
X        str_set(str,buf);
X    }
X    break;
X    case O_HELEM:
X    tmpstab = arg[1].arg_ptr.arg_stab;
X    tmps = str_get(st[2]);
X    str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE);
X    if (!str)
X        goto say_undef;
X    break;
X    case O_LAELEM:
X    anum = ((int)str_gnum(st[2])) - arybase;
X    str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE);
X    if (!str)
X        fatal("Assignment to non-creatable value, subscript %d",anum);
X    break;
X    case O_LHELEM:
X    tmpstab = arg[1].arg_ptr.arg_stab;
X    tmps = str_get(st[2]);
X    anum = st[2]->str_cur;
X    str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE);
X    if (!str)
X        fatal("Assignment to non-creatable value, subscript \"%s\"",tmps);
X    if (tmpstab == envstab)        /* heavy wizardry going on here */
X        str_magic(str, tmpstab, 'E', tmps, anum);    /* str is now magic */
X                    /* he threw the brick up into the air */
X    else if (tmpstab == sigstab)
X        str_magic(str, tmpstab, 'S', tmps, anum);
X#ifdef SOME_DBM
X    else if (stab_hash(tmpstab)->tbl_dbm)
X        str_magic(str, tmpstab, 'D', tmps, anum);
X#endif
X    break;
X    case O_ASLICE:
X    anum = TRUE;
X    argtype = FALSE;
X    goto do_slice_already;
X    case O_HSLICE:
X    anum = FALSE;
X    argtype = FALSE;
X    goto do_slice_already;
X    case O_LASLICE:
X    anum = TRUE;
X    argtype = TRUE;
X    goto do_slice_already;
X    case O_LHSLICE:
X    anum = FALSE;
X    argtype = TRUE;
X      do_slice_already:
X    sp = do_slice(arg[1].arg_ptr.arg_stab,anum,argtype,
X        gimme,arglast);
X    goto array_return;
X    case O_PUSH:
X    if (arglast[2] - arglast[1] != 1)
X        str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast);
X    else {
X        str = Str_new(51,0);        /* must copy the STR */
X        str_sset(str,st[2]);
X        (void)apush(stab_array(arg[1].arg_ptr.arg_stab),str);
X    }
X    break;
X    case O_POP:
X    str = apop(ary = stab_array(arg[1].arg_ptr.arg_stab));
X    goto staticalization;
X    case O_SHIFT:
X    str = ashift(ary = stab_array(arg[1].arg_ptr.arg_stab));
X      staticalization:
X    if (!str)
X        goto say_undef;
X    if (ary->ary_flags & ARF_REAL)
X        (void)str_2static(str);
X    break;
X    case O_UNPACK:
X    sp = do_unpack(str,gimme,arglast);
X    goto array_return;
X    case O_SPLIT:
X    value = str_gnum(st[3]);
X    sp = do_split(str, arg[2].arg_ptr.arg_spat, (int)value,
X      gimme,arglast);
X    goto array_return;
X    case O_LENGTH:
X    if (maxarg < 1)
X        value = (double)str_len(stab_val(defstab));
X    else
X        value = (double)str_len(st[1]);
X    goto donumset;
X    case O_SPRINTF:
X    do_sprintf(str, sp-arglast[0], st+1);
X    break;
X    case O_SUBSTR:
X    anum = ((int)str_gnum(st[2])) - arybase;    /* anum=where to start*/
X    tmps = str_get(st[1]);        /* force conversion to string */
X    if (argtype = (str == st[1]))
X        str = arg->arg_ptr.arg_str;
X    if (anum < 0)
X        anum += st[1]->str_cur + arybase;
X    if (anum < 0 || anum > st[1]->str_cur)
X        str_nset(str,"",0);
X    else {
X        optype = (int)str_gnum(st[3]);
X        if (optype < 0)
X        optype = 0;
X        tmps += anum;
X        anum = st[1]->str_cur - anum;    /* anum=how many bytes left*/
X        if (anum > optype)
X        anum = optype;
X        str_nset(str, tmps, anum);
X        if (argtype) {            /* it's an lvalue! */
X        lstr = (struct lstring*)str;
X        str->str_magic = st[1];
X        st[1]->str_rare = 's';
X        lstr->lstr_offset = tmps - str_get(st[1]);
X        lstr->lstr_len = anum;
X        }
X    }
X    break;
X    case O_PACK:
X    (void)do_pack(str,arglast);
X    break;
X    case O_GREP:
X    sp = do_grep(arg,str,gimme,arglast);
X    goto array_return;
X    case O_JOIN:
X    do_join(str,arglast);
X    break;
X    case O_SLT:
X    tmps = str_get(st[1]);
X    value = (double) (str_cmp(st[1],st[2]) < 0);
X    goto donumset;
X    case O_SGT:
X    tmps = str_get(st[1]);
X    value = (double) (str_cmp(st[1],st[2]) > 0);
X    goto donumset;
X    case O_SLE:
X    tmps = str_get(st[1]);
X    value = (double) (str_cmp(st[1],st[2]) <= 0);
X    goto donumset;
X    case O_SGE:
X    tmps = str_get(st[1]);
X    value = (double) (str_cmp(st[1],st[2]) >= 0);
X    goto donumset;
X    case O_SEQ:
X    tmps = str_get(st[1]);
X    value = (double) str_eq(st[1],st[2]);
X    goto donumset;
X    case O_SNE:
X    tmps = str_get(st[1]);
X    value = (double) !str_eq(st[1],st[2]);
X    goto donumset;
X    case O_SUBR:
X    sp = do_subr(arg,gimme,arglast);
X    st = stack->ary_array + arglast[0];        /* maybe realloced */
X    goto array_return;
X    case O_DBSUBR:
X    sp = do_dbsubr(arg,gimme,arglast);
X    st = stack->ary_array + arglast[0];        /* maybe realloced */
X    goto array_return;
X    case O_SORT:
X    if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X    if (!stab)
X        stab = defoutstab;
X    sp = do_sort(str,stab,
X      gimme,arglast);
X    goto array_return;
X    case O_REVERSE:
X    sp = do_reverse(str,
X      gimme,arglast);
X    goto array_return;
X    case O_WARN:
X    if (arglast[2] - arglast[1] != 1) {
X        do_join(str,arglast);
X        tmps = str_get(st[1]);
X    }
X    else {
X        str = st[2];
X        tmps = str_get(st[2]);
X    }
X    if (!tmps || !*tmps)
X        tmps = "Warning: something's wrong";
X    warn("%s",tmps);
X    goto say_yes;
X    case O_DIE:
X    if (arglast[2] - arglast[1] != 1) {
X        do_join(str,arglast);
X        tmps = str_get(st[1]);
X    }
X    else {
X        str = st[2];
X        tmps = str_get(st[2]);
X    }
X    if (!tmps || !*tmps)
X        exit(1);
X    fatal("%s",tmps);
X    goto say_zero;
X    case O_PRTF:
X    case O_PRINT:
X    if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X    if (!stab)
X        stab = defoutstab;
X    if (!stab_io(stab)) {
X        if (dowarn)
X        warn("Filehandle never opened");
X        goto say_zero;
X    }
X    if (!(fp = stab_io(stab)->ofp)) {
X        if (dowarn)  {
X        if (stab_io(stab)->ifp)
X            warn("Filehandle opened only for input");
X        else
X            warn("Print on closed filehandle");
X        }
X        goto say_zero;
X    }
X    else {
X        if (optype == O_PRTF || arglast[2] - arglast[1] != 1)
X        value = (double)do_aprint(arg,fp,arglast);
X        else {
X        value = (double)do_print(st[2],fp);
X        if (orslen && optype == O_PRINT)
X            if (fwrite(ors, 1, orslen, fp) == 0)
X            goto say_zero;
X        }
X        if (stab_io(stab)->flags & IOF_FLUSH)
X        if (fflush(fp) == EOF)
X            goto say_zero;
X    }
X    goto donumset;
X    case O_CHDIR:
X    if (maxarg < 1)
X        tmps = str_get(stab_val(defstab));
X    else
X        tmps = str_get(st[1]);
X    if (!tmps || !*tmps) {
X        tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE);
X        if (tmpstr)
X        tmps = str_get(tmpstr);
X    }
X    if (!tmps || !*tmps) {
X        tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE);
X        if (tmpstr)
X        tmps = str_get(tmpstr);
X    }
X#ifdef TAINT
X    taintproper("Insecure dependency in chdir");
X#endif
X    value = (double)(chdir(tmps) >= 0);
X    goto donumset;
X    case O_EXIT:
X    if (maxarg < 1)
X        anum = 0;
X    else
X        anum = (int)str_gnum(st[1]);
X    exit(anum);
X    goto say_zero;
X    case O_RESET:
X    if (maxarg < 1)
X        tmps = "";
X    else
X        tmps = str_get(st[1]);
X    str_reset(tmps,arg[2].arg_ptr.arg_hash);
X    value = 1.0;
X    goto donumset;
X    case O_LIST:
X    if (gimme == G_ARRAY)
X        goto array_return;
X    if (maxarg > 0)
X        str = st[sp - arglast[0]];    /* unwanted list, return last item */
X    else
X        str = &str_undef;
X    break;
X    case O_EOF:
X    if (maxarg <= 0)
X        stab = last_in_stab;
X    else if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X    str_set(str, do_eof(stab) ? Yes : No);
X    STABSET(str);
X    break;
X    case O_GETC:
X    if (maxarg <= 0)
X        stab = stdinstab;
X    else if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X    if (do_eof(stab))    /* make sure we have fp with something */
X        str_set(str, No);
X    else {
X#ifdef TAINT
X        tainted = 1;
X#endif
X        str_set(str," ");
X        *str->str_ptr = getc(stab_io(stab)->ifp); /* should never be EOF */
X    }
X    STABSET(str);
X    break;
X    case O_TELL:
X    if (maxarg <= 0)
X        stab = last_in_stab;
X    else if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X#ifndef lint
X    value = (double)do_tell(stab);
X#else
X    (void)do_tell(stab);
X#endif
X    goto donumset;
X    case O_RECV:
X    case O_READ:
X    if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X    tmps = str_get(st[2]);
X    anum = (int)str_gnum(st[3]);
X    STR_GROW(st[2], anum+1), (tmps = str_get(st[2]));    /* sneaky */
X    errno = 0;
X    if (!stab_io(stab) || !stab_io(stab)->ifp)
X        goto say_zero;
X#ifdef SOCKET
X    else if (optype == O_RECV) {
X        argtype = sizeof buf;
X        optype = (int)str_gnum(st[4]);
X        anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, optype,
X        buf, &argtype);
X        if (anum >= 0) {
X        st[2]->str_cur = anum;
X        st[2]->str_ptr[anum] = '\0';
X        str_nset(str,buf,argtype);
X        }
X        else
X        str_sset(str,&str_undef);
X        break;
X    }
X    else if (stab_io(stab)->type == 's') {
X        argtype = sizeof buf;
X        anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, 0,
X        buf, &argtype);
X    }
X#else
X    else if (optype == O_RECV)
X        goto badsock;
X#endif
X    else
X        anum = fread(tmps, 1, anum, stab_io(stab)->ifp);
X    if (anum < 0)
X        goto say_undef;
X    st[2]->str_cur = anum;
X    st[2]->str_ptr[anum] = '\0';
X    value = (double)anum;
X    goto donumset;
X    case O_SEND:
X#ifdef SOCKET
X    if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X    tmps = str_get(st[2]);
X    anum = (int)str_gnum(st[3]);
X    optype = sp - arglast[0];
X    errno = 0;
X    if (optype > 4)
X        warn("Too many args on send");
X    if (optype >= 4) {
X        tmps2 = str_get(st[4]);
X        anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur,
X          anum, tmps2, st[4]->str_cur);
X    }
X    else
X        anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum);
X    if (anum < 0)
X        goto say_undef;
X    value = (double)anum;
X    goto donumset;
X#else
X    goto badsock;
X#endif
X    case O_SEEK:
X    if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X    value = str_gnum(st[2]);
X    str_set(str, do_seek(stab,
X      (long)value, (int)str_gnum(st[3]) ) ? Yes : No);
X    STABSET(str);
X    break;
X    case O_RETURN:
X    tmps = "SUB";        /* just fake up a "last SUB" */
X    optype = O_LAST;
X    if (gimme == G_ARRAY) {
X        lastretstr = Nullstr;
X        lastspbase = arglast[1];
X        lastsize = arglast[2] - arglast[1];
X    }
X    else
X        lastretstr = str_static(st[arglast[2] - arglast[0]]);
X    goto dopop;
X    case O_REDO:
X    case O_NEXT:
X    case O_LAST:
X    if (maxarg > 0) {
X        tmps = str_get(arg[1].arg_ptr.arg_str);
X      dopop:
X        while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
X          strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
X#ifdef DEBUGGING
X        if (debug & 4) {
X            deb("(Skipping label #%d %s)\n",loop_ptr,
X            loop_stack[loop_ptr].loop_label);
X        }
X#endif
X        loop_ptr--;
X        }
X#ifdef DEBUGGING
X        if (debug & 4) {
X        deb("(Found label #%d %s)\n",loop_ptr,
X            loop_stack[loop_ptr].loop_label);
X        }
X#endif
X    }
X    if (loop_ptr < 0)
X        fatal("Bad label: %s", maxarg > 0 ? tmps : "<null>");
X    if (!lastretstr && optype == O_LAST && lastsize) {
X        st -= arglast[0];
X        st += lastspbase + 1;
X        optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */
X        if (optype) {
X        for (anum = lastsize; anum > 0; anum--,st++)
X            st[optype] = str_static(st[0]);
X        }
X        longjmp(loop_stack[loop_ptr].loop_env, O_LAST);
X    }
X    longjmp(loop_stack[loop_ptr].loop_env, optype);
X    case O_DUMP:
X    case O_GOTO:/* shudder */
X    goto_targ = str_get(arg[1].arg_ptr.arg_str);
X    if (!*goto_targ)
X        goto_targ = Nullch;        /* just restart from top */
X    if (optype == O_DUMP) {
X        do_undump = 1;
X        abort();
X    }
X    longjmp(top_env, 1);
X    case O_INDEX:
X    tmps = str_get(st[1]);
X#ifndef lint
X    if (!(tmps2 = fbminstr((unsigned char*)tmps,
X      (unsigned char*)tmps + st[1]->str_cur, st[2])))
X#else
X    if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr))
X#endif
X        value = (double)(-1 + arybase);
X    else
X        value = (double)(tmps2 - tmps + arybase);
X    goto donumset;
X    case O_RINDEX:
X    tmps = str_get(st[1]);
X    tmps2 = str_get(st[2]);
X#ifndef lint
X    if (!(tmps2 = rninstr(tmps,  tmps  + st[1]->str_cur,
X                  tmps2, tmps2 + st[2]->str_cur)))
X#else
X    if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch))
X#endif
X        value = (double)(-1 + arybase);
X    else
X        value = (double)(tmps2 - tmps + arybase);
X    goto donumset;
X    case O_TIME:
X#ifndef lint
X    value = (double) time(Null(long*));
X#endif
X    goto donumset;
X    case O_TMS:
X    sp = do_tms(str,gimme,arglast);
X    goto array_return;
X    case O_LOCALTIME:
X    if (maxarg < 1)
X        (void)time(&when);
X    else
X        when = (long)str_gnum(st[1]);
X    sp = do_time(str,localtime(&when),
X      gimme,arglast);
X    goto array_return;
X    case O_GMTIME:
X    if (maxarg < 1)
X        (void)time(&when);
X    else
X        when = (long)str_gnum(st[1]);
X    sp = do_time(str,gmtime(&when),
X      gimme,arglast);
X    goto array_return;
X    case O_LSTAT:
X    case O_STAT:
X    sp = do_stat(str,arg,
X      gimme,arglast);
X    goto array_return;
X    case O_CRYPT:
X#ifdef CRYPT
X    tmps = str_get(st[1]);
X#ifdef FCRYPT
X    str_set(str,fcrypt(tmps,str_get(st[2])));
X#else
X    str_set(str,crypt(tmps,str_get(st[2])));
X#endif
X#else
X    fatal(
X      "The crypt() function is unimplemented due to excessive paranoia.");
X#endif
X    break;
X    case O_ATAN2:
X    value = str_gnum(st[1]);
X    value = atan2(value,str_gnum(st[2]));
X    goto donumset;
X    case O_SIN:
X    if (maxarg < 1)
X        value = str_gnum(stab_val(defstab));
X    else
X        value = str_gnum(st[1]);
X    value = sin(value);
X    goto donumset;
X    case O_COS:
X    if (maxarg < 1)
X        value = str_gnum(stab_val(defstab));
X    else
X        value = str_gnum(st[1]);
X    value = cos(value);
X    goto donumset;
X    case O_RAND:
X    if (maxarg < 1)
X        value = 1.0;
X    else
X        value = str_gnum(st[1]);
X    if (value == 0.0)
X        value = 1.0;
X#if RANDBITS == 31
X    value = rand() * value / 2147483648.0;
X#else
X#if RANDBITS == 16
X    value = rand() * value / 65536.0;
X#else
X#if RANDBITS == 15
X    value = rand() * value / 32768.0;
X#else
X    value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
X#endif
X#endif
X#endif
X    goto donumset;
X    case O_SRAND:
X    if (maxarg < 1) {
X        (void)time(&when);
X        anum = when;
X    }
X    else
X        anum = (int)str_gnum(st[1]);
X    (void)srand(anum);
X    goto say_yes;
X    case O_EXP:
X    if (maxarg < 1)
X        value = str_gnum(stab_val(defstab));
X    else
X        value = str_gnum(st[1]);
X    value = exp(value);
X    goto donumset;
X    case O_LOG:
X    if (maxarg < 1)
X        value = str_gnum(stab_val(defstab));
X    else
X        value = str_gnum(st[1]);
X    value = log(value);
X    goto donumset;
X    case O_SQRT:
X    if (maxarg < 1)
X        value = str_gnum(stab_val(defstab));
X    else
X        value = str_gnum(st[1]);
X    value = sqrt(value);
X    goto donumset;
X    case O_INT:
X    if (maxarg < 1)
X        value = str_gnum(stab_val(defstab));
X    else
X        value = str_gnum(st[1]);
X    if (value >= 0.0)
X        (void)modf(value,&value);
X    else {
X        (void)modf(-value,&value);
X        value = -value;
X    }
X    goto donumset;
X    case O_ORD:
X    if (maxarg < 1)
X        tmps = str_get(stab_val(defstab));
X    else
X        tmps = str_get(st[1]);
X#ifndef I286
X    value = (double) *tmps;
X#else
X    anum = (int) *tmps;
X    value = (double) anum;
X#endif
X    goto donumset;
X    case O_SLEEP:
X    if (maxarg < 1)
X        tmps = Nullch;
X    else
X        tmps = str_get(st[1]);
X    (void)time(&when);
X    if (!tmps || !*tmps)
X        sleep((32767<<16)+32767);
X    else
X        sleep((unsigned int)atoi(tmps));
X#ifndef lint
X    value = (double)when;
X    (void)time(&when);
X    value = ((double)when) - value;
X#endif
X    goto donumset;
X    case O_RANGE:
X    sp = do_range(gimme,arglast);
X    goto array_return;
X    case O_F_OR_R:
X    if (gimme == G_ARRAY) {        /* it's a range */
X        /* can we optimize to constant array? */
X        if ((arg[1].arg_type & A_MASK) == A_SINGLE &&
X          (arg[2].arg_type & A_MASK) == A_SINGLE) {
X        st[2] = arg[2].arg_ptr.arg_str;
X        sp = do_range(gimme,arglast);
X        st = stack->ary_array;
X        maxarg = sp - arglast[0];
X        str_free(arg[1].arg_ptr.arg_str);
X        str_free(arg[2].arg_ptr.arg_str);
X        arg->arg_type = O_ARRAY;
X        arg[1].arg_type = A_STAB|A_DONT;
X        arg->arg_len = 1;
X        stab = arg[1].arg_ptr.arg_stab = aadd(genstab());
X        ary = stab_array(stab);
X        afill(ary,maxarg - 1);
X        st += arglast[0]+1;
X        while (maxarg-- > 0)
X            ary->ary_array[maxarg] = str_smake(st[maxarg]);
X        goto array_return;
X        }
X        arg->arg_type = optype = O_RANGE;
X        maxarg = arg->arg_len = 2;
X        anum = 2;
X        arg[anum].arg_flags &= ~AF_ARYOK;
X        argflags = arg[anum].arg_flags;
X        argtype = arg[anum].arg_type & A_MASK;
X        arg[anum].arg_type = argtype;
X        argptr = arg[anum].arg_ptr;
X        sp = arglast[0];
X        st -= sp;
X        sp++;
X        goto re_eval;
X    }
X    arg->arg_type = O_FLIP;
X    /* FALL THROUGH */
X    case O_FLIP:
X    if ((arg[1].arg_type & A_MASK) == A_SINGLE ?
X      last_in_stab && (int)str_gnum(st[1]) == stab_io(last_in_stab)->lines
X      :
X      str_true(st[1]) ) {
X        str_numset(str,0.0);
X        anum = 2;
X        arg->arg_type = optype = O_FLOP;
X        arg[2].arg_type &= ~A_DONT;
X        arg[1].arg_type |= A_DONT;
X        argflags = arg[2].arg_flags;
X        argtype = arg[2].arg_type & A_MASK;
X        argptr = arg[2].arg_ptr;
X        sp = arglast[0];
X        st -= sp;
X        goto re_eval;
X    }
X    str_set(str,"");
X    break;
X    case O_FLOP:
X    str_inc(str);
X    if ((arg[2].arg_type & A_MASK) == A_SINGLE ?
X      last_in_stab && (int)str_gnum(st[2]) == stab_io(last_in_stab)->lines
X      :
X      str_true(st[2]) ) {
X        arg->arg_type = O_FLIP;
X        arg[1].arg_type &= ~A_DONT;
X        arg[2].arg_type |= A_DONT;
X        str_cat(str,"E0");
X    }
X    break;
X    case O_FORK:
X    anum = fork();
X    if (!anum && (tmpstab = stabent("$",allstabs)))
X        str_numset(STAB_STR(tmpstab),(double)getpid());
X    value = (double)anum;
X    goto donumset;
X    case O_WAIT:
X#ifndef lint
X    ihand = signal(SIGINT, SIG_IGN);
X    qhand = signal(SIGQUIT, SIG_IGN);
X    anum = wait(&argflags);
X    if (anum > 0)
X        pidgone(anum,argflags);
X    value = (double)anum;
X#else
X    ihand = qhand = 0;
X#endif
X    (void)signal(SIGINT, ihand);
X    (void)signal(SIGQUIT, qhand);
X    statusvalue = (unsigned short)argflags;
X    goto donumset;
X    case O_SYSTEM:
X#ifdef TAINT
X    if (arglast[2] - arglast[1] == 1) {
X        taintenv();
X        tainted |= st[2]->str_tainted;
X        taintproper("Insecure dependency in system");
X    }
X#endif
X    while ((anum = vfork()) == -1) {
X        if (errno != EAGAIN) {
X        value = -1.0;
X        goto donumset;
X        }
X        sleep(5);
X    }
X    if (anum > 0) {
X#ifndef lint
X        ihand = signal(SIGINT, SIG_IGN);
X        qhand = signal(SIGQUIT, SIG_IGN);
X        while ((argtype = wait(&argflags)) != anum && argtype >= 0)
X        pidgone(argtype,argflags);
X#else
X        ihand = qhand = 0;
X#endif
X        (void)signal(SIGINT, ihand);
X        (void)signal(SIGQUIT, qhand);
X        statusvalue = (unsigned short)argflags;
X        if (argtype == -1)
X        value = -1.0;
X        else {
X        value = (double)((unsigned int)argflags & 0xffff);
X        }
X        goto donumset;
X    }
X    if ((arg[1].arg_type & A_MASK) == A_STAB)
X        value = (double)do_aexec(st[1],arglast);
X    else if (arglast[2] - arglast[1] != 1)
X        value = (double)do_aexec(Nullstr,arglast);
X    else {
X        value = (double)do_exec(str_get(str_static(st[2])));
X    }
X    _exit(-1);
X    case O_EXEC:
X    if ((arg[1].arg_type & A_MASK) == A_STAB)
X        value = (double)do_aexec(st[1],arglast);
X    else if (arglast[2] - arglast[1] != 1)
X        value = (double)do_aexec(Nullstr,arglast);
X    else {
X        value = (double)do_exec(str_get(str_static(st[2])));
X    }
X    goto donumset;
X    case O_HEX:
X    argtype = 4;
X    goto snarfnum;
X
X    case O_OCT:
X    argtype = 3;
X
X      snarfnum:
X    anum = 0;
X    if (maxarg < 1)
X        tmps = str_get(stab_val(defstab));
X    else
X        tmps = str_get(st[1]);
X    for (;;) {
X        switch (*tmps) {
X        default:
X        goto out;
X        case '8': case '9':
X        if (argtype != 4)
X            goto out;
X        /* FALL THROUGH */
X        case '0': case '1': case '2': case '3': case '4':
X        case '5': case '6': case '7':
X        anum <<= argtype;
X        anum += *tmps++ & 15;
X        break;
X        case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
X        case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
X        if (argtype != 4)
X            goto out;
X        anum <<= 4;
X        anum += (*tmps++ & 7) + 9;
X        break;
X        case 'x':
X        argtype = 4;
X        tmps++;
X        break;
X        }
X    }
X      out:
X    value = (double)anum;
X    goto donumset;
X    case O_CHMOD:
X    case O_CHOWN:
X    case O_KILL:
X    case O_UNLINK:
X    case O_UTIME:
X    value = (double)apply(optype,arglast);
X    goto donumset;
X    case O_UMASK:
X    if (maxarg < 1) {
X        anum = umask(0);
X        (void)umask(anum);
X    }
X    else
X        anum = umask((int)str_gnum(st[1]));
X    value = (double)anum;
X#ifdef TAINT
X    taintproper("Insecure dependency in umask");
X#endif
X    goto donumset;
X    case O_RENAME:
X    tmps = str_get(st[1]);
X    tmps2 = str_get(st[2]);
X#ifdef TAINT
X    taintproper("Insecure dependency in rename");
X#endif
X#ifdef RENAME
X    value = (double)(rename(tmps,tmps2) >= 0);
X#else
X    if (euid || stat(tmps2,&statbuf) < 0 ||
X      (statbuf.st_mode & S_IFMT) != S_IFDIR )
X        (void)UNLINK(tmps2);    /* avoid unlinking a directory */
X    if (!(anum = link(tmps,tmps2)))
X        anum = UNLINK(tmps);
X    value = (double)(anum >= 0);
X#endif
X    goto donumset;
X    case O_LINK:
X    tmps = str_get(st[1]);
X    tmps2 = str_get(st[2]);
X#ifdef TAINT
X    taintproper("Insecure dependency in link");
X#endif
X    value = (double)(link(tmps,tmps2) >= 0);
X    goto donumset;
X    case O_MKDIR:
X    tmps = str_get(st[1]);
X    anum = (int)str_gnum(st[2]);
X#ifdef TAINT
X    taintproper("Insecure dependency in mkdir");
X#endif
X#ifdef MKDIR
X    value = (double)(mkdir(tmps,anum) >= 0);
X#else
X    (void)sprintf(buf,"mkdir %s 2>&1",tmps);
X      one_liner:
X    rsfp = mypopen(buf,"r");
X    if (rsfp) {
X        *buf = '\0';
X        tmps2 = fgets(buf,sizeof buf,rsfp);
X        (void)mypclose(rsfp);
X        if (tmps2 != Nullch) {
X        for (errno = 1; errno <= sys_nerr; errno++) {
X            if (instr(buf,sys_errlist[errno]))    /* you don't see this */
X            goto say_zero;
X        }
X        errno = 0;
X        goto say_zero;
X        }
X        else
X        value = 1.0;
X    }
X    else
X        goto say_zero;
X#endif
X    goto donumset;
X    case O_RMDIR:
X    if (maxarg < 1)
X        tmps = str_get(stab_val(defstab));
X    else
X        tmps = str_get(st[1]);
X#ifdef TAINT
X    taintproper("Insecure dependency in rmdir");
X#endif
X#ifdef RMDIR
X    value = (double)(rmdir(tmps) >= 0);
X    goto donumset;
X#else
X    (void)sprintf(buf,"rmdir %s 2>&1",tmps);
X    goto one_liner;        /* see above in MKDIR */
X#endif
X    case O_GETPPID:
X    value = (double)getppid();
X    goto donumset;
X    case O_GETPGRP:
X#ifdef GETPGRP
X    if (maxarg < 1)
X        anum = 0;
X    else
X        anum = (int)str_gnum(st[1]);
X    value = (double)getpgrp(anum);
X    goto donumset;
X#else
X    fatal("The getpgrp() function is unimplemented on this machine");
X    break;
X#endif
X    case O_SETPGRP:
X#ifdef SETPGRP
X    argtype = (int)str_gnum(st[1]);
X    anum = (int)str_gnum(st[2]);
X#ifdef TAINT
X    taintproper("Insecure dependency in setpgrp");
X#endif
X    value = (double)(setpgrp(argtype,anum) >= 0);
X    goto donumset;
X#else
X    fatal("The setpgrp() function is unimplemented on this machine");
X    break;
X#endif
X    case O_GETPRIORITY:
X#ifdef GETPRIORITY
X    argtype = (int)str_gnum(st[1]);
X    anum = (int)str_gnum(st[2]);
X    value = (double)getpriority(argtype,anum);
X    goto donumset;
X#else
X    fatal("The getpriority() function is unimplemented on this machine");
X    break;
X#endif
X    case O_SETPRIORITY:
X#ifdef SETPRIORITY
X    argtype = (int)str_gnum(st[1]);
X    anum = (int)str_gnum(st[2]);
X    optype = (int)str_gnum(st[3]);
X#ifdef TAINT
X    taintproper("Insecure dependency in setpriority");
X#endif
X    value = (double)(setpriority(argtype,anum,optype) >= 0);
X    goto donumset;
X#else
X    fatal("The setpriority() function is unimplemented on this machine");
X    break;
X#endif
X    case O_CHROOT:
X    if (maxarg < 1)
X        tmps = str_get(stab_val(defstab));
X    else
X        tmps = str_get(st[1]);
X#ifdef TAINT
X    taintproper("Insecure dependency in chroot");
X#endif
X    value = (double)(chroot(tmps) >= 0);
X    goto donumset;
X    case O_FCNTL:
X    case O_IOCTL:
X    if (maxarg <= 0)
X        stab = last_in_stab;
X    else if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X    argtype = (int)str_gnum(st[2]);
X#ifdef TAINT
X    taintproper("Insecure dependency in ioctl");
X#endif
X    anum = do_ctl(optype,stab,argtype,st[3]);
X    if (anum == -1)
X        goto say_undef;
X    if (anum != 0)
X        goto donumset;
X    str_set(str,"0 but true");
X    STABSET(str);
X    break;
X    case O_FLOCK:
X#ifdef FLOCK
X    if (maxarg <= 0)
X        stab = last_in_stab;
X    else if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X    if (stab && stab_io(stab))
X        fp = stab_io(stab)->ifp;
X    else
X        fp = Nullfp;
X    if (fp) {
X        argtype = (int)str_gnum(st[2]);
X        value = (double)(flock(fileno(fp),argtype) >= 0);
X    }
X    else
X        value = 0;
X    goto donumset;
X#else
X    fatal("The flock() function is unimplemented on this machine");
X    break;
X#endif
X    case O_UNSHIFT:
X    ary = stab_array(arg[1].arg_ptr.arg_stab);
X    if (arglast[2] - arglast[1] != 1)
X        do_unshift(ary,arglast);
X    else {
X        str = Str_new(52,0);        /* must copy the STR */
X        str_sset(str,st[2]);
X        aunshift(ary,1);
X        (void)astore(ary,0,str);
X    }
X    value = (double)(ary->ary_fill + 1);
X    break;
X    case O_DOFILE:
X    case O_EVAL:
X    if (maxarg < 1)
X        tmpstr = stab_val(defstab);
X    else
X        tmpstr =
X          (arg[1].arg_type & A_MASK) != A_NULL ? st[1] : stab_val(defstab);
X#ifdef TAINT
X    tainted |= tmpstr->str_tainted;
X    taintproper("Insecure dependency in eval");
X#endif
X    sp = do_eval(tmpstr, optype, arg[2].arg_ptr.arg_hash,
X        gimme,arglast);
X    goto array_return;
X
X    case O_FTRREAD:
X    argtype = 0;
X    anum = S_IREAD;
X    goto check_perm;
X    case O_FTRWRITE:
X    argtype = 0;
X    anum = S_IWRITE;
X    goto check_perm;
X    case O_FTREXEC:
X    argtype = 0;
X    anum = S_IEXEC;
X    goto check_perm;
X    case O_FTEREAD:
X    argtype = 1;
X    anum = S_IREAD;
X    goto check_perm;
X    case O_FTEWRITE:
X    argtype = 1;
X    anum = S_IWRITE;
X    goto check_perm;
X    case O_FTEEXEC:
X    argtype = 1;
X    anum = S_IEXEC;
X      check_perm:
X    if (mystat(arg,st[1]) < 0)
X        goto say_undef;
X    if (cando(anum,argtype,&statcache))
X        goto say_yes;
X    goto say_no;
X
X    case O_FTIS:
X    if (mystat(arg,st[1]) < 0)
X        goto say_undef;
X    goto say_yes;
X    case O_FTEOWNED:
X    case O_FTROWNED:
X    if (mystat(arg,st[1]) < 0)
X        goto say_undef;
X    if (statcache.st_uid == (optype == O_FTEOWNED ? euid : uid) )
X        goto say_yes;
X    goto say_no;
X    case O_FTZERO:
X    if (mystat(arg,st[1]) < 0)
X        goto say_undef;
X    if (!statcache.st_size)
X        goto say_yes;
X    goto say_no;
X    case O_FTSIZE:
X    if (mystat(arg,st[1]) < 0)
X        goto say_undef;
X    if (statcache.st_size)
X        goto say_yes;
X    goto say_no;
X
X    case O_FTSOCK:
X#ifdef S_IFSOCK
X    anum = S_IFSOCK;
X    goto check_file_type;
X#else
X    goto say_no;
X#endif
X    case O_FTCHR:
X    anum = S_IFCHR;
X    goto check_file_type;
X    case O_FTBLK:
X    anum = S_IFBLK;
X    goto check_file_type;
X    case O_FTFILE:
X    anum = S_IFREG;
X    goto check_file_type;
X    case O_FTDIR:
X    anum = S_IFDIR;
X      check_file_type:
X    if (mystat(arg,st[1]) < 0)
X        goto say_undef;
X    if ((statcache.st_mode & S_IFMT) == anum )
X        goto say_yes;
X    goto say_no;
X    case O_FTPIPE:
X#ifdef S_IFIFO
X    anum = S_IFIFO;
X    goto check_file_type;
X#else
X    goto say_no;
X#endif
X    case O_FTLINK:
X#ifdef SYMLINK
X    if (lstat(str_get(st[1]),&statcache) < 0)
X        goto say_undef;
X    if ((statcache.st_mode & S_IFMT) == S_IFLNK )
X        goto say_yes;
X#endif
X    goto say_no;
X    case O_SYMLINK:
X#ifdef SYMLINK
X    tmps = str_get(st[1]);
X    tmps2 = str_get(st[2]);
X#ifdef TAINT
X    taintproper("Insecure dependency in symlink");
X#endif
X    value = (double)(symlink(tmps,tmps2) >= 0);
X    goto donumset;
X#else
X    fatal("Unsupported function symlink()");
X#endif
X    case O_READLINK:
X#ifdef SYMLINK
X    if (maxarg < 1)
X        tmps = str_get(stab_val(defstab));
X    else
X        tmps = str_get(st[1]);
X    anum = readlink(tmps,buf,sizeof buf);
X    if (anum < 0)
X        goto say_undef;
X    str_nset(str,buf,anum);
X    break;
X#else
X    fatal("Unsupported function readlink()");
X#endif
X    case O_FTSUID:
X    anum = S_ISUID;
X    goto check_xid;
X    case O_FTSGID:
X    anum = S_ISGID;
X    goto check_xid;
X    case O_FTSVTX:
X    anum = S_ISVTX;
X      check_xid:
X    if (mystat(arg,st[1]) < 0)
X        goto say_undef;
X    if (statcache.st_mode & anum)
X        goto say_yes;
X    goto say_no;
X    case O_FTTTY:
X    if (arg[1].arg_type & A_DONT) {
X        stab = arg[1].arg_ptr.arg_stab;
X        tmps = "";
X    }
X    else
X        stab = stabent(tmps = str_get(st[1]),FALSE);
X    if (stab && stab_io(stab) && stab_io(stab)->ifp)
X        anum = fileno(stab_io(stab)->ifp);
X    else if (isdigit(*tmps))
X        anum = atoi(tmps);
X    else
X        goto say_undef;
X    if (isatty(anum))
X        goto say_yes;
X    goto say_no;
X    case O_FTTEXT:
X    case O_FTBINARY:
X    str = do_fttext(arg,st[1]);
X    break;
X#ifdef SOCKET
X    case O_SOCKET:
X    if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X#ifndef lint
X    value = (double)do_socket(stab,arglast);
X#else
X    (void)do_socket(stab,arglast);
X#endif
X    goto donumset;
X    case O_BIND:
X    if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X#ifndef lint
X    value = (double)do_bind(stab,arglast);
X#else
X    (void)do_bind(stab,arglast);
X#endif
X    goto donumset;
X    case O_CONNECT:
X    if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X#ifndef lint
X    value = (double)do_connect(stab,arglast);
X#else
X    (void)do_connect(stab,arglast);
X#endif
X    goto donumset;
X    case O_LISTEN:
X    if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X#ifndef lint
X    value = (double)do_listen(stab,arglast);
X#else
X    (void)do_listen(stab,arglast);
X#endif
X    goto donumset;
X    case O_ACCEPT:
X    if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X    if ((arg[2].arg_type & A_MASK) == A_WORD)
X        stab2 = arg[2].arg_ptr.arg_stab;
X    else
X        stab2 = stabent(str_get(st[2]),TRUE);
X    do_accept(str,stab,stab2);
X    STABSET(str);
X    break;
X    case O_GHBYNAME:
X    if (maxarg < 1)
X        goto say_undef;
X    case O_GHBYADDR:
X    case O_GHOSTENT:
X    sp = do_ghent(optype,
X      gimme,arglast);
X    goto array_return;
X    case O_GNBYNAME:
X    if (maxarg < 1)
X        goto say_undef;
X    case O_GNBYADDR:
X    case O_GNETENT:
X    sp = do_gnent(optype,
X      gimme,arglast);
X    goto array_return;
X    case O_GPBYNAME:
X    if (maxarg < 1)
X        goto say_undef;
X    case O_GPBYNUMBER:
X    case O_GPROTOENT:
X    sp = do_gpent(optype,
X      gimme,arglast);
X    goto array_return;
X    case O_GSBYNAME:
X    if (maxarg < 1)
X        goto say_undef;
X    case O_GSBYPORT:
X    case O_GSERVENT:
X    sp = do_gsent(optype,
X      gimme,arglast);
X    goto array_return;
X    case O_SHOSTENT:
X    value = (double) sethostent((int)str_gnum(st[1]));
X    goto donumset;
X    case O_SNETENT:
X    value = (double) setnetent((int)str_gnum(st[1]));
X    goto donumset;
X    case O_SPROTOENT:
X    value = (double) setprotoent((int)str_gnum(st[1]));
X    goto donumset;
X    case O_SSERVENT:
X    value = (double) setservent((int)str_gnum(st[1]));
X    goto donumset;
X    case O_EHOSTENT:
X    value = (double) endhostent();
X    goto donumset;
X    case O_ENETENT:
X    value = (double) endnetent();
X    goto donumset;
X    case O_EPROTOENT:
X    value = (double) endprotoent();
X    goto donumset;
X    case O_ESERVENT:
X    value = (double) endservent();
X    goto donumset;
X    case O_SSELECT:
X    sp = do_select(gimme,arglast);
X    goto array_return;
X    case O_SOCKETPAIR:
X    if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X    if ((arg[2].arg_type & A_MASK) == A_WORD)
X        stab2 = arg[2].arg_ptr.arg_stab;
X    else
X        stab2 = stabent(str_get(st[2]),TRUE);
X#ifndef lint
X    value = (double)do_spair(stab,stab2,arglast);
X#else
X    (void)do_spair(stab,stab2,arglast);
X#endif
X    goto donumset;
X    case O_SHUTDOWN:
X    if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X#ifndef lint
X    value = (double)do_shutdown(stab,arglast);
X#else
X    (void)do_shutdown(stab,arglast);
X#endif
X    goto donumset;
X    case O_GSOCKOPT:
X    case O_SSOCKOPT:
X    if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X    sp = do_sopt(optype,stab,arglast);
X    goto array_return;
X    case O_GETSOCKNAME:
X    case O_GETPEERNAME:
X    if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X    sp = do_getsockname(optype,stab,arglast);
X    goto array_return;
X
X#else /* SOCKET not defined */
X    case O_SOCKET:
X    case O_BIND:
X    case O_CONNECT:
X    case O_LISTEN:
X    case O_ACCEPT:
X    case O_SSELECT:
X    case O_SOCKETPAIR:
X    case O_GHBYNAME:
X    case O_GHBYADDR:
X    case O_GHOSTENT:
X    case O_GNBYNAME:
X    case O_GNBYADDR:
X    case O_GNETENT:
X    case O_GPBYNAME:
X    case O_GPBYNUMBER:
X    case O_GPROTOENT:
X    case O_GSBYNAME:
X    case O_GSBYPORT:
X    case O_GSERVENT:
X    case O_SHOSTENT:
X    case O_SNETENT:
X    case O_SPROTOENT:
X    case O_SSERVENT:
X    case O_EHOSTENT:
X    case O_ENETENT:
X    case O_EPROTOENT:
X    case O_ESERVENT:
X    case O_SHUTDOWN:
X    case O_GSOCKOPT:
X    case O_SSOCKOPT:
X    case O_GETSOCKNAME:
X    case O_GETPEERNAME:
X      badsock:
X    fatal("Unsupported socket function");
X#endif /* SOCKET */
X    case O_FILENO:
X    if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X    if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
X        goto say_undef;
X    value = fileno(fp);
X    goto donumset;
X    case O_VEC:
X    sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast);
X    goto array_return;
X    case O_GPWNAM:
X    case O_GPWUID:
X    case O_GPWENT:
X    sp = do_gpwent(optype,
X      gimme,arglast);
X    goto array_return;
X    case O_SPWENT:
X    value = (double) setpwent();
X    goto donumset;
X    case O_EPWENT:
X    value = (double) endpwent();
X    goto donumset;
X    case O_GGRNAM:
X    case O_GGRGID:
X    case O_GGRENT:
X    sp = do_ggrent(optype,
X      gimme,arglast);
X    goto array_return;
X    case O_SGRENT:
X    value = (double) setgrent();
X    goto donumset;
X    case O_EGRENT:
X    value = (double) endgrent();
X    goto donumset;
X    case O_GETLOGIN:
X    if (!(tmps = getlogin()))
X        goto say_undef;
X    str_set(str,tmps);
X    break;
X    case O_OPENDIR:
X    case O_READDIR:
X    case O_TELLDIR:
X    case O_SEEKDIR:
X    case O_REWINDDIR:
X    case O_CLOSEDIR:
X    if ((arg[1].arg_type & A_MASK) == A_WORD)
X        stab = arg[1].arg_ptr.arg_stab;
X    else
X        stab = stabent(str_get(st[1]),TRUE);
X    sp = do_dirop(optype,stab,gimme,arglast);
X    goto array_return;
X    case O_SYSCALL:
X    value = (double)do_syscall(arglast);
X    goto donumset;
X    }
X
X  normal_return:
X    st[1] = str;
X#ifdef DEBUGGING
X    if (debug) {
X    dlevel--;
X    if (debug & 8)
X        deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
X    }
X#endif
X    return arglast[0] + 1;
X
Xarray_return:
X#ifdef DEBUGGING
X    if (debug) {
X    dlevel--;
X    if (debug & 8)
X        deb("%s RETURNS ARRAY OF %d ARGS\n",opname[optype],sp - arglast[0]);
X    }
X#endif
X    return sp;
X
Xsay_yes:
X    str = &str_yes;
X    goto normal_return;
X
Xsay_no:
X    str = &str_no;
X    goto normal_return;
X
Xsay_undef:
X    str = &str_undef;
X    goto normal_return;
X
Xsay_zero:
X    value = 0.0;
X    /* FALL THROUGH */
X
Xdonumset:
X    str_numset(str,value);
X    STABSET(str);
X    st[1] = str;
X#ifdef DEBUGGING
X    if (debug) {
X    dlevel--;
X    if (debug & 8)
X        deb("%s RETURNS \"%f\"\n",opname[optype],value);
X    }
X#endif
X    return arglast[0] + 1;
X}
!STUFFY!FUNK!
echo ""
echo "End of kit 3 (of 24)"
cat /dev/null >kit3isdone
run=''
config=''
for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24; do
    if test -f kit${iskit}isdone; then
    run="$run $iskit"
    else
    todo="$todo $iskit"
    fi
done
case $todo in
    '')
    echo "You have run all your kits.  Please read README and then type Configure."
    chmod 755 Configure
    ;;
    *)  echo "You have run$run."
    echo "You still need to run$todo."
    ;;
esac
: Someone might mail this, so...
exit