Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/unix/volume15/perl2/part01

Internet Message Format | 1989-01-05 | 49.0 KB

Subject:  v15i090:  Perl, release 2, Part01/15
Newsgroups: comp.sources.unix
Sender: sources
Approved: [e-mail]

Submitted-by: Larry Wall <[e-mail]>
Posting-number: Volume 15, Issue 90
Archive-name: perl2/part01

#! /bin/sh

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

echo "This is perl 2.0 kit 1 (of 15).  If kit 1 is complete, the line"
echo '"'"End of kit 1 (of 15)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir eg eg/g t 2>/dev/null
echo Extracting README
sed >README <<'!STUFFY!FUNK!' -e 's/X//'
X
X            Perl Kit, Version 2.0
X
X            Copyright (c) 1988, Larry Wall
X
XYou may copy the perl kit in whole or in part as long as you don't try to
Xmake money off it, or pretend that you wrote it.
X--------------------------------------------------------------------------
X
XPerl is a language that combines some of the features of C, sed, awk and shell.
XSee the manual page for more hype.
X
XPerl will probably not run on machines with a small address space.
X
XPlease read all the directions below before you proceed any further, and
Xthen follow them carefully.  Failure to do so may void your warranty. :-)
X
XAfter you have unpacked your kit, you should have all the files listed
Xin MANIFEST.
X
XInstallation
X
X1)  Run Configure.  This will figure out various things about your system.
X    Some things Configure will figure out for itself, other things it will
X    ask you about.  It will then proceed to make config.h, config.sh, and
X    Makefile.
X
X    You might possibly have to trim # comments from the front of Configure
X    if your sh doesn't handle them, but all other # comments will be taken
X    care of.
X
X    (If you don't have sh, you'll have to copy the sample file config.H to
X    config.h and edit the config.h to reflect your system's peculiarities.)
X
X2)  Glance through config.h to make sure system dependencies are correct.
X    Most of them should have been taken care of by running the Configure script.
X
X    If you have any additional changes to make to the C definitions, they
X    can be done in the Makefile, or in config.h.  Bear in mind that they will
X    get undone next time you run Configure.
X
X3)  make depend
X
X    This will look for all the includes and modify Makefile accordingly.
X    Configure will offer to do this for you.
X
X4)  make
X
X    This will attempt to make perl in the current directory.
X
X5)  make test
X
X    This will run the regression tests on the perl you just made.
X    If it doesn't say "All tests successful" then something went wrong.
X    See the README in the t subdirectory.  Note that you can't run it
X    in background if this disables opening of /dev/tty.  If in doubt, just
X    cd to the t directory and run TEST by hand.
X
X6)  make install
X
X    This will put perl into a public directory (normally /usr/local/bin).
X    It will also try to put the man pages in a reasonable place.  It will not
X    nroff the man page, however.  You may need to be root to do this.  If
X    you are not root, you must own the directories in question and you should
X    ignore any messages about chown not working.
X
X7)  Read the manual entry before running perl.
X
X8)  Go down to the x2p directory and do a "make depend, a "make" and a
X    "make install" to create the awk to perl and sed to perl translators.
X
X9)  IMPORTANT!  Help save the world!  Communicate any problems and suggested
X    patches to me, [e-mail] (Larry Wall), so we can
X    keep the world in sync.  If you have a problem, there's someone else
X    out there who either has had or will have the same problem.
X
X    If possible, send in patches such that the patch program will apply them.
X    Context diffs are the best, then normal diffs.  Don't send ed scripts--
X    I've probably changed my copy since the version you have.
X
X    Watch for perl patches in comp.sources.bugs.  Patches will generally be
X    in a form usable by the patch program.  If you are just now bringing up
X    perl and aren't sure how many patches there are, write to me and I'll
X    send any you don't have.  Your current patch level is shown in patchlevel.h.
X
!STUFFY!FUNK!
echo Extracting eg/README
sed >eg/README <<'!STUFFY!FUNK!' -e 's/X//'
XThis stuff is supplied on an as-is basis--little attempt has been made to make
Xany of it portable.  It's mostly here to give you an idea of what perl code
Xlooks like, and what tricks and idioms are used.
X
XSystem administrators responsible for many computers will enjoy the items
Xdown in the g directory very much.  The scan directory contains the beginnings
Xof a system to check on and report various kinds of anomalies.
X
XIf you machine doesn't support #!, the first thing you'll want to do is
Xreplace the #! with a couple of lines that look like this:
X
X    eval "exec /usr/bin/perl -S $0 $*"
X        if $running_under_some_shell;
X
Xbeing sure to include any flags that were on the #! line.  A supplied script
Xcalled "nih" will translate perl scripts in place for you:
X
X    nih g/g??
!STUFFY!FUNK!
echo Extracting t/README
sed >t/README <<'!STUFFY!FUNK!' -e 's/X//'
XThis is the perl test library.  To run all the tests, just type 'TEST'.
X
XTo add new tests, just look at the current tests and do likewise.
X
XIf a test fails, run it by itself to see if it prints any informative
Xdiagnostics.  If not, modify the test to print informative diagnostics.
XIf you put out extra lines with a '#' character on the front, you don't
Xhave to worry about removing the extra print statements later since TEST
Xignores lines beginning with '#'.
X
XIf you come up with new tests, send them to [e-mail].
!STUFFY!FUNK!
echo Extracting arg.c
sed >arg.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: arg.c,v 2.0 88/06/05 00:08:04 root Exp $
X *
X * $Log:    arg.c,v $
X * Revision 2.0  88/06/05  00:08:04  root
X * Baseline version 2.0.
X *
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X
X#include <signal.h>
X#include <errno.h>
X
Xextern int errno;
X
XSTR *
Xdo_match(arg,retary,sarg,ptrmaxsarg,sargoff,cushion)
Xregister ARG *arg;
XSTR ***retary;
Xregister STR **sarg;
Xint *ptrmaxsarg;
Xint sargoff;
Xint cushion;
X{
X    register SPAT *spat = arg[2].arg_ptr.arg_spat;
X    register char *t;
X    register char *s = str_get(sarg[1]);
X    char *strend = s + sarg[1]->str_cur;
X
X    if (!spat)
X    return &str_yes;
X    if (!s)
X    fatal("panic: do_match");
X    if (retary) {
X    *retary = sarg;        /* assume no match */
X    *ptrmaxsarg = sargoff;
X    }
X    if (spat->spat_flags & SPAT_USED) {
X#ifdef DEBUGGING
X    if (debug & 8)
X        deb("2.SPAT USED\n");
X#endif
X    return &str_no;
X    }
X    if (spat->spat_runtime) {
X    t = str_get(eval(spat->spat_runtime,Null(STR***),-1));
X#ifdef DEBUGGING
X    if (debug & 8)
X        deb("2.SPAT /%s/\n",t);
X#endif
X    spat->spat_regexp = regcomp(t,spat->spat_flags & SPAT_FOLD,1);
X    if (!*spat->spat_regexp->precomp && lastspat)
X        spat = lastspat;
X    if (regexec(spat->spat_regexp, s, strend, TRUE, 0,
X      sarg[1]->str_pok & 4 ? sarg[1] : Nullstr)) {
X        if (spat->spat_regexp->subbase)
X        curspat = spat;
X        lastspat = spat;
X        goto gotcha;
X    }
X    else
X        return &str_no;
X    }
X    else {
X#ifdef DEBUGGING
X    if (debug & 8) {
X        char ch;
X
X        if (spat->spat_flags & SPAT_ONCE)
X        ch = '?';
X        else
X        ch = '/';
X        deb("2.SPAT %c%s%c\n",ch,spat->spat_regexp->precomp,ch);
X    }
X#endif
X    if (!*spat->spat_regexp->precomp && lastspat)
X        spat = lastspat;
X    t = s;
X    if (hint) {
X        if (hint < s || hint > strend)
X        fatal("panic: hint in do_match");
X        s = hint;
X        hint = Nullch;
X        if (spat->spat_regexp->regback >= 0) {
X        s -= spat->spat_regexp->regback;
X        if (s < t)
X            s = t;
X        }
X        else
X        s = t;
X    }
X    else if (spat->spat_short) {
X        if (spat->spat_flags & SPAT_SCANFIRST) {
X        if (sarg[1]->str_pok == 5) {
X            if (screamfirst[spat->spat_short->str_rare] < 0)
X            goto nope;
X            else if (!(s = screaminstr(sarg[1],spat->spat_short)))
X            goto nope;
X            else if (spat->spat_flags & SPAT_ALL)
X            goto yup;
X        }
X        else if (!(s = fbminstr(s, strend, spat->spat_short)))
X            goto nope;
X        else if (spat->spat_flags & SPAT_ALL)
X            goto yup;
X        else if (spat->spat_regexp->regback >= 0) {
X            ++*(long*)&spat->spat_short->str_nval;
X            s -= spat->spat_regexp->regback;
X            if (s < t)
X            s = t;
X        }
X        else
X            s = t;
X        }
X        else if (!multiline && (*spat->spat_short->str_ptr != *s ||
X          strnNE(spat->spat_short->str_ptr, s, spat->spat_slen) ))
X        goto nope;
X        if (--*(long*)&spat->spat_short->str_nval < 0) {
X        str_free(spat->spat_short);
X        spat->spat_short = Nullstr;    /* opt is being useless */
X        }
X    }
X    if (regexec(spat->spat_regexp, s, strend, s == t, 0,
X      sarg[1]->str_pok & 4 ? sarg[1] : Nullstr)) {
X        if (spat->spat_regexp->subbase)
X        curspat = spat;
X        lastspat = spat;
X        if (spat->spat_flags & SPAT_ONCE)
X        spat->spat_flags |= SPAT_USED;
X        goto gotcha;
X    }
X    else
X        return &str_no;
X    }
X    /*NOTREACHED*/
X
X  gotcha:
X    if (retary && curspat == spat) {
X    int iters, i, len;
X
X    iters = spat->spat_regexp->nparens;
X    *ptrmaxsarg = iters + sargoff;
X    sarg = (STR**)saferealloc((char*)(sarg - sargoff),
X      (iters+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
X
X    for (i = 1; i <= iters; i++) {
X        sarg[i] = str_static(&str_no);
X        if (s = spat->spat_regexp->startp[i]) {
X        len = spat->spat_regexp->endp[i] - s;
X        if (len > 0)
X            str_nset(sarg[i],s,len);
X        }
X    }
X    *retary = sarg;
X    }
X    return &str_yes;
X
Xyup:
X    ++*(long*)&spat->spat_short->str_nval;
X    return &str_yes;
X
Xnope:
X    ++*(long*)&spat->spat_short->str_nval;
X    return &str_no;
X}
X
Xint
Xdo_subst(str,arg)
XSTR *str;
Xregister ARG *arg;
X{
X    register SPAT *spat;
X    register STR *dstr;
X    register char *s = str_get(str);
X    char *strend = s + str->str_cur;
X    register char *m;
X
X    spat = arg[2].arg_ptr.arg_spat;
X    if (!spat || !s)
X    fatal("panic: do_subst");
X    else if (spat->spat_runtime) {
X    m = str_get(eval(spat->spat_runtime,Null(STR***),-1));
X    spat->spat_regexp = regcomp(m,spat->spat_flags & SPAT_FOLD,1);
X    }
X#ifdef DEBUGGING
X    if (debug & 8) {
X    deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
X    }
X#endif
X    if (!*spat->spat_regexp->precomp && lastspat)
X    spat = lastspat;
X    m = s;
X    if (hint) {
X    if (hint < s || hint > strend)
X        fatal("panic: hint in do_match");
X    s = hint;
X    hint = Nullch;
X    if (spat->spat_regexp->regback >= 0) {
X        s -= spat->spat_regexp->regback;
X        if (s < m)
X        s = m;
X    }
X    else
X        s = m;
X    }
X    else if (spat->spat_short) {
X    if (spat->spat_flags & SPAT_SCANFIRST) {
X        if (str->str_pok == 5) {
X        if (screamfirst[spat->spat_short->str_rare] < 0)
X            goto nope;
X        else if (!(s = screaminstr(str,spat->spat_short)))
X            goto nope;
X        }
X        else if (!(s = fbminstr(s, strend, spat->spat_short)))
X        goto nope;
X        else if (spat->spat_regexp->regback >= 0) {
X        ++*(long*)&spat->spat_short->str_nval;
X        s -= spat->spat_regexp->regback;
X        if (s < m)
X            s = m;
X        }
X        else
X        s = m;
X    }
X    else if (!multiline && (*spat->spat_short->str_ptr != *s ||
X      strnNE(spat->spat_short->str_ptr, s, spat->spat_slen) ))
X        goto nope;
X    if (--*(long*)&spat->spat_short->str_nval < 0) {
X        str_free(spat->spat_short);
X        spat->spat_short = Nullstr;    /* opt is being useless */
X    }
X    }
X    if (regexec(spat->spat_regexp, s, strend, s == m, 1,
X      str->str_pok & 4 ? str : Nullstr)) {
X    int iters = 0;
X
X    dstr = str_new(str_len(str));
X    str_nset(dstr,m,s-m);
X    if (spat->spat_regexp->subbase)
X        curspat = spat;
X    lastspat = spat;
X    do {
X        m = spat->spat_regexp->startp[0];
X        if (iters++ > 10000)
X        fatal("Substitution loop");
X        if (spat->spat_regexp->subbase)
X        s = spat->spat_regexp->subbase;
X        str_ncat(dstr,s,m-s);
X        s = spat->spat_regexp->endp[0];
X        str_scat(dstr,eval(spat->spat_repl,Null(STR***),-1));
X        if (spat->spat_flags & SPAT_ONCE)
X        break;
X    } while (regexec(spat->spat_regexp, s, strend, FALSE, 1, Nullstr));
X    str_cat(dstr,s);
X    str_replace(str,dstr);
X    STABSET(str);
X    return iters;
X    }
X    return 0;
X
Xnope:
X    ++*(long*)&spat->spat_short->str_nval;
X    return 0;
X}
X
Xint
Xdo_trans(str,arg)
XSTR *str;
Xregister ARG *arg;
X{
X    register char *tbl;
X    register char *s;
X    register int matches = 0;
X    register int ch;
X
X    tbl = arg[2].arg_ptr.arg_cval;
X    s = str_get(str);
X    if (!tbl || !s)
X    fatal("panic: do_trans");
X#ifdef DEBUGGING
X    if (debug & 8) {
X    deb("2.TBL\n");
X    }
X#endif
X    while (*s) {
X    if (ch = tbl[*s & 0377]) {
X        matches++;
X        *s = ch;
X    }
X    s++;
X    }
X    STABSET(str);
X    return matches;
X}
X
Xint
Xdo_split(spat,retary,sarg,ptrmaxsarg,sargoff,cushion)
Xregister SPAT *spat;
XSTR ***retary;
Xregister STR **sarg;
Xint *ptrmaxsarg;
Xint sargoff;
Xint cushion;
X{
X    register char *s = str_get(sarg[1]);
X    char *strend = s + sarg[1]->str_cur;
X    register STR *dstr;
X    register char *m;
X    register ARRAY *ary;
X    static ARRAY *myarray = Null(ARRAY*);
X    int iters = 0;
X    int i;
X
X    if (!spat || !s)
X    fatal("panic: do_split");
X    else if (spat->spat_runtime) {
X    m = str_get(eval(spat->spat_runtime,Null(STR***),-1));
X    if (!*m || (*m == ' ' && !m[1])) {
X        m = "\\s+";
X        spat->spat_flags |= SPAT_SKIPWHITE;
X    }
X    if (spat->spat_runtime->arg_type == O_ITEM &&
X      spat->spat_runtime[1].arg_type == A_SINGLE) {
X        arg_free(spat->spat_runtime);    /* it won't change, so */
X        spat->spat_runtime = Nullarg;    /* no point compiling again */
X    }
X    spat->spat_regexp = regcomp(m,spat->spat_flags & SPAT_FOLD,1);
X    }
X#ifdef DEBUGGING
X    if (debug & 8) {
X    deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
X    }
X#endif
X    if (retary)
X    ary = myarray;
X    else
X    ary = spat->spat_repl[1].arg_ptr.arg_stab->stab_array;
X    if (!ary)
X    myarray = ary = anew(Nullstab);
X    ary->ary_fill = -1;
X    if (spat->spat_flags & SPAT_SKIPWHITE) {
X    while (isspace(*s))
X        s++;
X    }
X    if (spat->spat_short) {
X    i = spat->spat_short->str_cur;
X    while (*s && (m = fbminstr(s, strend, spat->spat_short))) {
X        dstr = str_new(m-s);
X        str_nset(dstr,s,m-s);
X        astore(ary, iters++, dstr);
X        if (iters > 10000)
X        fatal("Substitution loop");
X        s = m + i;
X    }
X    }
X    else {
X    while (*s && regexec(spat->spat_regexp, s, strend, (iters == 0), 1,
X      Nullstr)) {
X        m = spat->spat_regexp->startp[0];
X        if (spat->spat_regexp->subbase)
X        s = spat->spat_regexp->subbase;
X        dstr = str_new(m-s);
X        str_nset(dstr,s,m-s);
X        astore(ary, iters++, dstr);
X        if (iters > 10000)
X        fatal("Substitution loop");
X        s = spat->spat_regexp->endp[0];
X    }
X    }
X    if (*s) {            /* ignore field after final "whitespace" */
X    dstr = str_new(0);    /*   if they interpolate, it's null anyway */
X    str_set(dstr,s);
X    astore(ary, iters++, dstr);
X    }
X    else {
X    while (iters > 0 && !*str_get(afetch(ary,iters-1)))
X        iters--;
X    }
X    if (retary) {
X    *ptrmaxsarg = iters + sargoff;
X    sarg = (STR**)saferealloc((char*)(sarg - sargoff),
X      (iters+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
X
X    for (i = 1; i <= iters; i++)
X        sarg[i] = afetch(ary,i-1);
X    *retary = sarg;
X    }
X    return iters;
X}
X
Xvoid
Xdo_join(arg,delim,str)
Xregister ARG *arg;
Xregister char *delim;
Xregister STR *str;
X{
X    STR **tmpary;    /* must not be register */
X    register STR **elem;
X    register int items;
X
X    (void)eval(arg[2].arg_ptr.arg_arg,&tmpary,-1);
X    items = (int)str_gnum(*tmpary);
X    elem = tmpary+1;
X    if (items-- > 0)
X    str_sset(str,*elem++);
X    for (; items > 0; items--,elem++) {
X    str_cat(str,delim);
X    str_scat(str,*elem);
X    }
X    STABSET(str);
X    safefree((char*)tmpary);
X}
X
XFILE *
Xforkopen(name,mode)
Xchar *name;
Xchar *mode;
X{
X    int pfd[2];
X
X    if (pipe(pfd) < 0)
X    return Nullfp;
X    while ((forkprocess = fork()) == -1) {
X    if (errno != EAGAIN)
X        return Nullfp;
X    sleep(5);
X    }
X    if (*mode == 'w') {
X    if (forkprocess) {
X        close(pfd[0]);
X        return fdopen(pfd[1],"w");
X    }
X    else {
X        close(pfd[1]);
X        close(0);
X        dup(pfd[0]);    /* substitute our pipe for stdin */
X        close(pfd[0]);
X        return Nullfp;
X    }
X    }
X    else {
X    if (forkprocess) {
X        close(pfd[1]);
X        return fdopen(pfd[0],"r");
X    }
X    else {
X        close(pfd[0]);
X        close(1);
X        if (dup(pfd[1]) == 0)
X        dup(pfd[1]);    /* substitute our pipe for stdout */
X        close(pfd[1]);
X        return Nullfp;
X    }
X    }
X}
X
Xbool
Xdo_open(stab,name)
XSTAB *stab;
Xregister char *name;
X{
X    FILE *fp;
X    int len = strlen(name);
X    register STIO *stio = stab->stab_io;
X    char *myname = savestr(name);
X    int result;
X    int fd;
X
X    name = myname;
X    forkprocess = 1;        /* assume true if no fork */
X    while (len && isspace(name[len-1]))
X    name[--len] = '\0';
X    if (!stio)
X    stio = stab->stab_io = stio_new();
X    if (stio->fp) {
X    fd = fileno(stio->fp);
X    if (stio->type == '|')
X        result = pclose(stio->fp);
X    else if (stio->type != '-')
X        result = fclose(stio->fp);
X    else
X        result = 0;
X    if (result == EOF && fd > 2)
X        fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
X          stab->stab_name);
X    stio->fp = Nullfp;
X    }
X    stio->type = *name;
X    if (*name == '|') {
X    for (name++; isspace(*name); name++) ;
X    if (strNE(name,"-"))
X        fp = popen(name,"w");
X    else {
X        fp = forkopen(name,"w");
X        stio->subprocess = forkprocess;
X        stio->type = '%';
X    }
X    }
X    else if (*name == '>' && name[1] == '>') {
X    stio->type = 'a';
X    for (name += 2; isspace(*name); name++) ;
X    fp = fopen(name,"a");
X    }
X    else if (*name == '>' && name[1] == '&') {
X    for (name += 2; isspace(*name); name++) ;
X    if (isdigit(*name))
X        fd = atoi(name);
X    else {
X        stab = stabent(name,FALSE);
X        if (stab->stab_io && stab->stab_io->fp) {
X        fd = fileno(stab->stab_io->fp);
X        stio->type = stab->stab_io->type;
X        }
X        else
X        fd = -1;
X    }
X    fp = fdopen(dup(fd),stio->type == 'a' ? "a" :
X      (stio->type == '<' ? "r" : "w") );
X    }
X    else if (*name == '>') {
X    for (name++; isspace(*name); name++) ;
X    if (strEQ(name,"-")) {
X        fp = stdout;
X        stio->type = '-';
X    }
X    else
X        fp = fopen(name,"w");
X    }
X    else {
X    if (*name == '<') {
X        for (name++; isspace(*name); name++) ;
X        if (strEQ(name,"-")) {
X        fp = stdin;
X        stio->type = '-';
X        }
X        else
X        fp = fopen(name,"r");
X    }
X    else if (name[len-1] == '|') {
X        name[--len] = '\0';
X        while (len && isspace(name[len-1]))
X        name[--len] = '\0';
X        for (; isspace(*name); name++) ;
X        if (strNE(name,"-")) {
X        fp = popen(name,"r");
X        stio->type = '|';
X        }
X        else {
X        fp = forkopen(name,"r");
X        stio->subprocess = forkprocess;
X        stio->type = '%';
X        }
X    }
X    else {
X        stio->type = '<';
X        for (; isspace(*name); name++) ;
X        if (strEQ(name,"-")) {
X        fp = stdin;
X        stio->type = '-';
X        }
X        else
X        fp = fopen(name,"r");
X    }
X    }
X    safefree(myname);
X    if (!fp)
X    return FALSE;
X    if (stio->type &&
X      stio->type != '|' && stio->type != '-' && stio->type != '%') {
X    if (fstat(fileno(fp),&statbuf) < 0) {
X        fclose(fp);
X        return FALSE;
X    }
X    if ((statbuf.st_mode & S_IFMT) != S_IFREG &&
X        (statbuf.st_mode & S_IFMT) != S_IFCHR) {
X        fclose(fp);
X        return FALSE;
X    }
X    }
X    stio->fp = fp;
X    return TRUE;
X}
X
XFILE *
Xnextargv(stab)
Xregister STAB *stab;
X{
X    register STR *str;
X    char *oldname;
X    int filemode,fileuid,filegid;
X
X    while (alen(stab->stab_array) >= 0) {
X    str = ashift(stab->stab_array);
X    str_sset(stab->stab_val,str);
X    STABSET(stab->stab_val);
X    oldname = str_get(stab->stab_val);
X    if (do_open(stab,oldname)) {
X        if (inplace) {
X        filemode = statbuf.st_mode;
X        fileuid = statbuf.st_uid;
X        filegid = statbuf.st_gid;
X        if (*inplace) {
X            str_cat(str,inplace);
X#ifdef RENAME
X            rename(oldname,str->str_ptr);
X#else
X            UNLINK(str->str_ptr);
X            link(oldname,str->str_ptr);
X            UNLINK(oldname);
X#endif
X        }
X        else {
X            UNLINK(oldname);
X        }
X        sprintf(tokenbuf,">%s",oldname);
X        errno = 0;        /* in case sprintf set errno */
X        do_open(argvoutstab,tokenbuf);
X        defoutstab = argvoutstab;
X#ifdef FCHMOD
X        fchmod(fileno(argvoutstab->stab_io->fp),filemode);
X#else
X        chmod(oldname,filemode);
X#endif
X#ifdef FCHOWN
X        fchown(fileno(argvoutstab->stab_io->fp),fileuid,filegid);
X#else
X        chown(oldname,fileuid,filegid);
X#endif
X        }
X        str_free(str);
X        return stab->stab_io->fp;
X    }
X    else
X        fprintf(stderr,"Can't open %s\n",str_get(str));
X    str_free(str);
X    }
X    if (inplace) {
X    do_close(argvoutstab,FALSE);
X    defoutstab = stabent("stdout",TRUE);
X    }
X    return Nullfp;
X}
X
Xbool
Xdo_close(stab,explicit)
XSTAB *stab;
Xbool explicit;
X{
X    bool retval = FALSE;
X    register STIO *stio = stab->stab_io;
X    int status;
X    int tmp;
X
X    if (!stio) {        /* never opened */
X    if (dowarn && explicit)
X        warn("Close on unopened file <%s>",stab->stab_name);
X    return FALSE;
X    }
X    if (stio->fp) {
X    if (stio->type == '|')
X        retval = (pclose(stio->fp) >= 0);
X    else if (stio->type == '-')
X        retval = TRUE;
X    else {
X        retval = (fclose(stio->fp) != EOF);
X        if (stio->type == '%' && stio->subprocess) {
X        while ((tmp = wait(&status)) != stio->subprocess && tmp != -1)
X            ;
X        if (tmp == -1)
X            statusvalue = -1;
X        else
X            statusvalue = (unsigned)status & 0xffff;
X        }
X    }
X    stio->fp = Nullfp;
X    }
X    if (explicit)
X    stio->lines = 0;
X    stio->type = ' ';
X    return retval;
X}
X
Xbool
Xdo_eof(stab)
XSTAB *stab;
X{
X    register STIO *stio;
X    int ch;
X
X    if (!stab)            /* eof() */
X    stio = argvstab->stab_io;
X    else
X    stio = stab->stab_io;
X
X    if (!stio)
X    return TRUE;
X
X    while (stio->fp) {
X
X#ifdef STDSTDIO            /* (the code works without this) */
X    if (stio->fp->_cnt)        /* cheat a little, since */
X        return FALSE;        /* this is the most usual case */
X#endif
X
X    ch = getc(stio->fp);
X    if (ch != EOF) {
X        ungetc(ch, stio->fp);
X        return FALSE;
X    }
X    if (!stab) {            /* not necessarily a real EOF yet? */
X        if (!nextargv(argvstab))    /* get another fp handy */
X        return TRUE;
X    }
X    else
X        return TRUE;        /* normal fp, definitely end of file */
X    }
X    return TRUE;
X}
X
Xlong
Xdo_tell(stab)
XSTAB *stab;
X{
X    register STIO *stio;
X
X    if (!stab)
X    goto phooey;
X
X    stio = stab->stab_io;
X    if (!stio || !stio->fp)
X    goto phooey;
X
X    return ftell(stio->fp);
X
Xphooey:
X    if (dowarn)
X    warn("tell() on unopened file");
X    return -1L;
X}
X
Xbool
Xdo_seek(stab, pos, whence)
XSTAB *stab;
Xlong pos;
Xint whence;
X{
X    register STIO *stio;
X
X    if (!stab)
X    goto nuts;
X
X    stio = stab->stab_io;
X    if (!stio || !stio->fp)
X    goto nuts;
X
X    return fseek(stio->fp, pos, whence) >= 0;
X
Xnuts:
X    if (dowarn)
X    warn("seek() on unopened file");
X    return FALSE;
X}
X
Xstatic CMD *sortcmd;
Xstatic STAB *firststab = Nullstab;
Xstatic STAB *secondstab = Nullstab;
X
Xdo_sort(arg,stab,retary,sarg,ptrmaxsarg,sargoff,cushion)
Xregister ARG *arg;
XSTAB *stab;
XSTR ***retary;
Xregister STR **sarg;
Xint *ptrmaxsarg;
Xint sargoff;
Xint cushion;
X{
X    STR **tmpary;    /* must not be register */
X    register STR **elem;
X    register bool retval;
X    register int max;
X    register int i;
X    int sortcmp();
X    int sortsub();
X    STR *oldfirst;
X    STR *oldsecond;
X
X    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary,-1);
X    max = (int)str_gnum(*tmpary);
X
X    if (retary) {
X    sarg = (STR**)saferealloc((char*)(sarg - sargoff),
X      (max+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
X    for (i = 1; i <= max; i++)
X        sarg[i] = tmpary[i];
X    *retary = sarg;
X    if (max > 1) {
X        if (stab->stab_sub && (sortcmd = stab->stab_sub->cmd)) {
X        if (!firststab) {
X            firststab = stabent("a",TRUE);
X            secondstab = stabent("b",TRUE);
X        }
X        oldfirst = firststab->stab_val;
X        oldsecond = secondstab->stab_val;
X        qsort((char*)(sarg+1),max,sizeof(STR*),sortsub);
X        firststab->stab_val = oldfirst;
X        secondstab->stab_val = oldsecond;
X        }
X        else
X        qsort((char*)(sarg+1),max,sizeof(STR*),sortcmp);
X    }
X    while (max > 0 && !sarg[max])
X        max--;
X    *ptrmaxsarg = max + sargoff;
X    }
X    safefree((char*)tmpary);
X    return max;
X}
X
Xint
Xsortcmp(str1,str2)
XSTR **str1;
XSTR **str2;
X{
X    char *tmps;
X
X    if (!*str1)
X    return -1;
X    if (!*str2)
X    return 1;
X    tmps = str_get(*str1);
X    return strcmp(tmps,str_get(*str2));
X}
X
Xint
Xsortsub(str1,str2)
XSTR **str1;
XSTR **str2;
X{
X    STR *str;
X
X    if (!*str1)
X    return -1;
X    if (!*str2)
X    return 1;
X    firststab->stab_val = *str1;
X    secondstab->stab_val = *str2;
X    return (int)str_gnum(cmd_exec(sortcmd));
X}
X
Xdo_stat(arg,retary,sarg,ptrmaxsarg,sargoff,cushion)
Xregister ARG *arg;
XSTR ***retary;
Xregister STR **sarg;
Xint *ptrmaxsarg;
Xint sargoff;
Xint cushion;
X{
X    register ARRAY *ary;
X    static ARRAY *myarray = Null(ARRAY*);
X    int max = 13;
X    register int i;
X
X    ary = myarray;
X    if (!ary)
X    myarray = ary = anew(Nullstab);
X    ary->ary_fill = -1;
X    if (arg[1].arg_type == A_LVAL) {
X    tmpstab = arg[1].arg_ptr.arg_stab;
X    if (!tmpstab->stab_io ||
X      fstat(fileno(tmpstab->stab_io->fp),&statbuf) < 0) {
X        max = 0;
X    }
X    }
X    else
X    if (stat(str_get(sarg[1]),&statbuf) < 0)
X        max = 0;
X
X    if (retary) {
X    if (max) {
X        apush(ary,str_nmake((double)statbuf.st_dev));
X        apush(ary,str_nmake((double)statbuf.st_ino));
X        apush(ary,str_nmake((double)statbuf.st_mode));
X        apush(ary,str_nmake((double)statbuf.st_nlink));
X        apush(ary,str_nmake((double)statbuf.st_uid));
X        apush(ary,str_nmake((double)statbuf.st_gid));
X        apush(ary,str_nmake((double)statbuf.st_rdev));
X        apush(ary,str_nmake((double)statbuf.st_size));
X        apush(ary,str_nmake((double)statbuf.st_atime));
X        apush(ary,str_nmake((double)statbuf.st_mtime));
X        apush(ary,str_nmake((double)statbuf.st_ctime));
X#ifdef STATBLOCKS
X        apush(ary,str_nmake((double)statbuf.st_blksize));
X        apush(ary,str_nmake((double)statbuf.st_blocks));
X#else
X        apush(ary,str_make(""));
X        apush(ary,str_make(""));
X#endif
X    }
X    *ptrmaxsarg = max + sargoff;
X    sarg = (STR**)saferealloc((char*)(sarg - sargoff),
X      (max+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
X    for (i = 1; i <= max; i++)
X        sarg[i] = afetch(ary,i-1);
X    *retary = sarg;
X    }
X    return max;
X}
X
Xdo_tms(retary,sarg,ptrmaxsarg,sargoff,cushion)
XSTR ***retary;
XSTR **sarg;
Xint *ptrmaxsarg;
Xint sargoff;
Xint cushion;
X{
X    register ARRAY *ary;
X    static ARRAY *myarray = Null(ARRAY*);
X    int max = 4;
X    register int i;
X
X    ary = myarray;
X    if (!ary)
X    myarray = ary = anew(Nullstab);
X    ary->ary_fill = -1;
X    times(×buf);
X
X#ifndef HZ
X#define HZ 60
X#endif
X
X    if (retary) {
X    if (max) {
X        apush(ary,str_nmake(((double)timesbuf.tms_utime)/HZ));
X        apush(ary,str_nmake(((double)timesbuf.tms_stime)/HZ));
X        apush(ary,str_nmake(((double)timesbuf.tms_cutime)/HZ));
X        apush(ary,str_nmake(((double)timesbuf.tms_cstime)/HZ));
X    }
X    *ptrmaxsarg = max + sargoff;
X    sarg = (STR**)saferealloc((char*)(sarg - sargoff),
X      (max+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
X    for (i = 1; i <= max; i++)
X        sarg[i] = afetch(ary,i-1);
X    *retary = sarg;
X    }
X    return max;
X}
X
Xdo_time(tmbuf,retary,sarg,ptrmaxsarg,sargoff,cushion)
Xstruct tm *tmbuf;
XSTR ***retary;
XSTR **sarg;
Xint *ptrmaxsarg;
Xint sargoff;
Xint cushion;
X{
X    register ARRAY *ary;
X    static ARRAY *myarray = Null(ARRAY*);
X    int max = 9;
X    register int i;
X
X    ary = myarray;
X    if (!ary)
X    myarray = ary = anew(Nullstab);
X    ary->ary_fill = -1;
X    if (!tmbuf)
X    max = 0;
X
X    if (retary) {
X    if (max) {
X        apush(ary,str_nmake((double)tmbuf->tm_sec));
X        apush(ary,str_nmake((double)tmbuf->tm_min));
X        apush(ary,str_nmake((double)tmbuf->tm_hour));
X        apush(ary,str_nmake((double)tmbuf->tm_mday));
X        apush(ary,str_nmake((double)tmbuf->tm_mon));
X        apush(ary,str_nmake((double)tmbuf->tm_year));
X        apush(ary,str_nmake((double)tmbuf->tm_wday));
X        apush(ary,str_nmake((double)tmbuf->tm_yday));
X        apush(ary,str_nmake((double)tmbuf->tm_isdst));
X    }
X    *ptrmaxsarg = max + sargoff;
X    sarg = (STR**)saferealloc((char*)(sarg - sargoff),
X      (max+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
X    for (i = 1; i <= max; i++)
X        sarg[i] = afetch(ary,i-1);
X    *retary = sarg;
X    }
X    return max;
X}
X
Xvoid
Xdo_sprintf(str,len,sarg)
Xregister STR *str;
Xregister int len;
Xregister STR **sarg;
X{
X    register char *s;
X    register char *t;
X    bool dolong;
X    char ch;
X    static STR *sargnull = &str_no;
X
X    str_set(str,"");
X    len--;            /* don't count pattern string */
X    sarg++;
X    for (s = str_get(*(sarg++)); *s; len--) {
X    if (len <= 0 || !*sarg) {
X        sarg = &sargnull;
X        len = 0;
X    }
X    dolong = FALSE;
X    for (t = s; *t && *t != '%'; t++) ;
X    if (!*t)
X        break;        /* not enough % patterns, oh well */
X    for (t++; *sarg && *t && t != s; t++) {
X        switch (*t) {
X        case '\0':
X        t--;
X        break;
X        case '%':
X        ch = *(++t);
X        *t = '\0';
X        sprintf(buf,s);
X        s = t;
X        *(t--) = ch;
X        break;
X        case 'l':
X        dolong = TRUE;
X        break;
X        case 'D': case 'X': case 'O':
X        dolong = TRUE;
X        /* FALL THROUGH */
X        case 'd': case 'x': case 'o': case 'c': case 'u':
X        ch = *(++t);
X        *t = '\0';
X        if (dolong)
X            sprintf(buf,s,(long)str_gnum(*(sarg++)));
X        else
X            sprintf(buf,s,(int)str_gnum(*(sarg++)));
X        s = t;
X        *(t--) = ch;
X        break;
X        case 'E': case 'e': case 'f': case 'G': case 'g':
X        ch = *(++t);
X        *t = '\0';
X        sprintf(buf,s,str_gnum(*(sarg++)));
X        s = t;
X        *(t--) = ch;
X        break;
X        case 's':
X        ch = *(++t);
X        *t = '\0';
X        if (strEQ(s,"%s")) {    /* some printfs fail on >128 chars */
X            *buf = '\0';
X            str_scat(str,*(sarg++));  /* so handle simple case */
X        }
X        else
X            sprintf(buf,s,str_get(*(sarg++)));
X        s = t;
X        *(t--) = ch;
X        break;
X        }
X    }
X    str_cat(str,buf);
X    }
X    if (*s)
X    str_cat(str,s);
X    STABSET(str);
X}
X
Xbool
Xdo_print(str,fp)
Xregister STR *str;
XFILE *fp;
X{
X    if (!fp) {
X    if (dowarn)
X        warn("print to unopened file");
X    return FALSE;
X    }
X    if (!str)
X    return FALSE;
X    if (ofmt &&
X      ((str->str_nok && str->str_nval != 0.0) || str_gnum(str) != 0.0) )
X    fprintf(fp, ofmt, str->str_nval);
X    else
X    fputs(str_get(str),fp);
X    return TRUE;
X}
X
Xbool
Xdo_aprint(arg,fp)
Xregister ARG *arg;
Xregister FILE *fp;
X{
X    STR **tmpary;    /* must not be register */
X    register STR **elem;
X    register bool retval;
X    register int items;
X
X    if (!fp) {
X    if (dowarn)
X        warn("print to unopened file");
X    return FALSE;
X    }
X    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary,-1);
X    items = (int)str_gnum(*tmpary);
X    if (arg->arg_type == O_PRTF) {
X    do_sprintf(arg->arg_ptr.arg_str,items,tmpary);
X    retval = do_print(arg->arg_ptr.arg_str,fp);
X    }
X    else {
X    retval = FALSE;
X    for (elem = tmpary+1; items > 0; items--,elem++) {
X        if (retval && ofs)
X        fputs(ofs, fp);
X        retval = do_print(*elem, fp);
X        if (!retval)
X        break;
X    }
X    if (ors)
X        fputs(ors, fp);
X    }
X    safefree((char*)tmpary);
X    return retval;
X}
X
Xbool
Xdo_aexec(arg)
Xregister ARG *arg;
X{
X    STR **tmpary;    /* must not be register */
X    register STR **elem;
X    register char **a;
X    register int items;
X    char **argv;
X
X    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary,-1);
X    items = (int)str_gnum(*tmpary);
X    if (items) {
X    argv = (char**)safemalloc((items+1)*sizeof(char*));
X    a = argv;
X    for (elem = tmpary+1; items > 0; items--,elem++) {
X        if (*elem)
X        *a++ = str_get(*elem);
X        else
X        *a++ = "";
X    }
X    *a = Nullch;
X    execvp(argv[0],argv);
X    safefree((char*)argv);
X    }
X    safefree((char*)tmpary);
X    return FALSE;
X}
X
Xbool
Xdo_exec(str)
XSTR *str;
X{
X    register char **a;
X    register char *s;
X    char **argv;
X    char *cmd = str_get(str);
X
X    /* see if there are shell metacharacters in it */
X
X    for (s = cmd; *s; s++) {
X    if (*s != ' ' && !isalpha(*s) && index("$&*(){}[]'\";\\|?<>~`",*s)) {
X        execl("/bin/sh","sh","-c",cmd,(char*)0);
X        return FALSE;
X    }
X    }
X    argv = (char**)safemalloc(((s - cmd) / 2 + 2)*sizeof(char*));
X
X    a = argv;
X    for (s = cmd; *s;) {
X    while (isspace(*s)) s++;
X    if (*s)
X        *(a++) = s;
X    while (*s && !isspace(*s)) s++;
X    if (*s)
X        *s++ = '\0';
X    }
X    *a = Nullch;
X    if (argv[0])
X    execvp(argv[0],argv);
X    safefree((char*)argv);
X    return FALSE;
X}
X
XSTR *
Xdo_push(arg,ary)
Xregister ARG *arg;
Xregister ARRAY *ary;
X{
X    STR **tmpary;    /* must not be register */
X    register STR **elem;
X    register STR *str = &str_no;
X    register int items;
X
X    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary,-1);
X    items = (int)str_gnum(*tmpary);
X    for (elem = tmpary+1; items > 0; items--,elem++) {
X    str = str_new(0);
X    if (*elem)
X        str_sset(str,*elem);
X    apush(ary,str);
X    }
X    safefree((char*)tmpary);
X    return str;
X}
X
Xdo_unshift(arg,ary)
Xregister ARG *arg;
Xregister ARRAY *ary;
X{
X    STR **tmpary;    /* must not be register */
X    register STR **elem;
X    register STR *str = &str_no;
X    register int i;
X    register int items;
X
X    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary,-1);
X    items = (int)str_gnum(*tmpary);
X    aunshift(ary,items);
X    i = 0;
X    for (elem = tmpary+1; i < items; i++,elem++) {
X    str = str_new(0);
X    str_sset(str,*elem);
X    astore(ary,i,str);
X    }
X    safefree((char*)tmpary);
X}
X
Xapply(type,arg,sarg)
Xint type;
Xregister ARG *arg;
XSTR **sarg;
X{
X    STR **tmpary;    /* must not be register */
X    register STR **elem;
X    register int items;
X    register int val;
X    register int val2;
X    char *s;
X
X    if (sarg) {
X    tmpary = sarg;
X    items = 0;
X    for (elem = tmpary+1; *elem; elem++)
X        items++;
X    }
X    else {
X    (void)eval(arg[1].arg_ptr.arg_arg,&tmpary,-1);
X    items = (int)str_gnum(*tmpary);
X    }
X    switch (type) {
X    case O_CHMOD:
X    if (--items > 0) {
X        val = (int)str_gnum(tmpary[1]);
X        for (elem = tmpary+2; *elem; elem++)
X        if (chmod(str_get(*elem),val))
X            items--;
X    }
X    break;
X    case O_CHOWN:
X    if (items > 2) {
X        items -= 2;
X        val = (int)str_gnum(tmpary[1]);
X        val2 = (int)str_gnum(tmpary[2]);
X        for (elem = tmpary+3; *elem; elem++)
X        if (chown(str_get(*elem),val,val2))
X            items--;
X    }
X    else
X        items = 0;
X    break;
X    case O_KILL:
X    if (--items > 0) {
X        val = (int)str_gnum(tmpary[1]);
X        if (val < 0) {
X        val = -val;
X        for (elem = tmpary+2; *elem; elem++)
X#ifdef KILLPG
X            if (killpg((int)(str_gnum(*elem)),val))    /* BSD */
X#else
X            if (kill(-(int)(str_gnum(*elem)),val))    /* SYSV */
X#endif
X            items--;
X        }
X        else {
X        for (elem = tmpary+2; *elem; elem++)
X            if (kill((int)(str_gnum(*elem)),val))
X            items--;
X        }
X    }
X    break;
X    case O_UNLINK:
X    for (elem = tmpary+1; *elem; elem++) {
X        s = str_get(*elem);
X        if (euid || unsafe) {
X        if (UNLINK(s))
X            items--;
X        }
X        else {    /* don't let root wipe out directories without -U */
X        if (stat(s,&statbuf) < 0 ||
X          (statbuf.st_mode & S_IFMT) == S_IFDIR )
X            items--;
X        else {
X            if (UNLINK(s))
X            items--;
X        }
X        }
X    }
X    break;
X    case O_UTIME:
X    if (items > 2) {
X        struct {
X        long    atime,
X            mtime;
X        } utbuf;
X
X        utbuf.atime = (long)str_gnum(tmpary[1]);    /* time accessed */
X        utbuf.mtime = (long)str_gnum(tmpary[2]);    /* time modified */
X        items -= 2;
X        for (elem = tmpary+3; *elem; elem++)
X        if (utime(str_get(*elem),&utbuf))
X            items--;
X    }
X    else
X        items = 0;
X    break;
X    }
X    if (!sarg)
X    safefree((char*)tmpary);
X    return items;
X}
X
XSTR *
Xdo_subr(arg,sarg)
Xregister ARG *arg;
Xregister STR **sarg;
X{
X    register SUBR *sub;
X    ARRAY *savearray;
X    STR *str;
X    STAB *stab;
X    char *oldfile = filename;
X    int oldsave = savestack->ary_fill;
X    int oldtmps_base = tmps_base;
X
X    if (arg[2].arg_type == A_WORD)
X    stab = arg[2].arg_ptr.arg_stab;
X    else
X    stab = stabent(str_get(arg[2].arg_ptr.arg_stab->stab_val),TRUE);
X    if (!stab) {
X    if (dowarn)
X        warn("Undefined subroutine called");
X    return &str_no;
X    }
X    sub = stab->stab_sub;
X    if (!sub) {
X    if (dowarn)
X        warn("Undefined subroutine \"%s\" called", stab->stab_name);
X    return &str_no;
X    }
X    savearray = defstab->stab_array;
X    defstab->stab_array = anew(defstab);
X    if (arg[1].arg_flags & AF_SPECIAL)
X    (void)do_push(arg,defstab->stab_array);
X    else if (arg[1].arg_type != A_NULL) {
X    str = str_new(0);
X    str_sset(str,sarg[1]);
X    apush(defstab->stab_array,str);
X    }
X    sub->depth++;
X    if (sub->depth >= 2) {    /* save temporaries on recursion? */
X    if (sub->depth == 100 && dowarn)
X        warn("Deep recursion on subroutine \"%s\"",stab->stab_name);
X    savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
X    }
X    filename = sub->filename;
X    tmps_base = tmps_max;
X
X    str = cmd_exec(sub->cmd);        /* so do it already */
X
X    sub->depth--;    /* assuming no longjumps out of here */
X    afree(defstab->stab_array);  /* put back old $_[] */
X    defstab->stab_array = savearray;
X    filename = oldfile;
X    tmps_base = oldtmps_base;
X    if (savestack->ary_fill > oldsave) {
X    str = str_static(str);    /* in case restore wipes old str */
X    restorelist(oldsave);
X    }
X    return str;
X}
X
Xvoid
Xdo_assign(retstr,arg,sarg)
XSTR *retstr;
Xregister ARG *arg;
Xregister STR **sarg;
X{
X    STR **tmpary;    /* must not be register */
X    register ARG *larg = arg[1].arg_ptr.arg_arg;
X    register STR **elem;
X    register STR *str;
X    register ARRAY *ary;
X    register int i;
X    register int items;
X    STR *tmpstr;
X
X    if (arg[2].arg_flags & AF_SPECIAL) {
X    (void)eval(arg[2].arg_ptr.arg_arg,&tmpary,-1);
X    items = (int)str_gnum(*tmpary);
X    }
X    else {
X    tmpary = sarg;
X    sarg[1] = sarg[2];
X    sarg[2] = Nullstr;
X    items = 1;
X    }
X
X    if (arg->arg_flags & AF_COMMON) {    /* always true currently, alas */
X    if (*(tmpary+1)) {
X        for (i=2,elem=tmpary+2; i <= items; i++,elem++) {
X        *elem = str_static(*elem);
X        }
X    }
X    }
X    if (larg->arg_type == O_LIST) {
X    for (i=1,elem=tmpary+1; i <= larg->arg_len; i++) {
X        switch (larg[i].arg_type) {
X        case A_STAB:
X        case A_LVAL:
X        str = STAB_STR(larg[i].arg_ptr.arg_stab);
X        break;
X        case A_LEXPR:
X        str = eval(larg[i].arg_ptr.arg_arg,Null(STR***),-1);
X        break;
X        }
X        if (larg->arg_flags & AF_LOCAL) {
X        apush(savestack,str);    /* save pointer */
X        tmpstr = str_new(0);
X        str_sset(tmpstr,str);
X        apush(savestack,tmpstr); /* save value */
X        }
X        if (*elem)
X        str_sset(str,*(elem++));
X        else
X        str_set(str,"");
X        STABSET(str);
X    }
X    }
X    else {            /* should be an array name */
X    ary = larg[1].arg_ptr.arg_stab->stab_array;
X    for (i=0,elem=tmpary+1; i < items; i++) {
X        str = str_new(0);
X        if (*elem)
X        str_sset(str,*(elem++));
X        astore(ary,i,str);
X    }
X    ary->ary_fill = items - 1;/* they can get the extra ones back by */
X    }                /*   setting $#ary larger than old fill */
X    str_numset(retstr,(double)items);
X    STABSET(retstr);
X    if (tmpary != sarg);
X    safefree((char*)tmpary);
X}
X
Xint
Xdo_kv(hash,kv,retary,sarg,ptrmaxsarg,sargoff,cushion)
XHASH *hash;
Xint kv;
XSTR ***retary;
Xregister STR **sarg;
Xint *ptrmaxsarg;
Xint sargoff;
Xint cushion;
X{
X    register ARRAY *ary;
X    int max = 0;
X    int i;
X    static ARRAY *myarray = Null(ARRAY*);
X    register HENT *entry;
X
X    ary = myarray;
X    if (!ary)
X    myarray = ary = anew(Nullstab);
X    ary->ary_fill = -1;
X
X    hiterinit(hash);
X    while (entry = hiternext(hash)) {
X    max++;
X    if (kv == O_KEYS)
X        apush(ary,str_make(hiterkey(entry)));
X    else
X        apush(ary,str_make(str_get(hiterval(entry))));
X    }
X    if (retary) { /* array wanted */
X    *ptrmaxsarg = max + sargoff;
X    sarg = (STR**)saferealloc((char*)(sarg - sargoff),
X      (max+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
X    for (i = 1; i <= max; i++)
X        sarg[i] = afetch(ary,i-1);
X    *retary = sarg;
X    }
X    return max;
X}
X
XSTR *
Xdo_each(hash,retary,sarg,ptrmaxsarg,sargoff,cushion)
XHASH *hash;
XSTR ***retary;
XSTR **sarg;
Xint *ptrmaxsarg;
Xint sargoff;
Xint cushion;
X{
X    static STR *mystr = Nullstr;
X    STR *retstr;
X    HENT *entry = hiternext(hash);
X
X    if (mystr) {
X    str_free(mystr);
X    mystr = Nullstr;
X    }
X
X    if (retary) { /* array wanted */
X    if (entry) {
X        *ptrmaxsarg = 2 + sargoff;
X        sarg = (STR**)saferealloc((char*)(sarg - sargoff),
X          (2+2+cushion+sargoff)*sizeof(STR*)) + sargoff;
X        sarg[1] = mystr = str_make(hiterkey(entry));
X        retstr = sarg[2] = hiterval(entry);
X        *retary = sarg;
X    }
X    else {
X        *ptrmaxsarg = sargoff;
X        sarg = (STR**)saferealloc((char*)(sarg - sargoff),
X          (2+cushion+sargoff)*sizeof(STR*)) + sargoff;
X        retstr = Nullstr;
X        *retary = sarg;
X    }
X    }
X    else
X    retstr = hiterval(entry);
X
X    return retstr;
X}
X
Xint
Xmystat(arg,str)
XARG *arg;
XSTR *str;
X{
X    STIO *stio;
X
X    if (arg[1].arg_flags & AF_SPECIAL) {
X    stio = arg[1].arg_ptr.arg_stab->stab_io;
X    if (stio && stio->fp)
X        return fstat(fileno(stio->fp), &statbuf);
X    else {
X        if (dowarn)
X        warn("Stat on unopened file <%s>",
X          arg[1].arg_ptr.arg_stab->stab_name);
X        return -1;
X    }
X    }
X    else
X    return stat(str_get(str),&statbuf);
X}
X
XSTR *
Xdo_fttext(arg,str)
Xregister ARG *arg;
XSTR *str;
X{
X    int i;
X    int len;
X    int odd = 0;
X    STDCHAR tbuf[512];
X    register STDCHAR *s;
X    register STIO *stio;
X
X    if (arg[1].arg_flags & AF_SPECIAL) {
X    stio = arg[1].arg_ptr.arg_stab->stab_io;
X    if (stio && stio->fp) {
X#ifdef STDSTDIO
X        if (stio->fp->_cnt <= 0) {
X        i = getc(stio->fp);
X        ungetc(i,stio->fp);
X        }
X        if (stio->fp->_cnt <= 0)    /* null file is anything */
X        return &str_yes;
X        len = stio->fp->_cnt + (stio->fp->_ptr - stio->fp->_base);
X        s = stio->fp->_base;
X#else
X        fatal("-T and -B not implemented on filehandles\n");
X#endif
X    }
X    else {
X        if (dowarn)
X        warn("Test on unopened file <%s>",
X          arg[1].arg_ptr.arg_stab->stab_name);
X        return &str_no;
X    }
X    }
X    else {
X    i = open(str_get(str),0);
X    if (i < 0)
X        return &str_no;
X    len = read(i,tbuf,512);
X    if (len <= 0)        /* null file is anything */
X        return &str_yes;
X    close(i);
X    s = tbuf;
X    }
X
X    /* now scan s to look for textiness */
X
X    for (i = 0; i < len; i++,s++) {
X    if (!*s) {            /* null never allowed in text */
X        odd += len;
X        break;
X    }
X    else if (*s & 128)
X        odd++;
X    else if (*s < 32 &&
X      *s != '\n' && *s != '\r' && *s != '\b' &&
X      *s != '\t' && *s != '\f' && *s != 27)
X        odd++;
X    }
X
X    if ((odd * 10 > len) == (arg->arg_type == O_FTTEXT)) /* allow 10% odd */
X    return &str_no;
X    else
X    return &str_yes;
X}
X
Xint
Xdo_study(str)
XSTR *str;
X{
X    register char *s = str_get(str);
X    register int pos = str->str_cur;
X    register int ch;
X    register int *sfirst;
X    register int *snext;
X    static int maxscream = -1;
X    static STR *lastscream = Nullstr;
X
X    if (lastscream && lastscream->str_pok == 5)
X    lastscream->str_pok &= ~4;
X    lastscream = str;
X    if (pos <= 0)
X    return 0;
X    if (pos > maxscream) {
X    if (maxscream < 0) {
X        maxscream = pos + 80;
X        screamfirst = (int*)safemalloc((MEM_SIZE)(256 * sizeof(int)));
X        screamnext = (int*)safemalloc((MEM_SIZE)(maxscream * sizeof(int)));
X    }
X    else {
X        maxscream = pos + pos / 4;
X        screamnext = (int*)saferealloc((char*)screamnext,
X        (MEM_SIZE)(maxscream * sizeof(int)));
X    }
X    }
X
X    sfirst = screamfirst;
X    snext = screamnext;
X
X    if (!sfirst || !snext)
X    fatal("do_study: out of memory");
X
X    for (ch = 256; ch; --ch)
X    *sfirst++ = -1;
X    sfirst -= 256;
X
X    while (--pos >= 0) {
X    ch = s[pos];
X    if (sfirst[ch] >= 0)
X        snext[pos] = sfirst[ch] - pos;
X    else
X        snext[pos] = -pos;
X    sfirst[ch] = pos;
X    }
X
X    str->str_pok |= 4;
X    return 1;
X}
X
Xinit_eval()
X{
X#define A(e1,e2,e3) (e1+(e2<<1)+(e3<<2))
X    opargs[O_ITEM] =        A(1,0,0);
X    opargs[O_ITEM2] =        A(0,0,0);
X    opargs[O_ITEM3] =        A(0,0,0);
X    opargs[O_CONCAT] =        A(1,1,0);
X    opargs[O_MATCH] =        A(1,0,0);
X    opargs[O_NMATCH] =        A(1,0,0);
X    opargs[O_SUBST] =        A(1,0,0);
X    opargs[O_NSUBST] =        A(1,0,0);
X    opargs[O_ASSIGN] =        A(1,1,0);
X    opargs[O_MULTIPLY] =    A(1,1,0);
X    opargs[O_DIVIDE] =        A(1,1,0);
X    opargs[O_MODULO] =        A(1,1,0);
X    opargs[O_ADD] =        A(1,1,0);
X    opargs[O_SUBTRACT] =    A(1,1,0);
X    opargs[O_LEFT_SHIFT] =    A(1,1,0);
X    opargs[O_RIGHT_SHIFT] =    A(1,1,0);
X    opargs[O_LT] =        A(1,1,0);
X    opargs[O_GT] =        A(1,1,0);
X    opargs[O_LE] =        A(1,1,0);
X    opargs[O_GE] =        A(1,1,0);
X    opargs[O_EQ] =        A(1,1,0);
X    opargs[O_NE] =        A(1,1,0);
X    opargs[O_BIT_AND] =        A(1,1,0);
X    opargs[O_XOR] =        A(1,1,0);
X    opargs[O_BIT_OR] =        A(1,1,0);
X    opargs[O_AND] =        A(1,0,0);    /* don't eval arg 2 (yet) */
X    opargs[O_OR] =        A(1,0,0);    /* don't eval arg 2 (yet) */
X    opargs[O_COND_EXPR] =    A(1,0,0);    /* don't eval args 2 or 3 */
X    opargs[O_COMMA] =        A(1,1,0);
X    opargs[O_NEGATE] =        A(1,0,0);
X    opargs[O_NOT] =        A(1,0,0);
X    opargs[O_COMPLEMENT] =    A(1,0,0);
X    opargs[O_WRITE] =        A(1,0,0);
X    opargs[O_OPEN] =        A(1,1,0);
X    opargs[O_TRANS] =        A(1,0,0);
X    opargs[O_NTRANS] =        A(1,0,0);
X    opargs[O_CLOSE] =        A(0,0,0);
X    opargs[O_ARRAY] =        A(1,0,0);
X    opargs[O_HASH] =        A(1,0,0);
X    opargs[O_LARRAY] =        A(1,0,0);
X    opargs[O_LHASH] =        A(1,0,0);
X    opargs[O_PUSH] =        A(1,0,0);
X    opargs[O_POP] =        A(0,0,0);
X    opargs[O_SHIFT] =        A(0,0,0);
X    opargs[O_SPLIT] =        A(1,0,0);
X    opargs[O_LENGTH] =        A(1,0,0);
X    opargs[O_SPRINTF] =        A(1,0,0);
X    opargs[O_SUBSTR] =        A(1,1,1);
X    opargs[O_JOIN] =        A(1,0,0);
X    opargs[O_SLT] =        A(1,1,0);
X    opargs[O_SGT] =        A(1,1,0);
X    opargs[O_SLE] =        A(1,1,0);
X    opargs[O_SGE] =        A(1,1,0);
X    opargs[O_SEQ] =        A(1,1,0);
X    opargs[O_SNE] =        A(1,1,0);
X    opargs[O_SUBR] =        A(1,0,0);
X    opargs[O_PRINT] =        A(1,1,0);
X    opargs[O_CHDIR] =        A(1,0,0);
X    opargs[O_DIE] =        A(1,0,0);
X    opargs[O_EXIT] =        A(1,0,0);
X    opargs[O_RESET] =        A(1,0,0);
X    opargs[O_LIST] =        A(0,0,0);
X    opargs[O_EOF] =        A(1,0,0);
X    opargs[O_TELL] =        A(1,0,0);
X    opargs[O_SEEK] =        A(1,1,1);
X    opargs[O_LAST] =        A(1,0,0);
X    opargs[O_NEXT] =        A(1,0,0);
X    opargs[O_REDO] =        A(1,0,0);
X    opargs[O_GOTO] =        A(1,0,0);
X    opargs[O_INDEX] =        A(1,1,0);
X    opargs[O_TIME] =         A(0,0,0);
X    opargs[O_TMS] =         A(0,0,0);
X    opargs[O_LOCALTIME] =    A(1,0,0);
X    opargs[O_GMTIME] =        A(1,0,0);
X    opargs[O_STAT] =        A(1,0,0);
X    opargs[O_CRYPT] =        A(1,1,0);
X    opargs[O_EXP] =        A(1,0,0);
X    opargs[O_LOG] =        A(1,0,0);
X    opargs[O_SQRT] =        A(1,0,0);
X    opargs[O_INT] =        A(1,0,0);
X    opargs[O_PRTF] =        A(1,1,0);
X    opargs[O_ORD] =         A(1,0,0);
X    opargs[O_SLEEP] =        A(1,0,0);
X    opargs[O_FLIP] =        A(1,0,0);
X    opargs[O_FLOP] =        A(0,1,0);
X    opargs[O_KEYS] =        A(0,0,0);
X    opargs[O_VALUES] =        A(0,0,0);
X    opargs[O_EACH] =        A(0,0,0);
X    opargs[O_CHOP] =        A(1,0,0);
X    opargs[O_FORK] =        A(1,0,0);
X    opargs[O_EXEC] =        A(1,0,0);
X    opargs[O_SYSTEM] =        A(1,0,0);
X    opargs[O_OCT] =        A(1,0,0);
X    opargs[O_HEX] =        A(1,0,0);
X    opargs[O_CHMOD] =        A(1,0,0);
X    opargs[O_CHOWN] =        A(1,0,0);
X    opargs[O_KILL] =        A(1,0,0);
X    opargs[O_RENAME] =        A(1,1,0);
X    opargs[O_UNLINK] =        A(1,0,0);
X    opargs[O_UMASK] =        A(1,0,0);
X    opargs[O_UNSHIFT] =        A(1,0,0);
X    opargs[O_LINK] =        A(1,1,0);
X    opargs[O_REPEAT] =        A(1,1,0);
X    opargs[O_EVAL] =        A(1,0,0);
X    opargs[O_FTEREAD] =        A(1,0,0);
X    opargs[O_FTEWRITE] =    A(1,0,0);
X    opargs[O_FTEEXEC] =        A(1,0,0);
X    opargs[O_FTEOWNED] =    A(1,0,0);
X    opargs[O_FTRREAD] =        A(1,0,0);
X    opargs[O_FTRWRITE] =    A(1,0,0);
X    opargs[O_FTREXEC] =        A(1,0,0);
X    opargs[O_FTROWNED] =    A(1,0,0);
X    opargs[O_FTIS] =        A(1,0,0);
X    opargs[O_FTZERO] =        A(1,0,0);
X    opargs[O_FTSIZE] =        A(1,0,0);
X    opargs[O_FTFILE] =        A(1,0,0);
X    opargs[O_FTDIR] =        A(1,0,0);
X    opargs[O_FTLINK] =        A(1,0,0);
X    opargs[O_SYMLINK] =        A(1,1,0);
X    opargs[O_FTPIPE] =        A(1,0,0);
X    opargs[O_FTSUID] =        A(1,0,0);
X    opargs[O_FTSGID] =        A(1,0,0);
X    opargs[O_FTSVTX] =        A(1,0,0);
X    opargs[O_FTCHR] =        A(1,0,0);
X    opargs[O_FTBLK] =        A(1,0,0);
X    opargs[O_FTSOCK] =        A(1,0,0);
X    opargs[O_FTTTY] =        A(1,0,0);
X    opargs[O_DOFILE] =        A(1,0,0);
X    opargs[O_FTTEXT] =        A(1,0,0);
X    opargs[O_FTBINARY] =    A(1,0,0);
X    opargs[O_UTIME] =        A(1,0,0);
X    opargs[O_WAIT] =        A(0,0,0);
X    opargs[O_SORT] =        A(1,0,0);
X    opargs[O_STUDY] =        A(1,0,0);
X    opargs[O_DELETE] =        A(1,0,0);
X}
!STUFFY!FUNK!
echo Extracting eg/g/ged
sed >eg/g/ged <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: ged,v 2.0 88/06/05 00:17:08 root Exp $
X
X# Does inplace edits on a set of files on a set of machines.
X#
X# Typical invokation:
X#
X#    ged vax+sun /etc/passwd
X#    s/Freddy/Freddie/;
X#    ^D
X#
X
X$class = shift;
X$files = join(' ',@ARGV);
X
Xdie "Usage: ged class files <perlcmds\n" unless $files;
X
Xexec "gsh", $class, "-d", "perl -pi.bak - $files";
X
Xdie "Couldn't execute gsh for some reason, stopped";
!STUFFY!FUNK!
echo ""
echo "End of kit 1 (of 15)"
cat /dev/null >kit1isdone
run=''
config=''
for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15; 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