X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=av.c;h=af463cb3aa47f55666fbad220948cfbd7a9c6e1d;hb=a9f58cadb705f6c8610a5b7e21bcd43f3dec6756;hp=af3e94e8bcad10402b1f486c4e01581b3085074f;hpb=5bc6513ddd9360f3cbfa6bf29425e38b658230f5;p=p5sagit%2Fp5-mst-13.2.git diff --git a/av.c b/av.c index af3e94e..af463cb 100644 --- a/av.c +++ b/av.c @@ -15,49 +15,70 @@ #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) - AvARRAY(av)[--key] = &sv_undef; + while (key > AvFILLp(av) + 1) + AvARRAY(av)[--key] = &PL_sv_undef; while (key) { sv = AvARRAY(av)[--key]; assert(sv); - if (sv != &sv_undef) + if (sv != &PL_sv_undef) { + dTHR; (void)SvREFCNT_inc(sv); + } } key = AvARRAY(av) - AvALLOC(av); while (key) - AvALLOC(av)[--key] = &sv_undef; + AvALLOC(av)[--key] = &PL_sv_undef; AvREAL_on(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; + PUSHSTACKi(PERLSI_MAGIC); + PUSHMARK(SP); + EXTEND(SP,2); + PUSHs(mg->mg_obj); + PUSHs(sv_2mortal(newSViv(key+1))); + PUTBACK; + perl_call_method("EXTEND", G_SCALAR|G_DISCARD); + POPSTACK; + 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)) { while (tmp) - ary[--tmp] = &sv_undef; + ary[--tmp] = &PL_sv_undef; } if (key > AvMAX(av) - 10) { @@ -71,9 +92,15 @@ I32 key; U32 bytes; #endif +#if defined(MYMALLOC) && !defined(PURIFY) && !defined(LEAKTEST) + newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1; + + if (key <= newmax) + goto resized; +#endif newmax = key + AvMAX(av) / 5; resize: -#ifdef STRANGE_MALLOC +#if defined(STRANGE_MALLOC) || defined(MYMALLOC) Renew(AvALLOC(av),newmax+1, SV*); #else bytes = (newmax + 1) * sizeof(SV*); @@ -87,32 +114,31 @@ I32 key; newmax = tmp - 1; New(2,ary, newmax+1, SV*); Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*); - if (AvMAX(av) > 64 && !nice_chunk) { - nice_chunk = (char*)AvALLOC(av); - nice_chunk_size = (AvMAX(av) + 1) * sizeof(SV*); - } + if (AvMAX(av) > 64) + offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*)); else Safefree(AvALLOC(av)); AvALLOC(av) = ary; #endif + resized: ary = AvALLOC(av) + AvMAX(av) + 1; tmp = newmax - AvMAX(av); - if (av == curstack) { /* Oops, grew stack (via av_store()?) */ - stack_sp = AvALLOC(av) + (stack_sp - stack_base); - stack_base = AvALLOC(av); - stack_max = stack_base + newmax; + if (av == PL_curstack) { /* Oops, grew stack (via av_store()?) */ + PL_stack_sp = AvALLOC(av) + (PL_stack_sp - PL_stack_base); + PL_stack_base = AvALLOC(av); + PL_stack_max = PL_stack_base + newmax; } } else { - newmax = key < 4 ? 4 : key; + newmax = key < 3 ? 3 : key; New(2,AvALLOC(av), newmax+1, SV*); ary = AvALLOC(av) + 1; tmp = newmax; - AvALLOC(av)[0] = &sv_undef; /* For the stacks */ + AvALLOC(av)[0] = &PL_sv_undef; /* For the stacks */ } if (AvREAL(av)) { while (tmp) - ary[--tmp] = &sv_undef; + ary[--tmp] = &PL_sv_undef; } SvPVX(av) = (char*)AvALLOC(av); @@ -122,31 +148,30 @@ 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')) { + if (mg_find((SV*)av,'P') || mg_find((SV*)av,'D')) { + dTHR; sv = sv_newmortal(); mg_copy((SV*)av, sv, 0, key); - Sv = sv; - return &Sv; + PL_av_fetch_sv = sv; + return &PL_av_fetch_sv; } } - 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)) @@ -155,7 +180,7 @@ I32 lval; sv = sv_newmortal(); return av_store(av,key,sv); } - if (AvARRAY(av)[key] == &sv_undef) { + if (AvARRAY(av)[key] == &PL_sv_undef) { emptyness: if (lval) { sv = NEWSV(6,0); @@ -166,60 +191,63 @@ I32 lval; else if (AvREIFY(av) && (!AvARRAY(av)[key] /* eg. @_ could have freed elts */ || SvTYPE(AvARRAY(av)[key]) == SVTYPEMASK)) { - AvARRAY(av)[key] = &sv_undef; /* 1/2 reify */ + AvARRAY(av)[key] = &PL_sv_undef; /* 1/2 reify */ goto emptyness; } return &AvARRAY(av)[key]; } 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; - } - } + val = &PL_sv_undef; 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 != &PL_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)) { - if (av == curstack && key > stack_sp - stack_base) - stack_sp = stack_base + key; /* XPUSH in disguise */ + dTHR; + if (av == PL_curstack && key > PL_stack_sp - PL_stack_base) + PL_stack_sp = PL_stack_base + key; /* XPUSH in disguise */ do - ary[++AvFILL(av)] = &sv_undef; - while (AvFILL(av) < key); + ary[++AvFILLp(av)] = &PL_sv_undef; + while (AvFILLp(av) < key); } - AvFILL(av) = key; + AvFILLp(av) = key; } else if (AvREAL(av)) SvREFCNT_dec(ary[key]); ary[key] = val; if (SvSMAGICAL(av)) { - if (val != &sv_undef) { + if (val != &PL_sv_undef) { MAGIC* mg = SvMAGIC(av); sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key); } @@ -229,7 +257,7 @@ SV *val; } AV * -newAV() +newAV(void) { register AV *av; @@ -238,14 +266,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; @@ -253,25 +279,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; @@ -283,7 +309,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); @@ -294,8 +320,7 @@ register SV **strp; } void -av_clear(av) -register AV *av; +av_clear(register AV *av) { register I32 key; SV** ary; @@ -305,43 +330,58 @@ register AV *av; warn("Attempt to clear deleted array"); } #endif - if (!av || AvMAX(av) < 0) + if (!av) return; /*SUPPRESS 560*/ + if (SvREADONLY(av)) + croak(no_modify); + + /* 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; + ary[key] = &PL_sv_undef; } } if (key = AvARRAY(av) - AvALLOC(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)); 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; @@ -349,44 +389,93 @@ 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; + PUSHSTACKi(PERLSI_MAGIC); + PUSHMARK(SP); + EXTEND(SP,2); + PUSHs(mg->mg_obj); + PUSHs(val); + PUTBACK; + ENTER; + perl_call_method("PUSH", G_SCALAR|G_DISCARD); + LEAVE; + POPSTACK; + 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; + return &PL_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; + PUSHSTACKi(PERLSI_MAGIC); + PUSHMARK(SP); + XPUSHs(mg->mg_obj); + PUTBACK; + ENTER; + if (perl_call_method("POP", G_SCALAR)) { + retval = newSVsv(*PL_stack_sp--); + } else { + retval = &PL_sv_undef; + } + LEAVE; + POPSTACK; + return retval; + } + retval = AvARRAY(av)[AvFILLp(av)]; + AvARRAY(av)[AvFILLp(av)--] = &PL_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; + PUSHSTACKi(PERLSI_MAGIC); + PUSHMARK(SP); + EXTEND(SP,1+num); + PUSHs(mg->mg_obj); + while (num-- > 0) { + PUSHs(&PL_sv_undef); + } + PUTBACK; + ENTER; + perl_call_method("UNSHIFT", G_SCALAR|G_DISCARD); + LEAVE; + POPSTACK; + return; + } + if (!AvREAL(av) && AvREIFY(av)) av_reify(av); i = AvARRAY(av) - AvALLOC(av); @@ -396,358 +485,174 @@ 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; + i = AvFILLp(av); + av_extend(av, i + num); + AvFILLp(av) += num; + ary = AvARRAY(av); + Move(ary, ary + num, i + 1, SV*); + do { + ary[--num] = &PL_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; + return &PL_sv_undef; if (SvREADONLY(av)) croak(no_modify); + if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { + dSP; + PUSHSTACKi(PERLSI_MAGIC); + PUSHMARK(SP); + XPUSHs(mg->mg_obj); + PUTBACK; + ENTER; + if (perl_call_method("SHIFT", G_SCALAR)) { + retval = newSVsv(*PL_stack_sp--); + } else { + retval = &PL_sv_undef; + } + LEAVE; + POPSTACK; + return retval; + } retval = *AvARRAY(av); if (AvREAL(av)) - *AvARRAY(av) = &sv_undef; + *AvARRAY(av) = &PL_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; + PUSHSTACKi(PERLSI_MAGIC); + PUSHMARK(SP); + EXTEND(SP,2); + PUSHs(mg->mg_obj); + PUSHs(sv_2mortal(newSViv(fill+1))); + PUTBACK; + perl_call_method("STORESIZE", G_SCALAR|G_DISCARD); + POPSTACK; + FREETMPS; + LEAVE; + return; + } if (fill <= AvMAX(av)) { - I32 key = AvFILL(av); + I32 key = AvFILLp(av); SV** ary = AvARRAY(av); if (AvREAL(av)) { while (key > fill) { SvREFCNT_dec(ary[key]); - ary[key--] = &sv_undef; + ary[key--] = &PL_sv_undef; } } else { while (key < fill) - ary[++key] = &sv_undef; + ary[++key] = &PL_sv_undef; } - AvFILL(av) = fill; + AvFILLp(av) = fill; if (SvSMAGICAL(av)) mg_set((SV*)av); } else - (void)av_store(av,fill,&sv_undef); + (void)av_store(av,fill,&PL_sv_undef); } -SV** -avhv_fetch(av, key, klen, lval) -AV *av; -char *key; -U32 klen; -I32 lval; -{ - SV **keys, **indsvp; - 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); - if (indsvp) { - ind = SvIV(*indsvp); - if (ind < 1) - croak("Bad index while coercing array into hash"); - } else { - if (!lval) - return 0; - - ind = AvFILL(av) + 1; - hv_store((HV*)SvRV(*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: Support for treating arrays as if they were hashes. The + * first element of the array should be a hash reference that maps + * hash keys to array indices. + */ + +STATIC I32 +avhv_index_sv(SV* sv) { - SV **keys, **indsvp; - 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); - if (he) { - ind = SvIV(HeVAL(he)); - if (ind < 1) - croak("Bad index while coercing array into hash"); - } else { - if (!lval) - return 0; - - ind = AvFILL(av) + 1; - hv_store_ent((HV*)SvRV(*keys), keysv, newSViv(ind), 0); - } - return av_fetch(av, ind, lval); + I32 index = SvIV(sv); + if (index < 1) + croak("Bad index while coercing array into hash"); + return index; } -SV** -avhv_store(av, key, klen, val, hash) -AV *av; -char *key; -U32 klen; -SV *val; -U32 hash; +HV* +avhv_keys(AV *av) { - SV **keys, **indsvp; - 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); - 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); + SV **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) + return (HV*)sv; + } } - return av_store(av, ind, val); + croak("Can't coerce array into hash"); + return Nullhv; } SV** -avhv_store_ent(av, keysv, val, hash) -AV *av; -SV *keysv; -SV *val; -U32 hash; +avhv_fetch_ent(AV *av, SV *keysv, I32 lval, U32 hash) { - SV **keys; + 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); - 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); - } - return av_store(av, ind, val); -} - -bool -avhv_exists_ent(av, keysv, hash) -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); + he = hv_fetch_ent(keys, keysv, FALSE, hash); + if (!he) + croak("No such array field"); + return av_fetch(av, avhv_index_sv(HeVAL(he)), lval); } bool -avhv_exists(av, key, klen) -AV *av; -char *key; -U32 klen; +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((HV*)SvRV(*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; -{ - SV **keys; - 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); - if (!sv) - return Nullsv; - ind = SvIV(sv); - if (ind < 1) - croak("Bad index while coercing array into hash"); - svp = av_fetch(av, ind, FALSE); - if (!svp) - return Nullsv; - if (flags & G_DISCARD) { - sv = Nullsv; - SvREFCNT_dec(*svp); - } else { - sv = sv_2mortal(*svp); - } - *svp = &sv_undef; - return sv; -} - -/* 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; -{ - SV **keys; - 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); - if (!sv) - return Nullsv; - ind = SvIV(sv); - if (ind < 1) - croak("Bad index while coercing array into hash"); - svp = av_fetch(av, ind, FALSE); - if (!svp) - return Nullsv; - if (flags & G_DISCARD) { - sv = Nullsv; - SvREFCNT_dec(*svp); - } else { - sv = sv_2mortal(*svp); - } - *svp = &sv_undef; - return sv; -} - -I32 -avhv_iterinit(av) -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_exists_ent(keys, keysv, hash); } 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; - 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); - ind = SvIV(sv); - if (ind < 1) - croak("Bad index while coercing array into hash"); - return *av_fetch(av, ind, TRUE); -} - -SV * -avhv_iternextsv(av, key, retlen) -AV *av; -char **key; -I32 *retlen; -{ - SV **keys; - 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; - *key = hv_iterkey(he, retlen); - sv = hv_iterval((HV*)SvRV(*keys), he); - ind = SvIV(sv); - if (ind < 1) - croak("Bad index while coercing array into hash"); - return *av_fetch(av, ind, TRUE); + SV *sv = hv_iterval(avhv_keys(av), entry); + return *av_fetch(av, avhv_index_sv(sv), TRUE); }