summaryrefslogtreecommitdiff
path: root/dolist.c
diff options
context:
space:
mode:
Diffstat (limited to 'dolist.c')
-rw-r--r--dolist.c1044
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;
+}
View Lorry Controller Status