Subject: v20i094:  Perl, a language with features of C/sed/awk/shell/etc, Part11/24
Newsgroups: comp.sources.unix
Approved: rsalz@uunet.UU.NET

Submitted-by: Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
Posting-number: Volume 20, Issue 94
Archive-name: perl3.0/part11

#! /bin/sh

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

echo "This is perl 3.0 kit 11 (of 24).  If kit 11 is complete, the line"
echo '"'"End of kit 11 (of 24)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir  2>/dev/null
echo Extracting doarg.c
sed >doarg.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: doarg.c,v 3.0 89/10/18 15:10:41 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:	doarg.c,v $
X * Revision 3.0  89/10/18  15:10:41  lwall
X * 3.0 baseline
X * 
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X
X#include <signal.h>
X
Xextern unsigned char fold[];
X
Xint wantarray;
X
Xint
Xdo_subst(str,arg,sp)
XSTR *str;
XARG *arg;
Xint sp;
X{
X    register SPAT *spat;
X    SPAT *rspat;
X    register STR *dstr;
X    register char *s = str_get(str);
X    char *strend = s + str->str_cur;
X    register char *m;
X    char *c;
X    register char *d;
X    int clen;
X    int iters = 0;
X    register int i;
X    bool once;
X    char *orig;
X    int safebase;
X
X    rspat = spat = arg[2].arg_ptr.arg_spat;
X    if (!spat || !s)
X	fatal("panic: do_subst");
X    else if (spat->spat_runtime) {
X	nointrp = "|)";
X	(void)eval(spat->spat_runtime,G_SCALAR,sp);
X	m = str_get(dstr = stack->ary_array[sp+1]);
X	nointrp = "";
X	if (spat->spat_regexp)
X	    regfree(spat->spat_regexp);
X	spat->spat_regexp = regcomp(m,m+dstr->str_cur,
X	    spat->spat_flags & SPAT_FOLD,1);
X	if (spat->spat_flags & SPAT_KEEP) {
X	    arg_free(spat->spat_runtime);	/* it won't change, so */
X	    spat->spat_runtime = Nullarg;	/* no point compiling again */
X	}
X    }
X#ifdef DEBUGGING
X    if (debug & 8) {
X	deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
X    }
X#endif
X    safebase = ((!spat->spat_regexp || !spat->spat_regexp->nparens) &&
X      !sawampersand);
X    if (!*spat->spat_regexp->precomp && lastspat)
X	spat = lastspat;
X    orig = 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 & SP_STUDIED) {
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#ifndef lint
X	    else if (!(s = fbminstr((unsigned char*)s, (unsigned char*)strend,
X	      spat->spat_short)))
X		goto nope;
X#endif
X	    if (s && spat->spat_regexp->regback >= 0) {
X		++spat->spat_short->str_u.str_useful;
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	  bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
X	    goto nope;
X	if (--spat->spat_short->str_u.str_useful < 0) {
X	    str_free(spat->spat_short);
X	    spat->spat_short = Nullstr;	/* opt is being useless */
X	}
X    }
X    once = ((rspat->spat_flags & SPAT_ONCE) != 0);
X    if (rspat->spat_flags & SPAT_CONST) {	/* known replacement string? */
X	if ((rspat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
X	    dstr = rspat->spat_repl[1].arg_ptr.arg_str;
X	else {					/* constant over loop, anyway */
X	    (void)eval(rspat->spat_repl,G_SCALAR,sp);
X	    dstr = stack->ary_array[sp+1];
X	}
X	c = str_get(dstr);
X	clen = dstr->str_cur;
X	if (clen <= spat->spat_slen + spat->spat_regexp->regback) {
X					/* can do inplace substitution */
X	    if (regexec(spat->spat_regexp, s, strend, orig, 1,
X	      str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
X		if (spat->spat_regexp->subbase) /* oops, no we can't */
X		    goto long_way;
X		d = s;
X		lastspat = spat;
X		str->str_pok = SP_VALID;	/* disable possible screamer */
X		if (once) {
X		    m = spat->spat_regexp->startp[0];
X		    d = spat->spat_regexp->endp[0];
X		    s = orig;
X		    if (m - s > strend - d) {	/* faster to shorten from end */
X			if (clen) {
X			    (void)bcopy(c, m, clen);
X			    m += clen;
X			}
X			i = strend - d;
X			if (i > 0) {
X			    (void)bcopy(d, m, i);
X			    m += i;
X			}
X			*m = '\0';
X			str->str_cur = m - s;
X			STABSET(str);
X			str_numset(arg->arg_ptr.arg_str, 1.0);
X			stack->ary_array[++sp] = arg->arg_ptr.arg_str;
X			return sp;
X		    }
X		    else if (i = m - s) {	/* faster from front */
X			d -= clen;
X			m = d;
X			str_chop(str,d-i);
X			s += i;
X			while (i--)
X			    *--d = *--s;
X			if (clen)
X			    (void)bcopy(c, m, clen);
X			STABSET(str);
X			str_numset(arg->arg_ptr.arg_str, 1.0);
X			stack->ary_array[++sp] = arg->arg_ptr.arg_str;
X			return sp;
X		    }
X		    else if (clen) {
X			d -= clen;
X			str_chop(str,d);
X			(void)bcopy(c,d,clen);
X			STABSET(str);
X			str_numset(arg->arg_ptr.arg_str, 1.0);
X			stack->ary_array[++sp] = arg->arg_ptr.arg_str;
X			return sp;
X		    }
X		    else {
X			str_chop(str,d);
X			STABSET(str);
X			str_numset(arg->arg_ptr.arg_str, 1.0);
X			stack->ary_array[++sp] = arg->arg_ptr.arg_str;
X			return sp;
X		    }
X		    /* NOTREACHED */
X		}
X		do {
X		    if (iters++ > 10000)
X			fatal("Substitution loop");
X		    m = spat->spat_regexp->startp[0];
X		    if (i = m - s) {
X			if (s != d)
X			    (void)bcopy(s,d,i);
X			d += i;
X		    }
X		    if (clen) {
X			(void)bcopy(c,d,clen);
X			d += clen;
X		    }
X		    s = spat->spat_regexp->endp[0];
X		} while (regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr,
X		    TRUE));
X		if (s != d) {
X		    i = strend - s;
X		    str->str_cur = d - str->str_ptr + i;
X		    (void)bcopy(s,d,i+1);		/* include the Null */
X		}
X		STABSET(str);
X		str_numset(arg->arg_ptr.arg_str, (double)iters);
X		stack->ary_array[++sp] = arg->arg_ptr.arg_str;
X		return sp;
X	    }
X	    str_numset(arg->arg_ptr.arg_str, 0.0);
X	    stack->ary_array[++sp] = arg->arg_ptr.arg_str;
X	    return sp;
X	}
X    }
X    else
X	c = Nullch;
X    if (regexec(spat->spat_regexp, s, strend, orig, 1,
X      str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
X    long_way:
X	dstr = Str_new(25,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	    if (iters++ > 10000)
X		fatal("Substitution loop");
X	    if (spat->spat_regexp->subbase
X	      && spat->spat_regexp->subbase != orig) {
X		m = s;
X		s = orig;
X		orig = spat->spat_regexp->subbase;
X		s = orig + (m - s);
X		strend = s + (strend - m);
X	    }
X	    m = spat->spat_regexp->startp[0];
X	    str_ncat(dstr,s,m-s);
X	    s = spat->spat_regexp->endp[0];
X	    if (c) {
X		if (clen)
X		    str_ncat(dstr,c,clen);
X	    }
X	    else {
X		(void)eval(rspat->spat_repl,G_SCALAR,sp);
X		str_scat(dstr,stack->ary_array[sp+1]);
X	    }
X	    if (once)
X		break;
X	} while (regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr,
X	    safebase));
X	str_ncat(dstr,s,strend - s);
X	str_replace(str,dstr);
X	STABSET(str);
X	str_numset(arg->arg_ptr.arg_str, (double)iters);
X	stack->ary_array[++sp] = arg->arg_ptr.arg_str;
X	return sp;
X    }
X    str_numset(arg->arg_ptr.arg_str, 0.0);
X    stack->ary_array[++sp] = arg->arg_ptr.arg_str;
X    return sp;
X
Xnope:
X    ++spat->spat_short->str_u.str_useful;
X    str_numset(arg->arg_ptr.arg_str, 0.0);
X    stack->ary_array[++sp] = arg->arg_ptr.arg_str;
X    return sp;
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    register char *send;
X
X    tbl = arg[2].arg_ptr.arg_cval;
X    s = str_get(str);
X    send = s + str->str_cur;
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 < send) {
X	if (ch = tbl[*s & 0377]) {
X	    matches++;
X	    *s = ch;
X	}
X	s++;
X    }
X    STABSET(str);
X    return matches;
X}
X
Xvoid
Xdo_join(str,arglast)
Xregister STR *str;
Xint *arglast;
X{
X    register STR **st = stack->ary_array;
X    register int sp = arglast[1];
X    register int items = arglast[2] - sp;
X    register char *delim = str_get(st[sp]);
X    int delimlen = st[sp]->str_cur;
X
X    st += ++sp;
X    if (items-- > 0)
X	str_sset(str,*st++);
X    else
X	str_set(str,"");
X    for (; items > 0; items--,st++) {
X	str_ncat(str,delim,delimlen);
X	str_scat(str,*st);
X    }
X    STABSET(str);
X}
X
Xvoid
Xdo_pack(str,arglast)
Xregister STR *str;
Xint *arglast;
X{
X    register STR **st = stack->ary_array;
X    register int sp = arglast[1];
X    register int items;
X    register char *pat = str_get(st[sp]);
X    register char *patend = pat + st[sp]->str_cur;
X    register int len;
X    int datumtype;
X    STR *fromstr;
X    static char *null10 = "\0\0\0\0\0\0\0\0\0\0";
X    static char *space10 = "          ";
X
X    /* These must not be in registers: */
X    char achar;
X    short ashort;
X    int aint;
X    long along;
X    char *aptr;
X
X    items = arglast[2] - sp;
X    st += ++sp;
X    str_nset(str,"",0);
X    while (pat < patend) {
X#define NEXTFROM (items-- > 0 ? *st++ : &str_no)
X	datumtype = *pat++;
X	if (isdigit(*pat)) {
X	    len = atoi(pat);
X	    while (isdigit(*pat))
X		pat++;
X	}
X	else
X	    len = 1;
X	switch(datumtype) {
X	default:
X	    break;
X	case 'x':
X	    while (len >= 10) {
X		str_ncat(str,null10,10);
X		len -= 10;
X	    }
X	    str_ncat(str,null10,len);
X	    break;
X	case 'A':
X	case 'a':
X	    fromstr = NEXTFROM;
X	    aptr = str_get(fromstr);
X	    if (fromstr->str_cur > len)
X		str_ncat(str,aptr,len);
X	    else
X		str_ncat(str,aptr,fromstr->str_cur);
X	    len -= fromstr->str_cur;
X	    if (datumtype == 'A') {
X		while (len >= 10) {
X		    str_ncat(str,space10,10);
X		    len -= 10;
X		}
X		str_ncat(str,space10,len);
X	    }
X	    else {
X		while (len >= 10) {
X		    str_ncat(str,null10,10);
X		    len -= 10;
X		}
X		str_ncat(str,null10,len);
X	    }
X	    break;
X	case 'C':
X	case 'c':
X	    while (len-- > 0) {
X		fromstr = NEXTFROM;
X		aint = (int)str_gnum(fromstr);
X		achar = aint;
X		str_ncat(str,&achar,sizeof(char));
X	    }
X	    break;
X	case 'n':
X	    while (len-- > 0) {
X		fromstr = NEXTFROM;
X		ashort = (short)str_gnum(fromstr);
X#ifdef HTONS
X		ashort = htons(ashort);
X#endif
X		str_ncat(str,(char*)&ashort,sizeof(short));
X	    }
X	    break;
X	case 'S':
X	case 's':
X	    while (len-- > 0) {
X		fromstr = NEXTFROM;
X		ashort = (short)str_gnum(fromstr);
X		str_ncat(str,(char*)&ashort,sizeof(short));
X	    }
X	    break;
X	case 'I':
X	case 'i':
X	    while (len-- > 0) {
X		fromstr = NEXTFROM;
X		aint = (int)str_gnum(fromstr);
X		str_ncat(str,(char*)&aint,sizeof(int));
X	    }
X	    break;
X	case 'N':
X	    while (len-- > 0) {
X		fromstr = NEXTFROM;
X		along = (long)str_gnum(fromstr);
X#ifdef HTONL
X		along = htonl(along);
X#endif
X		str_ncat(str,(char*)&along,sizeof(long));
X	    }
X	    break;
X	case 'L':
X	case 'l':
X	    while (len-- > 0) {
X		fromstr = NEXTFROM;
X		along = (long)str_gnum(fromstr);
X		str_ncat(str,(char*)&along,sizeof(long));
X	    }
X	    break;
X	case 'p':
X	    while (len-- > 0) {
X		fromstr = NEXTFROM;
X		aptr = str_get(fromstr);
X		str_ncat(str,(char*)&aptr,sizeof(char*));
X	    }
X	    break;
X	}
X    }
X    STABSET(str);
X}
X#undef NEXTFROM
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    register char *send;
X    char *xs;
X    int xlen;
X
X    str_set(str,"");
X    len--;			/* don't count pattern string */
X    s = str_get(*sarg);
X    send = s + (*sarg)->str_cur;
X    sarg++;
X    for ( ; s < send; len--) {
X	if (len <= 0 || !*sarg) {
X	    sarg = &sargnull;
X	    len = 0;
X	}
X	dolong = FALSE;
X	for (t = s; t < send && *t != '%'; t++) ;
X	if (t >= send)
X	    break;		/* not enough % patterns, oh well */
X	for (t++; *sarg && t < send && t != s; t++) {
X	    switch (*t) {
X	    default:
X		ch = *(++t);
X		*t = '\0';
X		(void)sprintf(buf,s);
X		s = t;
X		*(t--) = ch;
X		len++;
X		break;
X	    case '0': case '1': case '2': case '3': case '4':
X	    case '5': case '6': case '7': case '8': case '9': 
X	    case '.': case '#': case '-': case '+':
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 'c':
X		*buf = (int)str_gnum(*(sarg++));
X		str_ncat(str,buf,1);	/* force even if null */
X		*buf = '\0';
X		s = t+1;
X		break;
X	    case 'd': case 'x': case 'o': case 'u':
X		ch = *(++t);
X		*t = '\0';
X		if (dolong)
X		    (void)sprintf(buf,s,(long)str_gnum(*(sarg++)));
X		else
X		    (void)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		(void)sprintf(buf,s,str_gnum(*(sarg++)));
X		s = t;
X		*(t--) = ch;
X		break;
X	    case 's':
X		ch = *(++t);
X		*t = '\0';
X		xs = str_get(*sarg);
X		xlen = (*sarg)->str_cur;
X		if (*xs == 'S' && xs[1] == 't' && xs[2] == 'a' && xs[3] == 'b'
X		  && xlen == sizeof(STBP) && strlen(xs) < xlen) {
X		    xs = stab_name(((STAB*)(*sarg))); /* a stab value! */
X		    sprintf(tokenbuf,"*%s",xs);	/* reformat to non-binary */
X		    xs = tokenbuf;
X		    xlen = strlen(tokenbuf);
X		}
X		if (strEQ(t-2,"%s")) {	/* some printfs fail on >128 chars */
X		    *buf = '\0';
X		    str_ncat(str,s,t - s - 2);
X		    str_ncat(str,xs,xlen);  /* so handle simple case */
X		}
X		else
X		    (void)sprintf(buf,s,xs);
X		sarg++;
X		s = t;
X		*(t--) = ch;
X		break;
X	    }
X	}
X	if (s < t && t >= send) {
X	    str_cat(str,s);
X	    s = t;
X	    break;
X	}
X	str_cat(str,buf);
X    }
X    if (*s) {
X	(void)sprintf(buf,s,0,0,0,0);
X	str_cat(str,buf);
X    }
X    STABSET(str);
X}
X
XSTR *
Xdo_push(ary,arglast)
Xregister ARRAY *ary;
Xint *arglast;
X{
X    register STR **st = stack->ary_array;
X    register int sp = arglast[1];
X    register int items = arglast[2] - sp;
X    register STR *str = &str_undef;
X
X    for (st += ++sp; items > 0; items--,st++) {
X	str = Str_new(26,0);
X	if (*st)
X	    str_sset(str,*st);
X	(void)apush(ary,str);
X    }
X    return str;
X}
X
Xint
Xdo_unshift(ary,arglast)
Xregister ARRAY *ary;
Xint *arglast;
X{
X    register STR **st = stack->ary_array;
X    register int sp = arglast[1];
X    register int items = arglast[2] - sp;
X    register STR *str;
X    register int i;
X
X    aunshift(ary,items);
X    i = 0;
X    for (st += ++sp; i < items; i++,st++) {
X	str = Str_new(27,0);
X	str_sset(str,*st);
X	(void)astore(ary,i,str);
X    }
X}
X
Xint
Xdo_subr(arg,gimme,arglast)
Xregister ARG *arg;
Xint gimme;
Xint *arglast;
X{
X    register STR **st = stack->ary_array;
X    register int sp = arglast[1];
X    register int items = arglast[2] - sp;
X    register SUBR *sub;
X    ARRAY *savearray;
X    STAB *stab;
X    char *oldfile = filename;
X    int oldsave = savestack->ary_fill;
X    int oldtmps_base = tmps_base;
X
X    if ((arg[1].arg_type & A_MASK) == A_WORD)
X	stab = arg[1].arg_ptr.arg_stab;
X    else {
X	STR *tmpstr = stab_val(arg[1].arg_ptr.arg_stab);
X
X	if (tmpstr)
X	    stab = stabent(str_get(tmpstr),TRUE);
X	else
X	    stab = Nullstab;
X    }
X    if (!stab)
X	fatal("Undefined subroutine called");
X    sub = stab_sub(stab);
X    if (!sub)
X	fatal("Undefined subroutine \"%s\" called", stab_name(stab));
X    if ((arg[2].arg_type & A_MASK) != A_NULL) {
X	savearray = stab_xarray(defstab);
X	stab_xarray(defstab) = afake(defstab, items, &st[sp+1]);
X    }
X    savelong(&sub->depth);
X    sub->depth++;
X    saveint(&wantarray);
X    wantarray = gimme;
X    if (sub->depth >= 2) {	/* save temporaries on recursion? */
X	if (sub->depth == 100 && dowarn)
X	    warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
X	savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
X    }
X    filename = sub->filename;
X    tmps_base = tmps_max;
X    sp = cmd_exec(sub->cmd,gimme,--sp);		/* so do it already */
X    st = stack->ary_array;
X
X    if ((arg[2].arg_type & A_MASK) != A_NULL) {
X	afree(stab_xarray(defstab));  /* put back old $_[] */
X	stab_xarray(defstab) = savearray;
X    }
X    filename = oldfile;
X    tmps_base = oldtmps_base;
X    if (savestack->ary_fill > oldsave) {
X	for (items = arglast[0] + 1; items <= sp; items++)
X	    st[items] = str_static(st[items]);
X		/* in case restore wipes old str */
X	restorelist(oldsave);
X    }
X    return sp;
X}
X
Xint
Xdo_dbsubr(arg,gimme,arglast)
Xregister ARG *arg;
Xint gimme;
Xint *arglast;
X{
X    register STR **st = stack->ary_array;
X    register int sp = arglast[1];
X    register int items = arglast[2] - sp;
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[1].arg_type & A_MASK) == A_WORD)
X	stab = arg[1].arg_ptr.arg_stab;
X    else {
X	STR *tmpstr = stab_val(arg[1].arg_ptr.arg_stab);
X
X	if (tmpstr)
X	    stab = stabent(str_get(tmpstr),TRUE);
X	else
X	    stab = Nullstab;
X    }
X    if (!stab)
X	fatal("Undefined subroutine called");
X    sub = stab_sub(stab);
X    if (!sub)
X	fatal("Undefined subroutine \"%s\" called", stab_name(stab));
X/* begin differences */
X    str = stab_val(DBsub);
X    saveitem(str);
X    str_set(str,stab_name(stab));
X    sub = stab_sub(DBsub);
X    if (!sub)
X	fatal("No DBsub routine");
X/* end differences */
X    if ((arg[2].arg_type & A_MASK) != A_NULL) {
X	savearray = stab_xarray(defstab);
X	stab_xarray(defstab) = afake(defstab, items, &st[sp+1]);
X    }
X    savelong(&sub->depth);
X    sub->depth++;
X    saveint(&wantarray);
X    wantarray = gimme;
X    if (sub->depth >= 2) {	/* save temporaries on recursion? */
X	if (sub->depth == 100 && dowarn)
X	    warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
X	savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
X    }
X    filename = sub->filename;
X    tmps_base = tmps_max;
X    sp = cmd_exec(sub->cmd,gimme, --sp);	/* so do it already */
X    st = stack->ary_array;
X
X    if ((arg[2].arg_type & A_MASK) != A_NULL) {
X	afree(stab_xarray(defstab));  /* put back old $_[] */
X	stab_xarray(defstab) = savearray;
X    }
X    filename = oldfile;
X    tmps_base = oldtmps_base;
X    if (savestack->ary_fill > oldsave) {
X	for (items = arglast[0] + 1; items <= sp; items++)
X	    st[items] = str_static(st[items]);
X		/* in case restore wipes old str */
X	restorelist(oldsave);
X    }
X    return sp;
X}
X
Xint
Xdo_assign(arg,gimme,arglast)
Xregister ARG *arg;
Xint gimme;
Xint *arglast;
X{
X
X    register STR **st = stack->ary_array;
X    STR **firstrelem = st + arglast[1] + 1;
X    STR **firstlelem = st + arglast[0] + 1;
X    STR **lastrelem = st + arglast[2];
X    STR **lastlelem = st + arglast[1];
X    register STR **relem;
X    register STR **lelem;
X
X    register STR *str;
X    register ARRAY *ary;
X    register int makelocal;
X    HASH *hash;
X    int i;
X
X    makelocal = (arg->arg_flags & AF_LOCAL);
X    delaymagic = DM_DELAY;		/* catch simultaneous items */
X
X    /* If there's a common identifier on both sides we have to take
X     * special care that assigning the identifier on the left doesn't
X     * clobber a value on the right that's used later in the list.
X     */
X    if (arg->arg_flags & AF_COMMON) {
X	for (relem = firstrelem; relem <= lastrelem; relem++) {
X	    if (str = *relem)
X		*relem = str_static(str);
X	}
X    }
X    relem = firstrelem;
X    lelem = firstlelem;
X    ary = Null(ARRAY*);
X    hash = Null(HASH*);
X    while (lelem <= lastlelem) {
X	str = *lelem++;
X	if (str->str_state >= SS_HASH) {
X	    if (str->str_state == SS_ARY) {
X		if (makelocal)
X		    ary = saveary(str->str_u.str_stab);
X		else {
X		    ary = stab_array(str->str_u.str_stab);
X		    ary->ary_fill = -1;
X		}
X		i = 0;
X		while (relem <= lastrelem) {	/* gobble up all the rest */
X		    str = Str_new(28,0);
X		    if (*relem)
X			str_sset(str,*(relem++));
X		    else
X			relem++;
X		    (void)astore(ary,i++,str);
X		}
X	    }
X	    else if (str->str_state == SS_HASH) {
X		char *tmps;
X		STR *tmpstr;
X
X		if (makelocal)
X		    hash = savehash(str->str_u.str_stab);
X		else {
X		    hash = stab_hash(str->str_u.str_stab);
X		    hclear(hash);
X		}
X		while (relem < lastrelem) {	/* gobble up all the rest */
X		    if (*relem)
X			str = *(relem++);
X		    else
X			str = &str_no, relem++;
X		    tmps = str_get(str);
X		    tmpstr = Str_new(29,0);
X		    if (*relem)
X			str_sset(tmpstr,*(relem++));	/* value */
X		    else
X			relem++;
X		    (void)hstore(hash,tmps,str->str_cur,tmpstr,0);
X		}
X	    }
X	    else
X		fatal("panic: do_assign");
X	}
X	else {
X	    if (makelocal)
X		saveitem(str);
X	    if (relem <= lastrelem)
X		str_sset(str, *(relem++));
X	    else
X		str_nset(str, "", 0);
X	    STABSET(str);
X	}
X    }
X    if (delaymagic > 1) {
X#ifdef SETREUID
X	if (delaymagic & DM_REUID)
X	    setreuid(uid,euid);
X#endif
X#ifdef SETREGID
X	if (delaymagic & DM_REGID)
X	    setregid(gid,egid);
X#endif
X    }
X    delaymagic = 0;
X    if (gimme == G_ARRAY) {
X	i = lastrelem - firstrelem + 1;
X	if (ary || hash)
X	    Copy(firstrelem, firstlelem, i, STR*);
X	return arglast[0] + i;
X    }
X    else {
X	str_numset(arg->arg_ptr.arg_str,(double)(arglast[2] - arglast[1]));
X	*firstlelem = arg->arg_ptr.arg_str;
X	return arglast[0] + 1;
X    }
X}
X
Xint
Xdo_study(str,arg,gimme,arglast)
XSTR *str;
XARG *arg;
Xint gimme;
Xint *arglast;
X{
X    register unsigned char *s;
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    int retval;
X    int retarg = arglast[0] + 1;
X
X#ifndef lint
X    s = (unsigned char*)(str_get(str));
X#else
X    s = Null(unsigned char*);
X#endif
X    if (lastscream)
X	lastscream->str_pok &= ~SP_STUDIED;
X    lastscream = str;
X    if (pos <= 0) {
X	retval = 0;
X	goto ret;
X    }
X    if (pos > maxscream) {
X	if (maxscream < 0) {
X	    maxscream = pos + 80;
X	    New(301,screamfirst, 256, int);
X	    New(302,screamnext, maxscream, int);
X	}
X	else {
X	    maxscream = pos + pos / 4;
X	    Renew(screamnext, maxscream, 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	/* If there were any case insensitive searches, we must assume they
X	 * all are.  This speeds up insensitive searches much more than
X	 * it slows down sensitive ones.
X	 */
X	if (sawi)
X	    sfirst[fold[ch]] = pos;
X    }
X
X    str->str_pok |= SP_STUDIED;
X    retval = 1;
X  ret:
X    str_numset(arg->arg_ptr.arg_str,(double)retval);
X    stack->ary_array[retarg] = arg->arg_ptr.arg_str;
X    return retarg;
X}
X
Xint
Xdo_defined(str,arg,gimme,arglast)
XSTR *str;
Xregister ARG *arg;
Xint gimme;
Xint *arglast;
X{
X    register int type;
X    register int retarg = arglast[0] + 1;
X    int retval;
X
X    if ((arg[1].arg_type & A_MASK) != A_LEXPR)
X	fatal("Illegal argument to defined()");
X    arg = arg[1].arg_ptr.arg_arg;
X    type = arg->arg_type;
X
X    if (type == O_ARRAY || type == O_LARRAY)
X	retval = stab_xarray(arg[1].arg_ptr.arg_stab) != 0;
X    else if (type == O_HASH || type == O_LHASH)
X	retval = stab_xhash(arg[1].arg_ptr.arg_stab) != 0;
X    else if (type == O_SUBR || type == O_DBSUBR)
X	retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
X    else if (type == O_ASLICE || type == O_LASLICE)
X	retval = stab_xarray(arg[1].arg_ptr.arg_stab) != 0;
X    else if (type == O_HSLICE || type == O_LHSLICE)
X	retval = stab_xhash(arg[1].arg_ptr.arg_stab) != 0;
X    else
X	retval = FALSE;
X    str_numset(str,(double)retval);
X    stack->ary_array[retarg] = str;
X    return retarg;
X}
X
Xint
Xdo_undef(str,arg,gimme,arglast)
XSTR *str;
Xregister ARG *arg;
Xint gimme;
Xint *arglast;
X{
X    register int type;
X    register STAB *stab;
X    int retarg = arglast[0] + 1;
X
X    if ((arg[1].arg_type & A_MASK) != A_LEXPR)
X	fatal("Illegal argument to undef()");
X    arg = arg[1].arg_ptr.arg_arg;
X    type = arg->arg_type;
X
X    if (type == O_ARRAY || type == O_LARRAY) {
X	stab = arg[1].arg_ptr.arg_stab;
X	afree(stab_xarray(stab));
X	stab_xarray(stab) = Null(ARRAY*);
X    }
X    else if (type == O_HASH || type == O_LHASH) {
X	stab = arg[1].arg_ptr.arg_stab;
X	(void)hfree(stab_xhash(stab));
X	stab_xhash(stab) = Null(HASH*);
X    }
X    else if (type == O_SUBR || type == O_DBSUBR) {
X	stab = arg[1].arg_ptr.arg_stab;
X	cmd_free(stab_sub(stab)->cmd);
X	afree(stab_sub(stab)->tosave);
X	Safefree(stab_sub(stab));
X	stab_sub(stab) = Null(SUBR*);
X    }
X    else
X	fatal("Can't undefine that kind of object");
X    str_numset(str,0.0);
X    stack->ary_array[retarg] = str;
X    return retarg;
X}
X
Xint
Xdo_vec(lvalue,astr,arglast)
Xint lvalue;
XSTR *astr;
Xint *arglast;
X{
X    STR **st = stack->ary_array;
X    int sp = arglast[0];
X    register STR *str = st[++sp];
X    register int offset = (int)str_gnum(st[++sp]);
X    register int size = (int)str_gnum(st[++sp]);
X    unsigned char *s = (unsigned char*)str_get(str);
X    unsigned long retnum;
X    int len;
X
X    sp = arglast[1];
X    offset *= size;		/* turn into bit offset */
X    len = (offset + size + 7) / 8;
X    if (offset < 0 || size < 1)
X	retnum = 0;
X    else if (!lvalue && len > str->str_cur)
X	retnum = 0;
X    else {
X	if (len > str->str_cur) {
X	    STR_GROW(str,len);
X	    (void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
X	    str->str_cur = len;
X	}
X	s = (unsigned char*)str_get(str);
X	if (size < 8)
X	    retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
X	else {
X	    offset >>= 3;
X	    if (size == 8)
X		retnum = s[offset];
X	    else if (size == 16)
X		retnum = (s[offset] << 8) + s[offset+1];
X	    else if (size == 32)
X		retnum = (s[offset] << 24) + (s[offset + 1] << 16) +
X			(s[offset + 2] << 8) + s[offset+3];
X	}
X
X	if (lvalue) {                      /* it's an lvalue! */
X	    struct lstring *lstr = (struct lstring*)astr;
X
X	    astr->str_magic = str;
X	    st[sp]->str_rare = 'v';
X	    lstr->lstr_offset = offset;
X	    lstr->lstr_len = size;
X	}
X    }
X
X    str_numset(astr,(double)retnum);
X    st[sp] = astr;
X    return sp;
X}
X
Xvoid
Xdo_vecset(mstr,str)
XSTR *mstr;
XSTR *str;
X{
X    struct lstring *lstr = (struct lstring*)str;
X    register int offset;
X    register int size;
X    register unsigned char *s = (unsigned char*)mstr->str_ptr;
X    register unsigned long lval = (unsigned long)str_gnum(str);
X    int mask;
X
X    mstr->str_rare = 0;
X    str->str_magic = Nullstr;
X    offset = lstr->lstr_offset;
X    size = lstr->lstr_len;
X    if (size < 8) {
X	mask = (1 << size) - 1;
X	size = offset & 7;
X	lval &= mask;
X	offset >>= 3;
X	s[offset] &= ~(mask << size);
X	s[offset] |= lval << size;
X    }
X    else {
X	if (size == 8)
X	    s[offset] = lval & 255;
X	else if (size == 16) {
X	    s[offset] = (lval >> 8) & 255;
X	    s[offset+1] = lval & 255;
X	}
X	else if (size == 32) {
X	    s[offset] = (lval >> 24) & 255;
X	    s[offset+1] = (lval >> 16) & 255;
X	    s[offset+2] = (lval >> 8) & 255;
X	    s[offset+3] = lval & 255;
X	}
X    }
X}
X
Xdo_chop(astr,str)
Xregister STR *astr;
Xregister STR *str;
X{
X    register char *tmps;
X    register int i;
X    ARRAY *ary;
X    HASH *hash;
X    HENT *entry;
X
X    if (!str)
X	return;
X    if (str->str_state == SS_ARY) {
X	ary = stab_array(str->str_u.str_stab);
X	for (i = 0; i <= ary->ary_fill; i++)
X	    do_chop(astr,ary->ary_array[i]);
X	return;
X    }
X    if (str->str_state == SS_HASH) {
X	hash = stab_hash(str->str_u.str_stab);
X	(void)hiterinit(hash);
X	while (entry = hiternext(hash))
X	    do_chop(astr,hiterval(hash,entry));
X	return;
X    }
X    tmps = str_get(str);
X    if (!tmps)
X	return;
X    tmps += str->str_cur - (str->str_cur != 0);
X    str_nset(astr,tmps,1);	/* remember last char */
X    *tmps = '\0';				/* wipe it out */
X    str->str_cur = tmps - str->str_ptr;
X    str->str_nok = 0;
X}
X
Xdo_vop(optype,str,left,right)
XSTR *str;
XSTR *left;
XSTR *right;
X{
X    register char *s = str_get(str);
X    register char *l = str_get(left);
X    register char *r = str_get(right);
X    register int len;
X
X    len = left->str_cur;
X    if (len > right->str_cur)
X	len = right->str_cur;
X    if (str->str_cur > len)
X	str->str_cur = len;
X    else if (str->str_cur < len) {
X	STR_GROW(str,len);
X	(void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
X	str->str_cur = len;
X	s = str_get(str);
X    }
X    switch (optype) {
X    case O_BIT_AND:
X	while (len--)
X	    *s++ = *l++ & *r++;
X	break;
X    case O_XOR:
X	while (len--)
X	    *s++ = *l++ ^ *r++;
X	goto mop_up;
X    case O_BIT_OR:
X	while (len--)
X	    *s++ = *l++ | *r++;
X      mop_up:
X	len = str->str_cur;
X	if (right->str_cur > len)
X	    str_ncat(str,right->str_ptr+len,right->str_cur - len);
X	else if (left->str_cur > len)
X	    str_ncat(str,left->str_ptr+len,left->str_cur - len);
X	break;
X    }
X}
X
Xint
Xdo_syscall(arglast)
Xint *arglast;
X{
X    register STR **st = stack->ary_array;
X    register int sp = arglast[1];
X    register int items = arglast[2] - sp;
X    long arg[8];
X    register int i = 0;
X    int retval = -1;
X
X#ifdef SYSCALL
X#ifdef TAINT
X    for (st += ++sp; items--; st++)
X	tainted |= (*st)->str_tainted;
X    st = stack->ary_array;
X    sp = arglast[1];
X    items = arglast[2] - sp;
X#endif
X#ifdef TAINT
X    taintproper("Insecure dependency in syscall");
X#endif
X    /* This probably won't work on machines where sizeof(long) != sizeof(int)
X     * or where sizeof(long) != sizeof(char*).  But such machines will
X     * not likely have syscall implemented either, so who cares?
X     */
X    while (items--) {
X	if (st[++sp]->str_nok || !i)
X	    arg[i++] = (long)str_gnum(st[sp]);
X#ifndef lint
X	else
X	    arg[i++] = (long)st[sp]->str_ptr;
X#endif /* lint */
X    }
X    sp = arglast[1];
X    items = arglast[2] - sp;
X    switch (items) {
X    case 0:
X	fatal("Too few args to syscall");
X    case 1:
X	retval = syscall(arg[0]);
X	break;
X    case 2:
X	retval = syscall(arg[0],arg[1]);
X	break;
X    case 3:
X	retval = syscall(arg[0],arg[1],arg[2]);
X	break;
X    case 4:
X	retval = syscall(arg[0],arg[1],arg[2],arg[3]);
X	break;
X    case 5:
X	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4]);
X	break;
X    case 6:
X	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5]);
X	break;
X    case 7:
X	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6]);
X	break;
X    case 8:
X	retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
X	  arg[7]);
X	break;
X    }
X    st[sp] = str_static(&str_undef);
X    str_numset(st[sp], (double)retval);
X    return sp;
X#else
X    fatal("syscall() unimplemented");
X#endif
X}
X
X
!STUFFY!FUNK!
echo Extracting arg.h
sed >arg.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: arg.h,v 3.0 89/10/18 15:08:27 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:	arg.h,v $
X * Revision 3.0  89/10/18  15:08:27  lwall
X * 3.0 baseline
X * 
X */
X
X#define O_NULL 0
X#define O_ITEM 1
X#define O_ITEM2 2
X#define O_ITEM3 3
X#define O_CONCAT 4
X#define O_MATCH 5
X#define O_NMATCH 6
X#define O_SUBST 7
X#define O_NSUBST 8
X#define O_ASSIGN 9
X#define O_MULTIPLY 10
X#define O_DIVIDE 11
X#define O_MODULO 12
X#define O_ADD 13
X#define O_SUBTRACT 14
X#define O_LEFT_SHIFT 15
X#define O_RIGHT_SHIFT 16
X#define O_LT 17
X#define O_GT 18
X#define O_LE 19
X#define O_GE 20
X#define O_EQ 21
X#define O_NE 22
X#define O_BIT_AND 23
X#define O_XOR 24
X#define O_BIT_OR 25
X#define O_AND 26
X#define O_OR 27
X#define O_COND_EXPR 28
X#define O_COMMA 29
X#define O_NEGATE 30
X#define O_NOT 31
X#define O_COMPLEMENT 32
X#define O_WRITE 33
X#define O_OPEN 34
X#define O_TRANS 35
X#define O_NTRANS 36
X#define O_CLOSE 37
X#define O_ARRAY 38
X#define O_HASH 39
X#define O_LARRAY 40
X#define O_LHASH 41
X#define O_PUSH 42
X#define O_POP 43
X#define O_SHIFT 44
X#define O_SPLIT 45
X#define O_LENGTH 46
X#define O_SPRINTF 47
X#define O_SUBSTR 48
X#define O_JOIN 49
X#define O_SLT 50
X#define O_SGT 51
X#define O_SLE 52
X#define O_SGE 53
X#define O_SEQ 54
X#define O_SNE 55
X#define O_SUBR 56
X#define O_PRINT 57
X#define O_CHDIR 58
X#define O_DIE 59
X#define O_EXIT 60
X#define O_RESET 61
X#define O_LIST 62
X#define O_SELECT 63
X#define O_EOF 64
X#define O_TELL 65
X#define O_SEEK 66
X#define O_LAST 67
X#define O_NEXT 68
X#define O_REDO 69
X#define O_GOTO 70
X#define O_INDEX 71
X#define O_TIME 72
X#define O_TMS 73
X#define O_LOCALTIME 74
X#define O_GMTIME 75
X#define O_STAT 76
X#define O_CRYPT 77
X#define O_EXP 78
X#define O_LOG 79
X#define O_SQRT 80
X#define O_INT 81
X#define O_PRTF 82
X#define O_ORD 83
X#define O_SLEEP 84
X#define O_FLIP 85
X#define O_FLOP 86
X#define O_KEYS 87
X#define O_VALUES 88
X#define O_EACH 89
X#define O_CHOP 90
X#define O_FORK 91
X#define O_EXEC 92
X#define O_SYSTEM 93
X#define O_OCT 94
X#define O_HEX 95
X#define O_CHMOD 96
X#define O_CHOWN 97
X#define O_KILL 98
X#define O_RENAME 99
X#define O_UNLINK 100
X#define O_UMASK 101
X#define O_UNSHIFT 102
X#define O_LINK 103
X#define O_REPEAT 104
X#define O_EVAL 105
X#define O_FTEREAD 106
X#define O_FTEWRITE 107
X#define O_FTEEXEC 108
X#define O_FTEOWNED 109
X#define O_FTRREAD 110
X#define O_FTRWRITE 111
X#define O_FTREXEC 112
X#define O_FTROWNED 113
X#define O_FTIS 114
X#define O_FTZERO 115
X#define O_FTSIZE 116
X#define O_FTFILE 117
X#define O_FTDIR 118
X#define O_FTLINK 119
X#define O_SYMLINK 120
X#define O_FTPIPE 121
X#define O_FTSOCK 122
X#define O_FTBLK 123
X#define O_FTCHR 124
X#define O_FTSUID 125
X#define O_FTSGID 126
X#define O_FTSVTX 127
X#define O_FTTTY 128
X#define O_DOFILE 129
X#define O_FTTEXT 130
X#define O_FTBINARY 131
X#define O_UTIME 132
X#define O_WAIT 133
X#define O_SORT 134
X#define O_DELETE 135
X#define O_STUDY 136
X#define O_ATAN2 137
X#define O_SIN 138
X#define O_COS 139
X#define O_RAND 140
X#define O_SRAND 141
X#define O_POW 142
X#define O_RETURN 143
X#define O_GETC 144
X#define O_MKDIR 145
X#define O_RMDIR 146
X#define O_GETPPID 147
X#define O_GETPGRP 148
X#define O_SETPGRP 149
X#define O_GETPRIORITY 150
X#define O_SETPRIORITY 151
X#define O_CHROOT 152
X#define O_IOCTL 153
X#define O_FCNTL 154
X#define O_FLOCK 155
X#define O_RINDEX 156
X#define O_PACK 157
X#define O_UNPACK 158
X#define O_READ 159
X#define O_WARN 160
X#define O_DBMOPEN 161
X#define O_DBMCLOSE 162
X#define O_ASLICE 163
X#define O_HSLICE 164
X#define O_LASLICE 165
X#define O_LHSLICE 166
X#define O_F_OR_R 167
X#define O_RANGE 168
X#define O_RCAT 169
X#define O_AASSIGN 170
X#define O_SASSIGN 171
X#define O_DUMP 172
X#define O_REVERSE 173
X#define O_ADDROF 174
X#define O_SOCKET 175
X#define O_BIND 176
X#define O_CONNECT 177
X#define O_LISTEN 178
X#define O_ACCEPT 179
X#define O_SEND 180
X#define O_RECV 181
X#define O_SSELECT 182
X#define O_SOCKETPAIR 183
X#define O_DBSUBR 184
X#define O_DEFINED 185
X#define O_UNDEF 186
X#define O_READLINK 187
X#define O_LSTAT 188
X#define O_AELEM 189
X#define O_HELEM 190
X#define O_LAELEM 191
X#define O_LHELEM 192
X#define O_LOCAL 193
X#define O_UNUSED 194
X#define O_FILENO 195
X#define O_GHBYNAME 196
X#define O_GHBYADDR 197
X#define O_GHOSTENT 198
X#define O_SHOSTENT 199
X#define O_EHOSTENT 200
X#define O_GSBYNAME 201
X#define O_GSBYPORT 202
X#define O_GSERVENT 203
X#define O_SSERVENT 204
X#define O_ESERVENT 205
X#define O_GPBYNAME 206
X#define O_GPBYNUMBER 207
X#define O_GPROTOENT 208
X#define O_SPROTOENT 209
X#define O_EPROTOENT 210
X#define O_GNBYNAME 211
X#define O_GNBYADDR 212
X#define O_GNETENT 213
X#define O_SNETENT 214
X#define O_ENETENT 215
X#define O_VEC 216
X#define O_GREP 217
X#define O_GPWNAM 218
X#define O_GPWUID 219
X#define O_GPWENT 220
X#define O_SPWENT 221
X#define O_EPWENT 222
X#define O_GGRNAM 223
X#define O_GGRGID 224
X#define O_GGRENT 225
X#define O_SGRENT 226
X#define O_EGRENT 227
X#define O_SHUTDOWN 228
X#define O_OPENDIR 229
X#define O_READDIR 230
X#define O_TELLDIR 231
X#define O_SEEKDIR 232
X#define O_REWINDDIR 233
X#define O_CLOSEDIR 234
X#define O_GETLOGIN 235
X#define O_SYSCALL 236
X#define O_GSOCKOPT 237
X#define O_SSOCKOPT 238
X#define O_GETSOCKNAME 239
X#define O_GETPEERNAME 240
X#define MAXO 241
X
X#ifndef DOINIT
Xextern char *opname[];
X#else
Xchar *opname[] = {
X    "NULL",
X    "ITEM",
X    "ITEM2",
X    "ITEM3",
X    "CONCAT",
X    "MATCH",
X    "NMATCH",
X    "SUBST",
X    "NSUBST",
X    "ASSIGN",
X    "MULTIPLY",
X    "DIVIDE",
X    "MODULO",
X    "ADD",
X    "SUBTRACT",
X    "LEFT_SHIFT",
X    "RIGHT_SHIFT",
X    "LT",
X    "GT",
X    "LE",
X    "GE",
X    "EQ",
X    "NE",
X    "BIT_AND",
X    "XOR",
X    "BIT_OR",
X    "AND",
X    "OR",
X    "COND_EXPR",
X    "COMMA",
X    "NEGATE",
X    "NOT",
X    "COMPLEMENT",
X    "WRITE",
X    "OPEN",
X    "TRANS",
X    "NTRANS",
X    "CLOSE",
X    "ARRAY",
X    "HASH",
X    "LARRAY",
X    "LHASH",
X    "PUSH",
X    "POP",
X    "SHIFT",
X    "SPLIT",
X    "LENGTH",
X    "SPRINTF",
X    "SUBSTR",
X    "JOIN",
X    "SLT",
X    "SGT",
X    "SLE",
X    "SGE",
X    "SEQ",
X    "SNE",
X    "SUBR",
X    "PRINT",
X    "CHDIR",
X    "DIE",
X    "EXIT",
X    "RESET",
X    "LIST",
X    "SELECT",
X    "EOF",
X    "TELL",
X    "SEEK",
X    "LAST",
X    "NEXT",
X    "REDO",
X    "GOTO",/* shudder */
X    "INDEX",
X    "TIME",
X    "TIMES",
X    "LOCALTIME",
X    "GMTIME",
X    "STAT",
X    "CRYPT",
X    "EXP",
X    "LOG",
X    "SQRT",
X    "INT",
X    "PRINTF",
X    "ORD",
X    "SLEEP",
X    "FLIP",
X    "FLOP",
X    "KEYS",
X    "VALUES",
X    "EACH",
X    "CHOP",
X    "FORK",
X    "EXEC",
X    "SYSTEM",
X    "OCT",
X    "HEX",
X    "CHMOD",
X    "CHOWN",
X    "KILL",
X    "RENAME",
X    "UNLINK",
X    "UMASK",
X    "UNSHIFT",
X    "LINK",
X    "REPEAT",
X    "EVAL",
X    "FTEREAD",
X    "FTEWRITE",
X    "FTEEXEC",
X    "FTEOWNED",
X    "FTRREAD",
X    "FTRWRITE",
X    "FTREXEC",
X    "FTROWNED",
X    "FTIS",
X    "FTZERO",
X    "FTSIZE",
X    "FTFILE",
X    "FTDIR",
X    "FTLINK",
X    "SYMLINK",
X    "FTPIPE",
X    "FTSOCK",
X    "FTBLK",
X    "FTCHR",
X    "FTSUID",
X    "FTSGID",
X    "FTSVTX",
X    "FTTTY",
X    "DOFILE",
X    "FTTEXT",
X    "FTBINARY",
X    "UTIME",
X    "WAIT",
X    "SORT",
X    "DELETE",
X    "STUDY",
X    "ATAN2",
X    "SIN",
X    "COS",
X    "RAND",
X    "SRAND",
X    "POW",
X    "RETURN",
X    "GETC",
X    "MKDIR",
X    "RMDIR",
X    "GETPPID",
X    "GETPGRP",
X    "SETPGRP",
X    "GETPRIORITY",
X    "SETPRIORITY",
X    "CHROOT",
X    "IOCTL",
X    "FCNTL",
X    "FLOCK",
X    "RINDEX",
X    "PACK",
X    "UNPACK",
X    "READ",
X    "WARN",
X    "DBMOPEN",
X    "DBMCLOSE",
X    "ASLICE",
X    "HSLICE",
X    "LASLICE",
X    "LHSLICE",
X    "FLIP_OR_RANGE",
X    "RANGE",
X    "RCAT",
X    "AASSIGN",
X    "SASSIGN",
X    "DUMP",
X    "REVERSE",
X    "ADDRESS_OF",
X    "SOCKET",
X    "BIND",
X    "CONNECT",
X    "LISTEN",
X    "ACCEPT",
X    "SEND",
X    "RECV",
X    "SSELECT",
X    "SOCKETPAIR",
X    "DBSUBR",
X    "DEFINED",
X    "UNDEF",
X    "READLINK",
X    "LSTAT",
X    "AELEM",
X    "HELEM",
X    "LAELEM",
X    "LHELEM",
X    "LOCAL",
X    "UNUSED",
X    "FILENO",
X    "GHBYNAME",
X    "GHBYADDR",
X    "GHOSTENT",
X    "SHOSTENT",
X    "EHOSTENT",
X    "GSBYNAME",
X    "GSBYPORT",
X    "GSERVENT",
X    "SSERVENT",
X    "ESERVENT",
X    "GPBYNAME",
X    "GPBYNUMBER",
X    "GPROTOENT",
X    "SPROTOENT",
X    "EPROTOENT",
X    "GNBYNAME",
X    "GNBYADDR",
X    "GNETENT",
X    "SNETENT",
X    "ENETENT",
X    "VEC",
X    "GREP",
X    "GPWNAM",
X    "GPWUID",
X    "GPWENT",
X    "SPWENT",
X    "EPWENT",
X    "GGRNAM",
X    "GGRGID",
X    "GGRENT",
X    "SGRENT",
X    "EGRENT",
X    "SHUTDOWN",
X    "OPENDIR",
X    "READDIR",
X    "TELLDIR",
X    "SEEKDIR",
X    "REWINDDIR",
X    "CLOSEDIR",
X    "GETLOGIN",
X    "SYSCALL",
X    "GSOCKOPT",
X    "SSOCKOPT",
X    "GETSOCKNAME",
X    "GETPEERNAME",
X    "241"
X};
X#endif
X
X#define A_NULL 0
X#define A_EXPR 1
X#define A_CMD 2
X#define A_STAB 3
X#define A_LVAL 4
X#define A_SINGLE 5
X#define A_DOUBLE 6
X#define A_BACKTICK 7
X#define A_READ 8
X#define A_SPAT 9
X#define A_LEXPR 10
X#define A_ARYLEN 11
X#define A_ARYSTAB 12
X#define A_LARYLEN 13
X#define A_GLOB 14
X#define A_WORD 15
X#define A_INDREAD 16
X#define A_LARYSTAB 17
X#define A_STAR 18
X#define A_LSTAR 19
X#define A_WANTARRAY 20
X
X#define A_MASK 31
X#define A_DONT 32		/* or this into type to suppress evaluation */
X
X#ifndef DOINIT
Xextern char *argname[];
X#else
Xchar *argname[] = {
X    "A_NULL",
X    "EXPR",
X    "CMD",
X    "STAB",
X    "LVAL",
X    "SINGLE",
X    "DOUBLE",
X    "BACKTICK",
X    "READ",
X    "SPAT",
X    "LEXPR",
X    "ARYLEN",
X    "ARYSTAB",
X    "LARYLEN",
X    "GLOB",
X    "WORD",
X    "INDREAD",
X    "LARYSTAB",
X    "STAR",
X    "LSTAR",
X    "WANTARRAY",
X    "21"
X};
X#endif
X
X#ifndef DOINIT
Xextern bool hoistable[];
X#else
Xbool hoistable[] =
X  {0,	/* A_NULL */
X   0,	/* EXPR */
X   1,	/* CMD */
X   1,	/* STAB */
X   0,	/* LVAL */
X   1,	/* SINGLE */
X   0,	/* DOUBLE */
X   0,	/* BACKTICK */
X   0,	/* READ */
X   0,	/* SPAT */
X   0,	/* LEXPR */
X   1,	/* ARYLEN */
X   1,	/* ARYSTAB */
X   0,	/* LARYLEN */
X   0,	/* GLOB */
X   1,	/* WORD */
X   0,	/* INDREAD */
X   0,	/* LARYSTAB */
X   1,	/* STAR */
X   1,	/* LSTAR */
X   1,	/* WANTARRAY */
X   0,	/* 21 */
X};
X#endif
X
Xunion argptr {
X    ARG		*arg_arg;
X    char	*arg_cval;
X    STAB	*arg_stab;
X    SPAT	*arg_spat;
X    CMD		*arg_cmd;
X    STR		*arg_str;
X    HASH	*arg_hash;
X};
X
Xstruct arg {
X    union argptr arg_ptr;
X    short	arg_len;
X#ifdef mips
X    short	pad;
X#endif
X    unsigned char arg_type;
X    unsigned char arg_flags;
X};
X
X#define AF_ARYOK 1		/* op can handle multiple values here */
X#define AF_POST 2		/* post *crement this item */
X#define AF_PRE 4		/* pre *crement this item */
X#define AF_UP 8			/* increment rather than decrement */
X#define AF_COMMON 16		/* left and right have symbols in common */
X#define AF_UNUSED 32		/*  */
X#define AF_LISTISH 64		/* turn into list if important */
X#define AF_LOCAL 128		/* list of local variables */
X
X/*
X * Most of the ARG pointers are used as pointers to arrays of ARG.  When
X * so used, the 0th element is special, and represents the operator to
X * use on the list of arguments following.  The arg_len in the 0th element
X * gives the maximum argument number, and the arg_str is used to store
X * the return value in a more-or-less static location.  Sorry it's not
X * re-entrant (yet), but it sure makes it efficient.  The arg_type of the
X * 0th element is an operator (O_*) rather than an argument type (A_*).
X */
X
X#define Nullarg Null(ARG*)
X
X#ifndef DOINIT
XEXT char opargs[MAXO+1];
X#else
X#define A(e1,e2,e3) (e1+(e2<<2)+(e3<<4))
Xchar opargs[MAXO+1] = {
X	A(0,0,0),	/* NULL */
X	A(1,0,0),	/* ITEM */
X	A(0,0,0),	/* ITEM2 */
X	A(0,0,0),	/* ITEM3 */
X	A(1,1,0),	/* CONCAT */
X	A(1,0,0),	/* MATCH */
X	A(1,0,0),	/* NMATCH */
X	A(1,0,0),	/* SUBST */
X	A(1,0,0),	/* NSUBST */
X	A(1,1,0),	/* ASSIGN */
X	A(1,1,0),	/* MULTIPLY */
X	A(1,1,0),	/* DIVIDE */
X	A(1,1,0),	/* MODULO */
X	A(1,1,0),	/* ADD */
X	A(1,1,0),	/* SUBTRACT */
X	A(1,1,0),	/* LEFT_SHIFT */
X	A(1,1,0),	/* RIGHT_SHIFT */
X	A(1,1,0),	/* LT */
X	A(1,1,0),	/* GT */
X	A(1,1,0),	/* LE */
X	A(1,1,0),	/* GE */
X	A(1,1,0),	/* EQ */
X	A(1,1,0),	/* NE */
X	A(1,1,0),	/* BIT_AND */
X	A(1,1,0),	/* XOR */
X	A(1,1,0),	/* BIT_OR */
X	A(1,0,0),	/* AND */
X	A(1,0,0),	/* OR */
X	A(1,0,0),	/* COND_EXPR */
X	A(1,1,0),	/* COMMA */
X	A(1,0,0),	/* NEGATE */
X	A(1,0,0),	/* NOT */
X	A(1,0,0),	/* COMPLEMENT */
X	A(1,0,0),	/* WRITE */
X	A(1,1,0),	/* OPEN */
X	A(1,0,0),	/* TRANS */
X	A(1,0,0),	/* NTRANS */
X	A(1,0,0),	/* CLOSE */
X	A(0,0,0),	/* ARRAY */
X	A(0,0,0),	/* HASH */
X	A(0,0,0),	/* LARRAY */
X	A(0,0,0),	/* LHASH */
X	A(0,3,0),	/* PUSH */
X	A(0,0,0),	/* POP */
X	A(0,0,0),	/* SHIFT */
X	A(1,0,1),	/* SPLIT */
X	A(1,0,0),	/* LENGTH */
X	A(3,0,0),	/* SPRINTF */
X	A(1,1,1),	/* SUBSTR */
X	A(1,3,0),	/* JOIN */
X	A(1,1,0),	/* SLT */
X	A(1,1,0),	/* SGT */
X	A(1,1,0),	/* SLE */
X	A(1,1,0),	/* SGE */
X	A(1,1,0),	/* SEQ */
X	A(1,1,0),	/* SNE */
X	A(0,3,0),	/* SUBR */
X	A(1,3,0),	/* PRINT */
X	A(1,0,0),	/* CHDIR */
X	A(0,3,0),	/* DIE */
X	A(1,0,0),	/* EXIT */
X	A(1,0,0),	/* RESET */
X	A(3,0,0),	/* LIST */
X	A(1,0,0),	/* SELECT */
X	A(1,0,0),	/* EOF */
X	A(1,0,0),	/* TELL */
X	A(1,1,1),	/* SEEK */
X	A(0,0,0),	/* LAST */
X	A(0,0,0),	/* NEXT */
X	A(0,0,0),	/* REDO */
X	A(0,0,0),	/* GOTO */
X	A(1,1,0),	/* INDEX */
X	A(0,0,0),	/* TIME */
X	A(0,0,0),	/* TIMES */
X	A(1,0,0),	/* LOCALTIME */
X	A(1,0,0),	/* GMTIME */
X	A(1,0,0),	/* STAT */
X	A(1,1,0),	/* CRYPT */
X	A(1,0,0),	/* EXP */
X	A(1,0,0),	/* LOG */
X	A(1,0,0),	/* SQRT */
X	A(1,0,0),	/* INT */
X	A(1,3,0),	/* PRINTF */
X	A(1,0,0),	/* ORD */
X	A(1,0,0),	/* SLEEP */
X	A(1,0,0),	/* FLIP */
X	A(0,1,0),	/* FLOP */
X	A(0,0,0),	/* KEYS */
X	A(0,0,0),	/* VALUES */
X	A(0,0,0),	/* EACH */
X	A(3,0,0),	/* CHOP */
X	A(0,0,0),	/* FORK */
X	A(1,3,0),	/* EXEC */
X	A(1,3,0),	/* SYSTEM */
X	A(1,0,0),	/* OCT */
X	A(1,0,0),	/* HEX */
X	A(0,3,0),	/* CHMOD */
X	A(0,3,0),	/* CHOWN */
X	A(0,3,0),	/* KILL */
X	A(1,1,0),	/* RENAME */
X	A(0,3,0),	/* UNLINK */
X	A(1,0,0),	/* UMASK */
X	A(0,3,0),	/* UNSHIFT */
X	A(1,1,0),	/* LINK */
X	A(1,1,0),	/* REPEAT */
X	A(1,0,0),	/* EVAL */
X	A(1,0,0),	/* FTEREAD */
X	A(1,0,0),	/* FTEWRITE */
X	A(1,0,0),	/* FTEEXEC */
X	A(1,0,0),	/* FTEOWNED */
X	A(1,0,0),	/* FTRREAD */
X	A(1,0,0),	/* FTRWRITE */
X	A(1,0,0),	/* FTREXEC */
X	A(1,0,0),	/* FTROWNED */
X	A(1,0,0),	/* FTIS */
X	A(1,0,0),	/* FTZERO */
X	A(1,0,0),	/* FTSIZE */
X	A(1,0,0),	/* FTFILE */
X	A(1,0,0),	/* FTDIR */
X	A(1,0,0),	/* FTLINK */
X	A(1,1,0),	/* SYMLINK */
X	A(1,0,0),	/* FTPIPE */
X	A(1,0,0),	/* FTSOCK */
X	A(1,0,0),	/* FTBLK */
X	A(1,0,0),	/* FTCHR */
X	A(1,0,0),	/* FTSUID */
X	A(1,0,0),	/* FTSGID */
X	A(1,0,0),	/* FTSVTX */
X	A(1,0,0),	/* FTTTY */
X	A(1,0,0),	/* DOFILE */
X	A(1,0,0),	/* FTTEXT */
X	A(1,0,0),	/* FTBINARY */
X	A(0,3,0),	/* UTIME */
X	A(0,0,0),	/* WAIT */
X	A(1,3,0),	/* SORT */
X	A(0,1,0),	/* DELETE */
X	A(1,0,0),	/* STUDY */
X	A(1,1,0),	/* ATAN2 */
X	A(1,0,0),	/* SIN */
X	A(1,0,0),	/* COS */
X	A(1,0,0),	/* RAND */
X	A(1,0,0),	/* SRAND */
X	A(1,1,0),	/* POW */
X	A(0,3,0),	/* RETURN */
X	A(1,0,0),	/* GETC */
X	A(1,1,0),	/* MKDIR */
X	A(1,0,0),	/* RMDIR */
X	A(0,0,0),	/* GETPPID */
X	A(1,0,0),	/* GETPGRP */
X	A(1,1,0),	/* SETPGRP */
X	A(1,1,0),	/* GETPRIORITY */
X	A(1,1,1),	/* SETPRIORITY */
X	A(1,0,0),	/* CHROOT */
X	A(1,1,1),	/* IOCTL */
X	A(1,1,1),	/* FCNTL */
X	A(1,1,0),	/* FLOCK */
X	A(1,1,0),	/* RINDEX */
X	A(1,3,0),	/* PACK */
X	A(1,1,0),	/* UNPACK */
X	A(1,1,1),	/* READ */
X	A(0,3,0),	/* WARN */
X	A(1,1,1),	/* DBMOPEN */
X	A(1,0,0),	/* DBMCLOSE */
X	A(0,3,0),	/* ASLICE */
X	A(0,3,0),	/* HSLICE */
X	A(0,3,0),	/* LASLICE */
X	A(0,3,0),	/* LHSLICE */
X	A(1,0,0),	/* F_OR_R */
X	A(1,1,0),	/* RANGE */
X	A(1,1,0),	/* RCAT */
X	A(3,3,0),	/* AASSIGN */
X	A(0,0,0),	/* SASSIGN */
X	A(0,0,0),	/* DUMP */
X	A(0,0,0),	/* REVERSE */
X	A(1,0,0),	/* ADDROF */
X	A(1,1,1),	/* SOCKET */
X	A(1,1,0),	/* BIND */
X	A(1,1,0),	/* CONNECT */
X	A(1,1,0),	/* LISTEN */
X	A(1,1,0),	/* ACCEPT */
X	A(1,1,2),	/* SEND */
X	A(1,1,1),	/* RECV */
X	A(1,1,1),	/* SSELECT */
X	A(1,1,1),	/* SOCKETPAIR */
X	A(0,3,0),	/* DBSUBR */
X	A(1,0,0),	/* DEFINED */
X	A(1,0,0),	/* UNDEF */
X	A(1,0,0),	/* READLINK */
X	A(1,0,0),	/* LSTAT */
X	A(0,1,0),	/* AELEM */
X	A(0,1,0),	/* HELEM */
X	A(0,1,0),	/* LAELEM */
X	A(0,1,0),	/* LHELEM */
X	A(1,0,0),	/* LOCAL */
X	A(0,0,0),	/* UNUSED */
X	A(1,0,0),	/* FILENO */
X	A(1,0,0),	/* GHBYNAME */
X	A(1,1,0),	/* GHBYADDR */
X	A(0,0,0),	/* GHOSTENT */
X	A(1,0,0),	/* SHOSTENT */
X	A(0,0,0),	/* EHOSTENT */
X	A(1,1,0),	/* GSBYNAME */
X	A(1,1,0),	/* GSBYPORT */
X	A(0,0,0),	/* GSERVENT */
X	A(1,0,0),	/* SSERVENT */
X	A(0,0,0),	/* ESERVENT */
X	A(1,0,0),	/* GPBYNAME */
X	A(1,0,0),	/* GPBYNUMBER */
X	A(0,0,0),	/* GPROTOENT */
X	A(1,0,0),	/* SPROTOENT */
X	A(0,0,0),	/* EPROTOENT */
X	A(1,0,0),	/* GNBYNAME */
X	A(1,1,0),	/* GNBYADDR */
X	A(0,0,0),	/* GNETENT */
X	A(1,0,0),	/* SNETENT */
X	A(0,0,0),	/* ENETENT */
X	A(1,1,1),	/* VEC */
X	A(0,3,0),	/* GREP */
X	A(1,0,0),	/* GPWNAM */
X	A(1,0,0),	/* GPWUID */
X	A(0,0,0),	/* GPWENT */
X	A(0,0,0),	/* SPWENT */
X	A(0,0,0),	/* EPWENT */
X	A(1,0,0),	/* GGRNAM */
X	A(1,0,0),	/* GGRGID */
X	A(0,0,0),	/* GGRENT */
X	A(0,0,0),	/* SGRENT */
X	A(0,0,0),	/* EGRENT */
X	A(1,1,0),	/* SHUTDOWN */
X	A(1,1,0),	/* OPENDIR */
X	A(1,0,0),	/* READDIR */
X	A(1,0,0),	/* TELLDIR */
X	A(1,1,0),	/* SEEKDIR */
X	A(1,0,0),	/* REWINDDIR */
X	A(1,0,0),	/* CLOSEDIR */
X	A(0,0,0),	/* GETLOGIN */
X	A(1,3,0),	/* SYSCALL */
X	A(1,1,1),	/* GSOCKOPT */
X	A(1,1,1),	/* SSOCKOPT */
X	A(1,0,0),	/* GETSOCKNAME */
X	A(1,0,0),	/* GETPEERNAME */
X	0
X};
X#undef A
X#endif
X
Xint do_trans();
Xint do_split();
Xbool do_eof();
Xlong do_tell();
Xbool do_seek();
Xint do_tms();
Xint do_time();
Xint do_stat();
XSTR *do_push();
XFILE *nextargv();
XSTR *do_fttext();
Xint do_slice();
!STUFFY!FUNK!
echo ""
echo "End of kit 11 (of 24)"
cat /dev/null >kit11isdone
run=''
config=''
for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24; do
    if test -f kit${iskit}isdone; then
	run="$run $iskit"
    else
	todo="$todo $iskit"
    fi
done
case $todo in
    '')
	echo "You have run all your kits.  Please read README and then type Configure."
	chmod 755 Configure
	;;
    *)  echo "You have run$run."
	echo "You still need to run$todo."
	;;
esac
: Someone might mail this, so...
exit

-- 
Please send comp.sources.unix-related mail to rsalz@uunet.uu.net.
Use a domain-based address or give alternate paths, or you may lose out.
