X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=av.c;h=819887e2ad59c17e9cc98f3701e558f8aa3117b1;hb=3a188f30750b7b6044dc11da3853f0d540738f37;hp=3b7e81338ad2027ba5d51354bfd54fa759584083;hpb=010205895f86f073b0b2a20bd4cfbb05f0134888;p=p5sagit%2Fp5-mst-13.2.git diff --git a/av.c b/av.c index 3b7e813..819887e 100644 --- a/av.c +++ b/av.c @@ -1,6 +1,6 @@ /* av.c * - * Copyright (c) 1991-1999, Larry Wall + * Copyright (c) 1991-2000, 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. @@ -46,12 +46,21 @@ Perl_av_reify(pTHX_ AV *av) AvREAL_on(av); } +/* +=for apidoc av_extend + +Pre-extend an array. The C is the index to which the array should be +extended. + +=cut +*/ + void Perl_av_extend(pTHX_ AV *av, I32 key) { dTHR; /* only necessary if we have to extend stack */ MAGIC *mg; - if (mg = SvTIED_mg((SV*)av, 'P')) { + if ((mg = SvTIED_mg((SV*)av, 'P'))) { dSP; ENTER; SAVETMPS; @@ -95,7 +104,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key) IV itmp; #endif -#if defined(MYMALLOC) && !defined(PURIFY) && !defined(LEAKTEST) +#if defined(MYMALLOC) && !defined(LEAKTEST) newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1; if (key <= newmax) @@ -151,6 +160,19 @@ Perl_av_extend(pTHX_ AV *av, I32 key) } } +/* +=for apidoc av_fetch + +Returns the SV at the specified index in the array. The C is the +index. If C is set then the fetch will be part of a store. Check +that the return value is non-null before dereferencing it to a C. + +See L for +more information on how to use this function on tied arrays. + +=cut +*/ + SV** Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval) { @@ -198,12 +220,27 @@ Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval) return &AvARRAY(av)[key]; } +/* +=for apidoc av_store + +Stores an SV in an array. The array index is specified as C. The +return value will be NULL if the operation failed or if the value did not +need to be actually stored within the array (as in the case of tied +arrays). Otherwise it can be dereferenced to get the original C. Note +that the caller is responsible for suitably incrementing the reference +count of C before the call, and decrementing it if the function +returned NULL. + +See L for +more information on how to use this function on tied arrays. + +=cut +*/ + SV** Perl_av_store(pTHX_ register AV *av, I32 key, SV *val) { SV** ary; - U32 fill; - if (!av) return 0; @@ -257,6 +294,14 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val) return &ary[key]; } +/* +=for apidoc newAV + +Creates a new AV. The reference count is set to 1. + +=cut +*/ + AV * Perl_newAV(pTHX) { @@ -271,6 +316,16 @@ Perl_newAV(pTHX) return av; } +/* +=for apidoc av_make + +Creates a new AV and populates it with a list of SVs. The SVs are copied +into the array, so they may be freed after the call to av_make. The new AV +will have a reference count of 1. + +=cut +*/ + AV * Perl_av_make(pTHX_ register I32 size, register SV **strp) { @@ -320,6 +375,15 @@ Perl_av_fake(pTHX_ register I32 size, register SV **strp) return av; } +/* +=for apidoc av_clear + +Clears an array, making it empty. Does not free the memory used by the +array itself. + +=cut +*/ + void Perl_av_clear(pTHX_ register AV *av) { @@ -327,7 +391,7 @@ Perl_av_clear(pTHX_ register AV *av) SV** ary; #ifdef DEBUGGING - if (SvREFCNT(av) <= 0 && ckWARN_d(WARN_DEBUGGING)) { + if (SvREFCNT(av) == 0 && ckWARN_d(WARN_DEBUGGING)) { Perl_warner(aTHX_ WARN_DEBUGGING, "Attempt to clear deleted array"); } #endif @@ -353,7 +417,7 @@ Perl_av_clear(pTHX_ register AV *av) ary[key] = &PL_sv_undef; } } - if (key = AvARRAY(av) - AvALLOC(av)) { + if ((key = AvARRAY(av) - AvALLOC(av))) { AvMAX(av) += key; SvPVX(av) = (char*)AvALLOC(av); } @@ -361,6 +425,14 @@ Perl_av_clear(pTHX_ register AV *av) } +/* +=for apidoc av_undef + +Undefines the array. Frees the memory used by the array itself. + +=cut +*/ + void Perl_av_undef(pTHX_ register AV *av) { @@ -389,6 +461,15 @@ Perl_av_undef(pTHX_ register AV *av) } } +/* +=for apidoc av_push + +Pushes an SV onto the end of the array. The array will grow automatically +to accommodate the addition. + +=cut +*/ + void Perl_av_push(pTHX_ register AV *av, SV *val) { @@ -398,7 +479,7 @@ Perl_av_push(pTHX_ register AV *av, SV *val) if (SvREADONLY(av)) Perl_croak(aTHX_ PL_no_modify); - if (mg = SvTIED_mg((SV*)av, 'P')) { + if ((mg = SvTIED_mg((SV*)av, 'P'))) { dSP; PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); @@ -415,6 +496,15 @@ Perl_av_push(pTHX_ register AV *av, SV *val) av_store(av,AvFILLp(av)+1,val); } +/* +=for apidoc av_pop + +Pops an SV off the end of the array. Returns C<&PL_sv_undef> if the array +is empty. + +=cut +*/ + SV * Perl_av_pop(pTHX_ register AV *av) { @@ -425,7 +515,7 @@ Perl_av_pop(pTHX_ register AV *av) return &PL_sv_undef; if (SvREADONLY(av)) Perl_croak(aTHX_ PL_no_modify); - if (mg = SvTIED_mg((SV*)av, 'P')) { + if ((mg = SvTIED_mg((SV*)av, 'P'))) { dSP; PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); @@ -448,6 +538,16 @@ Perl_av_pop(pTHX_ register AV *av) return retval; } +/* +=for apidoc av_unshift + +Unshift the given number of C values onto the beginning of the +array. The array will grow automatically to accommodate the addition. You +must then use C to assign values to these new elements. + +=cut +*/ + void Perl_av_unshift(pTHX_ register AV *av, register I32 num) { @@ -460,7 +560,7 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num) if (SvREADONLY(av)) Perl_croak(aTHX_ PL_no_modify); - if (mg = SvTIED_mg((SV*)av, 'P')) { + if ((mg = SvTIED_mg((SV*)av, 'P'))) { dSP; PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); @@ -501,6 +601,14 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num) } } +/* +=for apidoc av_shift + +Shifts an SV off the beginning of the array. + +=cut +*/ + SV * Perl_av_shift(pTHX_ register AV *av) { @@ -511,7 +619,7 @@ Perl_av_shift(pTHX_ register AV *av) return &PL_sv_undef; if (SvREADONLY(av)) Perl_croak(aTHX_ PL_no_modify); - if (mg = SvTIED_mg((SV*)av, 'P')) { + if ((mg = SvTIED_mg((SV*)av, 'P'))) { dSP; PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); @@ -538,6 +646,15 @@ Perl_av_shift(pTHX_ register AV *av) return retval; } +/* +=for apidoc av_len + +Returns the highest index in the array. Returns -1 if the array is +empty. + +=cut +*/ + I32 Perl_av_len(pTHX_ register AV *av) { @@ -552,7 +669,7 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill) Perl_croak(aTHX_ "panic: null array"); if (fill < 0) fill = -1; - if (mg = SvTIED_mg((SV*)av, 'P')) { + if ((mg = SvTIED_mg((SV*)av, 'P'))) { dSP; ENTER; SAVETMPS; @@ -663,8 +780,11 @@ Perl_av_exists(pTHX_ AV *av, I32 key) return SvTRUE(sv); } } - if (av_fetch(av, key, 0)) + if (key <= AvFILLp(av) && AvARRAY(av)[key] != &PL_sv_undef + && AvARRAY(av)[key]) + { return TRUE; + } else return FALSE; } @@ -683,6 +803,20 @@ S_avhv_index_sv(pTHX_ SV* sv) return index; } +STATIC I32 +S_avhv_index(pTHX_ AV *av, SV *keysv, U32 hash) +{ + HV *keys; + HE *he; + STRLEN n_a; + + keys = avhv_keys(av); + he = hv_fetch_ent(keys, keysv, FALSE, hash); + if (!he) + Perl_croak(aTHX_ "No such pseudo-hash field \"%s\"", SvPV(keysv,n_a)); + return avhv_index_sv(HeVAL(he)); +} + HV* Perl_avhv_keys(pTHX_ AV *av) { @@ -702,17 +836,15 @@ Perl_avhv_keys(pTHX_ AV *av) } SV** +Perl_avhv_store_ent(pTHX_ AV *av, SV *keysv, SV *val, U32 hash) +{ + return av_store(av, avhv_index(av, keysv, hash), val); +} + +SV** Perl_avhv_fetch_ent(pTHX_ AV *av, SV *keysv, I32 lval, U32 hash) { - SV **indsvp; - HV *keys = avhv_keys(av); - HE *he; - STRLEN n_a; - - he = hv_fetch_ent(keys, keysv, FALSE, hash); - if (!he) - Perl_croak(aTHX_ "No such pseudo-hash field \"%s\"", SvPV(keysv,n_a)); - return av_fetch(av, avhv_index_sv(HeVAL(he)), lval); + return av_fetch(av, avhv_index(av, keysv, hash), lval); } SV *