perl 3.0: (no announcement message available)perl-3.000

A few of the new features: (18 Oct)

    * Perl can now handle binary data correctly and has functions to pack and unpack binary structures into arrays or lists. You can now do arbitrary ioctl functions.
    * You can now pass things to subroutines by reference.
    * Debugger enhancements.
    * An array or associative array may now appear in a local() list.
    * Array values may now be interpolated into strings.
    * Subroutine names are now distinguished by prefixing with &. You can call subroutines without using do, and without passing any argument list at all.
    * You can use the new -u switch to cause perl to dump core so that you can run undump and produce a binary executable image. Alternately you can use the "dump" operator after initializing any variables and such.
    * You can now chop lists.
    * Perl now uses /bin/csh to do filename globbing, if available. This means that filenames with spaces or other strangenesses work right.
    * New functions: mkdir and rmdir, getppid, getpgrp and setpgrp, getpriority and setpriority, chroot, ioctl and fcntl, flock, readlink, lstat, rindex, pack and unpack, read, warn, dbmopen and dbmclose, dump, reverse, defined, undef.

1 files changed, 1044 insertions, 0 deletions

diff --git a/dolist.c b/dolist.c
new file mode 100644
index 0000000000..e47c37d492
--- /dev/null
+++ b/dolist.c
@@ -0,0 +1,1044 @@
+/* $Header: dolist.c,v 3.0 89/10/18 15:11:02 lwall Locked $
+ *
+ *    Copyright (c) 1989, Larry Wall
+ *
+ *    You may distribute under the terms of the GNU General Public License
+ *    as specified in the README file that comes with the perl 3.0 kit.
+ *
+ * $Log:	dolist.c,v $
+ * Revision 3.0  89/10/18  15:11:02  lwall
+ * 3.0 baseline
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+
+int
+do_match(str,arg,gimme,arglast)
+STR *str;
+register ARG *arg;
+int gimme;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register SPAT *spat = arg[2].arg_ptr.arg_spat;
+    register char *t;
+    register int sp = arglast[0] + 1;
+    STR *srchstr = st[sp];
+    register char *s = str_get(st[sp]);
+    char *strend = s + st[sp]->str_cur;
+    STR *tmpstr;
+
+    if (!spat) {
+	if (gimme == G_ARRAY)
+	    return --sp;
+	str_set(str,Yes);
+	STABSET(str);
+	st[sp] = str;
+	return sp;
+    }
+    if (!s)
+	fatal("panic: do_match");
+    if (spat->spat_flags & SPAT_USED) {
+#ifdef DEBUGGING
+	if (debug & 8)
+	    deb("2.SPAT USED\n");
+#endif
+	if (gimme == G_ARRAY)
+	    return --sp;
+	str_set(str,No);
+	STABSET(str);
+	st[sp] = str;
+	return sp;
+    }
+    --sp;
+    if (spat->spat_runtime) {
+	nointrp = "|)";
+	sp = eval(spat->spat_runtime,G_SCALAR,sp);
+	st = stack->ary_array;
+	t = str_get(tmpstr = st[sp--]);
+	nointrp = "";
+#ifdef DEBUGGING
+	if (debug & 8)
+	    deb("2.SPAT /%s/\n",t);
+#endif
+	if (spat->spat_regexp)
+	    regfree(spat->spat_regexp);
+	spat->spat_regexp = regcomp(t,t+tmpstr->str_cur,
+	    spat->spat_flags & SPAT_FOLD,1);
+	if (!*spat->spat_regexp->precomp && lastspat)
+	    spat = lastspat;
+	if (spat->spat_flags & SPAT_KEEP) {
+	    arg_free(spat->spat_runtime);	/* it won't change, so */
+	    spat->spat_runtime = Nullarg;	/* no point compiling again */
+	}
+	if (!spat->spat_regexp->nparens)
+	    gimme = G_SCALAR;			/* accidental array context? */
+	if (regexec(spat->spat_regexp, s, strend, s, 0,
+	  srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
+	  gimme == G_ARRAY)) {
+	    if (spat->spat_regexp->subbase)
+		curspat = spat;
+	    lastspat = spat;
+	    goto gotcha;
+	}
+	else {
+	    if (gimme == G_ARRAY)
+		return sp;
+	    str_sset(str,&str_no);
+	    STABSET(str);
+	    st[++sp] = str;
+	    return sp;
+	}
+    }
+    else {
+#ifdef DEBUGGING
+	if (debug & 8) {
+	    char ch;
+
+	    if (spat->spat_flags & SPAT_ONCE)
+		ch = '?';
+	    else
+		ch = '/';
+	    deb("2.SPAT %c%s%c\n",ch,spat->spat_regexp->precomp,ch);
+	}
+#endif
+	if (!*spat->spat_regexp->precomp && lastspat)
+	    spat = lastspat;
+	t = s;
+	if (hint) {
+	    if (hint < s || hint > strend)
+		fatal("panic: hint in do_match");
+	    s = hint;
+	    hint = Nullch;
+	    if (spat->spat_regexp->regback >= 0) {
+		s -= spat->spat_regexp->regback;
+		if (s < t)
+		    s = t;
+	    }
+	    else
+		s = t;
+	}
+	else if (spat->spat_short) {
+	    if (spat->spat_flags & SPAT_SCANFIRST) {
+		if (srchstr->str_pok & SP_STUDIED) {
+		    if (screamfirst[spat->spat_short->str_rare] < 0)
+			goto nope;
+		    else if (!(s = screaminstr(srchstr,spat->spat_short)))
+			goto nope;
+		    else if (spat->spat_flags & SPAT_ALL)
+			goto yup;
+		}
+#ifndef lint
+		else if (!(s = fbminstr((unsigned char*)s,
+		  (unsigned char*)strend, spat->spat_short)))
+		    goto nope;
+#endif
+		else if (spat->spat_flags & SPAT_ALL)
+		    goto yup;
+		if (s && spat->spat_regexp->regback >= 0) {
+		    ++spat->spat_short->str_u.str_useful;
+		    s -= spat->spat_regexp->regback;
+		    if (s < t)
+			s = t;
+		}
+		else
+		    s = t;
+	    }
+	    else if (!multiline && (*spat->spat_short->str_ptr != *s ||
+	      bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
+		goto nope;
+	    if (--spat->spat_short->str_u.str_useful < 0) {
+		str_free(spat->spat_short);
+		spat->spat_short = Nullstr;	/* opt is being useless */
+	    }
+	}
+	if (!spat->spat_regexp->nparens)
+	    gimme = G_SCALAR;			/* accidental array context? */
+	if (regexec(spat->spat_regexp, s, strend, t, 0,
+	  srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
+	  gimme == G_ARRAY)) {
+	    if (spat->spat_regexp->subbase)
+		curspat = spat;
+	    lastspat = spat;
+	    if (spat->spat_flags & SPAT_ONCE)
+		spat->spat_flags |= SPAT_USED;
+	    goto gotcha;
+	}
+	else {
+	    if (gimme == G_ARRAY)
+		return sp;
+	    str_sset(str,&str_no);
+	    STABSET(str);
+	    st[++sp] = str;
+	    return sp;
+	}
+    }
+    /*NOTREACHED*/
+
+  gotcha:
+    if (gimme == G_ARRAY) {
+	int iters, i, len;
+
+	iters = spat->spat_regexp->nparens;
+	if (sp + iters >= stack->ary_max) {
+	    astore(stack,sp + iters, Nullstr);
+	    st = stack->ary_array;		/* possibly realloced */
+	}
+
+	for (i = 1; i <= iters; i++) {
+	    st[++sp] = str_static(&str_no);
+	    if (s = spat->spat_regexp->startp[i]) {
+		len = spat->spat_regexp->endp[i] - s;
+		if (len > 0)
+		    str_nset(st[sp],s,len);
+	    }
+	}
+	return sp;
+    }
+    else {
+	str_sset(str,&str_yes);
+	STABSET(str);
+	st[++sp] = str;
+	return sp;
+    }
+
+yup:
+    ++spat->spat_short->str_u.str_useful;
+    lastspat = spat;
+    if (spat->spat_flags & SPAT_ONCE)
+	spat->spat_flags |= SPAT_USED;
+    if (sawampersand) {
+	char *tmps;
+
+	tmps = spat->spat_regexp->subbase = nsavestr(t,strend-t);
+	tmps = spat->spat_regexp->startp[0] = tmps + (s - t);
+	spat->spat_regexp->endp[0] = tmps + spat->spat_short->str_cur;
+	curspat = spat;
+    }
+    str_sset(str,&str_yes);
+    STABSET(str);
+    st[++sp] = str;
+    return sp;
+
+nope:
+    ++spat->spat_short->str_u.str_useful;
+    if (gimme == G_ARRAY)
+	return sp;
+    str_sset(str,&str_no);
+    STABSET(str);
+    st[++sp] = str;
+    return sp;
+}
+
+int
+do_split(str,spat,limit,gimme,arglast)
+STR *str;
+register SPAT *spat;
+register int limit;
+int gimme;
+int *arglast;
+{
+    register ARRAY *ary = stack;
+    STR **st = ary->ary_array;
+    register int sp = arglast[0] + 1;
+    register char *s = str_get(st[sp]);
+    char *strend = s + st[sp--]->str_cur;
+    register STR *dstr;
+    register char *m;
+    int iters = 0;
+    int i;
+    char *orig;
+    int origlimit = limit;
+    int realarray = 0;
+
+    if (!spat || !s)
+	fatal("panic: do_split");
+    else if (spat->spat_runtime) {
+	nointrp = "|)";
+	sp = eval(spat->spat_runtime,G_SCALAR,sp);
+	st = stack->ary_array;
+	m = str_get(dstr = st[sp--]);
+	nointrp = "";
+	if (!dstr->str_cur || (*m == ' ' && dstr->str_cur == 1)) {
+	    str_set(dstr,"\\s+");
+	    m = dstr->str_ptr;
+	    spat->spat_flags |= SPAT_SKIPWHITE;
+	}
+	if (spat->spat_regexp)
+	    regfree(spat->spat_regexp);
+	spat->spat_regexp = regcomp(m,m+dstr->str_cur,
+	    spat->spat_flags & SPAT_FOLD,1);
+	if (spat->spat_flags & SPAT_KEEP ||
+	    (spat->spat_runtime->arg_type == O_ITEM &&
+	      (spat->spat_runtime[1].arg_type & A_MASK) == A_SINGLE) ) {
+	    arg_free(spat->spat_runtime);	/* it won't change, so */
+	    spat->spat_runtime = Nullarg;	/* no point compiling again */
+	}
+    }
+#ifdef DEBUGGING
+    if (debug & 8) {
+	deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
+    }
+#endif
+    ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab);
+    if (ary && ((ary->ary_flags & ARF_REAL) || gimme != G_ARRAY)) {
+	ary->ary_flags |= ARF_REAL;
+	realarray = 1;
+	ary->ary_fill = -1;
+	sp = -1;	/* temporarily switch stacks */
+    }
+    else
+	ary = stack;
+    orig = s;
+    if (spat->spat_flags & SPAT_SKIPWHITE) {
+	while (isspace(*s))
+	    s++;
+    }
+    if (!limit)
+	limit = 10001;
+    if (spat->spat_short) {
+	i = spat->spat_short->str_cur;
+	if (i == 1) {
+	    i = *spat->spat_short->str_ptr;
+	    while (--limit) {
+		for (m = s; m < strend && *m != i; m++) ;
+		if (m >= strend)
+		    break;
+		if (realarray)
+		    dstr = Str_new(30,m-s);
+		else
+		    dstr = str_static(&str_undef);
+		str_nset(dstr,s,m-s);
+		(void)astore(ary, ++sp, dstr);
+		s = m + 1;
+	    }
+	}
+	else {
+#ifndef lint
+	    while (s < strend && --limit &&
+	      (m=fbminstr((unsigned char*)s, (unsigned char*)strend,
+		    spat->spat_short)) )
+#endif
+	    {
+		if (realarray)
+		    dstr = Str_new(31,m-s);
+		else
+		    dstr = str_static(&str_undef);
+		str_nset(dstr,s,m-s);
+		(void)astore(ary, ++sp, dstr);
+		s = m + i;
+	    }
+	}
+    }
+    else {
+	while (s < strend && --limit &&
+	    regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr, TRUE) ) {
+	    if (spat->spat_regexp->subbase
+	      && spat->spat_regexp->subbase != orig) {
+		m = s;
+		s = orig;
+		orig = spat->spat_regexp->subbase;
+		s = orig + (m - s);
+		strend = s + (strend - m);
+	    }
+	    m = spat->spat_regexp->startp[0];
+	    if (realarray)
+		dstr = Str_new(32,m-s);
+	    else
+		dstr = str_static(&str_undef);
+	    str_nset(dstr,s,m-s);
+	    (void)astore(ary, ++sp, dstr);
+	    if (spat->spat_regexp->nparens) {
+		for (i = 1; i <= spat->spat_regexp->nparens; i++) {
+		    s = spat->spat_regexp->startp[i];
+		    m = spat->spat_regexp->endp[i];
+		    if (realarray)
+			dstr = Str_new(33,m-s);
+		    else
+			dstr = str_static(&str_undef);
+		    str_nset(dstr,s,m-s);
+		    (void)astore(ary, ++sp, dstr);
+		}
+	    }
+	    s = spat->spat_regexp->endp[0];
+	}
+    }
+    if (realarray)
+	iters = sp + 1;
+    else
+	iters = sp - arglast[0];
+    if (iters > 9999)
+	fatal("Split loop");
+    if (s < strend || origlimit) {	/* keep field after final delim? */
+	if (realarray)
+	    dstr = Str_new(34,strend-s);
+	else
+	    dstr = str_static(&str_undef);
+	str_nset(dstr,s,strend-s);
+	(void)astore(ary, ++sp, dstr);
+	iters++;
+    }
+    else {
+#ifndef I286
+	while (iters > 0 && ary->ary_array[sp]->str_cur == 0)
+	    iters--,sp--;
+#else
+	char *zaps;
+	int   zapb;
+
+	if (iters > 0) {
+		zaps = str_get(afetch(ary,sp,FALSE));
+		zapb = (int) *zaps;
+	}
+	
+	while (iters > 0 && (!zapb)) {
+	    iters--,sp--;
+	    if (iters > 0) {
+		zaps = str_get(afetch(ary,iters-1,FALSE));
+		zapb = (int) *zaps;
+	    }
+	}
+#endif
+    }
+    if (realarray) {
+	ary->ary_fill = sp;
+	if (gimme == G_ARRAY) {
+	    sp++;
+	    astore(stack, arglast[0] + 1 + sp, Nullstr);
+	    Copy(ary->ary_array, stack->ary_array + arglast[0] + 1, sp, STR*);
+	    return arglast[0] + sp;
+	}
+    }
+    else {
+	if (gimme == G_ARRAY)
+	    return sp;
+    }
+    sp = arglast[0] + 1;
+    str_numset(str,(double)iters);
+    STABSET(str);
+    st[sp] = str;
+    return sp;
+}
+
+int
+do_unpack(str,gimme,arglast)
+STR *str;
+int gimme;
+int *arglast;
+{
+    STR **st = stack->ary_array;
+    register int sp = arglast[0] + 1;
+    register char *pat = str_get(st[sp++]);
+    register char *s = str_get(st[sp]);
+    char *strend = s + st[sp--]->str_cur;
+    register char *patend = pat + st[sp]->str_cur;
+    int datumtype;
+    register int len;
+
+    /* These must not be in registers: */
+    char achar;
+    short ashort;
+    int aint;
+    long along;
+    unsigned char auchar;
+    unsigned short aushort;
+    unsigned int auint;
+    unsigned long aulong;
+    char *aptr;
+
+    if (gimme != G_ARRAY) {
+	str_sset(str,&str_undef);
+	STABSET(str);
+	st[sp] = str;
+	return sp;
+    }
+    sp--;
+    while (pat < patend) {
+	datumtype = *pat++;
+	if (isdigit(*pat)) {
+	    len = atoi(pat);
+	    while (isdigit(*pat))
+		pat++;
+	}
+	else
+	    len = 1;
+	switch(datumtype) {
+	default:
+	    break;
+	case 'x':
+	    s += len;
+	    break;
+	case 'A':
+	case 'a':
+	    if (s + len > strend)
+		len = strend - s;
+	    str = Str_new(35,len);
+	    str_nset(str,s,len);
+	    s += len;
+	    if (datumtype == 'A') {
+		aptr = s;	/* borrow register */
+		s = str->str_ptr + len - 1;
+		while (s >= str->str_ptr && (!*s || isspace(*s)))
+		    s--;
+		*++s = '\0';
+		str->str_cur = s - str->str_ptr;
+		s = aptr;	/* unborrow register */
+	    }
+	    (void)astore(stack, ++sp, str_2static(str));
+	    break;
+	case 'c':
+	    while (len-- > 0) {
+		if (s + sizeof(char) > strend)
+		    achar = 0;
+		else {
+		    bcopy(s,(char*)&achar,sizeof(char));
+		    s += sizeof(char);
+		}
+		str = Str_new(36,0);
+		aint = achar;
+		if (aint >= 128)	/* fake up signed chars */
+		    aint -= 256;
+		str_numset(str,(double)aint);
+		(void)astore(stack, ++sp, str_2static(str));
+	    }
+	    break;
+	case 'C':
+	    while (len-- > 0) {
+		if (s + sizeof(unsigned char) > strend)
+		    auchar = 0;
+		else {
+		    bcopy(s,(char*)&auchar,sizeof(unsigned char));
+		    s += sizeof(unsigned char);
+		}
+		str = Str_new(37,0);
+		auint = auchar;		/* some can't cast uchar to double */
+		str_numset(str,(double)auint);
+		(void)astore(stack, ++sp, str_2static(str));
+	    }
+	    break;
+	case 's':
+	    while (len-- > 0) {
+		if (s + sizeof(short) > strend)
+		    ashort = 0;
+		else {
+		    bcopy(s,(char*)&ashort,sizeof(short));
+		    s += sizeof(short);
+		}
+		str = Str_new(38,0);
+		str_numset(str,(double)ashort);
+		(void)astore(stack, ++sp, str_2static(str));
+	    }
+	    break;
+	case 'n':
+	case 'S':
+	    while (len-- > 0) {
+		if (s + sizeof(unsigned short) > strend)
+		    aushort = 0;
+		else {
+		    bcopy(s,(char*)&aushort,sizeof(unsigned short));
+		    s += sizeof(unsigned short);
+		}
+		str = Str_new(39,0);
+#ifdef NTOHS
+		if (datumtype == 'n')
+		    aushort = ntohs(aushort);
+#endif
+		str_numset(str,(double)aushort);
+		(void)astore(stack, ++sp, str_2static(str));
+	    }
+	    break;
+	case 'i':
+	    while (len-- > 0) {
+		if (s + sizeof(int) > strend)
+		    aint = 0;
+		else {
+		    bcopy(s,(char*)&aint,sizeof(int));
+		    s += sizeof(int);
+		}
+		str = Str_new(40,0);
+		str_numset(str,(double)aint);
+		(void)astore(stack, ++sp, str_2static(str));
+	    }
+	    break;
+	case 'I':
+	    while (len-- > 0) {
+		if (s + sizeof(unsigned int) > strend)
+		    auint = 0;
+		else {
+		    bcopy(s,(char*)&auint,sizeof(unsigned int));
+		    s += sizeof(unsigned int);
+		}
+		str = Str_new(41,0);
+		str_numset(str,(double)auint);
+		(void)astore(stack, ++sp, str_2static(str));
+	    }
+	    break;
+	case 'l':
+	    while (len-- > 0) {
+		if (s + sizeof(long) > strend)
+		    along = 0;
+		else {
+		    bcopy(s,(char*)&along,sizeof(long));
+		    s += sizeof(long);
+		}
+		str = Str_new(42,0);
+		str_numset(str,(double)along);
+		(void)astore(stack, ++sp, str_2static(str));
+	    }
+	    break;
+	case 'N':
+	case 'L':
+	    while (len-- > 0) {
+		if (s + sizeof(unsigned long) > strend)
+		    aulong = 0;
+		else {
+		    bcopy(s,(char*)&aulong,sizeof(unsigned long));
+		    s += sizeof(unsigned long);
+		}
+		str = Str_new(43,0);
+#ifdef NTOHL
+		if (datumtype == 'N')
+		    aulong = ntohl(aulong);
+#endif
+		str_numset(str,(double)aulong);
+		(void)astore(stack, ++sp, str_2static(str));
+	    }
+	    break;
+	case 'p':
+	    while (len-- > 0) {
+		if (s + sizeof(char*) > strend)
+		    aptr = 0;
+		else {
+		    bcopy(s,(char*)&aptr,sizeof(char*));
+		    s += sizeof(char*);
+		}
+		str = Str_new(44,0);
+		if (aptr)
+		    str_set(str,aptr);
+		(void)astore(stack, ++sp, str_2static(str));
+	    }
+	    break;
+	}
+    }
+    return sp;
+}
+
+int
+do_slice(stab,numarray,lval,gimme,arglast)
+register STAB *stab;
+int numarray;
+int lval;
+int gimme;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register int max = arglast[2];
+    register char *tmps;
+    register int len;
+    register int magic = 0;
+
+    if (lval && !numarray) {
+	if (stab == envstab)
+	    magic = 'E';
+	else if (stab == sigstab)
+	    magic = 'S';
+#ifdef SOME_DBM
+	else if (stab_hash(stab)->tbl_dbm)
+	    magic = 'D';
+#endif /* SOME_DBM */
+    }
+
+    if (gimme == G_ARRAY) {
+	if (numarray) {
+	    while (sp < max) {
+		if (st[++sp]) {
+		    st[sp-1] = afetch(stab_array(stab),(int)str_gnum(st[sp]),
+			lval);
+		}
+		else
+		    st[sp-1] = Nullstr;
+	    }
+	}
+	else {
+	    while (sp < max) {
+		if (st[++sp]) {
+		    tmps = str_get(st[sp]);
+		    len = st[sp]->str_cur;
+		    st[sp-1] = hfetch(stab_hash(stab),tmps,len, lval);
+		    if (magic)
+			str_magic(st[sp-1],stab,magic,tmps,len);
+		}
+		else
+		    st[sp-1] = Nullstr;
+	    }
+	}
+	sp--;
+    }
+    else {
+	if (numarray) {
+	    if (st[max])
+		st[sp] = afetch(stab_array(stab),(int)str_gnum(st[max]), lval);
+	    else
+		st[sp] = Nullstr;
+	}
+	else {
+	    if (st[max]) {
+		tmps = str_get(st[max]);
+		len = st[max]->str_cur;
+		st[sp] = hfetch(stab_hash(stab),tmps,len, lval);
+		if (magic)
+		    str_magic(st[sp],stab,magic,tmps,len);
+	    }
+	    else
+		st[sp] = Nullstr;
+	}
+    }
+    return sp;
+}
+
+int
+do_grep(arg,str,gimme,arglast)
+register ARG *arg;
+STR *str;
+int gimme;
+int *arglast;
+{
+    STR **st = stack->ary_array;
+    register STR **dst = &st[arglast[1]];
+    register STR **src = dst + 1;
+    register int sp = arglast[2];
+    register int i = sp - arglast[1];
+    int oldsave = savestack->ary_fill;
+
+    savesptr(&stab_val(defstab));
+    if ((arg[1].arg_type & A_MASK) != A_EXPR)
+	dehoist(arg,1);
+    arg = arg[1].arg_ptr.arg_arg;
+    while (i-- > 0) {
+	stab_val(defstab) = *src;
+	(void)eval(arg,G_SCALAR,sp);
+	if (str_true(st[sp+1]))
+	    *dst++ = *src;
+	src++;
+    }
+    restorelist(oldsave);
+    if (gimme != G_ARRAY) {
+	str_sset(str,&str_undef);
+	STABSET(str);
+	st[arglast[0]+1] = str;
+	return arglast[0]+1;
+    }
+    return arglast[0] + (dst - &st[arglast[1]]);
+}
+
+int
+do_reverse(str,gimme,arglast)
+STR *str;
+int gimme;
+int *arglast;
+{
+    STR **st = stack->ary_array;
+    register STR **up = &st[arglast[1]];
+    register STR **down = &st[arglast[2]];
+    register int i = arglast[2] - arglast[1];
+
+    if (gimme != G_ARRAY) {
+	str_sset(str,&str_undef);
+	STABSET(str);
+	st[arglast[0]+1] = str;
+	return arglast[0]+1;
+    }
+    while (i-- > 0) {
+	*up++ = *down;
+	*down-- = *up;
+    }
+    return arglast[2] - 1;
+}
+
+static CMD *sortcmd;
+static STAB *firststab = Nullstab;
+static STAB *secondstab = Nullstab;
+
+int
+do_sort(str,stab,gimme,arglast)
+STR *str;
+STAB *stab;
+int gimme;
+int *arglast;
+{
+    STR **st = stack->ary_array;
+    int sp = arglast[1];
+    register STR **up;
+    register int max = arglast[2] - sp;
+    register int i;
+    int sortcmp();
+    int sortsub();
+    STR *oldfirst;
+    STR *oldsecond;
+    ARRAY *oldstack;
+    static ARRAY *sortstack = Null(ARRAY*);
+
+    if (gimme != G_ARRAY) {
+	str_sset(str,&str_undef);
+	STABSET(str);
+	st[sp] = str;
+	return sp;
+    }
+    up = &st[sp];
+    for (i = 0; i < max; i++) {
+	if ((*up = up[1]) && !(*up)->str_pok)
+	    (void)str_2ptr(*up);
+	up++;
+    }
+    sp--;
+    if (max > 1) {
+	if (stab_sub(stab) && (sortcmd = stab_sub(stab)->cmd)) {
+	    int oldtmps_base = tmps_base;
+
+	    if (!sortstack) {
+		sortstack = anew(Nullstab);
+		sortstack->ary_flags = 0;
+	    }
+	    oldstack = stack;
+	    stack = sortstack;
+	    tmps_base = tmps_max;
+	    if (!firststab) {
+		firststab = stabent("a",TRUE);
+		secondstab = stabent("b",TRUE);
+	    }
+	    oldfirst = stab_val(firststab);
+	    oldsecond = stab_val(secondstab);
+#ifndef lint
+	    qsort((char*)(st+sp+1),max,sizeof(STR*),sortsub);
+#else
+	    qsort(Nullch,max,sizeof(STR*),sortsub);
+#endif
+	    stab_val(firststab) = oldfirst;
+	    stab_val(secondstab) = oldsecond;
+	    tmps_base = oldtmps_base;
+	    stack = oldstack;
+	}
+#ifndef lint
+	else
+	    qsort((char*)(st+sp+1),max,sizeof(STR*),sortcmp);
+#endif
+    }
+    up = &st[arglast[1]];
+    while (max > 0 && !*up)
+	max--,up--;
+    return sp+max;
+}
+
+int
+sortsub(str1,str2)
+STR **str1;
+STR **str2;
+{
+    if (!*str1)
+	return -1;
+    if (!*str2)
+	return 1;
+    stab_val(firststab) = *str1;
+    stab_val(secondstab) = *str2;
+    cmd_exec(sortcmd,G_SCALAR,-1);
+    return (int)str_gnum(*stack->ary_array);
+}
+
+sortcmp(strp1,strp2)
+STR **strp1;
+STR **strp2;
+{
+    register STR *str1 = *strp1;
+    register STR *str2 = *strp2;
+    int retval;
+
+    if (!str1)
+	return -1;
+    if (!str2)
+	return 1;
+
+    if (str1->str_cur < str2->str_cur) {
+	if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
+	    return retval;
+	else
+	    return -1;
+    }
+    else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
+	return retval;
+    else if (str1->str_cur == str2->str_cur)
+	return 0;
+    else
+	return 1;
+}
+
+int
+do_range(gimme,arglast)
+int gimme;
+int *arglast;
+{
+    STR **st = stack->ary_array;
+    register int sp = arglast[0];
+    register int i = (int)str_gnum(st[sp+1]);
+    register ARRAY *ary = stack;
+    register STR *str;
+    int max = (int)str_gnum(st[sp+2]);
+
+    if (gimme != G_ARRAY)
+	fatal("panic: do_range");
+
+    while (i <= max) {
+	(void)astore(ary, ++sp, str = str_static(&str_no));
+	str_numset(str,(double)i++);
+    }
+    return sp;
+}
+
+int
+do_tms(str,gimme,arglast)
+STR *str;
+int gimme;
+int *arglast;
+{
+    STR **st = stack->ary_array;
+    register int sp = arglast[0];
+
+    if (gimme != G_ARRAY) {
+	str_sset(str,&str_undef);
+	STABSET(str);
+	st[++sp] = str;
+	return sp;
+    }
+    (void)times(&timesbuf);
+
+#ifndef HZ
+#define HZ 60
+#endif
+
+#ifndef lint
+    (void)astore(stack,++sp,
+      str_2static(str_nmake(((double)timesbuf.tms_utime)/HZ)));
+    (void)astore(stack,++sp,
+      str_2static(str_nmake(((double)timesbuf.tms_stime)/HZ)));
+    (void)astore(stack,++sp,
+      str_2static(str_nmake(((double)timesbuf.tms_cutime)/HZ)));
+    (void)astore(stack,++sp,
+      str_2static(str_nmake(((double)timesbuf.tms_cstime)/HZ)));
+#else
+    (void)astore(stack,++sp,
+      str_2static(str_nmake(0.0)));
+#endif
+    return sp;
+}
+
+int
+do_time(str,tmbuf,gimme,arglast)
+STR *str;
+struct tm *tmbuf;
+int gimme;
+int *arglast;
+{
+    register ARRAY *ary = stack;
+    STR **st = ary->ary_array;
+    register int sp = arglast[0];
+
+    if (!tmbuf || gimme != G_ARRAY) {
+	str_sset(str,&str_undef);
+	STABSET(str);
+	st[++sp] = str;
+	return sp;
+    }
+    (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_sec)));
+    (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_min)));
+    (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_hour)));
+    (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_mday)));
+    (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_mon)));
+    (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_year)));
+    (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_wday)));
+    (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_yday)));
+    (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_isdst)));
+    return sp;
+}
+
+int
+do_kv(str,hash,kv,gimme,arglast)
+STR *str;
+HASH *hash;
+int kv;
+int gimme;
+int *arglast;
+{
+    register ARRAY *ary = stack;
+    STR **st = ary->ary_array;
+    register int sp = arglast[0];
+    int i;
+    register HENT *entry;
+    char *tmps;
+    STR *tmpstr;
+    int dokeys = (kv == O_KEYS || kv == O_HASH);
+    int dovalues = (kv == O_VALUES || kv == O_HASH);
+
+    if (gimme != G_ARRAY) {
+	str_sset(str,&str_undef);
+	STABSET(str);
+	st[++sp] = str;
+	return sp;
+    }
+    (void)hiterinit(hash);
+    while (entry = hiternext(hash)) {
+	if (dokeys) {
+	    tmps = hiterkey(entry,&i);
+	    (void)astore(ary,++sp,str_2static(str_make(tmps,i)));
+	}
+	if (dovalues) {
+	    tmpstr = Str_new(45,0);
+#ifdef DEBUGGING
+	    if (debug & 8192) {
+		sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
+		    hash->tbl_max+1,entry->hent_hash & hash->tbl_max);
+		str_set(tmpstr,buf);
+	    }
+	    else
+#endif
+	    str_sset(tmpstr,hiterval(hash,entry));
+	    (void)astore(ary,++sp,str_2static(tmpstr));
+	}
+    }
+    return sp;
+}
+
+int
+do_each(str,hash,gimme,arglast)
+STR *str;
+HASH *hash;
+int gimme;
+int *arglast;
+{
+    STR **st = stack->ary_array;
+    register int sp = arglast[0];
+    static STR *mystrk = Nullstr;
+    HENT *entry = hiternext(hash);
+    int i;
+    char *tmps;
+
+    if (mystrk) {
+	str_free(mystrk);
+	mystrk = Nullstr;
+    }
+
+    if (entry) {
+	if (gimme == G_ARRAY) {
+	    tmps = hiterkey(entry, &i);
+	    st[++sp] = mystrk = str_make(tmps,i);
+	}
+	st[++sp] = str;
+	str_sset(str,hiterval(hash,entry));
+	STABSET(str);
+	return sp;
+    }
+    else
+	return sp;
+}