/* av.c * * Copyright (c) 1991-1997, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * */ /* * "...for the Entwives desired order, and plenty, and peace (by which they * meant that things should remain where they had set them)." --Treebeard */ #include "EXTERN.h" #include "perl.h" 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 > AvFILLp(av) + 1) AvARRAY(av)[--key] = &sv_undef; while (key) { sv = AvARRAY(av)[--key]; assert(sv); if (sv != &sv_undef) { dTHR; (void)SvREFCNT_inc(sv); } } key = AvARRAY(av) - AvALLOC(av); while (key) AvALLOC(av)[--key] = &sv_undef; AvREAL_on(av); } 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; PUSHSTACKi(SI_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) + AvFILLp(av) + 1; tmp = AvARRAY(av) - AvALLOC(av); 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; } if (key > AvMAX(av) - 10) { newmax = key + AvMAX(av); goto resize; } } else { if (AvALLOC(av)) { #ifndef STRANGE_MALLOC U32 bytes; #endif #ifdef MYMALLOC newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1; if (key <= newmax) goto resized; #endif newmax = key + AvMAX(av) / 5; resize: #if defined(STRANGE_MALLOC) || defined(MYMALLOC) Renew(AvALLOC(av),newmax+1, SV*); #else bytes = (newmax + 1) * sizeof(SV*); #define MALLOC_OVERHEAD 16 tmp = MALLOC_OVERHEAD; while (tmp - MALLOC_OVERHEAD < bytes) tmp += tmp; tmp -= MALLOC_OVERHEAD; tmp /= sizeof(SV*); assert(tmp > newmax); newmax = tmp - 1; New(2,ary, newmax+1, SV*); Copy(AvALLOC(av), ary, AvMAX(av)+1, 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; } } else { 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 */ } if (AvREAL(av)) { while (tmp) ary[--tmp] = &sv_undef; } SvPVX(av) = (char*)AvALLOC(av); AvMAX(av) = newmax; } } } SV** 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; sv = sv_newmortal(); mg_copy((SV*)av, sv, 0, key); av_fetch_sv = sv; return &av_fetch_sv; } } if (key > AvFILLp(av)) { if (!lval) return 0; if (AvREALISH(av)) sv = NEWSV(5,0); else sv = sv_newmortal(); return av_store(av,key,sv); } if (AvARRAY(av)[key] == &sv_undef) { emptyness: if (lval) { sv = NEWSV(6,0); return av_store(av,key,sv); } return 0; } 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 */ goto emptyness; } return &AvARRAY(av)[key]; } SV** av_store(register AV *av, I32 key, SV *val) { SV** ary; U32 fill; if (!av) return 0; if (!val) val = &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 != &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 (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[++AvFILLp(av)] = &sv_undef; while (AvFILLp(av) < key); } AvFILLp(av) = key; } else if (AvREAL(av)) SvREFCNT_dec(ary[key]); ary[key] = val; if (SvSMAGICAL(av)) { if (val != &sv_undef) { MAGIC* mg = SvMAGIC(av); sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key); } mg_set((SV*)av); } return &ary[key]; } AV * newAV(void) { register AV *av; av = (AV*)NEWSV(3,0); sv_upgrade((SV *)av, SVt_PVAV); AvREAL_on(av); AvALLOC(av) = 0; SvPVX(av) = 0; AvMAX(av) = AvFILLp(av) = -1; return av; } AV * av_make(register I32 size, register SV **strp) { register AV *av; register I32 i; register SV** ary; av = (AV*)NEWSV(8,0); sv_upgrade((SV *) av,SVt_PVAV); AvFLAGS(av) = AVf_REAL; 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(register I32 size, register SV **strp) { register AV *av; register SV** ary; av = (AV*)NEWSV(9,0); sv_upgrade((SV *)av, SVt_PVAV); New(4,ary,size+1,SV*); AvALLOC(av) = ary; Copy(strp,ary,size,SV*); AvFLAGS(av) = AVf_REIFY; SvPVX(av) = (char*)ary; AvFILLp(av) = size - 1; AvMAX(av) = size - 1; while (size--) { assert (*strp); SvTEMP_off(*strp); strp++; } return av; } void av_clear(register AV *av) { register I32 key; SV** ary; #ifdef DEBUGGING if (SvREFCNT(av) <= 0) { warn("Attempt to clear deleted array"); } #endif 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 = AvFILLp(av) + 1; while (key) { SvREFCNT_dec(ary[--key]); ary[key] = &sv_undef; } } if (key = AvARRAY(av) - AvALLOC(av)) { AvMAX(av) += key; SvPVX(av) = (char*)AvALLOC(av); } AvFILLp(av) = -1; } void 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 = AvFILLp(av) + 1; while (key) SvREFCNT_dec(AvARRAY(av)[--key]); } Safefree(AvALLOC(av)); AvALLOC(av) = 0; SvPVX(av) = 0; AvMAX(av) = AvFILLp(av) = -1; if (AvARYLEN(av)) { SvREFCNT_dec(AvARYLEN(av)); AvARYLEN(av) = 0; } } void av_push(register AV *av, SV *val) { MAGIC *mg; if (!av) return; if (SvREADONLY(av)) croak(no_modify); if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) { dSP; PUSHSTACKi(SI_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(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; PUSHSTACKi(SI_MAGIC); PUSHMARK(SP); XPUSHs(mg->mg_obj); PUTBACK; ENTER; if (perl_call_method("POP", G_SCALAR)) { retval = newSVsv(*stack_sp--); } else { retval = &sv_undef; } LEAVE; POPSTACK; 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(register AV *av, register I32 num) { register I32 i; 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(SI_MAGIC); 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; POPSTACK; return; } if (!AvREAL(av) && AvREIFY(av)) av_reify(av); i = AvARRAY(av) - AvALLOC(av); if (i) { if (i > num) i = num; num -= i; AvMAX(av) += i; AvFILLp(av) += i; SvPVX(av) = (char*)(AvARRAY(av) - i); } 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(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; PUSHSTACKi(SI_MAGIC); PUSHMARK(SP); XPUSHs(mg->mg_obj); PUTBACK; ENTER; if (perl_call_method("SHIFT", G_SCALAR)) { retval = newSVsv(*stack_sp--); } else { retval = &sv_undef; } LEAVE; POPSTACK; return retval; } retval = *AvARRAY(av); if (AvREAL(av)) *AvARRAY(av) = &sv_undef; SvPVX(av) = (char*)(AvARRAY(av) + 1); AvMAX(av)--; AvFILLp(av)--; if (SvSMAGICAL(av)) mg_set((SV*)av); return retval; } I32 av_len(register AV *av) { return AvFILL(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; PUSHSTACKi(SI_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 = AvFILLp(av); SV** ary = AvARRAY(av); if (AvREAL(av)) { while (key > fill) { SvREFCNT_dec(ary[key]); ary[key--] = &sv_undef; } } else { while (key < fill) ary[++key] = &sv_undef; } AvFILLp(av) = fill; if (SvSMAGICAL(av)) mg_set((SV*)av); } else (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 **indsvp; HV *keys = avhv_keys(av); I32 ind; indsvp = hv_fetch(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(keys, key, klen, newSViv(ind), 0); } return av_fetch(av, ind, lval); } SV** avhv_fetch_ent(AV *av, SV *keysv, I32 lval, U32 hash) { SV **indsvp; HV *keys = avhv_keys(av); HE *he; I32 ind; 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 { if (!lval) return 0; ind = AvFILL(av) + 1; hv_store_ent(keys, keysv, newSViv(ind), 0); } return av_fetch(av, ind, lval); } SV** avhv_store(AV *av, char *key, U32 klen, SV *val, U32 hash) { SV **indsvp; HV *keys = avhv_keys(av); I32 ind; 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(keys, key, klen, newSViv(ind), hash); } return av_store(av, ind, val); } SV** avhv_store_ent(AV *av, SV *keysv, SV *val, U32 hash) { HV *keys = avhv_keys(av); HE *he; I32 ind; 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(keys, keysv, newSViv(ind), hash); } return av_store(av, ind, val); } bool avhv_exists_ent(AV *av, SV *keysv, U32 hash) { HV *keys = avhv_keys(av); return hv_exists_ent(keys, keysv, hash); } bool avhv_exists(AV *av, char *key, U32 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) { HV *keys = avhv_keys(av); SV *sv; SV **svp; I32 ind; sv = hv_delete(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 *av, SV *keysv, I32 flags, U32 hash) { HV *keys = avhv_keys(av); SV *sv; SV **svp; I32 ind; sv = hv_delete_ent(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; } HE * avhv_iternext(AV *av) { HV *keys = avhv_keys(av); return hv_iternext(keys); } SV * avhv_iterval(AV *av, register HE *entry) { HV *keys = avhv_keys(av); SV *sv; I32 ind; sv = hv_iterval(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 *av, char **key, I32 *retlen) { HV *keys = avhv_keys(av); HE *he; SV *sv; I32 ind; he = hv_iternext(keys); if (!he) return Nullsv; *key = hv_iterkey(he, retlen); sv = hv_iterval(keys, he); ind = SvIV(sv); if (ind < 1) croak("Bad index while coercing array into hash"); return *av_fetch(av, ind, TRUE); }