X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=av.c;h=ae5ffab47256eda0b5ed1a41a69eac3df36e99b5;hb=15ee1d8715e28c0c0be2cceb2f9f90d79153090e;hp=86232216ec76fe7e323c168ff9062414e058426e;hpb=fba3b22e783d72569126ff6fe76f3cb6cd1f043b;p=p5sagit%2Fp5-mst-13.2.git diff --git a/av.c b/av.c index 8623221..ae5ffab 100644 --- a/av.c +++ b/av.c @@ -15,17 +15,20 @@ #include "EXTERN.h" #include "perl.h" -static void av_reify _((AV* av)); - -static void -av_reify(av) -AV* av; +void +av_reify(AV *av) { I32 key; SV* sv; - + + 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]; @@ -42,20 +45,33 @@ AV* av; } void -av_extend(av,key) -AV *av; -I32 key; +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)) { @@ -123,16 +139,19 @@ I32 key; } SV** -av_fetch(av,key,lval) -register AV *av; -I32 key; -I32 lval; +av_fetch(register AV *av, I32 key, I32 lval) { SV *sv; 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; @@ -143,12 +162,7 @@ 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)) @@ -175,48 +189,50 @@ I32 lval; } SV** -av_store(av,key,val) -register AV *av; -I32 key; -SV *val; +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 +248,7 @@ SV *val; } AV * -newAV() +newAV(void) { register AV *av; @@ -241,14 +257,12 @@ newAV() AvREAL_on(av); AvALLOC(av) = 0; SvPVX(av) = 0; - AvMAX(av) = AvFILL(av) = -1; + AvMAX(av) = AvFILLp(av) = -1; return av; } AV * -av_make(size,strp) -register I32 size; -register SV **strp; +av_make(register I32 size, register SV **strp) { register AV *av; register I32 i; @@ -256,25 +270,25 @@ register SV **strp; av = (AV*)NEWSV(8,0); sv_upgrade((SV *) av,SVt_PVAV); - New(4,ary,size+1,SV*); - AvALLOC(av) = ary; AvFLAGS(av) = AVf_REAL; - SvPVX(av) = (char*)ary; - AvFILL(av) = size - 1; - AvMAX(av) = size - 1; - for (i = 0; i < size; i++) { - assert (*strp); - ary[i] = NEWSV(7,0); - sv_setsv(ary[i], *strp); - strp++; + if (size) { /* `defined' was returning undef for size==0 anyway. */ + New(4,ary,size,SV*); + AvALLOC(av) = ary; + SvPVX(av) = (char*)ary; + AvFILLp(av) = size - 1; + AvMAX(av) = size - 1; + for (i = 0; i < size; i++) { + assert (*strp); + ary[i] = NEWSV(7,0); + sv_setsv(ary[i], *strp); + strp++; + } } return av; } AV * -av_fake(size,strp) -register I32 size; -register SV **strp; +av_fake(register I32 size, register SV **strp) { register AV *av; register SV** ary; @@ -286,7 +300,7 @@ 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); @@ -297,8 +311,7 @@ register SV **strp; } void -av_clear(av) -register AV *av; +av_clear(register AV *av) { register I32 key; SV** ary; @@ -308,13 +321,20 @@ 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; @@ -324,27 +344,33 @@ register AV *av; AvMAX(av) += key; SvPVX(av) = (char*)AvALLOC(av); } - AvFILL(av) = -1; + AvFILLp(av) = -1; + } void -av_undef(av) -register AV *av; +av_undef(register AV *av) { register I32 key; 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; @@ -352,44 +378,87 @@ register AV *av; } void -av_push(av,val) -register AV *av; -SV *val; -{ +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(av) -register AV *av; +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; } void -av_unshift(av,num) -register AV *av; -register I32 num; +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); @@ -399,67 +468,86 @@ 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); } } SV * -av_shift(av) -register AV *av; +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; } I32 -av_len(av) -register AV *av; +av_len(register AV *av) { return AvFILL(av); } void -av_fill(av, fill) -register AV *av; -I32 fill; +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)) { @@ -473,7 +561,7 @@ I32 fill; ary[++key] = &sv_undef; } - AvFILL(av) = fill; + AvFILLp(av) = fill; if (SvSMAGICAL(av)) mg_set((SV*)av); } @@ -481,20 +569,37 @@ 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, key, klen, lval) -AV *av; -char *key; -U32 klen; -I32 lval; +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) @@ -504,26 +609,20 @@ 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); } SV** -avhv_fetch_ent(av, keysv, lval, hash) -AV *av; -SV *keysv; -I32 lval; -U32 hash; +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) @@ -533,108 +632,73 @@ 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); } SV** -avhv_store(av, key, klen, val, hash) -AV *av; -char *key; -U32 klen; -SV *val; -U32 hash; +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); } SV** -avhv_store_ent(av, keysv, val, hash) -AV *av; -SV *keysv; -SV *val; -U32 hash; +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); } bool -avhv_exists_ent(av, keysv, hash) -AV *av; -SV *keysv; -U32 hash; +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, key, klen) -AV *av; -char *key; -U32 klen; +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, key, klen, flags) -AV *av; -char *key; -U32 klen; -I32 flags; +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); @@ -655,21 +719,14 @@ I32 flags; /* avhv_delete_ent leaks. Caller can re-index and compress if so desired. */ SV * -avhv_delete_ent(av, keysv, flags, hash) -AV *av; -SV *keysv; -I32 flags; -U32 hash; +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); @@ -689,42 +746,27 @@ U32 hash; } I32 -avhv_iterinit(av) -AV *av; +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 *av; +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, entry) -AV *av; -register HE *entry; +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"); @@ -732,23 +774,18 @@ register HE *entry; } SV * -avhv_iternextsv(av, key, retlen) -AV *av; -char **key; -I32 *retlen; +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");