/* 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.
AvREAL_on(av);
}
+/*
+=for apidoc av_extend
+
+Pre-extend an array. The C<key> 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;
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)
}
}
+/*
+=for apidoc av_fetch
+
+Returns the SV at the specified index in the array. The C<key> is the
+index. If C<lval> 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<SV*>.
+
+See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> 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)
{
return &AvARRAY(av)[key];
}
+/*
+=for apidoc av_store
+
+Stores an SV in an array. The array index is specified as C<key>. 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<SV*>. Note
+that the caller is responsible for suitably incrementing the reference
+count of C<val> before the call, and decrementing it if the function
+returned NULL.
+
+See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> 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;
return &ary[key];
}
+/*
+=for apidoc newAV
+
+Creates a new AV. The reference count is set to 1.
+
+=cut
+*/
+
AV *
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)
{
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)
{
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
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);
}
}
+/*
+=for apidoc av_undef
+
+Undefines the array. Frees the memory used by the array itself.
+
+=cut
+*/
+
void
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)
{
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);
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)
{
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);
return retval;
}
+/*
+=for apidoc av_unshift
+
+Unshift the given number of C<undef> values onto the beginning of the
+array. The array will grow automatically to accommodate the addition. You
+must then use C<av_store> to assign values to these new elements.
+
+=cut
+*/
+
void
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);
}
}
+/*
+=for apidoc av_shift
+
+Shifts an SV off the beginning of the array.
+
+=cut
+*/
+
SV *
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);
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)
{
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;
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)
{
}
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 *
https://perl5.git.perl.org / perl5.git / blobdiff