perl-5.24.0.tar.gz

/*    av.c
 *
 *    Copyright （C） 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000
 *    2001 2002 2003 2004 2005 2006 2007 2008 by Larry Wall and others
 *
 *    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
 *
 *     [p.476 of _The Lord of the Rings_ III/iv: “Treebeard“]
 */

/*
=head1 Array Manipulation Functions
*/

#include “EXTERN.h“
#define PERL_IN_AV_C
#include “perl.h“

void
Perl_av_reify（pTHX_ AV *av）
{
    SSize_t key;

    PERL_ARGS_ASSERT_AV_REIFY;
    assert（SvTYPE（av） == SVt_PVAV）;

    if （AvREAL（av））
	return;
#ifdef DEBUGGING
    if （SvTIED_mg（（const SV *）av PERL_MAGIC_tied））
	Perl_ck_warner_d（aTHX_ packWARN（WARN_DEBUGGING） “av_reify called on tied array“）;
#endif
    key = AvMAX（av） + 1;
    while （key > AvFILLp（av） + 1）
	AvARRAY（av）[--key] = NULL;
    while （key） {
	SV * const sv = AvARRAY（av）[--key];
	if （sv != &PL_sv_undef）
	    SvREFCNT_inc_simple_void（sv）;
    }
    key = AvARRAY（av） - AvALLOC（av）;
    while （key）
	AvALLOC（av）[--key] = NULL;
    AvREIFY_off（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 SSize_t key）
{
    MAGIC *mg;

    PERL_ARGS_ASSERT_AV_EXTEND;
    assert（SvTYPE（av） == SVt_PVAV）;

    mg = SvTIED_mg（（const SV *）av PERL_MAGIC_tied）;
    if （mg） {
	SV *arg1 = sv_newmortal（）;
	sv_setiv（arg1 （IV）（key + 1））;
	Perl_magic_methcall（aTHX_ MUTABLE_SV（av） mg SV_CONST（EXTEND） G_DISCARD 1
			    arg1）;
	return;
    }
    av_extend_guts（avkey&AvMAX（av）&AvALLOC（av）&AvARRAY（av））;
}    

/* The guts of av_extend.  *Not* for general use! */
void
Perl_av_extend_guts（pTHX_ AV *av SSize_t key SSize_t *maxp SV ***allocp
			  SV ***arrayp）
{
    PERL_ARGS_ASSERT_AV_EXTEND_GUTS;

    if （key < -1） /* -1 is legal */
        Perl_croak（aTHX_
            “panic: av_extend_guts（） negative count （%“IVdf“）“ （IV）key）;

    if （key > *maxp） {
	SV** ary;
	SSize_t tmp;
	SSize_t newmax;

	if （av && *allocp != *arrayp） {
	    ary = *allocp + AvFILLp（av） + 1;
	    tmp = *arrayp - *allocp;
	    Move（*arrayp *allocp AvFILLp（av）+1 SV*）;
	    *maxp += tmp;
	    *arrayp = *allocp;
	    if （AvREAL（av）） {
		while （tmp）
		    ary[--tmp] = NULL;
	    }
	    if （key > *maxp - 10） {
		newmax = key + *maxp;
		goto resize;
	    }
	}
	else {
	    if （*allocp） {

#ifdef Perl_safesysmalloc_size
		/* Whilst it would be quite possible to move this logic around
		   （as I did in the SV code） so as to set AvMAX（av） early
		   based on calling Perl_safesysmalloc_size（） immediately after
		   allocation I‘m not convinced that it is a great idea here.
		   In an array we have to loop round setting everything to
		   NULL which means wr