-/* $Header: dolist.c,v 4.0 91/03/20 01:08:03 lwall Locked $
+/* $RCSfile: dolist.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 17:07:02 $
*
- * Copyright (c) 1989, Larry Wall
+ * Copyright (c) 1991, 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.
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Artistic License, as specified in the README file.
*
* $Log: dolist.c,v $
+ * Revision 4.0.1.3 91/11/05 17:07:02 lwall
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * patch11: /$foo/o optimizer could access deallocated data
+ * patch11: certain optimizations of //g in array context returned too many values
+ * patch11: regexp with no parens in array context returned wacky $`, $& and $'
+ * patch11: $' not set right on some //g
+ * patch11: added some support for 64-bit integers
+ * patch11: grep of a split lost its values
+ * patch11: added sort {} LIST
+ * patch11: multiple reallocations now avoided in 1 .. 100000
+ *
+ * Revision 4.0.1.2 91/06/10 01:22:15 lwall
+ * patch10: //g only worked first time through
+ *
+ * Revision 4.0.1.1 91/06/07 10:58:28 lwall
+ * patch4: new copyright notice
+ * patch4: added global modifier for pattern matches
+ * patch4: // wouldn't use previous pattern if it started with a null character
+ * patch4: //o and s///o now optimize themselves fully at runtime
+ * patch4: $` was busted inside s///
+ * patch4: caller($arg) didn't work except under debugger
+ *
* Revision 4.0 91/03/20 01:08:03 lwall
* 4.0 baseline.
*
char *strend = s + st[sp]->str_cur;
STR *tmpstr;
char *myhint = hint;
+ int global;
+ int safebase;
hint = Nullch;
if (!spat) {
st[sp] = str;
return sp;
}
+ global = spat->spat_flags & SPAT_GLOBAL;
+ safebase = (gimme == G_ARRAY) || global;
if (!s)
fatal("panic: do_match");
if (spat->spat_flags & SPAT_USED) {
}
spat->spat_regexp = regcomp(t,t+tmpstr->str_cur,
spat->spat_flags & SPAT_FOLD);
- if (!*spat->spat_regexp->precomp && lastspat)
+ if (!spat->spat_regexp->prelen && lastspat)
spat = lastspat;
if (spat->spat_flags & SPAT_KEEP) {
+ scanconst(spat,spat->spat_regexp->precomp, spat->spat_regexp->prelen);
if (spat->spat_runtime)
arg_free(spat->spat_runtime); /* it won't change, so */
spat->spat_runtime = Nullarg; /* no point compiling again */
+ hoistmust(spat);
+ if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) {
+ curcmd->c_flags &= ~CF_OPTIMIZE;
+ opt_arg(curcmd, 1, curcmd->c_type == C_EXPR);
+ }
+ }
+ if (global) {
+ if (spat->spat_regexp->startp[0]) {
+ s = spat->spat_regexp->endp[0];
+ }
}
- if (!spat->spat_regexp->nparens)
+ else 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)
+ safebase)) {
+ if (spat->spat_regexp->subbase || global)
curspat = spat;
lastspat = spat;
goto gotcha;
deb("2.SPAT %c%s%c\n",ch,spat->spat_regexp->precomp,ch);
}
#endif
- if (!*spat->spat_regexp->precomp && lastspat)
+ if (!spat->spat_regexp->prelen && lastspat)
spat = lastspat;
t = s;
+ play_it_again:
+ if (global && spat->spat_regexp->startp[0])
+ t = s = spat->spat_regexp->endp[0];
if (myhint) {
if (myhint < s || myhint > strend)
fatal("panic: hint in do_match");
spat->spat_short = Nullstr; /* opt is being useless */
}
}
- if (!spat->spat_regexp->nparens)
+ if (!spat->spat_regexp->nparens && !global) {
gimme = G_SCALAR; /* accidental array context? */
+ safebase = FALSE;
+ }
if (regexec(spat->spat_regexp, s, strend, t, 0,
srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
- gimme == G_ARRAY)) {
- if (spat->spat_regexp->subbase)
+ safebase)) {
+ if (spat->spat_regexp->subbase || global)
curspat = spat;
lastspat = spat;
if (spat->spat_flags & SPAT_ONCE)
goto gotcha;
}
else {
+ if (global)
+ spat->spat_regexp->startp[0] = Nullch;
if (gimme == G_ARRAY)
return sp;
str_sset(str,&str_no);
int iters, i, len;
iters = spat->spat_regexp->nparens;
- if (sp + iters >= stack->ary_max) {
- astore(stack,sp + iters, Nullstr);
+ if (global && !iters)
+ i = 1;
+ else
+ i = 0;
+ if (sp + iters + i >= stack->ary_max) {
+ astore(stack,sp + iters + i, Nullstr);
st = stack->ary_array; /* possibly realloced */
}
- for (i = 1; i <= iters; i++) {
+ for (i = !i; i <= iters; i++) {
st[++sp] = str_mortal(&str_no);
+ /*SUPPRESS 560*/
if (s = spat->spat_regexp->startp[i]) {
len = spat->spat_regexp->endp[i] - s;
if (len > 0)
str_nset(st[sp],s,len);
}
}
+ if (global)
+ goto play_it_again;
return sp;
}
else {
lastspat = spat;
if (spat->spat_flags & SPAT_ONCE)
spat->spat_flags |= SPAT_USED;
+ if (global) {
+ spat->spat_regexp->subbeg = t;
+ spat->spat_regexp->subend = strend;
+ spat->spat_regexp->startp[0] = s;
+ spat->spat_regexp->endp[0] = s + spat->spat_short->str_cur;
+ curspat = spat;
+ goto gotcha;
+ }
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->subbeg = tmps;
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;
return sp;
nope:
+ spat->spat_regexp->startp[0] = Nullch;
++spat->spat_short->str_u.str_useful;
+ if (global)
+ spat->spat_regexp->startp[0] = Nullch;
if (gimme == G_ARRAY)
return sp;
str_sset(str,&str_no);
ary = stack;
orig = s;
if (spat->spat_flags & SPAT_SKIPWHITE) {
- while (isascii(*s) && isspace(*s))
+ while (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++) ;
+ /*SUPPRESS 530*/
+ for (m = s; m < strend && !isSPACE(*m); m++) ;
if (m >= strend)
break;
dstr = Str_new(30,m-s);
if (!realarray)
str_2mortal(dstr);
(void)astore(ary, ++sp, dstr);
- for (s = m + 1; s < strend && isascii(*s) && isspace(*s); s++) ;
+ /*SUPPRESS 530*/
+ for (s = m + 1; s < strend && isSPACE(*s); s++) ;
}
}
else if (strEQ("^",spat->spat_regexp->precomp)) {
while (--limit) {
+ /*SUPPRESS 530*/
for (m = s; m < strend && *m != '\n'; m++) ;
m++;
if (m >= strend)
int fold = (spat->spat_flags & SPAT_FOLD);
i = *spat->spat_short->str_ptr;
- if (fold && isupper(i))
+ if (fold && isUPPER(i))
i = tolower(i);
while (--limit) {
if (fold) {
for ( m = s;
m < strend && *m != i &&
- (!isupper(*m) || tolower(*m) != i);
- m++)
+ (!isUPPER(*m) || tolower(*m) != i);
+ m++) /*SUPPRESS 530*/
;
}
- else
+ else /*SUPPRESS 530*/
for (m = s; m < strend && *m != i; m++) ;
if (m >= strend)
break;
short ashort;
int aint;
long along;
+#ifdef QUAD
+ quad aquad;
+#endif
unsigned short aushort;
unsigned int auint;
unsigned long aulong;
+#ifdef QUAD
+ unsigned quad auquad;
+#endif
char *aptr;
float afloat;
double adouble;
double cdouble;
if (gimme != G_ARRAY) { /* arrange to do first one only */
- for (patend = pat; !isalpha(*patend); patend++);
+ /*SUPPRESS 530*/
+ for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
if (index("aAbBhH", *patend) || *pat == '%') {
patend++;
- while (isdigit(*patend) || *patend == '*')
+ while (isDIGIT(*patend) || *patend == '*')
patend++;
}
else
len = strend - strbeg; /* long enough */
pat++;
}
- else if (isdigit(*pat)) {
+ else if (isDIGIT(*pat)) {
len = *pat++ - '0';
- while (isdigit(*pat))
+ while (isDIGIT(*pat))
len = (len * 10) + (*pat++ - '0');
}
else
if (datumtype == 'A') {
aptr = s; /* borrow register */
s = str->str_ptr + len - 1;
- while (s >= str->str_ptr && (!*s || (isascii(*s)&&isspace(*s))))
+ while (s >= str->str_ptr && (!*s || isSPACE(*s)))
s--;
*++s = '\0';
str->str_cur = s - str->str_ptr;
if (datumtype == 'b') {
aint = len;
for (len = 0; len < aint; len++) {
- if (len & 7)
+ if (len & 7) /*SUPPRESS 595*/
bits >>= 1;
else
bits = *s++;
(void)astore(stack, ++sp, str_2mortal(str));
}
break;
+#ifdef QUAD
+ case 'q':
+ while (len-- > 0) {
+ if (s + sizeof(quad) > strend)
+ aquad = 0;
+ else {
+ bcopy(s,(char*)&aquad,sizeof(quad));
+ s += sizeof(quad);
+ }
+ str = Str_new(42,0);
+ str_numset(str,(double)aquad);
+ (void)astore(stack, ++sp, str_2mortal(str));
+ }
+ break;
+ case 'Q':
+ while (len-- > 0) {
+ if (s + sizeof(unsigned quad) > strend)
+ auquad = 0;
+ else {
+ bcopy(s,(char*)&auquad,sizeof(unsigned quad));
+ s += sizeof(unsigned quad);
+ }
+ str = Str_new(43,0);
+ str_numset(str,(double)auquad);
+ (void)astore(stack, ++sp, str_2mortal(str));
+ }
+ break;
+#endif
/* float and double added gnb@melba.bby.oz.au 22/11/89 */
case 'f':
case 'F':
length = 0;
}
else
- length = ary->ary_max; /* close enough to infinity */
+ length = ary->ary_max + 1; /* close enough to infinity */
}
else {
offset = 0;
- length = ary->ary_max;
+ length = ary->ary_max + 1;
}
if (offset < 0) {
length += offset;
}
arg = arg[1].arg_ptr.arg_arg;
while (i-- > 0) {
- if (st[src])
+ if (st[src]) {
+ st[src]->str_pok &= ~SP_TEMP;
stab_val(defstab) = st[src];
+ }
else
stab_val(defstab) = str_mortal(&str_undef);
(void)eval(arg,G_SCALAR,sp);
static STAB *secondstab = Nullstab;
int
-do_sort(str,stab,gimme,arglast)
+do_sort(str,arg,gimme,arglast)
STR *str;
-STAB *stab;
+ARG *arg;
int gimme;
int *arglast;
{
STR *oldfirst;
STR *oldsecond;
ARRAY *oldstack;
+ HASH *stash;
static ARRAY *sortstack = Null(ARRAY*);
if (gimme != G_ARRAY) {
up = &st[sp];
st += sp; /* temporarily make st point to args */
for (i = 1; i <= max; i++) {
+ /*SUPPRESS 560*/
if (*up = st[i]) {
if (!(*up)->str_pok)
(void)str_2ptr(*up);
max = up - &st[sp];
sp--;
if (max > 1) {
- if (stab) {
+ STAB *stab;
+
+ if (arg[1].arg_type == (A_CMD|A_DONT)) {
+ sortcmd = arg[1].arg_ptr.arg_cmd;
+ stash = curcmd->c_stash;
+ }
+ else {
+ if ((arg[1].arg_type & A_MASK) == A_WORD)
+ stab = arg[1].arg_ptr.arg_stab;
+ else
+ stab = stabent(str_get(st[sp+1]),TRUE);
+
+ if (stab) {
+ if (!stab_sub(stab) || !(sortcmd = stab_sub(stab)->cmd))
+ fatal("Undefined subroutine \"%s\" in sort",
+ stab_name(stab));
+ stash = stab_stash(stab);
+ }
+ else
+ sortcmd = Nullcmd;
+ }
+
+ if (sortcmd) {
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);
oldstack = stack;
stack = sortstack;
tmps_base = tmps_max;
- if (sortstash != stab_stash(stab)) {
+ if (sortstash != stash) {
firststab = stabent("a",TRUE);
secondstab = stabent("b",TRUE);
- sortstash = stab_stash(stab);
+ sortstash = stash;
}
oldfirst = stab_val(firststab);
oldsecond = stab_val(secondstab);
int retval;
if (str1->str_cur < str2->str_cur) {
+ /*SUPPRESS 560*/
if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
return retval;
else
return -1;
}
+ /*SUPPRESS 560*/
else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
return retval;
else if (str1->str_cur == str2->str_cur)
(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]);
+ if (max > i)
+ (void)astore(ary, sp + max - i + 1, Nullstr);
while (i <= max) {
(void)astore(ary, ++sp, str = str_mortal(&str_no));
str_numset(str,(double)i++);
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;
if (csv->hasargs) {
ARRAY *ary = csv->argarray;
+ if (!dbargs)
+ dbargs = stab_xarray(aadd(stabent("DB'args", TRUE)));
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*);
return sp;
}
(void)hiterinit(hash);
+ /*SUPPRESS 560*/
while (entry = hiternext(hash)) {
if (dokeys) {
tmps = hiterkey(entry,&i);
projects / p5sagit/p5-mst-13.2.git / blobdiff