X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=av.c;h=ae5ffab47256eda0b5ed1a41a69eac3df36e99b5;hb=1d603a678689f1e74cf73914a432b2a8d38be470;hp=5a8646071b23eb9cc31c71e94b38976119caf905;hpb=8ac853655d9b744749adcb9687c13d99cdd6e9fb;p=p5sagit%2Fp5-mst-13.2.git diff --git a/av.c b/av.c index 5a86460..ae5ffab 100644 --- a/av.c +++ b/av.c @@ -21,10 +21,14 @@ av_reify(AV *av) I32 key; SV* sv; - if (AvREAL(av)) - return; + if (AvREAL(av)) + return; +#ifdef DEBUGGING + if (SvRMAGICAL(av) && mg_find((SV*)av,'P')) + warn("av_reify called on tied array"); +#endif key = AvMAX(av) + 1; - while (key > AvFILL(av) + 1) + while (key > AvFILLp(av) + 1) AvARRAY(av)[--key] = &sv_undef; while (key) { sv = AvARRAY(av)[--key]; @@ -44,15 +48,30 @@ void av_extend(AV *av, I32 key) { dTHR; /* only necessary if we have to extend stack */ + MAGIC *mg; + if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { + dSP; + ENTER; + SAVETMPS; + PUSHMARK(sp); + EXTEND(sp,2); + PUSHs(mg->mg_obj); + PUSHs(sv_2mortal(newSViv(key+1))); + PUTBACK; + perl_call_method("EXTEND", G_SCALAR|G_DISCARD); + FREETMPS; + LEAVE; + return; + } if (key > AvMAX(av)) { SV** ary; I32 tmp; I32 newmax; if (AvALLOC(av) != AvARRAY(av)) { - ary = AvALLOC(av) + AvFILL(av) + 1; + ary = AvALLOC(av) + AvFILLp(av) + 1; tmp = AvARRAY(av) - AvALLOC(av); - Move(AvARRAY(av), AvALLOC(av), AvFILL(av)+1, SV*); + Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*); AvMAX(av) += tmp; SvPVX(av) = (char*)AvALLOC(av); if (AvREAL(av)) { @@ -127,6 +146,12 @@ av_fetch(register AV *av, I32 key, I32 lval) if (!av) return 0; + if (key < 0) { + key += AvFILL(av) + 1; + if (key < 0) + return 0; + } + if (SvRMAGICAL(av)) { if (mg_find((SV*)av,'P')) { dTHR; @@ -137,12 +162,7 @@ av_fetch(register AV *av, I32 key, I32 lval) } } - if (key < 0) { - key += AvFILL(av) + 1; - if (key < 0) - return 0; - } - else if (key > AvFILL(av)) { + if (key > AvFILLp(av)) { if (!lval) return 0; if (AvREALISH(av)) @@ -172,42 +192,47 @@ SV** av_store(register AV *av, I32 key, SV *val) { SV** ary; + U32 fill; + if (!av) return 0; if (!val) val = &sv_undef; - if (SvRMAGICAL(av)) { - if (mg_find((SV*)av,'P')) { - if (val != &sv_undef) - mg_copy((SV*)av, val, 0, key); - return 0; - } - } - if (key < 0) { key += AvFILL(av) + 1; if (key < 0) return 0; } + if (SvREADONLY(av) && key >= AvFILL(av)) croak(no_modify); + + if (SvRMAGICAL(av)) { + if (mg_find((SV*)av,'P')) { + if (val != &sv_undef) { + mg_copy((SV*)av, val, 0, key); + } + return 0; + } + } + if (!AvREAL(av) && AvREIFY(av)) av_reify(av); if (key > AvMAX(av)) av_extend(av,key); ary = AvARRAY(av); - if (AvFILL(av) < key) { + if (AvFILLp(av) < key) { if (!AvREAL(av)) { dTHR; if (av == curstack && key > stack_sp - stack_base) stack_sp = stack_base + key; /* XPUSH in disguise */ do - ary[++AvFILL(av)] = &sv_undef; - while (AvFILL(av) < key); + ary[++AvFILLp(av)] = &sv_undef; + while (AvFILLp(av) < key); } - AvFILL(av) = key; + AvFILLp(av) = key; } else if (AvREAL(av)) SvREFCNT_dec(ary[key]); @@ -232,7 +257,7 @@ newAV(void) AvREAL_on(av); AvALLOC(av) = 0; SvPVX(av) = 0; - AvMAX(av) = AvFILL(av) = -1; + AvMAX(av) = AvFILLp(av) = -1; return av; } @@ -250,7 +275,7 @@ av_make(register I32 size, register SV **strp) New(4,ary,size,SV*); AvALLOC(av) = ary; SvPVX(av) = (char*)ary; - AvFILL(av) = size - 1; + AvFILLp(av) = size - 1; AvMAX(av) = size - 1; for (i = 0; i < size; i++) { assert (*strp); @@ -275,7 +300,7 @@ av_fake(register I32 size, register SV **strp) Copy(strp,ary,size,SV*); AvFLAGS(av) = AVf_REIFY; SvPVX(av) = (char*)ary; - AvFILL(av) = size - 1; + AvFILLp(av) = size - 1; AvMAX(av) = size - 1; while (size--) { assert (*strp); @@ -296,13 +321,20 @@ av_clear(register AV *av) warn("Attempt to clear deleted array"); } #endif - if (!av || AvMAX(av) < 0) + if (!av) return; /*SUPPRESS 560*/ + /* Give any tie a chance to cleanup first */ + if (SvRMAGICAL(av)) + mg_clear((SV*)av); + + if (AvMAX(av) < 0) + return; + if (AvREAL(av)) { ary = AvARRAY(av); - key = AvFILL(av) + 1; + key = AvFILLp(av) + 1; while (key) { SvREFCNT_dec(ary[--key]); ary[key] = &sv_undef; @@ -312,10 +344,8 @@ av_clear(register AV *av) AvMAX(av) += key; SvPVX(av) = (char*)AvALLOC(av); } - AvFILL(av) = -1; + AvFILLp(av) = -1; - if (SvRMAGICAL(av)) - mg_clear((SV*)av); } void @@ -326,15 +356,21 @@ av_undef(register AV *av) if (!av) return; /*SUPPRESS 560*/ + + /* Give any tie a chance to cleanup first */ + if (SvRMAGICAL(av) && mg_find((SV*)av,'P')) + av_fill(av, -1); /* mg_clear() ? */ + if (AvREAL(av)) { - key = AvFILL(av) + 1; + key = AvFILLp(av) + 1; while (key) SvREFCNT_dec(AvARRAY(av)[--key]); } Safefree(AvALLOC(av)); + SvPVX(av) = 0; AvALLOC(av) = 0; SvPVX(av) = 0; - AvMAX(av) = AvFILL(av) = -1; + AvMAX(av) = AvFILLp(av) = -1; if (AvARYLEN(av)) { SvREFCNT_dec(AvARYLEN(av)); AvARYLEN(av) = 0; @@ -343,23 +379,54 @@ av_undef(register AV *av) void av_push(register AV *av, SV *val) -{ +{ + MAGIC *mg; if (!av) return; - av_store(av,AvFILL(av)+1,val); + if (SvREADONLY(av)) + croak(no_modify); + + if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { + dSP; + PUSHMARK(sp); + EXTEND(sp,2); + PUSHs(mg->mg_obj); + PUSHs(val); + PUTBACK; + ENTER; + perl_call_method("PUSH", G_SCALAR|G_DISCARD); + LEAVE; + return; + } + av_store(av,AvFILLp(av)+1,val); } SV * av_pop(register AV *av) { SV *retval; + MAGIC* mg; if (!av || AvFILL(av) < 0) return &sv_undef; if (SvREADONLY(av)) croak(no_modify); - retval = AvARRAY(av)[AvFILL(av)]; - AvARRAY(av)[AvFILL(av)--] = &sv_undef; + if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { + dSP; + PUSHMARK(sp); + XPUSHs(mg->mg_obj); + PUTBACK; + ENTER; + if (perl_call_method("POP", G_SCALAR)) { + retval = newSVsv(*stack_sp--); + } else { + retval = &sv_undef; + } + LEAVE; + return retval; + } + retval = AvARRAY(av)[AvFILLp(av)]; + AvARRAY(av)[AvFILLp(av)--] = &sv_undef; if (SvSMAGICAL(av)) mg_set((SV*)av); return retval; @@ -369,12 +436,29 @@ void av_unshift(register AV *av, register I32 num) { register I32 i; - register SV **sstr,**dstr; + register SV **ary; + MAGIC* mg; if (!av || num <= 0) return; if (SvREADONLY(av)) croak(no_modify); + + if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { + dSP; + PUSHMARK(sp); + EXTEND(sp,1+num); + PUSHs(mg->mg_obj); + while (num-- > 0) { + PUSHs(&sv_undef); + } + PUTBACK; + ENTER; + perl_call_method("UNSHIFT", G_SCALAR|G_DISCARD); + LEAVE; + return; + } + if (!AvREAL(av) && AvREIFY(av)) av_reify(av); i = AvARRAY(av) - AvALLOC(av); @@ -384,25 +468,18 @@ av_unshift(register AV *av, register I32 num) num -= i; AvMAX(av) += i; - AvFILL(av) += i; + AvFILLp(av) += i; SvPVX(av) = (char*)(AvARRAY(av) - i); } - if (num) { - av_extend(av,AvFILL(av)+num); - AvFILL(av) += num; - dstr = AvARRAY(av) + AvFILL(av); - sstr = dstr - num; -#ifdef BUGGY_MSC5 - # pragma loop_opt(off) /* don't loop-optimize the following code */ -#endif /* BUGGY_MSC5 */ - for (i = AvFILL(av) - num; i >= 0; --i) { - *dstr-- = *sstr--; -#ifdef BUGGY_MSC5 - # pragma loop_opt() /* loop-optimization back to command-line setting */ -#endif /* BUGGY_MSC5 */ - } - while (num) - AvARRAY(av)[--num] = &sv_undef; + if (num) { + i = AvFILLp(av); + av_extend(av, i + num); + AvFILLp(av) += num; + ary = AvARRAY(av); + Move(ary, ary + num, i + 1, SV*); + do { + ary[--num] = &sv_undef; + } while (num); } } @@ -410,17 +487,32 @@ SV * av_shift(register AV *av) { SV *retval; + MAGIC* mg; if (!av || AvFILL(av) < 0) return &sv_undef; if (SvREADONLY(av)) croak(no_modify); + if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { + dSP; + PUSHMARK(sp); + XPUSHs(mg->mg_obj); + PUTBACK; + ENTER; + if (perl_call_method("SHIFT", G_SCALAR)) { + retval = newSVsv(*stack_sp--); + } else { + retval = &sv_undef; + } + LEAVE; + return retval; + } retval = *AvARRAY(av); if (AvREAL(av)) *AvARRAY(av) = &sv_undef; SvPVX(av) = (char*)(AvARRAY(av) + 1); AvMAX(av)--; - AvFILL(av)--; + AvFILLp(av)--; if (SvSMAGICAL(av)) mg_set((SV*)av); return retval; @@ -435,12 +527,27 @@ av_len(register AV *av) void av_fill(register AV *av, I32 fill) { + MAGIC *mg; if (!av) croak("panic: null array"); if (fill < 0) fill = -1; + if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { + dSP; + ENTER; + SAVETMPS; + PUSHMARK(sp); + EXTEND(sp,2); + PUSHs(mg->mg_obj); + PUSHs(sv_2mortal(newSViv(fill+1))); + PUTBACK; + perl_call_method("STORESIZE", G_SCALAR|G_DISCARD); + FREETMPS; + LEAVE; + return; + } if (fill <= AvMAX(av)) { - I32 key = AvFILL(av); + I32 key = AvFILLp(av); SV** ary = AvARRAY(av); if (AvREAL(av)) { @@ -454,7 +561,7 @@ av_fill(register AV *av, I32 fill) ary[++key] = &sv_undef; } - AvFILL(av) = fill; + AvFILLp(av) = fill; if (SvSMAGICAL(av)) mg_set((SV*)av); } @@ -462,16 +569,37 @@ av_fill(register AV *av, I32 fill) (void)av_store(av,fill,&sv_undef); } + +HV* +avhv_keys(AV *av) +{ + SV **keysp; + HV *keys = Nullhv; + + keysp = av_fetch(av, 0, FALSE); + if (keysp) { + SV *sv = *keysp; + if (SvGMAGICAL(sv)) + mg_get(sv); + if (SvROK(sv)) { + sv = SvRV(sv); + if (SvTYPE(sv) == SVt_PVHV) + keys = (HV*)sv; + } + } + if (!keys) + croak("Can't coerce array into hash"); + return keys; +} + SV** avhv_fetch(AV *av, char *key, U32 klen, I32 lval) { - SV **keys, **indsvp; + SV **indsvp; + HV *keys = avhv_keys(av); I32 ind; - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - indsvp = hv_fetch((HV*)SvRV(*keys), key, klen, FALSE); + indsvp = hv_fetch(keys, key, klen, FALSE); if (indsvp) { ind = SvIV(*indsvp); if (ind < 1) @@ -481,7 +609,7 @@ avhv_fetch(AV *av, char *key, U32 klen, I32 lval) return 0; ind = AvFILL(av) + 1; - hv_store((HV*)SvRV(*keys), key, klen, newSViv(ind), 0); + hv_store(keys, key, klen, newSViv(ind), 0); } return av_fetch(av, ind, lval); } @@ -489,14 +617,12 @@ avhv_fetch(AV *av, char *key, U32 klen, I32 lval) SV** avhv_fetch_ent(AV *av, SV *keysv, I32 lval, U32 hash) { - SV **keys, **indsvp; + SV **indsvp; + HV *keys = avhv_keys(av); HE *he; I32 ind; - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - he = hv_fetch_ent((HV*)SvRV(*keys), keysv, FALSE, hash); + he = hv_fetch_ent(keys, keysv, FALSE, hash); if (he) { ind = SvIV(HeVAL(he)); if (ind < 1) @@ -506,7 +632,7 @@ avhv_fetch_ent(AV *av, SV *keysv, I32 lval, U32 hash) return 0; ind = AvFILL(av) + 1; - hv_store_ent((HV*)SvRV(*keys), keysv, newSViv(ind), 0); + hv_store_ent(keys, keysv, newSViv(ind), 0); } return av_fetch(av, ind, lval); } @@ -514,20 +640,18 @@ avhv_fetch_ent(AV *av, SV *keysv, I32 lval, U32 hash) SV** avhv_store(AV *av, char *key, U32 klen, SV *val, U32 hash) { - SV **keys, **indsvp; + SV **indsvp; + HV *keys = avhv_keys(av); I32 ind; - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - indsvp = hv_fetch((HV*)SvRV(*keys), key, klen, FALSE); + indsvp = hv_fetch(keys, key, klen, FALSE); if (indsvp) { ind = SvIV(*indsvp); if (ind < 1) croak("Bad index while coercing array into hash"); } else { ind = AvFILL(av) + 1; - hv_store((HV*)SvRV(*keys), key, klen, newSViv(ind), hash); + hv_store(keys, key, klen, newSViv(ind), hash); } return av_store(av, ind, val); } @@ -535,21 +659,18 @@ avhv_store(AV *av, char *key, U32 klen, SV *val, U32 hash) SV** avhv_store_ent(AV *av, SV *keysv, SV *val, U32 hash) { - SV **keys; + HV *keys = avhv_keys(av); HE *he; I32 ind; - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - he = hv_fetch_ent((HV*)SvRV(*keys), keysv, FALSE, hash); + he = hv_fetch_ent(keys, keysv, FALSE, hash); if (he) { ind = SvIV(HeVAL(he)); if (ind < 1) croak("Bad index while coercing array into hash"); } else { ind = AvFILL(av) + 1; - hv_store_ent((HV*)SvRV(*keys), keysv, newSViv(ind), hash); + hv_store_ent(keys, keysv, newSViv(ind), hash); } return av_store(av, ind, val); } @@ -557,38 +678,27 @@ avhv_store_ent(AV *av, SV *keysv, SV *val, U32 hash) bool avhv_exists_ent(AV *av, SV *keysv, U32 hash) { - SV **keys; - - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - return hv_exists_ent((HV*)SvRV(*keys), keysv, hash); + HV *keys = avhv_keys(av); + return hv_exists_ent(keys, keysv, hash); } bool avhv_exists(AV *av, char *key, U32 klen) { - SV **keys; - - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - return hv_exists((HV*)SvRV(*keys), key, klen); + HV *keys = avhv_keys(av); + return hv_exists(keys, key, klen); } /* avhv_delete leaks. Caller can re-index and compress if so desired. */ SV * avhv_delete(AV *av, char *key, U32 klen, I32 flags) { - SV **keys; + HV *keys = avhv_keys(av); SV *sv; SV **svp; I32 ind; - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - sv = hv_delete((HV*)SvRV(*keys), key, klen, 0); + sv = hv_delete(keys, key, klen, 0); if (!sv) return Nullsv; ind = SvIV(sv); @@ -611,15 +721,12 @@ avhv_delete(AV *av, char *key, U32 klen, I32 flags) SV * avhv_delete_ent(AV *av, SV *keysv, I32 flags, U32 hash) { - SV **keys; + HV *keys = avhv_keys(av); SV *sv; SV **svp; I32 ind; - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - sv = hv_delete_ent((HV*)SvRV(*keys), keysv, 0, hash); + sv = hv_delete_ent(keys, keysv, 0, hash); if (!sv) return Nullsv; ind = SvIV(sv); @@ -641,36 +748,25 @@ avhv_delete_ent(AV *av, SV *keysv, I32 flags, U32 hash) I32 avhv_iterinit(AV *av) { - SV **keys; - - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - return hv_iterinit((HV*)SvRV(*keys)); + HV *keys = avhv_keys(av); + return hv_iterinit(keys); } HE * avhv_iternext(AV *av) { - SV **keys; - - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - return hv_iternext((HV*)SvRV(*keys)); + HV *keys = avhv_keys(av); + return hv_iternext(keys); } SV * avhv_iterval(AV *av, register HE *entry) { - SV **keys; + HV *keys = avhv_keys(av); SV *sv; I32 ind; - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - sv = hv_iterval((HV*)SvRV(*keys), entry); + sv = hv_iterval(keys, entry); ind = SvIV(sv); if (ind < 1) croak("Bad index while coercing array into hash"); @@ -680,18 +776,16 @@ avhv_iterval(AV *av, register HE *entry) SV * avhv_iternextsv(AV *av, char **key, I32 *retlen) { - SV **keys; + HV *keys = avhv_keys(av); HE *he; SV *sv; I32 ind; - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - if ( (he = hv_iternext((HV*)SvRV(*keys))) == NULL) - return NULL; + he = hv_iternext(keys); + if (!he) + return Nullsv; *key = hv_iterkey(he, retlen); - sv = hv_iterval((HV*)SvRV(*keys), he); + sv = hv_iterval(keys, he); ind = SvIV(sv); if (ind < 1) croak("Bad index while coercing array into hash");