if (mg) {
SV *arg1 = sv_newmortal();
sv_setiv(arg1, (IV)(key + 1));
- Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "EXTEND", G_DISCARD, 1,
+ Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(EXTEND), G_DISCARD, 1,
arg1);
return;
}
#endif
if (*allocp) {
-#if !defined(STRANGE_MALLOC) && !defined(MYMALLOC)
- MEM_SIZE bytes;
- IV itmp;
-#endif
#ifdef Perl_safesysmalloc_size
/* Whilst it would be quite possible to move this logic around
newmax = key + *maxp / 5;
resize:
MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend);
-#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
Renew(*allocp,newmax+1, SV*);
-#else
- bytes = (newmax + 1) * sizeof(const SV *);
-#define MALLOC_OVERHEAD 16
- itmp = MALLOC_OVERHEAD;
- while ((MEM_SIZE)(itmp - MALLOC_OVERHEAD) < bytes)
- itmp += itmp;
- itmp -= MALLOC_OVERHEAD;
- itmp /= sizeof(const SV *);
- assert(itmp > newmax);
- newmax = itmp - 1;
- assert(newmax >= *maxp);
- Newx(ary, newmax+1, SV*);
- Copy(*allocp, ary, *maxp+1, SV*);
- Safefree(*allocp);
- *allocp = ary;
-#endif
#ifdef Perl_safesysmalloc_size
resized:
#endif
}
SV**
-Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
+Perl_av_fetch(pTHX_ AV *av, I32 key, I32 lval)
{
dVAR;
*/
SV**
-Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
+Perl_av_store(pTHX_ AV *av, I32 key, SV *val)
{
dVAR;
SV** ary;
}
if (SvREADONLY(av) && key >= AvFILL(av))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
if (!AvREAL(av) && AvREIFY(av))
av_reify(av);
*/
AV *
-Perl_av_make(pTHX_ register I32 size, register SV **strp)
+Perl_av_make(pTHX_ I32 size, SV **strp)
{
AV * const av = MUTABLE_AV(newSV_type(SVt_PVAV));
/* sv_upgrade does AvREAL_only() */
*/
void
-Perl_av_clear(pTHX_ register AV *av)
+Perl_av_clear(pTHX_ AV *av)
{
dVAR;
I32 extra;
#endif
if (SvREADONLY(av))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
/* Give any tie a chance to cleanup first */
if (SvRMAGICAL(av)) {
*/
void
-Perl_av_undef(pTHX_ register AV *av)
+Perl_av_undef(pTHX_ AV *av)
{
bool real;
*/
void
-Perl_av_push(pTHX_ register AV *av, SV *val)
+Perl_av_push(pTHX_ AV *av, SV *val)
{
dVAR;
MAGIC *mg;
assert(SvTYPE(av) == SVt_PVAV);
if (SvREADONLY(av))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
- Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "PUSH", G_DISCARD, 1,
+ Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(PUSH), G_DISCARD, 1,
val);
return;
}
/*
=for apidoc av_pop
-Pops an SV off the end of the array. Returns C<&PL_sv_undef> if the array
-is empty.
+Removes one SV from the end of the array, reducing its size by one and
+returning the SV (transferring control of one reference count) to the
+caller. Returns C<&PL_sv_undef> if the array is empty.
Perl equivalent: C<pop(@myarray);>
*/
SV *
-Perl_av_pop(pTHX_ register AV *av)
+Perl_av_pop(pTHX_ AV *av)
{
dVAR;
SV *retval;
assert(SvTYPE(av) == SVt_PVAV);
if (SvREADONLY(av))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
- retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "POP", 0, 0);
+ retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(POP), 0, 0);
if (retval)
retval = newSVsv(retval);
return retval;
must then use C<av_store> to assign values to these new elements.
Perl equivalent: C<unshift @myarray, ( (undef) x $n );>
-
+
=cut
*/
void
-Perl_av_unshift(pTHX_ register AV *av, register I32 num)
+Perl_av_unshift(pTHX_ AV *av, I32 num)
{
dVAR;
I32 i;
assert(SvTYPE(av) == SVt_PVAV);
if (SvREADONLY(av))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
- Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "UNSHIFT",
+ Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(UNSHIFT),
G_DISCARD | G_UNDEF_FILL, num);
return;
}
/*
=for apidoc av_shift
-Shifts an SV off the beginning of the
-array. Returns C<&PL_sv_undef> if the
-array is empty.
+Removes one SV from the start of the array, reducing its size by one and
+returning the SV (transferring control of one reference count) to the
+caller. Returns C<&PL_sv_undef> if the array is empty.
Perl equivalent: C<shift(@myarray);>
*/
SV *
-Perl_av_shift(pTHX_ register AV *av)
+Perl_av_shift(pTHX_ AV *av)
{
dVAR;
SV *retval;
assert(SvTYPE(av) == SVt_PVAV);
if (SvREADONLY(av))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
- retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "SHIFT", 0, 0);
+ retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(SHIFT), 0, 0);
if (retval)
retval = newSVsv(retval);
return retval;
}
/*
-=for apidoc av_len
+=for apidoc av_top_index
Returns the highest index in the array. The number of elements in the
-array is C<av_len(av) + 1>. Returns -1 if the array is empty.
+array is C<av_top_index(av) + 1>. Returns -1 if the array is empty.
The Perl equivalent for this is C<$#myarray>.
+(A slightly shorter form is C<av_tindex>.)
+
+=for apidoc av_len
+
+Same as L</av_top_index>. Returns the highest index in the array. Note that the
+return value is +1 what its name implies it returns; and hence differs in
+meaning from what the similarly named L</sv_len> returns.
+
=cut
*/
Perl_av_len(pTHX_ AV *av)
{
PERL_ARGS_ASSERT_AV_LEN;
- assert(SvTYPE(av) == SVt_PVAV);
- return AvFILL(av);
+ return av_top_index(av);
}
/*
=cut
*/
void
-Perl_av_fill(pTHX_ register AV *av, I32 fill)
+Perl_av_fill(pTHX_ AV *av, I32 fill)
{
dVAR;
MAGIC *mg;
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
SV *arg1 = sv_newmortal();
sv_setiv(arg1, (IV)(fill + 1));
- Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "STORESIZE", G_DISCARD,
+ Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(STORESIZE), G_DISCARD,
1, arg1);
return;
}
assert(SvTYPE(av) == SVt_PVAV);
if (SvREADONLY(av))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
if (SvRMAGICAL(av)) {
const MAGIC * const tied_magic
const MAGIC * const regdata_magic
= mg_find((const SV *)av, PERL_MAGIC_regdata);
if (tied_magic || regdata_magic) {
- SV * const sv = sv_newmortal();
MAGIC *mg;
/* Handle negative array indices 20020222 MJD */
if (key < 0) {
else
return FALSE;
}
-
- mg_copy(MUTABLE_SV(av), sv, 0, key);
- mg = mg_find(sv, PERL_MAGIC_tiedelem);
- if (mg) {
- magic_existspack(sv, mg);
- return cBOOL(SvTRUE_nomg(sv));
- }
-
+ {
+ SV * const sv = sv_newmortal();
+ mg_copy(MUTABLE_SV(av), sv, 0, key);
+ mg = mg_find(sv, PERL_MAGIC_tiedelem);
+ if (mg) {
+ magic_existspack(sv, mg);
+ {
+ I32 retbool = SvTRUE_nomg_NN(sv);
+ return cBOOL(retbool);
+ }
+ }
+ }
}
}