Usenet 1994 October/usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso/misc/volume18/perl/part13

Internet Message Format | 1991-04-15 | 51KB

From: [e-mail] (Larry Wall)
Newsgroups: comp.sources.misc
Subject: v18i031:  perl - The perl programming language, Part13/36
Message-ID: <[e-mail]>
Date: 16 Apr 91 00:00:55 GMT
Approved: [e-mail]
X-Checksum-Snefru: e7499025 189af290 df5e914e c3e89925

Submitted-by: Larry Wall <[e-mail]>
Posting-number: Volume 18, Issue 31
Archive-name: perl/part13

[There are 36 kits for perl version 4.0.]

#! /bin/sh

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

echo "This is perl 4.0 kit 13 (of 36).  If kit 13 is complete, the line"
echo '"'"End of kit 13 (of 36)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir msdos x2p 2>/dev/null
echo Extracting cons.c
sed >cons.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: cons.c,v 4.0 91/03/20 01:05:51 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:    cons.c,v $
X * Revision 4.0  91/03/20  01:05:51  lwall
X * 4.0 baseline.
X *
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X#include "perly.h"
X
Xextern char *tokename[];
Xextern int yychar;
X
Xstatic int cmd_tosave();
Xstatic int arg_tosave();
Xstatic int spat_tosave();
X
Xstatic bool saw_return;
X
XSUBR *
Xmake_sub(name,cmd)
Xchar *name;
XCMD *cmd;
X{
X    register SUBR *sub;
X    STAB *stab = stabent(name,TRUE);
X
X    Newz(101,sub,1,SUBR);
X    if (stab_sub(stab)) {
X    if (dowarn) {
X        CMD *oldcurcmd = curcmd;
X
X        if (cmd)
X        curcmd = cmd;
X        warn("Subroutine %s redefined",name);
X        curcmd = oldcurcmd;
X    }
X    if (stab_sub(stab)->cmd) {
X        cmd_free(stab_sub(stab)->cmd);
X        stab_sub(stab)->cmd = Nullcmd;
X        afree(stab_sub(stab)->tosave);
X    }
X    Safefree(stab_sub(stab));
X    }
X    stab_sub(stab) = sub;
X    sub->filestab = curcmd->c_filestab;
X    saw_return = FALSE;
X    tosave = anew(Nullstab);
X    tosave->ary_fill = 0;    /* make 1 based */
X    (void)cmd_tosave(cmd,FALSE);    /* this builds the tosave array */
X    sub->tosave = tosave;
X    if (saw_return) {
X    struct compcmd mycompblock;
X
X    mycompblock.comp_true = cmd;
X    mycompblock.comp_alt = Nullcmd;
X    cmd = add_label(savestr("_SUB_"),make_ccmd(C_BLOCK,Nullarg,mycompblock));
X    saw_return = FALSE;
X    cmd->c_flags |= CF_TERM;
X    }
X    sub->cmd = cmd;
X    if (perldb) {
X    STR *str;
X    STR *tmpstr = str_mortal(&str_undef);
X
X    sprintf(buf,"%s:%ld",stab_val(curcmd->c_filestab)->str_ptr,
X      (long)subline);
X    str = str_make(buf,0);
X    str_cat(str,"-");
X    sprintf(buf,"%ld",(long)curcmd->c_line);
X    str_cat(str,buf);
X    name = str_get(subname);
X    stab_fullname(tmpstr,stab);
X    hstore(stab_xhash(DBsub), tmpstr->str_ptr, tmpstr->str_cur, str, 0);
X    str_set(subname,"main");
X    }
X    subline = 0;
X    return sub;
X}
X
XSUBR *
Xmake_usub(name, ix, subaddr, filename)
Xchar *name;
Xint ix;
Xint (*subaddr)();
Xchar *filename;
X{
X    register SUBR *sub;
X    STAB *stab = stabent(name,allstabs);
X
X    if (!stab)                /* unused function */
X    return Null(SUBR*);
X    Newz(101,sub,1,SUBR);
X    if (stab_sub(stab)) {
X    if (dowarn)
X        warn("Subroutine %s redefined",name);
X    if (stab_sub(stab)->cmd) {
X        cmd_free(stab_sub(stab)->cmd);
X        stab_sub(stab)->cmd = Nullcmd;
X        afree(stab_sub(stab)->tosave);
X    }
X    Safefree(stab_sub(stab));
X    }
X    stab_sub(stab) = sub;
X    sub->filestab = fstab(filename);
X    sub->usersub = subaddr;
X    sub->userindex = ix;
X    return sub;
X}
X
Xmake_form(stab,fcmd)
XSTAB *stab;
XFCMD *fcmd;
X{
X    if (stab_form(stab)) {
X    FCMD *tmpfcmd;
X    FCMD *nextfcmd;
X
X    for (tmpfcmd = stab_form(stab); tmpfcmd; tmpfcmd = nextfcmd) {
X        nextfcmd = tmpfcmd->f_next;
X        if (tmpfcmd->f_expr)
X        arg_free(tmpfcmd->f_expr);
X        if (tmpfcmd->f_unparsed)
X        str_free(tmpfcmd->f_unparsed);
X        if (tmpfcmd->f_pre)
X        Safefree(tmpfcmd->f_pre);
X        Safefree(tmpfcmd);
X    }
X    }
X    stab_form(stab) = fcmd;
X}
X
XCMD *
Xblock_head(tail)
Xregister CMD *tail;
X{
X    CMD *head;
X    register int opt;
X    register int last_opt = 0;
X    register STAB *last_stab = Nullstab;
X    register int count = 0;
X    register CMD *switchbeg = Nullcmd;
X
X    if (tail == Nullcmd) {
X    return tail;
X    }
X    head = tail->c_head;
X
X    for (tail = head; tail; tail = tail->c_next) {
X
X    /* save one measly dereference at runtime */
X    if (tail->c_type == C_IF) {
X        if (!(tail->ucmd.ccmd.cc_alt = tail->ucmd.ccmd.cc_alt->c_next))
X        tail->c_flags |= CF_TERM;
X    }
X    else if (tail->c_type == C_EXPR) {
X        ARG *arg;
X
X        if (tail->ucmd.acmd.ac_expr)
X        arg = tail->ucmd.acmd.ac_expr;
X        else
X        arg = tail->c_expr;
X        if (arg) {
X        if (arg->arg_type == O_RETURN)
X            tail->c_flags |= CF_TERM;
X        else if (arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
X            tail->c_flags |= CF_TERM;
X        }
X    }
X    if (!tail->c_next)
X        tail->c_flags |= CF_TERM;
X
X    if (tail->c_expr && (tail->c_flags & CF_OPTIMIZE) == CFT_FALSE)
X        opt_arg(tail,1, tail->c_type == C_EXPR);
X
X    /* now do a little optimization on case-ish structures */
X    switch(tail->c_flags & (CF_OPTIMIZE|CF_FIRSTNEG|CF_INVERT)) {
X    case CFT_ANCHOR:
X        if (stabent("*",FALSE)) {    /* bad assumption here!!! */
X        opt = 0;
X        break;
X        }
X        /* FALL THROUGH */
X    case CFT_STROP:
X        opt = (tail->c_flags & CF_NESURE) ? CFT_STROP : 0;
X        break;
X    case CFT_CCLASS:
X        opt = CFT_STROP;
X        break;
X    case CFT_NUMOP:
X        opt = (tail->c_slen == O_NE ? 0 : CFT_NUMOP);
X        if ((tail->c_flags&(CF_NESURE|CF_EQSURE)) != (CF_NESURE|CF_EQSURE))
X        opt = 0;
X        break;
X    default:
X        opt = 0;
X    }
X    if (opt && opt == last_opt && tail->c_stab == last_stab)
X        count++;
X    else {
X        if (count >= 3) {        /* is this the breakeven point? */
X        if (last_opt == CFT_NUMOP)
X            make_nswitch(switchbeg,count);
X        else
X            make_cswitch(switchbeg,count);
X        }
X        if (opt) {
X        count = 1;
X        switchbeg = tail;
X        }
X        else
X        count = 0;
X    }
X    last_opt = opt;
X    last_stab = tail->c_stab;
X    }
X    if (count >= 3) {        /* is this the breakeven point? */
X    if (last_opt == CFT_NUMOP)
X        make_nswitch(switchbeg,count);
X    else
X        make_cswitch(switchbeg,count);
X    }
X    return head;
X}
X
X/* We've spotted a sequence of CMDs that all test the value of the same
X * spat.  Thus we can insert a SWITCH in front and jump directly
X * to the correct one.
X */
Xmake_cswitch(head,count)
Xregister CMD *head;
Xint count;
X{
X    register CMD *cur;
X    register CMD **loc;
X    register int i;
X    register int min = 255;
X    register int max = 0;
X
X    /* make a new head in the exact same spot */
X    New(102,cur, 1, CMD);
X#ifdef STRUCTCOPY
X    *cur = *head;
X#else
X    Copy(head,cur,1,CMD);
X#endif
X    Zero(head,1,CMD);
X    head->c_type = C_CSWITCH;
X    head->c_next = cur;        /* insert new cmd at front of list */
X    head->c_stab = cur->c_stab;
X
X    Newz(103,loc,258,CMD*);
X    loc++;                /* lie a little */
X    while (count--) {
X    if ((cur->c_flags & CF_OPTIMIZE) == CFT_CCLASS) {
X        for (i = 0; i <= 255; i++) {
X        if (!loc[i] && cur->c_short->str_ptr[i>>3] & (1 << (i&7))) {
X            loc[i] = cur;
X            if (i < min)
X            min = i;
X            if (i > max)
X            max = i;
X        }
X        }
X    }
X    else {
X        i = *cur->c_short->str_ptr & 255;
X        if (!loc[i]) {
X        loc[i] = cur;
X        if (i < min)
X            min = i;
X        if (i > max)
X            max = i;
X        }
X    }
X    cur = cur->c_next;
X    }
X    max++;
X    if (min > 0)
X    Copy(&loc[min],&loc[0], max - min, CMD*);
X    loc--;
X    min--;
X    max -= min;
X    for (i = 0; i <= max; i++)
X    if (!loc[i])
X        loc[i] = cur;
X    Renew(loc,max+1,CMD*);    /* chop it down to size */
X    head->ucmd.scmd.sc_offset = min;
X    head->ucmd.scmd.sc_max = max;
X    head->ucmd.scmd.sc_next = loc;
X}
X
Xmake_nswitch(head,count)
Xregister CMD *head;
Xint count;
X{
X    register CMD *cur = head;
X    register CMD **loc;
X    register int i;
X    register int min = 32767;
X    register int max = -32768;
X    int origcount = count;
X    double value;        /* or your money back! */
X    short changed;        /* so triple your money back! */
X
X    while (count--) {
X    i = (int)str_gnum(cur->c_short);
X    value = (double)i;
X    if (value != cur->c_short->str_u.str_nval)
X        return;        /* fractional values--just forget it */
X    changed = i;
X    if (changed != i)
X        return;        /* too big for a short */
X    if (cur->c_slen == O_LE)
X        i++;
X    else if (cur->c_slen == O_GE)    /* we only do < or > here */
X        i--;
X    if (i < min)
X        min = i;
X    if (i > max)
X        max = i;
X    cur = cur->c_next;
X    }
X    count = origcount;
X    if (max - min > count * 2 + 10)        /* too sparse? */
X    return;
X
X    /* now make a new head in the exact same spot */
X    New(104,cur, 1, CMD);
X#ifdef STRUCTCOPY
X    *cur = *head;
X#else
X    Copy(head,cur,1,CMD);
X#endif
X    Zero(head,1,CMD);
X    head->c_type = C_NSWITCH;
X    head->c_next = cur;        /* insert new cmd at front of list */
X    head->c_stab = cur->c_stab;
X
X    Newz(105,loc, max - min + 3, CMD*);
X    loc++;
X    max -= min;
X    max++;
X    while (count--) {
X    i = (int)str_gnum(cur->c_short);
X    i -= min;
X    switch(cur->c_slen) {
X    case O_LE:
X        i++;
X    case O_LT:
X        for (i--; i >= -1; i--)
X        if (!loc[i])
X            loc[i] = cur;
X        break;
X    case O_GE:
X        i--;
X    case O_GT:
X        for (i++; i <= max; i++)
X        if (!loc[i])
X            loc[i] = cur;
X        break;
X    case O_EQ:
X        if (!loc[i])
X        loc[i] = cur;
X        break;
X    }
X    cur = cur->c_next;
X    }
X    loc--;
X    min--;
X    max++;
X    for (i = 0; i <= max; i++)
X    if (!loc[i])
X        loc[i] = cur;
X    head->ucmd.scmd.sc_offset = min;
X    head->ucmd.scmd.sc_max = max;
X    head->ucmd.scmd.sc_next = loc;
X}
X
XCMD *
Xappend_line(head,tail)
Xregister CMD *head;
Xregister CMD *tail;
X{
X    if (tail == Nullcmd)
X    return head;
X    if (!tail->c_head)            /* make sure tail is well formed */
X    tail->c_head = tail;
X    if (head != Nullcmd) {
X    tail = tail->c_head;        /* get to start of tail list */
X    if (!head->c_head)
X        head->c_head = head;    /* start a new head list */
X    while (head->c_next) {
X        head->c_next->c_head = head->c_head;
X        head = head->c_next;    /* get to end of head list */
X    }
X    head->c_next = tail;        /* link to end of old list */
X    tail->c_head = head->c_head;    /* propagate head pointer */
X    }
X    while (tail->c_next) {
X    tail->c_next->c_head = tail->c_head;
X    tail = tail->c_next;
X    }
X    return tail;
X}
X
XCMD *
Xdodb(cur)
XCMD *cur;
X{
X    register CMD *cmd;
X    register CMD *head = cur->c_head;
X    STR *str;
X
X    if (!head)
X    head = cur;
X    if (!head->c_line)
X    return cur;
X    str = afetch(stab_xarray(curcmd->c_filestab),(int)head->c_line,FALSE);
X    if (str == &str_undef || str->str_nok)
X    return cur;
X    str->str_u.str_nval = (double)head->c_line;
X    str->str_nok = 1;
X    Newz(106,cmd,1,CMD);
X    str_magic(str, curcmd->c_filestab, 0, Nullch, 0);
X    str->str_magic->str_u.str_cmd = cmd;
X    cmd->c_type = C_EXPR;
X    cmd->ucmd.acmd.ac_stab = Nullstab;
X    cmd->ucmd.acmd.ac_expr = Nullarg;
X    cmd->c_expr = make_op(O_SUBR, 2,
X    stab2arg(A_WORD,DBstab),
X    Nullarg,
X    Nullarg);
X    cmd->c_flags |= CF_COND|CF_DBSUB|CFT_D0;
X    cmd->c_line = head->c_line;
X    cmd->c_label = head->c_label;
X    cmd->c_filestab = curcmd->c_filestab;
X    cmd->c_stash = curstash;
X    return append_line(cmd, cur);
X}
X
XCMD *
Xmake_acmd(type,stab,cond,arg)
Xint type;
XSTAB *stab;
XARG *cond;
XARG *arg;
X{
X    register CMD *cmd;
X
X    Newz(107,cmd,1,CMD);
X    cmd->c_type = type;
X    cmd->ucmd.acmd.ac_stab = stab;
X    cmd->ucmd.acmd.ac_expr = arg;
X    cmd->c_expr = cond;
X    if (cond)
X    cmd->c_flags |= CF_COND;
X    if (cmdline == NOLINE)
X    cmd->c_line = curcmd->c_line;
X    else {
X    cmd->c_line = cmdline;
X    cmdline = NOLINE;
X    }
X    cmd->c_filestab = curcmd->c_filestab;
X    cmd->c_stash = curstash;
X    if (perldb)
X    cmd = dodb(cmd);
X    return cmd;
X}
X
XCMD *
Xmake_ccmd(type,arg,cblock)
Xint type;
XARG *arg;
Xstruct compcmd cblock;
X{
X    register CMD *cmd;
X
X    Newz(108,cmd, 1, CMD);
X    cmd->c_type = type;
X    cmd->c_expr = arg;
X    cmd->ucmd.ccmd.cc_true = cblock.comp_true;
X    cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
X    if (arg)
X    cmd->c_flags |= CF_COND;
X    if (cmdline == NOLINE)
X    cmd->c_line = curcmd->c_line;
X    else {
X    cmd->c_line = cmdline;
X    cmdline = NOLINE;
X    }
X    cmd->c_filestab = curcmd->c_filestab;
X    cmd->c_stash = curstash;
X    if (perldb)
X    cmd = dodb(cmd);
X    return cmd;
X}
X
XCMD *
Xmake_icmd(type,arg,cblock)
Xint type;
XARG *arg;
Xstruct compcmd cblock;
X{
X    register CMD *cmd;
X    register CMD *alt;
X    register CMD *cur;
X    register CMD *head;
X    struct compcmd ncblock;
X
X    Newz(109,cmd, 1, CMD);
X    head = cmd;
X    cmd->c_type = type;
X    cmd->c_expr = arg;
X    cmd->ucmd.ccmd.cc_true = cblock.comp_true;
X    cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
X    if (arg)
X    cmd->c_flags |= CF_COND;
X    if (cmdline == NOLINE)
X    cmd->c_line = curcmd->c_line;
X    else {
X    cmd->c_line = cmdline;
X    cmdline = NOLINE;
X    }
X    cmd->c_filestab = curcmd->c_filestab;
X    cmd->c_stash = curstash;
X    cur = cmd;
X    alt = cblock.comp_alt;
X    while (alt && alt->c_type == C_ELSIF) {
X    cur = alt;
X    alt = alt->ucmd.ccmd.cc_alt;
X    }
X    if (alt) {            /* a real life ELSE at the end? */
X    ncblock.comp_true = alt;
X    ncblock.comp_alt = Nullcmd;
X    alt = append_line(cur,make_ccmd(C_ELSE,Nullarg,ncblock));
X    cur->ucmd.ccmd.cc_alt = alt;
X    }
X    else
X    alt = cur;        /* no ELSE, so cur is proxy ELSE */
X
X    cur = cmd;
X    while (cmd) {        /* now point everyone at the ELSE */
X    cur = cmd;
X    cmd = cur->ucmd.ccmd.cc_alt;
X    cur->c_head = head;
X    if (cur->c_type == C_ELSIF)
X        cur->c_type = C_IF;
X    if (cur->c_type == C_IF)
X        cur->ucmd.ccmd.cc_alt = alt;
X    if (cur == alt)
X        break;
X    cur->c_next = cmd;
X    }
X    if (perldb)
X    cur = dodb(cur);
X    return cur;
X}
X
Xvoid
Xopt_arg(cmd,fliporflop,acmd)
Xregister CMD *cmd;
Xint fliporflop;
Xint acmd;
X{
X    register ARG *arg;
X    int opt = CFT_EVAL;
X    int sure = 0;
X    ARG *arg2;
X    int context = 0;    /* 0 = normal, 1 = before &&, 2 = before || */
X    int flp = fliporflop;
X
X    if (!cmd)
X    return;
X    if (!(arg = cmd->c_expr)) {
X    cmd->c_flags &= ~CF_COND;
X    return;
X    }
X
X    /* Can we turn && and || into if and unless? */
X
X    if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM) &&
X      (arg->arg_type == O_AND || arg->arg_type == O_OR) ) {
X    dehoist(arg,1);
X    arg[2].arg_type &= A_MASK;    /* don't suppress eval */
X    dehoist(arg,2);
X    cmd->ucmd.acmd.ac_expr = arg[2].arg_ptr.arg_arg;
X    cmd->c_expr = arg[1].arg_ptr.arg_arg;
X    if (arg->arg_type == O_OR)
X        cmd->c_flags ^= CF_INVERT;        /* || is like unless */
X    arg->arg_len = 0;
X    free_arg(arg);
X    arg = cmd->c_expr;
X    }
X
X    /* Turn "if (!expr)" into "unless (expr)" */
X
X    if (!(cmd->c_flags & CF_TERM)) {        /* unless return value wanted */
X    while (arg->arg_type == O_NOT) {
X        dehoist(arg,1);
X        cmd->c_flags ^= CF_INVERT;        /* flip sense of cmd */
X        cmd->c_expr = arg[1].arg_ptr.arg_arg; /* hoist the rest of expr */
X        free_arg(arg);
X        arg = cmd->c_expr;            /* here we go again */
X    }
X    }
X
X    if (!arg->arg_len) {        /* sanity check */
X    cmd->c_flags |= opt;
X    return;
X    }
X
X    /* for "cond .. cond" we set up for the initial check */
X
X    if (arg->arg_type == O_FLIP)
X    context |= 4;
X
X    /* for "cond && expr" and "cond || expr" we can ignore expr, sort of */
X
X  morecontext:
X    if (arg->arg_type == O_AND)
X    context |= 1;
X    else if (arg->arg_type == O_OR)
X    context |= 2;
X    if (context && (arg[flp].arg_type & A_MASK) == A_EXPR) {
X    arg = arg[flp].arg_ptr.arg_arg;
X    flp = 1;
X    if (arg->arg_type == O_AND || arg->arg_type == O_OR)
X        goto morecontext;
X    }
X    if ((context & 3) == 3)
X    return;
X
X    if (arg[flp].arg_flags & (AF_PRE|AF_POST)) {
X    cmd->c_flags |= opt;
X    if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM)
X      && cmd->c_expr->arg_type == O_ITEM) {
X        arg[flp].arg_flags &= ~AF_POST;    /* prefer ++$foo to $foo++ */
X        arg[flp].arg_flags |= AF_PRE;    /*  if value not wanted */
X    }
X    return;                /* side effect, can't optimize */
X    }
X
X    if (arg->arg_type == O_ITEM || arg->arg_type == O_FLIP ||
X      arg->arg_type == O_AND || arg->arg_type == O_OR) {
X    if ((arg[flp].arg_type & A_MASK) == A_SINGLE) {
X        opt = (str_true(arg[flp].arg_ptr.arg_str) ? CFT_TRUE : CFT_FALSE);
X        cmd->c_short = str_smake(arg[flp].arg_ptr.arg_str);
X        goto literal;
X    }
X    else if ((arg[flp].arg_type & A_MASK) == A_STAB ||
X      (arg[flp].arg_type & A_MASK) == A_LVAL) {
X        cmd->c_stab  = arg[flp].arg_ptr.arg_stab;
X        if (!context)
X        arg[flp].arg_ptr.arg_stab = Nullstab;
X        opt = CFT_REG;
X      literal:
X        if (!context) {    /* no && or ||? */
X        arg_free(arg);
X        cmd->c_expr = Nullarg;
X        }
X        if (!(context & 1))
X        cmd->c_flags |= CF_EQSURE;
X        if (!(context & 2))
X        cmd->c_flags |= CF_NESURE;
X    }
X    }
X    else if (arg->arg_type == O_MATCH || arg->arg_type == O_SUBST ||
X         arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST) {
X    if ((arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
X        (arg[2].arg_type & A_MASK) == A_SPAT &&
X        arg[2].arg_ptr.arg_spat->spat_short ) {
X        cmd->c_stab  = arg[1].arg_ptr.arg_stab;
X        cmd->c_short = str_smake(arg[2].arg_ptr.arg_spat->spat_short);
X        cmd->c_slen  = arg[2].arg_ptr.arg_spat->spat_slen;
X        if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ALL &&
X        !(arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ONCE) &&
X        (arg->arg_type == O_MATCH || arg->arg_type == O_NMATCH) )
X        sure |= CF_EQSURE;        /* (SUBST must be forced even */
X                        /* if we know it will work.) */
X        if (arg->arg_type != O_SUBST) {
X        arg[2].arg_ptr.arg_spat->spat_short = Nullstr;
X        arg[2].arg_ptr.arg_spat->spat_slen = 0; /* only one chk */
X        }
X        sure |= CF_NESURE;        /* normally only sure if it fails */
X        if (arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST)
X        cmd->c_flags |= CF_FIRSTNEG;
X        if (context & 1) {        /* only sure if thing is false */
X        if (cmd->c_flags & CF_FIRSTNEG)
X            sure &= ~CF_NESURE;
X        else
X            sure &= ~CF_EQSURE;
X        }
X        else if (context & 2) {    /* only sure if thing is true */
X        if (cmd->c_flags & CF_FIRSTNEG)
X            sure &= ~CF_EQSURE;
X        else
X            sure &= ~CF_NESURE;
X        }
X        if (sure & (CF_EQSURE|CF_NESURE)) {    /* if we know anything*/
X        if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_SCANFIRST)
X            opt = CFT_SCAN;
X        else
X            opt = CFT_ANCHOR;
X        if (sure == (CF_EQSURE|CF_NESURE)    /* really sure? */
X            && arg->arg_type == O_MATCH
X            && context & 4
X            && fliporflop == 1) {
X            spat_free(arg[2].arg_ptr.arg_spat);
X            arg[2].arg_ptr.arg_spat = Nullspat;    /* don't do twice */
X        }
X        else
X            cmd->c_spat = arg[2].arg_ptr.arg_spat;
X        cmd->c_flags |= sure;
X        }
X    }
X    }
X    else if (arg->arg_type == O_SEQ || arg->arg_type == O_SNE ||
X         arg->arg_type == O_SLT || arg->arg_type == O_SGT) {
X    if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
X        if (arg[2].arg_type == A_SINGLE) {
X        char *junk = str_get(arg[2].arg_ptr.arg_str);
X
X        cmd->c_stab  = arg[1].arg_ptr.arg_stab;
X        cmd->c_short = str_smake(arg[2].arg_ptr.arg_str);
X        cmd->c_slen  = cmd->c_short->str_cur+1;
X        switch (arg->arg_type) {
X        case O_SLT: case O_SGT:
X            sure |= CF_EQSURE;
X            cmd->c_flags |= CF_FIRSTNEG;
X            break;
X        case O_SNE:
X            cmd->c_flags |= CF_FIRSTNEG;
X            /* FALL THROUGH */
X        case O_SEQ:
X            sure |= CF_NESURE|CF_EQSURE;
X            break;
X        }
X        if (context & 1) {    /* only sure if thing is false */
X            if (cmd->c_flags & CF_FIRSTNEG)
X            sure &= ~CF_NESURE;
X            else
X            sure &= ~CF_EQSURE;
X        }
X        else if (context & 2) { /* only sure if thing is true */
X            if (cmd->c_flags & CF_FIRSTNEG)
X            sure &= ~CF_EQSURE;
X            else
X            sure &= ~CF_NESURE;
X        }
X        if (sure & (CF_EQSURE|CF_NESURE)) {
X            opt = CFT_STROP;
X            cmd->c_flags |= sure;
X        }
X        }
X    }
X    }
X    else if (arg->arg_type == O_EQ || arg->arg_type == O_NE ||
X         arg->arg_type == O_LE || arg->arg_type == O_GE ||
X         arg->arg_type == O_LT || arg->arg_type == O_GT) {
X    if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
X        if (arg[2].arg_type == A_SINGLE) {
X        cmd->c_stab  = arg[1].arg_ptr.arg_stab;
X        if (dowarn) {
X            STR *str = arg[2].arg_ptr.arg_str;
X
X            if ((!str->str_nok && !looks_like_number(str)))
X            warn("Possible use of == on string value");
X        }
X        cmd->c_short = str_nmake(str_gnum(arg[2].arg_ptr.arg_str));
X        cmd->c_slen = arg->arg_type;
X        sure |= CF_NESURE|CF_EQSURE;
X        if (context & 1) {    /* only sure if thing is false */
X            sure &= ~CF_EQSURE;
X        }
X        else if (context & 2) { /* only sure if thing is true */
X            sure &= ~CF_NESURE;
X        }
X        if (sure & (CF_EQSURE|CF_NESURE)) {
X            opt = CFT_NUMOP;
X            cmd->c_flags |= sure;
X        }
X        }
X    }
X    }
X    else if (arg->arg_type == O_ASSIGN &&
X         (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
X         arg[1].arg_ptr.arg_stab == defstab &&
X         arg[2].arg_type == A_EXPR ) {
X    arg2 = arg[2].arg_ptr.arg_arg;
X    if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) {
X        opt = CFT_GETS;
X        cmd->c_stab = arg2[1].arg_ptr.arg_stab;
X        if (!(stab_io(arg2[1].arg_ptr.arg_stab)->flags & IOF_ARGV)) {
X        free_arg(arg2);
X        arg[2].arg_ptr.arg_arg = Nullarg;
X        free_arg(arg);
X        cmd->c_expr = Nullarg;
X        }
X    }
X    }
X    else if (arg->arg_type == O_CHOP &&
X         (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) ) {
X    opt = CFT_CHOP;
X    cmd->c_stab = arg[1].arg_ptr.arg_stab;
X    free_arg(arg);
X    cmd->c_expr = Nullarg;
X    }
X    if (context & 4)
X    opt |= CF_FLIP;
X    cmd->c_flags |= opt;
X
X    if (cmd->c_flags & CF_FLIP) {
X    if (fliporflop == 1) {
X        arg = cmd->c_expr;    /* get back to O_FLIP arg */
X        New(110,arg[3].arg_ptr.arg_cmd, 1, CMD);
X        Copy(cmd, arg[3].arg_ptr.arg_cmd, 1, CMD);
X        New(111,arg[4].arg_ptr.arg_cmd,1,CMD);
X        Copy(cmd, arg[4].arg_ptr.arg_cmd, 1, CMD);
X        opt_arg(arg[4].arg_ptr.arg_cmd,2,acmd);
X        arg->arg_len = 2;        /* this is a lie */
X    }
X    else {
X        if ((opt & CF_OPTIMIZE) == CFT_EVAL)
X        cmd->c_flags = (cmd->c_flags & ~CF_OPTIMIZE) | CFT_UNFLIP;
X    }
X    }
X}
X
XCMD *
Xadd_label(lbl,cmd)
Xchar *lbl;
Xregister CMD *cmd;
X{
X    if (cmd)
X    cmd->c_label = lbl;
X    return cmd;
X}
X
XCMD *
Xaddcond(cmd, arg)
Xregister CMD *cmd;
Xregister ARG *arg;
X{
X    cmd->c_expr = arg;
X    cmd->c_flags |= CF_COND;
X    return cmd;
X}
X
XCMD *
Xaddloop(cmd, arg)
Xregister CMD *cmd;
Xregister ARG *arg;
X{
X    void while_io();
X
X    cmd->c_expr = arg;
X    cmd->c_flags |= CF_COND|CF_LOOP;
X
X    if (!(cmd->c_flags & CF_INVERT))
X    while_io(cmd);        /* add $_ =, if necessary */
X
X    if (cmd->c_type == C_BLOCK)
X    cmd->c_flags &= ~CF_COND;
X    else {
X    arg = cmd->ucmd.acmd.ac_expr;
X    if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
X        cmd->c_flags &= ~CF_COND;  /* "do {} while" happens at least once */
X    if (arg && (arg->arg_flags & AF_DEPR) &&
X      (arg->arg_type == O_SUBR || arg->arg_type == O_DBSUBR) )
X        cmd->c_flags &= ~CF_COND;  /* likewise for "do subr() while" */
X    }
X    return cmd;
X}
X
XCMD *
Xinvert(cmd)
XCMD *cmd;
X{
X    register CMD *targ = cmd;
X    if (targ->c_head)
X    targ = targ->c_head;
X    if (targ->c_flags & CF_DBSUB)
X    targ = targ->c_next;
X    targ->c_flags ^= CF_INVERT;
X    return cmd;
X}
X
Xyyerror(s)
Xchar *s;
X{
X    char tmpbuf[258];
X    char tmp2buf[258];
X    char *tname = tmpbuf;
X
X    if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
X      oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
X    while (isspace(*oldoldbufptr))
X        oldoldbufptr++;
X    strncpy(tmp2buf, oldoldbufptr, bufptr - oldoldbufptr);
X    tmp2buf[bufptr - oldoldbufptr] = '\0';
X    sprintf(tname,"next 2 tokens \"%s\"",tmp2buf);
X    }
X    else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
X      oldbufptr != bufptr) {
X    while (isspace(*oldbufptr))
X        oldbufptr++;
X    strncpy(tmp2buf, oldbufptr, bufptr - oldbufptr);
X    tmp2buf[bufptr - oldbufptr] = '\0';
X    sprintf(tname,"next token \"%s\"",tmp2buf);
X    }
X    else if (yychar > 256)
X    tname = "next token ???";
X    else if (!yychar)
X    (void)strcpy(tname,"at EOF");
X    else if (yychar < 32)
X    (void)sprintf(tname,"next char ^%c",yychar+64);
X    else if (yychar == 127)
X    (void)strcpy(tname,"at EOF");
X    else
X    (void)sprintf(tname,"next char %c",yychar);
X    (void)sprintf(buf, "%s in file %s at line %d, %s\n",
X      s,stab_val(curcmd->c_filestab)->str_ptr,curcmd->c_line,tname);
X    if (curcmd->c_line == multi_end && multi_start < multi_end)
X    sprintf(buf+strlen(buf),
X      "  (Might be a runaway multi-line %c%c string starting on line %d)\n",
X      multi_open,multi_close,multi_start);
X    if (in_eval)
X    str_cat(stab_val(stabent("@",TRUE)),buf);
X    else
X    fputs(buf,stderr);
X    if (++error_count >= 10)
X    fatal("%s has too many errors.\n",
X    stab_val(curcmd->c_filestab)->str_ptr);
X}
X
Xvoid
Xwhile_io(cmd)
Xregister CMD *cmd;
X{
X    register ARG *arg = cmd->c_expr;
X    STAB *asgnstab;
X
X    /* hoist "while (<channel>)" up into command block */
X
X    if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_READ) {
X    cmd->c_flags &= ~CF_OPTIMIZE;    /* clear optimization type */
X    cmd->c_flags |= CFT_GETS;    /* and set it to do the input */
X    cmd->c_stab = arg[1].arg_ptr.arg_stab;
X    if (stab_io(arg[1].arg_ptr.arg_stab)->flags & IOF_ARGV) {
X        cmd->c_expr = l(make_op(O_ASSIGN, 2,    /* fake up "$_ =" */
X           stab2arg(A_LVAL,defstab), arg, Nullarg));
X    }
X    else {
X        free_arg(arg);
X        cmd->c_expr = Nullarg;
X    }
X    }
X    else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_INDREAD) {
X    cmd->c_flags &= ~CF_OPTIMIZE;    /* clear optimization type */
X    cmd->c_flags |= CFT_INDGETS;    /* and set it to do the input */
X    cmd->c_stab = arg[1].arg_ptr.arg_stab;
X    free_arg(arg);
X    cmd->c_expr = Nullarg;
X    }
X    else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_GLOB) {
X    if ((cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY)
X        asgnstab = cmd->c_stab;
X    else
X        asgnstab = defstab;
X    cmd->c_expr = l(make_op(O_ASSIGN, 2,    /* fake up "$foo =" */
X       stab2arg(A_LVAL,asgnstab), arg, Nullarg));
X    cmd->c_flags &= ~CF_OPTIMIZE;    /* clear optimization type */
X    }
X}
X
XCMD *
Xwopt(cmd)
Xregister CMD *cmd;
X{
X    register CMD *tail;
X    CMD *newtail;
X    register int i;
X
X    if (cmd->c_expr && (cmd->c_flags & CF_OPTIMIZE) == CFT_FALSE)
X    opt_arg(cmd,1, cmd->c_type == C_EXPR);
X
X    while_io(cmd);        /* add $_ =, if necessary */
X
X    /* First find the end of the true list */
X
X    tail = cmd->ucmd.ccmd.cc_true;
X    if (tail == Nullcmd)
X    return cmd;
X    New(112,newtail, 1, CMD);    /* guaranteed continue */
X    for (;;) {
X    /* optimize "next" to point directly to continue block */
X    if (tail->c_type == C_EXPR &&
X        tail->ucmd.acmd.ac_expr &&
X        tail->ucmd.acmd.ac_expr->arg_type == O_NEXT &&
X        (tail->ucmd.acmd.ac_expr->arg_len == 0 ||
X         (cmd->c_label &&
X          strEQ(cmd->c_label,
X            tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
X    {
X        arg_free(tail->ucmd.acmd.ac_expr);
X        tail->ucmd.acmd.ac_expr = Nullarg;
X        tail->c_type = C_NEXT;
X        if (cmd->ucmd.ccmd.cc_alt != Nullcmd)
X        tail->ucmd.ccmd.cc_alt = cmd->ucmd.ccmd.cc_alt;
X        else
X        tail->ucmd.ccmd.cc_alt = newtail;
X        tail->ucmd.ccmd.cc_true = Nullcmd;
X    }
X    else if (tail->c_type == C_IF && !tail->ucmd.ccmd.cc_alt) {
X        if (cmd->ucmd.ccmd.cc_alt != Nullcmd)
X        tail->ucmd.ccmd.cc_alt = cmd->ucmd.ccmd.cc_alt;
X        else
X        tail->ucmd.ccmd.cc_alt = newtail;
X    }
X    else if (tail->c_type == C_CSWITCH || tail->c_type == C_NSWITCH) {
X        if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
X        for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
X            if (!tail->ucmd.scmd.sc_next[i])
X            tail->ucmd.scmd.sc_next[i] = cmd->ucmd.ccmd.cc_alt;
X        }
X        else {
X        for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
X            if (!tail->ucmd.scmd.sc_next[i])
X            tail->ucmd.scmd.sc_next[i] = newtail;
X        }
X    }
X
X    if (!tail->c_next)
X        break;
X    tail = tail->c_next;
X    }
X
X    /* if there's a continue block, link it to true block and find end */
X
X    if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
X    tail->c_next = cmd->ucmd.ccmd.cc_alt;
X    tail = tail->c_next;
X    for (;;) {
X        /* optimize "next" to point directly to continue block */
X        if (tail->c_type == C_EXPR &&
X        tail->ucmd.acmd.ac_expr &&
X        tail->ucmd.acmd.ac_expr->arg_type == O_NEXT &&
X        (tail->ucmd.acmd.ac_expr->arg_len == 0 ||
X         (cmd->c_label &&
X          strEQ(cmd->c_label,
X            tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
X        {
X        arg_free(tail->ucmd.acmd.ac_expr);
X        tail->ucmd.acmd.ac_expr = Nullarg;
X        tail->c_type = C_NEXT;
X        tail->ucmd.ccmd.cc_alt = newtail;
X        tail->ucmd.ccmd.cc_true = Nullcmd;
X        }
X        else if (tail->c_type == C_IF && !tail->ucmd.ccmd.cc_alt) {
X        tail->ucmd.ccmd.cc_alt = newtail;
X        }
X        else if (tail->c_type == C_CSWITCH || tail->c_type == C_NSWITCH) {
X        for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
X            if (!tail->ucmd.scmd.sc_next[i])
X            tail->ucmd.scmd.sc_next[i] = newtail;
X        }
X
X        if (!tail->c_next)
X        break;
X        tail = tail->c_next;
X    }
X    for ( ; tail->c_next; tail = tail->c_next) ;
X    }
X
X    /* Here's the real trick: link the end of the list back to the beginning,
X     * inserting a "last" block to break out of the loop.  This saves one or
X     * two procedure calls every time through the loop, because of how cmd_exec
X     * does tail recursion.
X     */
X
X    tail->c_next = newtail;
X    tail = newtail;
X    if (!cmd->ucmd.ccmd.cc_alt)
X    cmd->ucmd.ccmd.cc_alt = tail;    /* every loop has a continue now */
X
X#ifndef lint
X    (void)bcopy((char *)cmd, (char *)tail, sizeof(CMD));
X#endif
X    tail->c_type = C_EXPR;
X    tail->c_flags ^= CF_INVERT;        /* turn into "last unless" */
X    tail->c_next = tail->ucmd.ccmd.cc_true;    /* loop directly back to top */
X    tail->ucmd.acmd.ac_expr = make_op(O_LAST,0,Nullarg,Nullarg,Nullarg);
X    tail->ucmd.acmd.ac_stab = Nullstab;
X    return cmd;
X}
X
XCMD *
Xover(eachstab,cmd)
XSTAB *eachstab;
Xregister CMD *cmd;
X{
X    /* hoist "for $foo (@bar)" up into command block */
X
X    cmd->c_flags &= ~CF_OPTIMIZE;    /* clear optimization type */
X    cmd->c_flags |= CFT_ARRAY;        /* and set it to do the iteration */
X    cmd->c_stab = eachstab;
X    cmd->c_short = str_new(0);        /* just to save a field in struct cmd */
X    cmd->c_short->str_u.str_useful = -1;
X
X    return cmd;
X}
X
Xcmd_free(cmd)
Xregister CMD *cmd;
X{
X    register CMD *tofree;
X    register CMD *head = cmd;
X
X    while (cmd) {
X    if (cmd->c_type != C_WHILE) {    /* WHILE block is duplicated */
X        if (cmd->c_label) {
X        Safefree(cmd->c_label);
X        cmd->c_label = Nullch;
X        }
X        if (cmd->c_short) {
X        str_free(cmd->c_short);
X        cmd->c_short = Nullstr;
X        }
X        if (cmd->c_expr) {
X        arg_free(cmd->c_expr);
X        cmd->c_expr = Nullarg;
X        }
X    }
X    switch (cmd->c_type) {
X    case C_WHILE:
X    case C_BLOCK:
X    case C_ELSE:
X    case C_IF:
X        if (cmd->ucmd.ccmd.cc_true) {
X        cmd_free(cmd->ucmd.ccmd.cc_true);
X        cmd->ucmd.ccmd.cc_true = Nullcmd;
X        }
X        break;
X    case C_EXPR:
X        if (cmd->ucmd.acmd.ac_expr) {
X        arg_free(cmd->ucmd.acmd.ac_expr);
X        cmd->ucmd.acmd.ac_expr = Nullarg;
X        }
X        break;
X    }
X    tofree = cmd;
X    cmd = cmd->c_next;
X    if (tofree != head)        /* to get Saber to shut up */
X        Safefree(tofree);
X    if (cmd && cmd == head)        /* reached end of while loop */
X        break;
X    }
X    Safefree(head);
X}
X
Xarg_free(arg)
Xregister ARG *arg;
X{
X    register int i;
X
X    for (i = 1; i <= arg->arg_len; i++) {
X    switch (arg[i].arg_type & A_MASK) {
X    case A_NULL:
X        if (arg->arg_type == O_TRANS) {
X        Safefree(arg[i].arg_ptr.arg_cval);
X        arg[i].arg_ptr.arg_cval = Nullch;
X        }
X        break;
X    case A_LEXPR:
X        if (arg->arg_type == O_AASSIGN &&
X          arg[i].arg_ptr.arg_arg->arg_type == O_LARRAY) {
X        char *name =
X          stab_name(arg[i].arg_ptr.arg_arg[1].arg_ptr.arg_stab);
X
X        if (strnEQ("_GEN_",name, 5))    /* array for foreach */
X            hdelete(defstash,name,strlen(name));
X        }
X        /* FALL THROUGH */
X    case A_EXPR:
X        arg_free(arg[i].arg_ptr.arg_arg);
X        arg[i].arg_ptr.arg_arg = Nullarg;
X        break;
X    case A_CMD:
X        cmd_free(arg[i].arg_ptr.arg_cmd);
X        arg[i].arg_ptr.arg_cmd = Nullcmd;
X        break;
X    case A_WORD:
X    case A_STAB:
X    case A_LVAL:
X    case A_READ:
X    case A_GLOB:
X    case A_ARYLEN:
X    case A_LARYLEN:
X    case A_ARYSTAB:
X    case A_LARYSTAB:
X        break;
X    case A_SINGLE:
X    case A_DOUBLE:
X    case A_BACKTICK:
X        str_free(arg[i].arg_ptr.arg_str);
X        arg[i].arg_ptr.arg_str = Nullstr;
X        break;
X    case A_SPAT:
X        spat_free(arg[i].arg_ptr.arg_spat);
X        arg[i].arg_ptr.arg_spat = Nullspat;
X        break;
X    }
X    }
X    free_arg(arg);
X}
X
Xspat_free(spat)
Xregister SPAT *spat;
X{
X    register SPAT *sp;
X    HENT *entry;
X
X    if (spat->spat_runtime) {
X    arg_free(spat->spat_runtime);
X    spat->spat_runtime = Nullarg;
X    }
X    if (spat->spat_repl) {
X    arg_free(spat->spat_repl);
X    spat->spat_repl = Nullarg;
X    }
X    if (spat->spat_short) {
X    str_free(spat->spat_short);
X    spat->spat_short = Nullstr;
X    }
X    if (spat->spat_regexp) {
X    regfree(spat->spat_regexp);
X    spat->spat_regexp = Null(REGEXP*);
X    }
X
X    /* now unlink from spat list */
X
X    for (entry = defstash->tbl_array['_']; entry; entry = entry->hent_next) {
X    register HASH *stash;
X    STAB *stab = (STAB*)entry->hent_val;
X
X    if (!stab)
X        continue;
X    stash = stab_hash(stab);
X    if (!stash || stash->tbl_spatroot == Null(SPAT*))
X        continue;
X    if (stash->tbl_spatroot == spat)
X        stash->tbl_spatroot = spat->spat_next;
X    else {
X        for (sp = stash->tbl_spatroot;
X          sp && sp->spat_next != spat;
X          sp = sp->spat_next)
X        ;
X        if (sp)
X        sp->spat_next = spat->spat_next;
X    }
X    }
X    Safefree(spat);
X}
X
X/* Recursively descend a command sequence and push the address of any string
X * that needs saving on recursion onto the tosave array.
X */
X
Xstatic int
Xcmd_tosave(cmd,willsave)
Xregister CMD *cmd;
Xint willsave;                /* willsave passes down the tree */
X{
X    register CMD *head = cmd;
X    int shouldsave = FALSE;        /* shouldsave passes up the tree */
X    int tmpsave;
X    register CMD *lastcmd = Nullcmd;
X
X    while (cmd) {
X    if (cmd->c_expr)
X        shouldsave |= arg_tosave(cmd->c_expr,willsave);
X    switch (cmd->c_type) {
X    case C_WHILE:
X        if (cmd->ucmd.ccmd.cc_true) {
X        tmpsave = cmd_tosave(cmd->ucmd.ccmd.cc_true,willsave);
X
X        /* Here we check to see if the temporary array generated for
X         * a foreach needs to be localized because of recursion.
X         */
X        if (tmpsave && (cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY) {
X            if (lastcmd &&
X              lastcmd->c_type == C_EXPR &&
X              lastcmd->c_expr) {
X            ARG *arg = lastcmd->c_expr;
X
X            if (arg->arg_type == O_ASSIGN &&
X                arg[1].arg_type == A_LEXPR &&
X                arg[1].arg_ptr.arg_arg->arg_type == O_LARRAY &&
X                strnEQ("_GEN_",
X                  stab_name(
X                arg[1].arg_ptr.arg_arg[1].arg_ptr.arg_stab),
X                  5)) {    /* array generated for foreach */
X                (void)localize(arg);
X            }
X            }
X
X            /* in any event, save the iterator */
X
X            (void)apush(tosave,cmd->c_short);
X        }
X        shouldsave |= tmpsave;
X        }
X        break;
X    case C_BLOCK:
X    case C_ELSE:
X    case C_IF:
X        if (cmd->ucmd.ccmd.cc_true)
X        shouldsave |= cmd_tosave(cmd->ucmd.ccmd.cc_true,willsave);
X        break;
X    case C_EXPR:
X        if (cmd->ucmd.acmd.ac_expr)
X        shouldsave |= arg_tosave(cmd->ucmd.acmd.ac_expr,willsave);
X        break;
X    }
X    lastcmd = cmd;
X    cmd = cmd->c_next;
X    if (cmd && cmd == head)        /* reached end of while loop */
X        break;
X    }
X    return shouldsave;
X}
X
Xstatic int
Xarg_tosave(arg,willsave)
Xregister ARG *arg;
Xint willsave;
X{
X    register int i;
X    int shouldsave = FALSE;
X
X    for (i = arg->arg_len; i >= 1; i--) {
X    switch (arg[i].arg_type & A_MASK) {
X    case A_NULL:
X        break;
X    case A_LEXPR:
X    case A_EXPR:
X        shouldsave |= arg_tosave(arg[i].arg_ptr.arg_arg,shouldsave);
X        break;
X    case A_CMD:
X        shouldsave |= cmd_tosave(arg[i].arg_ptr.arg_cmd,shouldsave);
X        break;
X    case A_WORD:
X    case A_STAB:
X    case A_LVAL:
X    case A_READ:
X    case A_GLOB:
X    case A_ARYLEN:
X    case A_SINGLE:
X    case A_DOUBLE:
X    case A_BACKTICK:
X        break;
X    case A_SPAT:
X        shouldsave |= spat_tosave(arg[i].arg_ptr.arg_spat);
X        break;
X    }
X    }
X    switch (arg->arg_type) {
X    case O_RETURN:
X    saw_return = TRUE;
X    break;
X    case O_EVAL:
X    case O_SUBR:
X    shouldsave = TRUE;
X    break;
X    }
X    if (willsave)
X    (void)apush(tosave,arg->arg_ptr.arg_str);
X    return shouldsave;
X}
X
Xstatic int
Xspat_tosave(spat)
Xregister SPAT *spat;
X{
X    int shouldsave = FALSE;
X
X    if (spat->spat_runtime)
X    shouldsave |= arg_tosave(spat->spat_runtime,FALSE);
X    if (spat->spat_repl) {
X    shouldsave |= arg_tosave(spat->spat_repl,FALSE);
X    }
X
X    return shouldsave;
X}
X
!STUFFY!FUNK!
echo Extracting x2p/str.c
sed >x2p/str.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: str.c,v 4.0 91/03/20 01:58:15 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:    str.c,v $
X * Revision 4.0  91/03/20  01:58:15  lwall
X * 4.0 baseline.
X *
X */
X
X#include "handy.h"
X#include "EXTERN.h"
X#include "util.h"
X#include "a2p.h"
X
Xstr_numset(str,num)
Xregister STR *str;
Xdouble num;
X{
X    str->str_nval = num;
X    str->str_pok = 0;        /* invalidate pointer */
X    str->str_nok = 1;        /* validate number */
X}
X
Xchar *
Xstr_2ptr(str)
Xregister STR *str;
X{
X    register char *s;
X
X    if (!str)
X    return "";
X    GROWSTR(&(str->str_ptr), &(str->str_len), 24);
X    s = str->str_ptr;
X    if (str->str_nok) {
X    sprintf(s,"%.20g",str->str_nval);
X    while (*s) s++;
X    }
X    *s = '\0';
X    str->str_cur = s - str->str_ptr;
X    str->str_pok = 1;
X#ifdef DEBUGGING
X    if (debug & 32)
X    fprintf(stderr,"0x%lx ptr(%s)\n",str,str->str_ptr);
X#endif
X    return str->str_ptr;
X}
X
Xdouble
Xstr_2num(str)
Xregister STR *str;
X{
X    if (!str)
X    return 0.0;
X    if (str->str_len && str->str_pok)
X    str->str_nval = atof(str->str_ptr);
X    else
X    str->str_nval = 0.0;
X    str->str_nok = 1;
X#ifdef DEBUGGING
X    if (debug & 32)
X    fprintf(stderr,"0x%lx num(%g)\n",str,str->str_nval);
X#endif
X    return str->str_nval;
X}
X
Xstr_sset(dstr,sstr)
XSTR *dstr;
Xregister STR *sstr;
X{
X    if (!sstr)
X    str_nset(dstr,No,0);
X    else if (sstr->str_nok)
X    str_numset(dstr,sstr->str_nval);
X    else if (sstr->str_pok)
X    str_nset(dstr,sstr->str_ptr,sstr->str_cur);
X    else
X    str_nset(dstr,"",0);
X}
X
Xstr_nset(str,ptr,len)
Xregister STR *str;
Xregister char *ptr;
Xregister int len;
X{
X    GROWSTR(&(str->str_ptr), &(str->str_len), len + 1);
X    bcopy(ptr,str->str_ptr,len);
X    str->str_cur = len;
X    *(str->str_ptr+str->str_cur) = '\0';
X    str->str_nok = 0;        /* invalidate number */
X    str->str_pok = 1;        /* validate pointer */
X}
X
Xstr_set(str,ptr)
Xregister STR *str;
Xregister char *ptr;
X{
X    register int len;
X
X    if (!ptr)
X    ptr = "";
X    len = strlen(ptr);
X    GROWSTR(&(str->str_ptr), &(str->str_len), len + 1);
X    bcopy(ptr,str->str_ptr,len+1);
X    str->str_cur = len;
X    str->str_nok = 0;        /* invalidate number */
X    str->str_pok = 1;        /* validate pointer */
X}
X
Xstr_chop(str,ptr)    /* like set but assuming ptr is in str */
Xregister STR *str;
Xregister char *ptr;
X{
X    if (!(str->str_pok))
X    str_2ptr(str);
X    str->str_cur -= (ptr - str->str_ptr);
X    bcopy(ptr,str->str_ptr, str->str_cur + 1);
X    str->str_nok = 0;        /* invalidate number */
X    str->str_pok = 1;        /* validate pointer */
X}
X
Xstr_ncat(str,ptr,len)
Xregister STR *str;
Xregister char *ptr;
Xregister int len;
X{
X    if (!(str->str_pok))
X    str_2ptr(str);
X    GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + len + 1);
X    bcopy(ptr,str->str_ptr+str->str_cur,len);
X    str->str_cur += len;
X    *(str->str_ptr+str->str_cur) = '\0';
X    str->str_nok = 0;        /* invalidate number */
X    str->str_pok = 1;        /* validate pointer */
X}
X
Xstr_scat(dstr,sstr)
XSTR *dstr;
Xregister STR *sstr;
X{
X    if (!(sstr->str_pok))
X    str_2ptr(sstr);
X    if (sstr)
X    str_ncat(dstr,sstr->str_ptr,sstr->str_cur);
X}
X
Xstr_cat(str,ptr)
Xregister STR *str;
Xregister char *ptr;
X{
X    register int len;
X
X    if (!ptr)
X    return;
X    if (!(str->str_pok))
X    str_2ptr(str);
X    len = strlen(ptr);
X    GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + len + 1);
X    bcopy(ptr,str->str_ptr+str->str_cur,len+1);
X    str->str_cur += len;
X    str->str_nok = 0;        /* invalidate number */
X    str->str_pok = 1;        /* validate pointer */
X}
X
Xchar *
Xstr_append_till(str,from,delim,keeplist)
Xregister STR *str;
Xregister char *from;
Xregister int delim;
Xchar *keeplist;
X{
X    register char *to;
X    register int len;
X
X    if (!from)
X    return Nullch;
X    len = strlen(from);
X    GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + len + 1);
X    str->str_nok = 0;        /* invalidate number */
X    str->str_pok = 1;        /* validate pointer */
X    to = str->str_ptr+str->str_cur;
X    for (; *from; from++,to++) {
X    if (*from == '\\' && from[1] && delim != '\\') {
X        if (!keeplist) {
X        if (from[1] == delim || from[1] == '\\')
X            from++;
X        else
X            *to++ = *from++;
X        }
X        else if (index(keeplist,from[1]))
X        *to++ = *from++;
X        else
X        from++;
X    }
X    else if (*from == delim)
X        break;
X    *to = *from;
X    }
X    *to = '\0';
X    str->str_cur = to - str->str_ptr;
X    return from;
X}
X
XSTR *
Xstr_new(len)
Xint len;
X{
X    register STR *str;
X
X    if (freestrroot) {
X    str = freestrroot;
X    freestrroot = str->str_link.str_next;
X    }
X    else {
X    str = (STR *) safemalloc(sizeof(STR));
X    bzero((char*)str,sizeof(STR));
X    }
X    if (len)
X    GROWSTR(&(str->str_ptr), &(str->str_len), len + 1);
X    return str;
X}
X
Xvoid
Xstr_grow(str,len)
Xregister STR *str;
Xint len;
X{
X    if (len && str)
X    GROWSTR(&(str->str_ptr), &(str->str_len), len + 1);
X}
X
X/* make str point to what nstr did */
X
Xvoid
Xstr_replace(str,nstr)
Xregister STR *str;
Xregister STR *nstr;
X{
X    safefree(str->str_ptr);
X    str->str_ptr = nstr->str_ptr;
X    str->str_len = nstr->str_len;
X    str->str_cur = nstr->str_cur;
X    str->str_pok = nstr->str_pok;
X    if (str->str_nok = nstr->str_nok)
X    str->str_nval = nstr->str_nval;
X    safefree((char*)nstr);
X}
X
Xvoid
Xstr_free(str)
Xregister STR *str;
X{
X    if (!str)
X    return;
X    if (str->str_len)
X    str->str_ptr[0] = '\0';
X    str->str_cur = 0;
X    str->str_nok = 0;
X    str->str_pok = 0;
X    str->str_link.str_next = freestrroot;
X    freestrroot = str;
X}
X
Xstr_len(str)
Xregister STR *str;
X{
X    if (!str)
X    return 0;
X    if (!(str->str_pok))
X    str_2ptr(str);
X    if (str->str_len)
X    return str->str_cur;
X    else
X    return 0;
X}
X
Xchar *
Xstr_gets(str,fp)
Xregister STR *str;
Xregister FILE *fp;
X{
X#ifdef STDSTDIO        /* Here is some breathtakingly efficient cheating */
X
X    register char *bp;        /* we're going to steal some values */
X    register int cnt;        /*  from the stdio struct and put EVERYTHING */
X    register STDCHAR *ptr;    /*   in the innermost loop into registers */
X    register char newline = '\n';    /* (assuming at least 6 registers) */
X    int i;
X    int bpx;
X
X    cnt = fp->_cnt;            /* get count into register */
X    str->str_nok = 0;            /* invalidate number */
X    str->str_pok = 1;            /* validate pointer */
X    if (str->str_len <= cnt)        /* make sure we have the room */
X    GROWSTR(&(str->str_ptr), &(str->str_len), cnt+1);
X    bp = str->str_ptr;            /* move these two too to registers */
X    ptr = fp->_ptr;
X    for (;;) {
X    while (--cnt >= 0) {
X        if ((*bp++ = *ptr++) == newline)
X        if (bp <= str->str_ptr || bp[-2] != '\\')
X            goto thats_all_folks;
X        else {
X            line++;
X            bp -= 2;
X        }
X    }
X
X    fp->_cnt = cnt;            /* deregisterize cnt and ptr */
X    fp->_ptr = ptr;
X    i = _filbuf(fp);        /* get more characters */
X    cnt = fp->_cnt;
X    ptr = fp->_ptr;            /* reregisterize cnt and ptr */
X
X    bpx = bp - str->str_ptr;    /* prepare for possible relocation */
X    GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + cnt + 1);
X    bp = str->str_ptr + bpx;    /* reconstitute our pointer */
X
X    if (i == newline) {        /* all done for now? */
X        *bp++ = i;
X        goto thats_all_folks;
X    }
X    else if (i == EOF)        /* all done for ever? */
X        goto thats_all_folks;
X    *bp++ = i;            /* now go back to screaming loop */
X    }
X
Xthats_all_folks:
X    fp->_cnt = cnt;            /* put these back or we're in trouble */
X    fp->_ptr = ptr;
X    *bp = '\0';
X    str->str_cur = bp - str->str_ptr;    /* set length */
X
X#else /* !STDSTDIO */    /* The big, slow, and stupid way */
X
X    static char buf[4192];
X
X    if (fgets(buf, sizeof buf, fp) != Nullch)
X    str_set(str, buf);
X    else
X    str_set(str, No);
X
X#endif /* STDSTDIO */
X
X    return str->str_cur ? str->str_ptr : Nullch;
X}
X
Xvoid
Xstr_inc(str)
Xregister STR *str;
X{
X    register char *d;
X
X    if (!str)
X    return;
X    if (str->str_nok) {
X    str->str_nval += 1.0;
X    str->str_pok = 0;
X    return;
X    }
X    if (!str->str_pok) {
X    str->str_nval = 1.0;
X    str->str_nok = 1;
X    return;
X    }
X    for (d = str->str_ptr; *d && *d != '.'; d++) ;
X    d--;
X    if (!isdigit(*str->str_ptr) || !isdigit(*d) ) {
X        str_numset(str,atof(str->str_ptr) + 1.0);  /* punt */
X    return;
X    }
X    while (d >= str->str_ptr) {
X    if (++*d <= '9')
X        return;
X    *(d--) = '0';
X    }
X    /* oh,oh, the number grew */
X    GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + 2);
X    str->str_cur++;
X    for (d = str->str_ptr + str->str_cur; d > str->str_ptr; d--)
X    *d = d[-1];
X    *d = '1';
X}
X
Xvoid
Xstr_dec(str)
Xregister STR *str;
X{
X    register char *d;
X
X    if (!str)
X    return;
X    if (str->str_nok) {
X    str->str_nval -= 1.0;
X    str->str_pok = 0;
X    return;
X    }
X    if (!str->str_pok) {
X    str->str_nval = -1.0;
X    str->str_nok = 1;
X    return;
X    }
X    for (d = str->str_ptr; *d && *d != '.'; d++) ;
X    d--;
X    if (!isdigit(*str->str_ptr) || !isdigit(*d) || (*d == '0' && d == str->str_ptr)) {
X        str_numset(str,atof(str->str_ptr) - 1.0);  /* punt */
X    return;
X    }
X    while (d >= str->str_ptr) {
X    if (--*d >= '0')
X        return;
X    *(d--) = '9';
X    }
X}
X
X/* make a string that will exist for the duration of the expression eval */
X
XSTR *
Xstr_mortal(oldstr)
XSTR *oldstr;
X{
X    register STR *str = str_new(0);
X    static long tmps_size = -1;
X
X    str_sset(str,oldstr);
X    if (++tmps_max > tmps_size) {
X    tmps_size = tmps_max;
X    if (!(tmps_size & 127)) {
X        if (tmps_size)
X        tmps_list = (STR**)saferealloc((char*)tmps_list,
X            (tmps_size + 128) * sizeof(STR*) );
X        else
X        tmps_list = (STR**)safemalloc(128 * sizeof(char*));
X    }
X    }
X    tmps_list[tmps_max] = str;
X    return str;
X}
X
XSTR *
Xstr_make(s)
Xchar *s;
X{
X    register STR *str = str_new(0);
X
X    str_set(str,s);
X    return str;
X}
X
XSTR *
Xstr_nmake(n)
Xdouble n;
X{
X    register STR *str = str_new(0);
X
X    str_numset(str,n);
X    return str;
X}
!STUFFY!FUNK!
echo Extracting msdos/Changes.dds
sed >msdos/Changes.dds <<'!STUFFY!FUNK!' -e 's/X//'
XThese are the changes done by the `patches' file:
X
X[These patches have been applied, more or less, so I don't supply the
Xpatches file--law]
X
XCompilation of some portions is done conditional on the definition
Xof the following symbols:
X
XBINARY        Enables the usage of setmode under MSDOS (added binmode command)
XBUGGY_MSC    Adds #pragma_function(memset) to avoid internal compiler error
XCHOWN        Enables chown
XCHROOT        Enables chroot
XFORK        Enables fork and changes the compilation of system
XGETLOGIN    Enables getlogin
XGETPPID        Enables getppid
XGROUP        Enables all the group access functions
XKILL        Enables kill
XLINK        Enables link
XPASSWD        Enables all the password access functions
XPIPE        Enables the pipe function
XWAIT        Enables the wait function
XUMASK        Enables the umask function
X
XS_IFBLK *    Enables the block special device check
XS_ISGID *    Enables the setgid check
XS_ISUID *    Enables the setuid check
XS_ISVTX *    Enables the vtx check
Xunix *        Compiles globbing for Unix
XMSDOS *        Compiles globbing for MS-DOS
X        Closes stdaux and stdprn on startup
X        Adds a copyright message for -v
X        Disables the compilation of my_popen, my_pclose as the
X        are in a separate file.
X
XSymbols marked with * are defined in the compilation environment.  The
Xrest should be added to config.h (config.h.SH).  All functions when not
Xsupported give a fatal error.
X
XAdded documentation for the binmode function in the manual.
X
XFixed the following bugs:
X
XIn eval.c function eval if ioctl or fcntl returned something
Xother than 0 or -1 the result was a random number as the
Xdouble `value' variable wasn't set to `anum'.
X
XIn doio.c function do_exec there were two errors associated with
Xfiring up the shell when the execv fails.  First argv was not freed,
Xsecondly an attempt was made to start up the shell with the cmd
Xstring that was now cut to pieces for the execv.  Also the maxible
Xpossible length of argv was calculated by (s - cmd).  Problem was
Xthat s was not pointing to the end of the string, but to the first
Xnon alpha.
X
X[These are incorporated in patches 15 and 16--law]
X
XDiomidis Spinellis, March 1990
!STUFFY!FUNK!
echo " "
echo "End of kit 13 (of 36)"
cat /dev/null >kit13isdone
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 25 26 27 28 29 30 31 32 33 34 35 36; 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."
    for combo in *:AA; do
        if test -f "$combo"; then
        realfile=`basename $combo :AA`
        cat $realfile:[A-Z][A-Z] >$realfile
        rm -rf $realfile:[A-Z][A-Z]
        fi
    done
    rm -rf kit*isdone
    chmod 755 Configure
    ;;
    *)  echo "You have run$run."
    echo "You still need to run$todo."
    ;;
esac
: Someone might mail this, so...
exit

exit 0 # Just in case...
--
Kent Landfield                   INTERNET: [e-mail]
Sterling Software, IMD           UUCP:     uunet!sparky!kent
Phone:    [phone]         FAX:      [phone]
Please send comp.sources.misc-related mail to [e-mail].