-/* $Header: dolist.c,v 3.0.1.2 89/11/11 04:28:17 lwall Locked $
+/* $Header: dolist.c,v 3.0.1.6 90/03/12 16:33:02 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: dolist.c,v $
+ * Revision 3.0.1.6 90/03/12 16:33:02 lwall
+ * patch13: added list slice operator (LIST)[LIST]
+ * patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST)
+ * patch13: made split('') act like split(//) rather than split(' ')
+ *
+ * Revision 3.0.1.5 90/02/28 17:09:44 lwall
+ * patch9: split now can split into more than 10000 elements
+ * patch9: @_ clobbered by ($foo,$bar) = split
+ * patch9: sped up pack and unpack
+ * patch9: unpack of single item now works in a scalar context
+ * patch9: slices ignored value of $[
+ * patch9: grep now returns number of items matched in scalar context
+ * patch9: grep iterations no longer in the regexp context of previous iteration
+ *
+ * Revision 3.0.1.4 89/12/21 19:58:46 lwall
+ * patch7: grep(1,@array) didn't work
+ * patch7: /$pat/; //; wrongly freed runtime pattern twice
+ *
+ * Revision 3.0.1.3 89/11/17 15:14:45 lwall
+ * patch5: grep() occasionally loses arguments or dumps core
+ *
* Revision 3.0.1.2 89/11/11 04:28:17 lwall
* patch2: non-existent slice values are now undefined rather than null
*
if (!*spat->spat_regexp->precomp && lastspat)
spat = lastspat;
if (spat->spat_flags & SPAT_KEEP) {
- arg_free(spat->spat_runtime); /* it won't change, so */
+ 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)
register STR *dstr;
register char *m;
int iters = 0;
+ int maxiters = (strend - s) + 10;
int i;
char *orig;
int origlimit = limit;
st = stack->ary_array;
m = str_get(dstr = st[sp--]);
nointrp = "";
- if (!dstr->str_cur || (*m == ' ' && dstr->str_cur == 1)) {
+ if (*m == ' ' && dstr->str_cur == 1) {
str_set(dstr,"\\s+");
m = dstr->str_ptr;
spat->spat_flags |= SPAT_SKIPWHITE;
}
#endif
ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab);
- if (ary && ((ary->ary_flags & ARF_REAL) || gimme != G_ARRAY)) {
+ if (ary && (gimme != G_ARRAY || (spat->spat_flags & SPAT_ONCE))) {
realarray = 1;
if (!(ary->ary_flags & ARF_REAL)) {
ary->ary_flags |= ARF_REAL;
s++;
}
if (!limit)
- limit = 10001;
+ limit = maxiters + 2;
if (spat->spat_short) {
i = spat->spat_short->str_cur;
if (i == 1) {
}
}
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
iters = sp + 1;
else
iters = sp - arglast[0];
- if (iters > 9999)
+ if (iters > maxiters)
fatal("Split loop");
if (s < strend || origlimit) { /* keep field after final delim? */
if (realarray)
unsigned long aulong;
char *aptr;
- if (gimme != G_ARRAY) {
- str_sset(str,&str_undef);
- STABSET(str);
- st[sp] = str;
- return sp;
+ if (gimme != G_ARRAY) { /* arrange to do first one only */
+ patend = pat+1;
+ if (*pat == 'a' || *pat == 'A') {
+ while (isdigit(*patend))
+ patend++;
+ }
}
sp--;
while (pat < patend) {
datumtype = *pat++;
if (isdigit(*pat)) {
- len = atoi(pat);
+ len = *pat++ - '0';
while (isdigit(*pat))
- pat++;
+ len = (len * 10) + (*pat++ - '0');
}
else
len = 1;
}
int
-do_slice(stab,numarray,lval,gimme,arglast)
-register STAB *stab;
+do_slice(stab,str,numarray,lval,gimme,arglast)
+STAB *stab;
+STR *str;
int numarray;
int lval;
int gimme;
register char *tmps;
register int len;
register int magic = 0;
+ register ARRAY *ary;
+ register HASH *hash;
+ int oldarybase = arybase;
- if (lval && !numarray) {
- if (stab == envstab)
- magic = 'E';
- else if (stab == sigstab)
- magic = 'S';
+ 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';
+ 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(stab_array(stab),(int)str_gnum(st[sp]),
- lval);
+ st[sp-1] = afetch(ary,
+ ((int)str_gnum(st[sp])) - arybase, lval);
}
else
st[sp-1] = &str_undef;
if (st[++sp]) {
tmps = str_get(st[sp]);
len = st[sp]->str_cur;
- st[sp-1] = hfetch(stab_hash(stab),tmps,len, lval);
+ st[sp-1] = hfetch(hash,tmps,len, lval);
if (magic)
str_magic(st[sp-1],stab,magic,tmps,len);
}
else {
if (numarray) {
if (st[max])
- st[sp] = afetch(stab_array(stab),(int)str_gnum(st[max]), lval);
+ st[sp] = afetch(ary,
+ ((int)str_gnum(st[max])) - arybase, lval);
else
st[sp] = &str_undef;
}
if (st[max]) {
tmps = str_get(st[max]);
len = st[max]->str_cur;
- st[sp] = hfetch(stab_hash(stab),tmps,len, lval);
+ st[sp] = hfetch(hash,tmps,len, lval);
if (magic)
str_magic(st[sp],stab,magic,tmps,len);
}
st[sp] = &str_undef;
}
}
+ arybase = oldarybase;
+ return sp;
+}
+
+int
+do_splice(ary,str,gimme,arglast)
+register ARRAY *ary;
+STR *str;
+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;
+ }
+
+ /* 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_2static(*dst++); /* free them eventualy */
+ }
+ sp += length - 1;
+ }
+ else {
+ st[sp] = ary->ary_array[offset+length-1];
+ if (ary->ary_flags & ARF_REAL)
+ str_2static(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--;
+ }
+ 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_2static(*dst++); /* free them eventualy */
+ }
+ Safefree(tmparyval);
+ }
+ sp += length - 1;
+ }
+ else if (length) {
+ st[sp] = tmparyval[length-1];
+ if (ary->ary_flags & ARF_REAL)
+ str_2static(st[sp]);
+ Safefree(tmparyval);
+ }
+ else
+ st[sp] = &str_undef;
+ }
return sp;
}
int *arglast;
{
STR **st = stack->ary_array;
- register STR **dst = &st[arglast[1]];
- register STR **src = dst + 1;
+ 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;
savesptr(&stab_val(defstab));
- if ((arg[1].arg_type & A_MASK) != A_EXPR)
+ 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) {
- stab_val(defstab) = *src;
+ stab_val(defstab) = st[src];
(void)eval(arg,G_SCALAR,sp);
+ st = stack->ary_array;
if (str_true(st[sp+1]))
- *dst++ = *src;
+ st[dst++] = st[src];
src++;
+ curspat = oldspat;
}
restorelist(oldsave);
if (gimme != G_ARRAY) {
- str_sset(str,&str_undef);
+ str_numset(str,(double)(dst - arglast[1]));
STABSET(str);
st[arglast[0]+1] = str;
return arglast[0]+1;
}
- return arglast[0] + (dst - &st[arglast[1]]);
+ return arglast[0] + (dst - arglast[1]);
}
int
projects / p5sagit/p5-mst-13.2.git / blobdiff