| /* $Header$ |
| * |
| * 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$ |
| * Revision 1.2 2004/09/01 14:33:24 criswell |
| * Migrating test suite out of the source tree. |
| * |
| * Revision 1.1 2004/02/17 22:21:16 criswell |
| * Initial commit of the perl Malloc Benchmark. I've cheated a little by |
| * generating the yacc output files and committing them directly, but it was |
| * easier than disabling the Bison Voodoo that gets executed by default. |
| * |
| * Revision 4.0 91/03/20 01:08:03 lwall |
| * 4.0 baseline. |
| * |
| */ |
| |
| #include "EXTERN.h" |
| #include "perl.h" |
| |
| |
| #ifdef BUGGY_MSC |
| #pragma function(memcmp) |
| #endif /* BUGGY_MSC */ |
| |
| 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; |
| char *myhint = hint; |
| |
| hint = Nullch; |
| 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 = Null(REGEXP*); /* crucial if regcomp aborts */ |
| } |
| spat->spat_regexp = regcomp(t,t+tmpstr->str_cur, |
| spat->spat_flags & SPAT_FOLD); |
| if (!*spat->spat_regexp->precomp && lastspat) |
| spat = lastspat; |
| if (spat->spat_flags & SPAT_KEEP) { |
| if (spat->spat_runtime) |
| 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 (myhint) { |
| if (myhint < s || myhint > strend) |
| fatal("panic: hint in do_match"); |
| s = myhint; |
| 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_mortal(&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; |
| |
| if (spat->spat_regexp->subbase) |
| Safefree(spat->spat_regexp->subbase); |
| tmps = spat->spat_regexp->subbase = nsavestr(t,strend-t); |
| spat->spat_regexp->subend = tmps + (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; |
| } |
| |
| #ifdef BUGGY_MSC |
| #pragma intrinsic(memcmp) |
| #endif /* BUGGY_MSC */ |
| |
| 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 maxiters = (strend - s) + 10; |
| 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 (*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 = Null(REGEXP*); /* avoid possible double free */ |
| } |
| spat->spat_regexp = regcomp(m,m+dstr->str_cur, |
| spat->spat_flags & SPAT_FOLD); |
| 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 && (gimme != G_ARRAY || (spat->spat_flags & SPAT_ONCE))) { |
| realarray = 1; |
| if (!(ary->ary_flags & ARF_REAL)) { |
| ary->ary_flags |= ARF_REAL; |
| for (i = ary->ary_fill; i >= 0; i--) |
| ary->ary_array[i] = Nullstr; /* don't free mere refs */ |
| } |
| ary->ary_fill = -1; |
| sp = -1; /* temporarily switch stacks */ |
| } |
| else |
| ary = stack; |
| orig = s; |
| if (spat->spat_flags & SPAT_SKIPWHITE) { |
| while (isascii(*s) && isspace(*s)) |
| s++; |
| } |
| if (!limit) |
| limit = maxiters + 2; |
| if (strEQ("\\s+",spat->spat_regexp->precomp)) { |
| while (--limit) { |
| for (m = s; m < strend && !(isascii(*m)&&isspace(*m)); m++) ; |
| if (m >= strend) |
| break; |
| dstr = Str_new(30,m-s); |
| str_nset(dstr,s,m-s); |
| if (!realarray) |
| str_2mortal(dstr); |
| (void)astore(ary, ++sp, dstr); |
| for (s = m + 1; s < strend && isascii(*s) && isspace(*s); s++) ; |
| } |
| } |
| else if (strEQ("^",spat->spat_regexp->precomp)) { |
| while (--limit) { |
| for (m = s; m < strend && *m != '\n'; m++) ; |
| m++; |
| if (m >= strend) |
| break; |
| dstr = Str_new(30,m-s); |
| str_nset(dstr,s,m-s); |
| if (!realarray) |
| str_2mortal(dstr); |
| (void)astore(ary, ++sp, dstr); |
| s = m; |
| } |
| } |
| else if (spat->spat_short) { |
| i = spat->spat_short->str_cur; |
| if (i == 1) { |
| int fold = (spat->spat_flags & SPAT_FOLD); |
| |
| i = *spat->spat_short->str_ptr; |
| if (fold && isupper(i)) |
| i = tolower(i); |
| while (--limit) { |
| if (fold) { |
| for ( m = s; |
| m < strend && *m != i && |
| (!isupper(*m) || tolower(*m) != i); |
| m++) |
| ; |
| } |
| else |
| for (m = s; m < strend && *m != i; m++) ; |
| if (m >= strend) |
| break; |
| dstr = Str_new(30,m-s); |
| str_nset(dstr,s,m-s); |
| if (!realarray) |
| str_2mortal(dstr); |
| (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 |
| { |
| dstr = Str_new(31,m-s); |
| str_nset(dstr,s,m-s); |
| if (!realarray) |
| str_2mortal(dstr); |
| (void)astore(ary, ++sp, dstr); |
| s = m + i; |
| } |
| } |
| } |
| else { |
| maxiters += (strend - s) * spat->spat_regexp->nparens; |
| 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]; |
| dstr = Str_new(32,m-s); |
| str_nset(dstr,s,m-s); |
| if (!realarray) |
| str_2mortal(dstr); |
| (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]; |
| dstr = Str_new(33,m-s); |
| str_nset(dstr,s,m-s); |
| if (!realarray) |
| str_2mortal(dstr); |
| (void)astore(ary, ++sp, dstr); |
| } |
| } |
| s = spat->spat_regexp->endp[0]; |
| } |
| } |
| if (realarray) |
| iters = sp + 1; |
| else |
| iters = sp - arglast[0]; |
| if (iters > maxiters) |
| fatal("Split loop"); |
| if (s < strend || origlimit) { /* keep field after final delim? */ |
| dstr = Str_new(34,strend-s); |
| str_nset(dstr,s,strend-s); |
| if (!realarray) |
| str_2mortal(dstr); |
| (void)astore(ary, ++sp, dstr); |
| iters++; |
| } |
| else { |
| #ifndef I286x |
| 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; |
| char *strbeg = s; |
| register char *patend = pat + st[sp]->str_cur; |
| int datumtype; |
| register int len; |
| register int bits; |
| |
| /* These must not be in registers: */ |
| short ashort; |
| int aint; |
| long along; |
| unsigned short aushort; |
| unsigned int auint; |
| unsigned long aulong; |
| char *aptr; |
| float afloat; |
| double adouble; |
| int checksum = 0; |
| unsigned long culong; |
| double cdouble; |
| |
| if (gimme != G_ARRAY) { /* arrange to do first one only */ |
| for (patend = pat; !isalpha(*patend); patend++); |
| if (index("aAbBhH", *patend) || *pat == '%') { |
| patend++; |
| while (isdigit(*patend) || *patend == '*') |
| patend++; |
| } |
| else |
| patend++; |
| } |
| sp--; |
| while (pat < patend) { |
| reparse: |
| datumtype = *pat++; |
| if (pat >= patend) |
| len = 1; |
| else if (*pat == '*') { |
| len = strend - strbeg; /* long enough */ |
| pat++; |
| } |
| else if (isdigit(*pat)) { |
| len = *pat++ - '0'; |
| while (isdigit(*pat)) |
| len = (len * 10) + (*pat++ - '0'); |
| } |
| else |
| len = (datumtype != '@'); |
| switch(datumtype) { |
| default: |
| break; |
| case '%': |
| if (len == 1 && pat[-1] != '1') |
| len = 16; |
| checksum = len; |
| culong = 0; |
| cdouble = 0; |
| if (pat < patend) |
| goto reparse; |
| break; |
| case '@': |
| if (len > strend - s) |
| fatal("@ outside of string"); |
| s = strbeg + len; |
| break; |
| case 'X': |
| if (len > s - strbeg) |
| fatal("X outside of string"); |
| s -= len; |
| break; |
| case 'x': |
| if (len > strend - s) |
| fatal("x outside of string"); |
| s += len; |
| break; |
| case 'A': |
| case 'a': |
| if (len > strend - s) |
| len = strend - s; |
| if (checksum) |
| goto uchar_checksum; |
| 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 || (isascii(*s)&&isspace(*s)))) |
| s--; |
| *++s = '\0'; |
| str->str_cur = s - str->str_ptr; |
| s = aptr; /* unborrow register */ |
| } |
| (void)astore(stack, ++sp, str_2mortal(str)); |
| break; |
| case 'B': |
| case 'b': |
| if (pat[-1] == '*' || len > (strend - s) * 8) |
| len = (strend - s) * 8; |
| str = Str_new(35, len + 1); |
| str->str_cur = len; |
| str->str_pok = 1; |
| aptr = pat; /* borrow register */ |
| pat = str->str_ptr; |
| if (datumtype == 'b') { |
| aint = len; |
| for (len = 0; len < aint; len++) { |
| if (len & 7) |
| bits >>= 1; |
| else |
| bits = *s++; |
| *pat++ = '0' + (bits & 1); |
| } |
| } |
| else { |
| aint = len; |
| for (len = 0; len < aint; len++) { |
| if (len & 7) |
| bits <<= 1; |
| else |
| bits = *s++; |
| *pat++ = '0' + ((bits & 128) != 0); |
| } |
| } |
| *pat = '\0'; |
| pat = aptr; /* unborrow register */ |
| (void)astore(stack, ++sp, str_2mortal(str)); |
| break; |
| case 'H': |
| case 'h': |
| if (pat[-1] == '*' || len > (strend - s) * 2) |
| len = (strend - s) * 2; |
| str = Str_new(35, len + 1); |
| str->str_cur = len; |
| str->str_pok = 1; |
| aptr = pat; /* borrow register */ |
| pat = str->str_ptr; |
| if (datumtype == 'h') { |
| aint = len; |
| for (len = 0; len < aint; len++) { |
| if (len & 1) |
| bits >>= 4; |
| else |
| bits = *s++; |
| *pat++ = hexdigit[bits & 15]; |
| } |
| } |
| else { |
| aint = len; |
| for (len = 0; len < aint; len++) { |
| if (len & 1) |
| bits <<= 4; |
| else |
| bits = *s++; |
| *pat++ = hexdigit[(bits >> 4) & 15]; |
| } |
| } |
| *pat = '\0'; |
| pat = aptr; /* unborrow register */ |
| (void)astore(stack, ++sp, str_2mortal(str)); |
| break; |
| case 'c': |
| if (len > strend - s) |
| len = strend - s; |
| if (checksum) { |
| while (len-- > 0) { |
| aint = *s++; |
| if (aint >= 128) /* fake up signed chars */ |
| aint -= 256; |
| culong += aint; |
| } |
| } |
| else { |
| while (len-- > 0) { |
| aint = *s++; |
| if (aint >= 128) /* fake up signed chars */ |
| aint -= 256; |
| str = Str_new(36,0); |
| str_numset(str,(double)aint); |
| (void)astore(stack, ++sp, str_2mortal(str)); |
| } |
| } |
| break; |
| case 'C': |
| if (len > strend - s) |
| len = strend - s; |
| if (checksum) { |
| uchar_checksum: |
| while (len-- > 0) { |
| auint = *s++ & 255; |
| culong += auint; |
| } |
| } |
| else { |
| while (len-- > 0) { |
| auint = *s++ & 255; |
| str = Str_new(37,0); |
| str_numset(str,(double)auint); |
| (void)astore(stack, ++sp, str_2mortal(str)); |
| } |
| } |
| break; |
| case 's': |
| along = (strend - s) / sizeof(short); |
| if (len > along) |
| len = along; |
| if (checksum) { |
| while (len-- > 0) { |
| bcopy(s,(char*)&ashort,sizeof(short)); |
| s += sizeof(short); |
| culong += ashort; |
| } |
| } |
| else { |
| while (len-- > 0) { |
| bcopy(s,(char*)&ashort,sizeof(short)); |
| s += sizeof(short); |
| str = Str_new(38,0); |
| str_numset(str,(double)ashort); |
| (void)astore(stack, ++sp, str_2mortal(str)); |
| } |
| } |
| break; |
| case 'n': |
| case 'S': |
| along = (strend - s) / sizeof(unsigned short); |
| if (len > along) |
| len = along; |
| if (checksum) { |
| while (len-- > 0) { |
| bcopy(s,(char*)&aushort,sizeof(unsigned short)); |
| s += sizeof(unsigned short); |
| #ifdef HAS_NTOHS |
| if (datumtype == 'n') |
| aushort = ntohs(aushort); |
| #endif |
| culong += aushort; |
| } |
| } |
| else { |
| while (len-- > 0) { |
| bcopy(s,(char*)&aushort,sizeof(unsigned short)); |
| s += sizeof(unsigned short); |
| str = Str_new(39,0); |
| #ifdef HAS_NTOHS |
| if (datumtype == 'n') |
| aushort = ntohs(aushort); |
| #endif |
| str_numset(str,(double)aushort); |
| (void)astore(stack, ++sp, str_2mortal(str)); |
| } |
| } |
| break; |
| case 'i': |
| along = (strend - s) / sizeof(int); |
| if (len > along) |
| len = along; |
| if (checksum) { |
| while (len-- > 0) { |
| bcopy(s,(char*)&aint,sizeof(int)); |
| s += sizeof(int); |
| if (checksum > 32) |
| cdouble += (double)aint; |
| else |
| culong += aint; |
| } |
| } |
| else { |
| while (len-- > 0) { |
| bcopy(s,(char*)&aint,sizeof(int)); |
| s += sizeof(int); |
| str = Str_new(40,0); |
| str_numset(str,(double)aint); |
| (void)astore(stack, ++sp, str_2mortal(str)); |
| } |
| } |
| break; |
| case 'I': |
| along = (strend - s) / sizeof(unsigned int); |
| if (len > along) |
| len = along; |
| if (checksum) { |
| while (len-- > 0) { |
| bcopy(s,(char*)&auint,sizeof(unsigned int)); |
| s += sizeof(unsigned int); |
| if (checksum > 32) |
| cdouble += (double)auint; |
| else |
| culong += auint; |
| } |
| } |
| else { |
| while (len-- > 0) { |
| 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_2mortal(str)); |
| } |
| } |
| break; |
| case 'l': |
| along = (strend - s) / sizeof(long); |
| if (len > along) |
| len = along; |
| if (checksum) { |
| while (len-- > 0) { |
| bcopy(s,(char*)&along,sizeof(long)); |
| s += sizeof(long); |
| if (checksum > 32) |
| cdouble += (double)along; |
| else |
| culong += along; |
| } |
| } |
| else { |
| while (len-- > 0) { |
| bcopy(s,(char*)&along,sizeof(long)); |
| s += sizeof(long); |
| str = Str_new(42,0); |
| str_numset(str,(double)along); |
| (void)astore(stack, ++sp, str_2mortal(str)); |
| } |
| } |
| break; |
| case 'N': |
| case 'L': |
| along = (strend - s) / sizeof(unsigned long); |
| if (len > along) |
| len = along; |
| if (checksum) { |
| while (len-- > 0) { |
| bcopy(s,(char*)&aulong,sizeof(unsigned long)); |
| s += sizeof(unsigned long); |
| #ifdef HAS_NTOHL |
| if (datumtype == 'N') |
| aulong = ntohl(aulong); |
| #endif |
| if (checksum > 32) |
| cdouble += (double)aulong; |
| else |
| culong += aulong; |
| } |
| } |
| else { |
| while (len-- > 0) { |
| bcopy(s,(char*)&aulong,sizeof(unsigned long)); |
| s += sizeof(unsigned long); |
| str = Str_new(43,0); |
| #ifdef HAS_NTOHL |
| if (datumtype == 'N') |
| aulong = ntohl(aulong); |
| #endif |
| str_numset(str,(double)aulong); |
| (void)astore(stack, ++sp, str_2mortal(str)); |
| } |
| } |
| break; |
| case 'p': |
| along = (strend - s) / sizeof(char*); |
| if (len > along) |
| len = along; |
| while (len-- > 0) { |
| if (sizeof(char*) > strend - s) |
| break; |
| 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_2mortal(str)); |
| } |
| break; |
| /* float and double added gnb@melba.bby.oz.au 22/11/89 */ |
| case 'f': |
| case 'F': |
| along = (strend - s) / sizeof(float); |
| if (len > along) |
| len = along; |
| if (checksum) { |
| while (len-- > 0) { |
| bcopy(s, (char *)&afloat, sizeof(float)); |
| s += sizeof(float); |
| cdouble += afloat; |
| } |
| } |
| else { |
| while (len-- > 0) { |
| bcopy(s, (char *)&afloat, sizeof(float)); |
| s += sizeof(float); |
| str = Str_new(47, 0); |
| str_numset(str, (double)afloat); |
| (void)astore(stack, ++sp, str_2mortal(str)); |
| } |
| } |
| break; |
| case 'd': |
| case 'D': |
| along = (strend - s) / sizeof(double); |
| if (len > along) |
| len = along; |
| if (checksum) { |
| while (len-- > 0) { |
| bcopy(s, (char *)&adouble, sizeof(double)); |
| s += sizeof(double); |
| cdouble += adouble; |
| } |
| } |
| else { |
| while (len-- > 0) { |
| bcopy(s, (char *)&adouble, sizeof(double)); |
| s += sizeof(double); |
| str = Str_new(48, 0); |
| str_numset(str, (double)adouble); |
| (void)astore(stack, ++sp, str_2mortal(str)); |
| } |
| } |
| break; |
| case 'u': |
| along = (strend - s) * 3 / 4; |
| str = Str_new(42,along); |
| while (s < strend && *s > ' ' && *s < 'a') { |
| int a,b,c,d; |
| char hunk[4]; |
| |
| hunk[3] = '\0'; |
| len = (*s++ - ' ') & 077; |
| while (len > 0) { |
| if (s < strend && *s >= ' ') |
| a = (*s++ - ' ') & 077; |
| else |
| a = 0; |
| if (s < strend && *s >= ' ') |
| b = (*s++ - ' ') & 077; |
| else |
| b = 0; |
| if (s < strend && *s >= ' ') |
| c = (*s++ - ' ') & 077; |
| else |
| c = 0; |
| if (s < strend && *s >= ' ') |
| d = (*s++ - ' ') & 077; |
| else |
| d = 0; |
| hunk[0] = a << 2 | b >> 4; |
| hunk[1] = b << 4 | c >> 2; |
| hunk[2] = c << 6 | d; |
| str_ncat(str,hunk, len > 3 ? 3 : len); |
| len -= 3; |
| } |
| if (*s == '\n') |
| s++; |
| else if (s[1] == '\n') /* possible checksum byte */ |
| s += 2; |
| } |
| (void)astore(stack, ++sp, str_2mortal(str)); |
| break; |
| } |
| if (checksum) { |
| str = Str_new(42,0); |
| if (index("fFdD", datumtype) || |
| (checksum > 32 && index("iIlLN", datumtype)) ) { |
| double modf(); |
| double trouble; |
| |
| adouble = 1.0; |
| while (checksum >= 16) { |
| checksum -= 16; |
| adouble *= 65536.0; |
| } |
| while (checksum >= 4) { |
| checksum -= 4; |
| adouble *= 16.0; |
| } |
| while (checksum--) |
| adouble *= 2.0; |
| along = (1 << checksum) - 1; |
| while (cdouble < 0.0) |
| cdouble += adouble; |
| cdouble = modf(cdouble / adouble, &trouble) * adouble; |
| str_numset(str,cdouble); |
| } |
| else { |
| if (checksum < 32) { |
| along = (1 << checksum) - 1; |
| culong &= (unsigned long)along; |
| } |
| str_numset(str,(double)culong); |
| } |
| (void)astore(stack, ++sp, str_2mortal(str)); |
| checksum = 0; |
| } |
| } |
| return sp; |
| } |
| |
| int |
| do_slice(stab,str,numarray,lval,gimme,arglast) |
| STAB *stab; |
| STR *str; |
| 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; |
| register ARRAY *ary; |
| register HASH *hash; |
| int oldarybase = arybase; |
| |
| if (numarray) { |
| if (numarray == 2) { /* a slice of a LIST */ |
| ary = stack; |
| ary->ary_fill = arglast[3]; |
| arybase -= max + 1; |
| st[sp] = str; /* make stack size available */ |
| str_numset(str,(double)(sp - 1)); |
| } |
| else |
| ary = stab_array(stab); /* a slice of an array */ |
| } |
| else { |
| if (lval) { |
| 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 */ |
| } |
| hash = stab_hash(stab); /* a slice of an associative array */ |
| } |
| |
| if (gimme == G_ARRAY) { |
| if (numarray) { |
| while (sp < max) { |
| if (st[++sp]) { |
| st[sp-1] = afetch(ary, |
| ((int)str_gnum(st[sp])) - arybase, lval); |
| } |
| else |
| st[sp-1] = &str_undef; |
| } |
| } |
| else { |
| while (sp < max) { |
| if (st[++sp]) { |
| tmps = str_get(st[sp]); |
| len = st[sp]->str_cur; |
| st[sp-1] = hfetch(hash,tmps,len, lval); |
| if (magic) |
| str_magic(st[sp-1],stab,magic,tmps,len); |
| } |
| else |
| st[sp-1] = &str_undef; |
| } |
| } |
| sp--; |
| } |
| else { |
| if (numarray) { |
| if (st[max]) |
| st[sp] = afetch(ary, |
| ((int)str_gnum(st[max])) - arybase, lval); |
| else |
| st[sp] = &str_undef; |
| } |
| else { |
| if (st[max]) { |
| tmps = str_get(st[max]); |
| len = st[max]->str_cur; |
| st[sp] = hfetch(hash,tmps,len, lval); |
| if (magic) |
| str_magic(st[sp],stab,magic,tmps,len); |
| } |
| else |
| st[sp] = &str_undef; |
| } |
| } |
| arybase = oldarybase; |
| return sp; |
| } |
| |
| int |
| do_splice(ary,gimme,arglast) |
| register ARRAY *ary; |
| int gimme; |
| int *arglast; |
| { |
| register STR **st = stack->ary_array; |
| register int sp = arglast[1]; |
| int max = arglast[2] + 1; |
| register STR **src; |
| register STR **dst; |
| register int i; |
| register int offset; |
| register int length; |
| int newlen; |
| int after; |
| int diff; |
| STR **tmparyval; |
| |
| if (++sp < max) { |
| offset = ((int)str_gnum(st[sp])) - arybase; |
| if (offset < 0) |
| offset += ary->ary_fill + 1; |
| if (++sp < max) { |
| length = (int)str_gnum(st[sp++]); |
| if (length < 0) |
| length = 0; |
| } |
| else |
| length = ary->ary_max; /* close enough to infinity */ |
| } |
| else { |
| offset = 0; |
| length = ary->ary_max; |
| } |
| if (offset < 0) { |
| length += offset; |
| offset = 0; |
| if (length < 0) |
| length = 0; |
| } |
| if (offset > ary->ary_fill + 1) |
| offset = ary->ary_fill + 1; |
| after = ary->ary_fill + 1 - (offset + length); |
| if (after < 0) { /* not that much array */ |
| length += after; /* offset+length now in array */ |
| after = 0; |
| if (!ary->ary_alloc) { |
| afill(ary,0); |
| afill(ary,-1); |
| } |
| } |
| |
| /* At this point, sp .. max-1 is our new LIST */ |
| |
| newlen = max - sp; |
| diff = newlen - length; |
| |
| if (diff < 0) { /* shrinking the area */ |
| if (newlen) { |
| New(451, tmparyval, newlen, STR*); /* so remember insertion */ |
| Copy(st+sp, tmparyval, newlen, STR*); |
| } |
| |
| sp = arglast[0] + 1; |
| if (gimme == G_ARRAY) { /* copy return vals to stack */ |
| if (sp + length >= stack->ary_max) { |
| astore(stack,sp + length, Nullstr); |
| st = stack->ary_array; |
| } |
| Copy(ary->ary_array+offset, st+sp, length, STR*); |
| if (ary->ary_flags & ARF_REAL) { |
| for (i = length, dst = st+sp; i; i--) |
| str_2mortal(*dst++); /* free them eventualy */ |
| } |
| sp += length - 1; |
| } |
| else { |
| st[sp] = ary->ary_array[offset+length-1]; |
| if (ary->ary_flags & ARF_REAL) |
| str_2mortal(st[sp]); |
| } |
| ary->ary_fill += diff; |
| |
| /* pull up or down? */ |
| |
| if (offset < after) { /* easier to pull up */ |
| if (offset) { /* esp. if nothing to pull */ |
| src = &ary->ary_array[offset-1]; |
| dst = src - diff; /* diff is negative */ |
| for (i = offset; i > 0; i--) /* can't trust Copy */ |
| *dst-- = *src--; |
| } |
| Zero(ary->ary_array, -diff, STR*); |
| ary->ary_array -= diff; /* diff is negative */ |
| ary->ary_max += diff; |
| } |
| else { |
| if (after) { /* anything to pull down? */ |
| src = ary->ary_array + offset + length; |
| dst = src + diff; /* diff is negative */ |
| Copy(src, dst, after, STR*); |
| } |
| Zero(&ary->ary_array[ary->ary_fill+1], -diff, STR*); |
| /* avoid later double free */ |
| } |
| if (newlen) { |
| for (src = tmparyval, dst = ary->ary_array + offset; |
| newlen; newlen--) { |
| *dst = Str_new(46,0); |
| str_sset(*dst++,*src++); |
| } |
| Safefree(tmparyval); |
| } |
| } |
| else { /* no, expanding (or same) */ |
| if (length) { |
| New(452, tmparyval, length, STR*); /* so remember deletion */ |
| Copy(ary->ary_array+offset, tmparyval, length, STR*); |
| } |
| |
| if (diff > 0) { /* expanding */ |
| |
| /* push up or down? */ |
| |
| if (offset < after && diff <= ary->ary_array - ary->ary_alloc) { |
| if (offset) { |
| src = ary->ary_array; |
| dst = src - diff; |
| Copy(src, dst, offset, STR*); |
| } |
| ary->ary_array -= diff; /* diff is positive */ |
| ary->ary_max += diff; |
| ary->ary_fill += diff; |
| } |
| else { |
| if (ary->ary_fill + diff >= ary->ary_max) /* oh, well */ |
| astore(ary, ary->ary_fill + diff, Nullstr); |
| else |
| ary->ary_fill += diff; |
| if (after) { |
| dst = ary->ary_array + ary->ary_fill; |
| src = dst - diff; |
| for (i = after; i; i--) { |
| if (*dst) /* str was hanging around */ |
| str_free(*dst); /* after $#foo */ |
| *dst-- = *src; |
| *src-- = Nullstr; |
| } |
| } |
| } |
| } |
| |
| for (src = st+sp, dst = ary->ary_array + offset; newlen; newlen--) { |
| *dst = Str_new(46,0); |
| str_sset(*dst++,*src++); |
| } |
| sp = arglast[0] + 1; |
| if (gimme == G_ARRAY) { /* copy return vals to stack */ |
| if (length) { |
| Copy(tmparyval, st+sp, length, STR*); |
| if (ary->ary_flags & ARF_REAL) { |
| for (i = length, dst = st+sp; i; i--) |
| str_2mortal(*dst++); /* free them eventualy */ |
| } |
| Safefree(tmparyval); |
| } |
| sp += length - 1; |
| } |
| else if (length) { |
| st[sp] = tmparyval[length-1]; |
| if (ary->ary_flags & ARF_REAL) |
| str_2mortal(st[sp]); |
| Safefree(tmparyval); |
| } |
| else |
| st[sp] = &str_undef; |
| } |
| return sp; |
| } |
| |
| int |
| do_grep(arg,str,gimme,arglast) |
| register ARG *arg; |
| STR *str; |
| int gimme; |
| int *arglast; |
| { |
| STR **st = stack->ary_array; |
| register int dst = arglast[1]; |
| register int src = dst + 1; |
| register int sp = arglast[2]; |
| register int i = sp - arglast[1]; |
| int oldsave = savestack->ary_fill; |
| SPAT *oldspat = curspat; |
| int oldtmps_base = tmps_base; |
| |
| savesptr(&stab_val(defstab)); |
| tmps_base = tmps_max; |
| if ((arg[1].arg_type & A_MASK) != A_EXPR) { |
| arg[1].arg_type &= A_MASK; |
| dehoist(arg,1); |
| arg[1].arg_type |= A_DONT; |
| } |
| arg = arg[1].arg_ptr.arg_arg; |
| while (i-- > 0) { |
| if (st[src]) |
| stab_val(defstab) = st[src]; |
| else |
| stab_val(defstab) = str_mortal(&str_undef); |
| (void)eval(arg,G_SCALAR,sp); |
| st = stack->ary_array; |
| if (str_true(st[sp+1])) |
| st[dst++] = st[src]; |
| src++; |
| curspat = oldspat; |
| } |
| restorelist(oldsave); |
| tmps_base = oldtmps_base; |
| if (gimme != G_ARRAY) { |
| str_numset(str,(double)(dst - arglast[1])); |
| STABSET(str); |
| st[arglast[0]+1] = str; |
| return arglast[0]+1; |
| } |
| return arglast[0] + (dst - arglast[1]); |
| } |
| |
| int |
| do_reverse(arglast) |
| 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]; |
| |
| while (i-- > 0) { |
| *up++ = *down; |
| if (i-- > 0) |
| *down-- = *up; |
| } |
| i = arglast[2] - arglast[1]; |
| Copy(down+1,up,i/2,STR*); |
| return arglast[2] - 1; |
| } |
| |
| int |
| do_sreverse(str,arglast) |
| STR *str; |
| int *arglast; |
| { |
| STR **st = stack->ary_array; |
| register char *up; |
| register char *down; |
| register int tmp; |
| |
| str_sset(str,st[arglast[2]]); |
| up = str_get(str); |
| if (str->str_cur > 1) { |
| down = str->str_ptr + str->str_cur - 1; |
| while (down > up) { |
| tmp = *up; |
| *up++ = *down; |
| *down-- = tmp; |
| } |
| } |
| STABSET(str); |
| st[arglast[0]+1] = str; |
| return arglast[0]+1; |
| } |
| |
| static CMD *sortcmd; |
| static HASH *sortstash = Null(HASH*); |
| static STAB *firststab = Nullstab; |
| static STAB *secondstab = Nullstab; |
| |
| int |
| do_sort(str,stab,gimme,arglast) |
| STR *str; |
| STAB *stab; |
| int gimme; |
| int *arglast; |
| { |
| register 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]; |
| st += sp; /* temporarily make st point to args */ |
| for (i = 1; i <= max; i++) { |
| if (*up = st[i]) { |
| if (!(*up)->str_pok) |
| (void)str_2ptr(*up); |
| else |
| (*up)->str_pok &= ~SP_TEMP; |
| up++; |
| } |
| } |
| st -= sp; |
| max = up - &st[sp]; |
| sp--; |
| if (max > 1) { |
| if (stab) { |
| int oldtmps_base = tmps_base; |
| |
| if (!stab_sub(stab) || !(sortcmd = stab_sub(stab)->cmd)) |
| fatal("Undefined subroutine \"%s\" in sort", stab_name(stab)); |
| if (!sortstack) { |
| sortstack = anew(Nullstab); |
| astore(sortstack, 0, Nullstr); |
| aclear(sortstack); |
| sortstack->ary_flags = 0; |
| } |
| oldstack = stack; |
| stack = sortstack; |
| tmps_base = tmps_max; |
| if (sortstash != stab_stash(stab)) { |
| firststab = stabent("a",TRUE); |
| secondstab = stabent("b",TRUE); |
| sortstash = stab_stash(stab); |
| } |
| 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 |
| } |
| return sp+max; |
| } |
| |
| int |
| sortsub(str1,str2) |
| STR **str1; |
| STR **str2; |
| { |
| 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->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; |
| register ARRAY *ary = stack; |
| register STR *str; |
| int max; |
| |
| if (gimme != G_ARRAY) |
| fatal("panic: do_range"); |
| |
| if (st[sp+1]->str_nok || !st[sp+1]->str_pok || |
| (looks_like_number(st[sp+1]) && *st[sp+1]->str_ptr != '0') ) { |
| i = (int)str_gnum(st[sp+1]); |
| max = (int)str_gnum(st[sp+2]); |
| while (i <= max) { |
| (void)astore(ary, ++sp, str = str_mortal(&str_no)); |
| str_numset(str,(double)i++); |
| } |
| } |
| else { |
| STR *final = str_mortal(st[sp+2]); |
| char *tmps = str_get(final); |
| |
| str = str_mortal(st[sp+1]); |
| while (!str->str_nok && str->str_cur <= final->str_cur && |
| strNE(str->str_ptr,tmps) ) { |
| (void)astore(ary, ++sp, str); |
| str = str_2mortal(str_smake(str)); |
| str_inc(str); |
| } |
| if (strEQ(str->str_ptr,tmps)) |
| (void)astore(ary, ++sp, str); |
| } |
| return sp; |
| } |
| |
| int |
| do_repeatary(arglast) |
| int *arglast; |
| { |
| STR **st = stack->ary_array; |
| register int sp = arglast[0]; |
| register int items = arglast[1] - sp; |
| register int count = (int) str_gnum(st[arglast[2]]); |
| register ARRAY *ary = stack; |
| register int i; |
| int max; |
| |
| max = items * count; |
| if (max > 0 && sp + max > stack->ary_max) { |
| astore(stack, sp + max, Nullstr); |
| st = stack->ary_array; |
| } |
| if (count > 1) { |
| for (i = arglast[1]; i > sp; i--) |
| st[i]->str_pok &= ~SP_TEMP; |
| repeatcpy((char*)&st[arglast[1]+1], (char*)&st[sp+1], |
| items * sizeof(STR*), count); |
| } |
| sp += max; |
| |
| return sp; |
| } |
| |
| int |
| do_caller(arg,maxarg,gimme,arglast) |
| ARG *arg; |
| int maxarg; |
| int gimme; |
| int *arglast; |
| { |
| STR **st = stack->ary_array; |
| register int sp = arglast[0]; |
| register CSV *csv = curcsv; |
| STR *str; |
| int count = 0; |
| |
| if (!csv) |
| fatal("There is no caller"); |
| if (maxarg) |
| count = (int) str_gnum(st[sp+1]); |
| for (;;) { |
| if (!csv) |
| return sp; |
| if (DBsub && csv->curcsv && csv->curcsv->sub == stab_sub(DBsub)) |
| count++; |
| if (!count--) |
| break; |
| csv = csv->curcsv; |
| } |
| if (gimme != G_ARRAY) { |
| STR *str = arg->arg_ptr.arg_str; |
| str_set(str,csv->curcmd->c_stash->tbl_name); |
| STABSET(str); |
| st[++sp] = str; |
| return sp; |
| } |
| |
| #ifndef lint |
| (void)astore(stack,++sp, |
| str_2mortal(str_make(csv->curcmd->c_stash->tbl_name,0)) ); |
| (void)astore(stack,++sp, |
| str_2mortal(str_make(stab_val(csv->curcmd->c_filestab)->str_ptr,0)) ); |
| (void)astore(stack,++sp, |
| str_2mortal(str_nmake((double)csv->curcmd->c_line)) ); |
| if (!maxarg) |
| return sp; |
| str = Str_new(49,0); |
| stab_fullname(str, csv->stab); |
| (void)astore(stack,++sp, str_2mortal(str)); |
| (void)astore(stack,++sp, |
| str_2mortal(str_nmake((double)csv->hasargs)) ); |
| (void)astore(stack,++sp, |
| str_2mortal(str_nmake((double)csv->wantarray)) ); |
| if (csv->hasargs) { |
| ARRAY *ary = csv->argarray; |
| |
| if (dbargs->ary_max < ary->ary_fill) |
| astore(dbargs,ary->ary_fill,Nullstr); |
| Copy(ary->ary_array, dbargs->ary_array, ary->ary_fill+1, STR*); |
| dbargs->ary_fill = ary->ary_fill; |
| } |
| #else |
| (void)astore(stack,++sp, |
| str_2mortal(str_make("",0))); |
| #endif |
| return sp; |
| } |
| |
| int |
| do_tms(str,gimme,arglast) |
| STR *str; |
| int gimme; |
| int *arglast; |
| { |
| #ifdef MSDOS |
| return -1; |
| #else |
| 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(×buf); |
| |
| #ifndef HZ |
| #define HZ 60 |
| #endif |
| |
| #ifndef lint |
| (void)astore(stack,++sp, |
| str_2mortal(str_nmake(((double)timesbuf.tms_utime)/HZ))); |
| (void)astore(stack,++sp, |
| str_2mortal(str_nmake(((double)timesbuf.tms_stime)/HZ))); |
| (void)astore(stack,++sp, |
| str_2mortal(str_nmake(((double)timesbuf.tms_cutime)/HZ))); |
| (void)astore(stack,++sp, |
| str_2mortal(str_nmake(((double)timesbuf.tms_cstime)/HZ))); |
| #else |
| (void)astore(stack,++sp, |
| str_2mortal(str_nmake(0.0))); |
| #endif |
| return sp; |
| #endif |
| } |
| |
| 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_2mortal(str_nmake((double)tmbuf->tm_sec))); |
| (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_min))); |
| (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_hour))); |
| (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_mday))); |
| (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_mon))); |
| (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_year))); |
| (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_wday))); |
| (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_yday))); |
| (void)astore(ary,++sp,str_2mortal(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); |
| if (!i) |
| tmps = ""; |
| (void)astore(ary,++sp,str_2mortal(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_2mortal(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); |
| if (!i) |
| tmps = ""; |
| st[++sp] = mystrk = str_make(tmps,i); |
| } |
| st[++sp] = str; |
| str_sset(str,hiterval(hash,entry)); |
| STABSET(str); |
| return sp; |
| } |
| else |
| return sp; |
| } |