home *** CD-ROM | disk | FTP | other *** search
- Subject: v20i094: Perl, a language with features of C/sed/awk/shell/etc, Part11/24
- Newsgroups: comp.sources.unix
- Sender: sources
- 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
-
-