[p5sagit/p5-mst-13.2.git] / av.c

/*    av.c
 *
 *    Copyright (c) 1991-1999, 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"
#define PERL_IN_AV_C
#include "perl.h"

void
Perl_av_reify(pTHX_ AV *av)
{
    I32 key;
    SV* sv;

    if (AvREAL(av))
	return;
#ifdef DEBUGGING
    if (SvTIED_mg((SV*)av, 'P') && ckWARN_d(WARN_DEBUGGING))
	Perl_warner(aTHX_ WARN_DEBUGGING, "av_reify called on tied array");
#endif
    key = AvMAX(av) + 1;
    while (key > AvFILLp(av) + 1)
	AvARRAY(av)[--key] = &PL_sv_undef;
    while (key) {
	sv = AvARRAY(av)[--key];
	assert(sv);
	if (sv != &PL_sv_undef) {
	    dTHR;
	    (void)SvREFCNT_inc(sv);
	}
    }
    key = AvARRAY(av) - AvALLOC(av);
    while (key)
	AvALLOC(av)[--key] = &PL_sv_undef;
    AvREIFY_off(av);
    AvREAL_on(av);
}

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')) {
	dSP;
	ENTER;
	SAVETMPS;
	PUSHSTACKi(PERLSI_MAGIC);
	PUSHMARK(SP);
	EXTEND(SP,2);
	PUSHs(SvTIED_obj((SV*)av, mg));
	PUSHs(sv_2mortal(newSViv(key+1)));
        PUTBACK;
	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] = &PL_sv_undef;
	    }
	    
	    if (key > AvMAX(av) - 10) {
		newmax = key + AvMAX(av);
		goto resize;
	    }
	}
	else {
	    if (AvALLOC(av)) {
#ifndef STRANGE_MALLOC
		MEM_SIZE bytes;
		IV itmp;
#endif

#if defined(MYMALLOC) && !defined(PURIFY) && !defined(LEAKTEST)
		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
		itmp = MALLOC_OVERHEAD;
		while (itmp - MALLOC_OVERHEAD < bytes)
		    itmp += itmp;
		itmp -= MALLOC_OVERHEAD;
		itmp /= sizeof(SV*);
		assert(itmp > newmax);
		newmax = itmp - 1;
		assert(newmax >= AvMAX(av));
		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 == PL_curstack) {	/* Oops, grew stack (via av_store()?) */
		    PL_stack_sp = AvALLOC(av) + (PL_stack_sp - PL_stack_base);
		    PL_stack_base = AvALLOC(av);
		    PL_stack_max = PL_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] = &PL_sv_undef;	/* For the stacks */
	    }
	    if (AvREAL(av)) {
		while (tmp)
		    ary[--tmp] = &PL_sv_undef;
	    }
	    
	    SvPVX(av) = (char*)AvALLOC(av);
	    AvMAX(av) = newmax;
	}
    }
}

SV**
Perl_av_fetch(pTHX_ 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') || mg_find((SV*)av,'D')) {
	    dTHR;
	    sv = sv_newmortal();
	    mg_copy((SV*)av, sv, 0, key);
	    PL_av_fetch_sv = sv;
	    return &PL_av_fetch_sv;
	}
    }

    if (key > AvFILLp(av)) {
	if (!lval)
	    return 0;
	sv = NEWSV(5,0);
	return av_store(av,key,sv);
    }
    if (AvARRAY(av)[key] == &PL_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] = &PL_sv_undef;	/* 1/2 reify */
	goto emptyness;
    }
    return &AvARRAY(av)[key];
}

SV**
Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
{
    SV** ary;
    U32  fill;


    if (!av)
	return 0;
    if (!val)
	val = &PL_sv_undef;

    if (key < 0) {
	key += AvFILL(av) + 1;
	if (key < 0)
	    return 0;
    }

    if (SvREADONLY(av) && key >= AvFILL(av))
	Perl_croak(aTHX_ PL_no_modify);

    if (SvRMAGICAL(av)) {
	if (mg_find((SV*)av,'P')) {
	    if (val != &PL_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 == PL_curstack && key > PL_stack_sp - PL_stack_base)
		PL_stack_sp = PL_stack_base + key;	/* XPUSH in disguise */
	    do
		ary[++AvFILLp(av)] = &PL_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 != &PL_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 *
Perl_newAV(pTHX)
{
    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 *
Perl_av_make(pTHX_ 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 *
Perl_av_fake(pTHX_ 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
Perl_av_clear(pTHX_ register AV *av)
{
    register I32 key;
    SV** ary;

#ifdef DEBUGGING
    if (SvREFCNT(av) <= 0 && ckWARN_d(WARN_DEBUGGING)) {
	Perl_warner(aTHX_ WARN_DEBUGGING, "Attempt to clear deleted array");
    }
#endif
    if (!av)
	return;
    /*SUPPRESS 560*/

    if (SvREADONLY(av))
	Perl_croak(aTHX_ PL_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] = &PL_sv_undef;
	}
    }
    if (key = AvARRAY(av) - AvALLOC(av)) {
	AvMAX(av) += key;
	SvPVX(av) = (char*)AvALLOC(av);
    }
    AvFILLp(av) = -1;

}

void
Perl_av_undef(pTHX_ register AV *av)
{
    register I32 key;

    if (!av)
	return;
    /*SUPPRESS 560*/

    /* Give any tie a chance to cleanup first */
    if (SvTIED_mg((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
Perl_av_push(pTHX_ register AV *av, SV *val)
{             
    MAGIC *mg;
    if (!av)
	return;
    if (SvREADONLY(av))
	Perl_croak(aTHX_ PL_no_modify);

    if (mg = SvTIED_mg((SV*)av, 'P')) {
	dSP;
	PUSHSTACKi(PERLSI_MAGIC);
	PUSHMARK(SP);
	EXTEND(SP,2);
	PUSHs(SvTIED_obj((SV*)av, mg));
	PUSHs(val);
	PUTBACK;
	ENTER;
	call_method("PUSH", G_SCALAR|G_DISCARD);
	LEAVE;
	POPSTACK;
	return;
    }
    av_store(av,AvFILLp(av)+1,val);
}

SV *
Perl_av_pop(pTHX_ register AV *av)
{
    SV *retval;
    MAGIC* mg;

    if (!av || AvFILL(av) < 0)
	return &PL_sv_undef;
    if (SvREADONLY(av))
	Perl_croak(aTHX_ PL_no_modify);
    if (mg = SvTIED_mg((SV*)av, 'P')) {
	dSP;    
	PUSHSTACKi(PERLSI_MAGIC);
	PUSHMARK(SP);
	XPUSHs(SvTIED_obj((SV*)av, mg));
	PUTBACK;
	ENTER;
	if (call_method("POP", G_SCALAR)) {
	    retval = newSVsv(*PL_stack_sp--);    
	} else {    
	    retval = &PL_sv_undef;
	}
	LEAVE;
	POPSTACK;
	return retval;
    }
    retval = AvARRAY(av)[AvFILLp(av)];
    AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
    if (SvSMAGICAL(av))
	mg_set((SV*)av);
    return retval;
}

void
Perl_av_unshift(pTHX_ register AV *av, register I32 num)
{
    register I32 i;
    register SV **ary;
    MAGIC* mg;

    if (!av || num <= 0)
	return;
    if (SvREADONLY(av))
	Perl_croak(aTHX_ PL_no_modify);

    if (mg = SvTIED_mg((SV*)av, 'P')) {
	dSP;
	PUSHSTACKi(PERLSI_MAGIC);
	PUSHMARK(SP);
	EXTEND(SP,1+num);
	PUSHs(SvTIED_obj((SV*)av, mg));
	while (num-- > 0) {
	    PUSHs(&PL_sv_undef);
	}
	PUTBACK;
	ENTER;
	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] = &PL_sv_undef;
	} while (num);
    }
}

SV *
Perl_av_shift(pTHX_ register AV *av)
{
    SV *retval;
    MAGIC* mg;

    if (!av || AvFILL(av) < 0)
	return &PL_sv_undef;
    if (SvREADONLY(av))
	Perl_croak(aTHX_ PL_no_modify);
    if (mg = SvTIED_mg((SV*)av, 'P')) {
	dSP;
	PUSHSTACKi(PERLSI_MAGIC);
	PUSHMARK(SP);
	XPUSHs(SvTIED_obj((SV*)av, mg));
	PUTBACK;
	ENTER;
	if (call_method("SHIFT", G_SCALAR)) {
	    retval = newSVsv(*PL_stack_sp--);            
	} else {    
	    retval = &PL_sv_undef;
	}     
	LEAVE;
	POPSTACK;
	return retval;
    }
    retval = *AvARRAY(av);
    if (AvREAL(av))
	*AvARRAY(av) = &PL_sv_undef;
    SvPVX(av) = (char*)(AvARRAY(av) + 1);
    AvMAX(av)--;
    AvFILLp(av)--;
    if (SvSMAGICAL(av))
	mg_set((SV*)av);
    return retval;
}

I32
Perl_av_len(pTHX_ register AV *av)
{
    return AvFILL(av);
}

void
Perl_av_fill(pTHX_ register AV *av, I32 fill)
{
    MAGIC *mg;
    if (!av)
	Perl_croak(aTHX_ "panic: null array");
    if (fill < 0)
	fill = -1;
    if (mg = SvTIED_mg((SV*)av, 'P')) {
	dSP;            
	ENTER;
	SAVETMPS;
	PUSHSTACKi(PERLSI_MAGIC);
	PUSHMARK(SP);
	EXTEND(SP,2);
	PUSHs(SvTIED_obj((SV*)av, mg));
	PUSHs(sv_2mortal(newSViv(fill+1)));
	PUTBACK;
	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--] = &PL_sv_undef;
	    }
	}
	else {
	    while (key < fill)
		ary[++key] = &PL_sv_undef;
	}
	    
	AvFILLp(av) = fill;
	if (SvSMAGICAL(av))
	    mg_set((SV*)av);
    }
    else
	(void)av_store(av,fill,&PL_sv_undef);
}


/* AVHV: Support for treating arrays as if they were hashes.  The
 * first element of the array should be a hash reference that maps
 * hash keys to array indices.
 */

STATIC I32
S_avhv_index_sv(pTHX_ SV* sv)
{
    I32 index = SvIV(sv);
    if (index < 1)
	Perl_croak(aTHX_ "Bad index while coercing array into hash");
    return index;    
}

HV*
Perl_avhv_keys(pTHX_ AV *av)
{
    SV **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)
		return (HV*)sv;
	}
    }
    Perl_croak(aTHX_ "Can't coerce array into hash");
    return Nullhv;
}

SV**
Perl_avhv_fetch_ent(pTHX_ AV *av, SV *keysv, I32 lval, U32 hash)
{
    SV **indsvp;
    HV *keys = avhv_keys(av);
    HE *he;
    
    he = hv_fetch_ent(keys, keysv, FALSE, hash);
    if (!he)
        Perl_croak(aTHX_ "No such array field");
    return av_fetch(av, avhv_index_sv(HeVAL(he)), lval);
}

bool
Perl_avhv_exists_ent(pTHX_ AV *av, SV *keysv, U32 hash)
{
    HV *keys = avhv_keys(av);
    return hv_exists_ent(keys, keysv, hash);
}

HE *
Perl_avhv_iternext(pTHX_ AV *av)
{
    HV *keys = avhv_keys(av);
    return hv_iternext(keys);
}

SV *
Perl_avhv_iterval(pTHX_ AV *av, register HE *entry)
{
    SV *sv = hv_iterval(avhv_keys(av), entry);
    return *av_fetch(av, avhv_index_sv(sv), TRUE);
}
Commit	Line	Data
a0d0e21e	1	/* av.c
79072805	2	*
4eb8286e	3	* Copyright (c) 1991-1999, Larry Wall
79072805	4	*
	5	* You may distribute under the terms of either the GNU General Public
	6	* License or the Artistic License, as specified in the README file.
	7	*
a0d0e21e	8	*/
	9
	10	/*
	11	* "...for the Entwives desired order, and plenty, and peace (by which they
	12	* meant that things should remain where they had set them)." --Treebeard
79072805	13	*/
	14
	15	#include "EXTERN.h"
864dbfa3	16	#define PERL_IN_AV_C
79072805	17	#include "perl.h"
79072805	18
fb73857a	19	void
864dbfa3	20	Perl_av_reify(pTHX_ AV *av)
a0d0e21e	21	{
	22	I32 key;
	23	SV* sv;
fb73857a	24
3c78fafa	25	if (AvREAL(av))
3c78fafa	26	return;
93965878	27	#ifdef DEBUGGING
0453d815	28	if (SvTIED_mg((SV*)av, 'P') && ckWARN_d(WARN_DEBUGGING))
0453d815	29	Perl_warner(aTHX_ WARN_DEBUGGING, "av_reify called on tied array");
93965878	30	#endif
a0d0e21e	31	key = AvMAX(av) + 1;
93965878	32	while (key > AvFILLp(av) + 1)
3280af22	33	AvARRAY(av)[--key] = &PL_sv_undef;
a0d0e21e	34	while (key) {
	35	sv = AvARRAY(av)[--key];
	36	assert(sv);
3280af22	37	if (sv != &PL_sv_undef) {
11343788	38	dTHR;
a0d0e21e	39	(void)SvREFCNT_inc(sv);
11343788	40	}
a0d0e21e	41	}
29de640a	42	key = AvARRAY(av) - AvALLOC(av);
29de640a	43	while (key)
3280af22	44	AvALLOC(av)[--key] = &PL_sv_undef;
62b1ebc2	45	AvREIFY_off(av);
a0d0e21e	46	AvREAL_on(av);
	47	}
	48
	49	void
864dbfa3	50	Perl_av_extend(pTHX_ AV *av, I32 key)
a0d0e21e	51	{
11343788	52	dTHR; /* only necessary if we have to extend stack */
93965878	53	MAGIC *mg;
33c27489	54	if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878	55	dSP;
	56	ENTER;
	57	SAVETMPS;
e788e7d3	58	PUSHSTACKi(PERLSI_MAGIC);
924508f0	59	PUSHMARK(SP);
924508f0	60	EXTEND(SP,2);
33c27489	61	PUSHs(SvTIED_obj((SV*)av, mg));
a60c0954	62	PUSHs(sv_2mortal(newSViv(key+1)));
93965878	63	PUTBACK;
864dbfa3	64	call_method("EXTEND", G_SCALAR\|G_DISCARD);
d3acc0f7	65	POPSTACK;
93965878	66	FREETMPS;
	67	LEAVE;
	68	return;
	69	}
a0d0e21e	70	if (key > AvMAX(av)) {
	71	SV** ary;
	72	I32 tmp;
	73	I32 newmax;
	74
	75	if (AvALLOC(av) != AvARRAY(av)) {
93965878	76	ary = AvALLOC(av) + AvFILLp(av) + 1;
a0d0e21e	77	tmp = AvARRAY(av) - AvALLOC(av);
93965878	78	Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*);
a0d0e21e	79	AvMAX(av) += tmp;
	80	SvPVX(av) = (char*)AvALLOC(av);
	81	if (AvREAL(av)) {
	82	while (tmp)
3280af22	83	ary[--tmp] = &PL_sv_undef;
a0d0e21e	84	}
	85
	86	if (key > AvMAX(av) - 10) {
	87	newmax = key + AvMAX(av);
	88	goto resize;
	89	}
	90	}
	91	else {
	92	if (AvALLOC(av)) {
c07a80fd	93	#ifndef STRANGE_MALLOC
c1f7b11a	94	MEM_SIZE bytes;
c1f7b11a	95	IV itmp;
c07a80fd	96	#endif
4633a7c4	97
1fe09876	98	#if defined(MYMALLOC) && !defined(PURIFY) && !defined(LEAKTEST)
8d6dde3e	99	newmax = malloced_size((void)AvALLOC(av))/sizeof(SV) - 1;
	100
	101	if (key <= newmax)
	102	goto resized;
	103	#endif
a0d0e21e	104	newmax = key + AvMAX(av) / 5;
a0d0e21e	105	resize:
8d6dde3e	106	#if defined(STRANGE_MALLOC) \|\| defined(MYMALLOC)
a0d0e21e	107	Renew(AvALLOC(av),newmax+1, SV*);
4633a7c4	108	#else
	109	bytes = (newmax + 1) * sizeof(SV*);
	110	#define MALLOC_OVERHEAD 16
c1f7b11a	111	itmp = MALLOC_OVERHEAD;
	112	while (itmp - MALLOC_OVERHEAD < bytes)
	113	itmp += itmp;
	114	itmp -= MALLOC_OVERHEAD;
	115	itmp /= sizeof(SV*);
	116	assert(itmp > newmax);
	117	newmax = itmp - 1;
	118	assert(newmax >= AvMAX(av));
4633a7c4	119	New(2,ary, newmax+1, SV*);
4633a7c4	120	Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
fba3b22e	121	if (AvMAX(av) > 64)
fba3b22e	122	offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*));
4633a7c4	123	else
	124	Safefree(AvALLOC(av));
	125	AvALLOC(av) = ary;
	126	#endif
8d6dde3e	127	resized:
a0d0e21e	128	ary = AvALLOC(av) + AvMAX(av) + 1;
a0d0e21e	129	tmp = newmax - AvMAX(av);
3280af22	130	if (av == PL_curstack) { /* Oops, grew stack (via av_store()?) */
	131	PL_stack_sp = AvALLOC(av) + (PL_stack_sp - PL_stack_base);
	132	PL_stack_base = AvALLOC(av);
	133	PL_stack_max = PL_stack_base + newmax;
a0d0e21e	134	}
	135	}
	136	else {
8d6dde3e	137	newmax = key < 3 ? 3 : key;
a0d0e21e	138	New(2,AvALLOC(av), newmax+1, SV*);
	139	ary = AvALLOC(av) + 1;
	140	tmp = newmax;
3280af22	141	AvALLOC(av)[0] = &PL_sv_undef; /* For the stacks */
a0d0e21e	142	}
	143	if (AvREAL(av)) {
	144	while (tmp)
3280af22	145	ary[--tmp] = &PL_sv_undef;
a0d0e21e	146	}
	147
	148	SvPVX(av) = (char*)AvALLOC(av);
	149	AvMAX(av) = newmax;
	150	}
	151	}
	152	}
	153
79072805	154	SV**
864dbfa3	155	Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
79072805	156	{
	157	SV *sv;
	158
a0d0e21e	159	if (!av)
	160	return 0;
	161
93965878	162	if (key < 0) {
	163	key += AvFILL(av) + 1;
	164	if (key < 0)
	165	return 0;
	166	}
	167
8990e307	168	if (SvRMAGICAL(av)) {
6cef1e77	169	if (mg_find((SV)av,'P') \|\| mg_find((SV)av,'D')) {
11343788	170	dTHR;
8990e307	171	sv = sv_newmortal();
463ee0b2	172	mg_copy((SV*)av, sv, 0, key);
3280af22	173	PL_av_fetch_sv = sv;
3280af22	174	return &PL_av_fetch_sv;
463ee0b2	175	}
	176	}
	177
93965878	178	if (key > AvFILLp(av)) {
a0d0e21e	179	if (!lval)
a0d0e21e	180	return 0;
352edd90	181	sv = NEWSV(5,0);
a0d0e21e	182	return av_store(av,key,sv);
79072805	183	}
3280af22	184	if (AvARRAY(av)[key] == &PL_sv_undef) {
4dbf4341	185	emptyness:
79072805	186	if (lval) {
79072805	187	sv = NEWSV(6,0);
463ee0b2	188	return av_store(av,key,sv);
79072805	189	}
	190	return 0;
	191	}
4dbf4341	192	else if (AvREIFY(av)
	193	&& (!AvARRAY(av)[key] /* eg. @_ could have freed elts */
	194	\|\| SvTYPE(AvARRAY(av)[key]) == SVTYPEMASK)) {
3280af22	195	AvARRAY(av)[key] = &PL_sv_undef; /* 1/2 reify */
4dbf4341	196	goto emptyness;
4dbf4341	197	}
463ee0b2	198	return &AvARRAY(av)[key];
79072805	199	}
	200
	201	SV**
864dbfa3	202	Perl_av_store(pTHX_ register AV av, I32 key, SV val)
79072805	203	{
79072805	204	SV** ary;
93965878	205	U32 fill;
93965878	206
79072805	207
a0d0e21e	208	if (!av)
a0d0e21e	209	return 0;
43fcc5d2	210	if (!val)
3280af22	211	val = &PL_sv_undef;
463ee0b2	212
a0d0e21e	213	if (key < 0) {
	214	key += AvFILL(av) + 1;
	215	if (key < 0)
	216	return 0;
79072805	217	}
93965878	218
43fcc5d2	219	if (SvREADONLY(av) && key >= AvFILL(av))
cea2e8a9	220	Perl_croak(aTHX_ PL_no_modify);
93965878	221
	222	if (SvRMAGICAL(av)) {
	223	if (mg_find((SV*)av,'P')) {
3280af22	224	if (val != &PL_sv_undef) {
93965878	225	mg_copy((SV*)av, val, 0, key);
	226	}
	227	return 0;
	228	}
	229	}
	230
49beac48	231	if (!AvREAL(av) && AvREIFY(av))
a0d0e21e	232	av_reify(av);
a0d0e21e	233	if (key > AvMAX(av))
a0d0e21e	234	av_extend(av,key);
463ee0b2	235	ary = AvARRAY(av);
93965878	236	if (AvFILLp(av) < key) {
a0d0e21e	237	if (!AvREAL(av)) {
11343788	238	dTHR;
3280af22	239	if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
3280af22	240	PL_stack_sp = PL_stack_base + key; /* XPUSH in disguise */
a0d0e21e	241	do
3280af22	242	ary[++AvFILLp(av)] = &PL_sv_undef;
93965878	243	while (AvFILLp(av) < key);
79072805	244	}
93965878	245	AvFILLp(av) = key;
79072805	246	}
a0d0e21e	247	else if (AvREAL(av))
a0d0e21e	248	SvREFCNT_dec(ary[key]);
79072805	249	ary[key] = val;
8990e307	250	if (SvSMAGICAL(av)) {
3280af22	251	if (val != &PL_sv_undef) {
a0d0e21e	252	MAGIC* mg = SvMAGIC(av);
	253	sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
	254	}
463ee0b2	255	mg_set((SV*)av);
463ee0b2	256	}
79072805	257	return &ary[key];
	258	}
	259
	260	AV *
864dbfa3	261	Perl_newAV(pTHX)
79072805	262	{
463ee0b2	263	register AV *av;
79072805	264
a0d0e21e	265	av = (AV*)NEWSV(3,0);
a0d0e21e	266	sv_upgrade((SV *)av, SVt_PVAV);
463ee0b2	267	AvREAL_on(av);
	268	AvALLOC(av) = 0;
	269	SvPVX(av) = 0;
93965878	270	AvMAX(av) = AvFILLp(av) = -1;
463ee0b2	271	return av;
79072805	272	}
	273
	274	AV *
864dbfa3	275	Perl_av_make(pTHX_ register I32 size, register SV **strp)
79072805	276	{
463ee0b2	277	register AV *av;
79072805	278	register I32 i;
	279	register SV** ary;
	280
a0d0e21e	281	av = (AV*)NEWSV(8,0);
a0d0e21e	282	sv_upgrade((SV *) av,SVt_PVAV);
a0d0e21e	283	AvFLAGS(av) = AVf_REAL;
573fa4ea	284	if (size) { /* `defined' was returning undef for size==0 anyway. */
	285	New(4,ary,size,SV*);
	286	AvALLOC(av) = ary;
	287	SvPVX(av) = (char*)ary;
93965878	288	AvFILLp(av) = size - 1;
573fa4ea	289	AvMAX(av) = size - 1;
	290	for (i = 0; i < size; i++) {
	291	assert (*strp);
	292	ary[i] = NEWSV(7,0);
	293	sv_setsv(ary[i], *strp);
	294	strp++;
	295	}
79072805	296	}
463ee0b2	297	return av;
79072805	298	}
	299
	300	AV *
864dbfa3	301	Perl_av_fake(pTHX_ register I32 size, register SV **strp)
79072805	302	{
463ee0b2	303	register AV *av;
79072805	304	register SV** ary;
79072805	305
a0d0e21e	306	av = (AV*)NEWSV(9,0);
a0d0e21e	307	sv_upgrade((SV *)av, SVt_PVAV);
79072805	308	New(4,ary,size+1,SV*);
463ee0b2	309	AvALLOC(av) = ary;
79072805	310	Copy(strp,ary,size,SV*);
a0d0e21e	311	AvFLAGS(av) = AVf_REIFY;
463ee0b2	312	SvPVX(av) = (char*)ary;
93965878	313	AvFILLp(av) = size - 1;
463ee0b2	314	AvMAX(av) = size - 1;
79072805	315	while (size--) {
a0d0e21e	316	assert (*strp);
a0d0e21e	317	SvTEMP_off(*strp);
79072805	318	strp++;
79072805	319	}
463ee0b2	320	return av;
79072805	321	}
	322
	323	void
864dbfa3	324	Perl_av_clear(pTHX_ register AV *av)
79072805	325	{
79072805	326	register I32 key;
a0d0e21e	327	SV** ary;
79072805	328
7d55f622	329	#ifdef DEBUGGING
0453d815	330	if (SvREFCNT(av) <= 0 && ckWARN_d(WARN_DEBUGGING)) {
0453d815	331	Perl_warner(aTHX_ WARN_DEBUGGING, "Attempt to clear deleted array");
7d55f622	332	}
7d55f622	333	#endif
a60c0954	334	if (!av)
79072805	335	return;
79072805	336	/SUPPRESS 560/
a0d0e21e	337
39caa665	338	if (SvREADONLY(av))
cea2e8a9	339	Perl_croak(aTHX_ PL_no_modify);
39caa665	340
93965878	341	/* Give any tie a chance to cleanup first */
	342	if (SvRMAGICAL(av))
	343	mg_clear((SV*)av);
	344
a60c0954	345	if (AvMAX(av) < 0)
	346	return;
	347
a0d0e21e	348	if (AvREAL(av)) {
a0d0e21e	349	ary = AvARRAY(av);
93965878	350	key = AvFILLp(av) + 1;
a0d0e21e	351	while (key) {
a0d0e21e	352	SvREFCNT_dec(ary[--key]);
3280af22	353	ary[key] = &PL_sv_undef;
a0d0e21e	354	}
a0d0e21e	355	}
463ee0b2	356	if (key = AvARRAY(av) - AvALLOC(av)) {
463ee0b2	357	AvMAX(av) += key;
a0d0e21e	358	SvPVX(av) = (char*)AvALLOC(av);
79072805	359	}
93965878	360	AvFILLp(av) = -1;
fb73857a	361
79072805	362	}
	363
	364	void
864dbfa3	365	Perl_av_undef(pTHX_ register AV *av)
79072805	366	{
	367	register I32 key;
	368
463ee0b2	369	if (!av)
79072805	370	return;
79072805	371	/SUPPRESS 560/
93965878	372
93965878	373	/* Give any tie a chance to cleanup first */
33c27489	374	if (SvTIED_mg((SV*)av, 'P'))
93965878	375	av_fill(av, -1); /* mg_clear() ? */
93965878	376
a0d0e21e	377	if (AvREAL(av)) {
93965878	378	key = AvFILLp(av) + 1;
a0d0e21e	379	while (key)
	380	SvREFCNT_dec(AvARRAY(av)[--key]);
	381	}
463ee0b2	382	Safefree(AvALLOC(av));
	383	AvALLOC(av) = 0;
	384	SvPVX(av) = 0;
93965878	385	AvMAX(av) = AvFILLp(av) = -1;
748a9306	386	if (AvARYLEN(av)) {
	387	SvREFCNT_dec(AvARYLEN(av));
	388	AvARYLEN(av) = 0;
	389	}
79072805	390	}
79072805	391
a0d0e21e	392	void
864dbfa3	393	Perl_av_push(pTHX_ register AV av, SV val)
93965878	394	{
93965878	395	MAGIC *mg;
a0d0e21e	396	if (!av)
a0d0e21e	397	return;
93965878	398	if (SvREADONLY(av))
cea2e8a9	399	Perl_croak(aTHX_ PL_no_modify);
93965878	400
33c27489	401	if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878	402	dSP;
e788e7d3	403	PUSHSTACKi(PERLSI_MAGIC);
924508f0	404	PUSHMARK(SP);
924508f0	405	EXTEND(SP,2);
33c27489	406	PUSHs(SvTIED_obj((SV*)av, mg));
93965878	407	PUSHs(val);
a60c0954	408	PUTBACK;
a60c0954	409	ENTER;
864dbfa3	410	call_method("PUSH", G_SCALAR\|G_DISCARD);
a60c0954	411	LEAVE;
d3acc0f7	412	POPSTACK;
93965878	413	return;
	414	}
	415	av_store(av,AvFILLp(av)+1,val);
79072805	416	}
	417
	418	SV *
864dbfa3	419	Perl_av_pop(pTHX_ register AV *av)
79072805	420	{
79072805	421	SV *retval;
93965878	422	MAGIC* mg;
79072805	423
a0d0e21e	424	if (!av \|\| AvFILL(av) < 0)
3280af22	425	return &PL_sv_undef;
43fcc5d2	426	if (SvREADONLY(av))
cea2e8a9	427	Perl_croak(aTHX_ PL_no_modify);
33c27489	428	if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878	429	dSP;
e788e7d3	430	PUSHSTACKi(PERLSI_MAGIC);
924508f0	431	PUSHMARK(SP);
33c27489	432	XPUSHs(SvTIED_obj((SV*)av, mg));
a60c0954	433	PUTBACK;
a60c0954	434	ENTER;
864dbfa3	435	if (call_method("POP", G_SCALAR)) {
3280af22	436	retval = newSVsv(*PL_stack_sp--);
93965878	437	} else {
3280af22	438	retval = &PL_sv_undef;
93965878	439	}
a60c0954	440	LEAVE;
d3acc0f7	441	POPSTACK;
93965878	442	return retval;
	443	}
	444	retval = AvARRAY(av)[AvFILLp(av)];
3280af22	445	AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
8990e307	446	if (SvSMAGICAL(av))
463ee0b2	447	mg_set((SV*)av);
79072805	448	return retval;
	449	}
	450
	451	void
864dbfa3	452	Perl_av_unshift(pTHX_ register AV *av, register I32 num)
79072805	453	{
79072805	454	register I32 i;
67a38de0	455	register SV **ary;
93965878	456	MAGIC* mg;
79072805	457
a0d0e21e	458	if (!av \|\| num <= 0)
79072805	459	return;
43fcc5d2	460	if (SvREADONLY(av))
cea2e8a9	461	Perl_croak(aTHX_ PL_no_modify);
93965878	462
33c27489	463	if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878	464	dSP;
e788e7d3	465	PUSHSTACKi(PERLSI_MAGIC);
924508f0	466	PUSHMARK(SP);
924508f0	467	EXTEND(SP,1+num);
33c27489	468	PUSHs(SvTIED_obj((SV*)av, mg));
93965878	469	while (num-- > 0) {
3280af22	470	PUSHs(&PL_sv_undef);
93965878	471	}
93965878	472	PUTBACK;
a60c0954	473	ENTER;
864dbfa3	474	call_method("UNSHIFT", G_SCALAR\|G_DISCARD);
a60c0954	475	LEAVE;
d3acc0f7	476	POPSTACK;
93965878	477	return;
	478	}
	479
49beac48	480	if (!AvREAL(av) && AvREIFY(av))
49beac48	481	av_reify(av);
a0d0e21e	482	i = AvARRAY(av) - AvALLOC(av);
	483	if (i) {
	484	if (i > num)
	485	i = num;
	486	num -= i;
	487
	488	AvMAX(av) += i;
93965878	489	AvFILLp(av) += i;
a0d0e21e	490	SvPVX(av) = (char*)(AvARRAY(av) - i);
a0d0e21e	491	}
d2719217	492	if (num) {
67a38de0	493	i = AvFILLp(av);
67a38de0	494	av_extend(av, i + num);
93965878	495	AvFILLp(av) += num;
67a38de0	496	ary = AvARRAY(av);
	497	Move(ary, ary + num, i + 1, SV*);
	498	do {
3280af22	499	ary[--num] = &PL_sv_undef;
67a38de0	500	} while (num);
79072805	501	}
	502	}
	503
	504	SV *
864dbfa3	505	Perl_av_shift(pTHX_ register AV *av)
79072805	506	{
79072805	507	SV *retval;
93965878	508	MAGIC* mg;
79072805	509
a0d0e21e	510	if (!av \|\| AvFILL(av) < 0)
3280af22	511	return &PL_sv_undef;
43fcc5d2	512	if (SvREADONLY(av))
cea2e8a9	513	Perl_croak(aTHX_ PL_no_modify);
33c27489	514	if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878	515	dSP;
e788e7d3	516	PUSHSTACKi(PERLSI_MAGIC);
924508f0	517	PUSHMARK(SP);
33c27489	518	XPUSHs(SvTIED_obj((SV*)av, mg));
a60c0954	519	PUTBACK;
a60c0954	520	ENTER;
864dbfa3	521	if (call_method("SHIFT", G_SCALAR)) {
3280af22	522	retval = newSVsv(*PL_stack_sp--);
93965878	523	} else {
3280af22	524	retval = &PL_sv_undef;
a60c0954	525	}
a60c0954	526	LEAVE;
d3acc0f7	527	POPSTACK;
93965878	528	return retval;
93965878	529	}
463ee0b2	530	retval = *AvARRAY(av);
a0d0e21e	531	if (AvREAL(av))
3280af22	532	*AvARRAY(av) = &PL_sv_undef;
463ee0b2	533	SvPVX(av) = (char*)(AvARRAY(av) + 1);
463ee0b2	534	AvMAX(av)--;
93965878	535	AvFILLp(av)--;
8990e307	536	if (SvSMAGICAL(av))
463ee0b2	537	mg_set((SV*)av);
79072805	538	return retval;
	539	}
	540
	541	I32
864dbfa3	542	Perl_av_len(pTHX_ register AV *av)
79072805	543	{
463ee0b2	544	return AvFILL(av);
79072805	545	}
	546
	547	void
864dbfa3	548	Perl_av_fill(pTHX_ register AV *av, I32 fill)
79072805	549	{
93965878	550	MAGIC *mg;
a0d0e21e	551	if (!av)
cea2e8a9	552	Perl_croak(aTHX_ "panic: null array");
79072805	553	if (fill < 0)
79072805	554	fill = -1;
33c27489	555	if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878	556	dSP;
	557	ENTER;
	558	SAVETMPS;
e788e7d3	559	PUSHSTACKi(PERLSI_MAGIC);
924508f0	560	PUSHMARK(SP);
924508f0	561	EXTEND(SP,2);
33c27489	562	PUSHs(SvTIED_obj((SV*)av, mg));
a60c0954	563	PUSHs(sv_2mortal(newSViv(fill+1)));
93965878	564	PUTBACK;
864dbfa3	565	call_method("STORESIZE", G_SCALAR\|G_DISCARD);
d3acc0f7	566	POPSTACK;
93965878	567	FREETMPS;
	568	LEAVE;
	569	return;
	570	}
463ee0b2	571	if (fill <= AvMAX(av)) {
93965878	572	I32 key = AvFILLp(av);
a0d0e21e	573	SV** ary = AvARRAY(av);
	574
	575	if (AvREAL(av)) {
	576	while (key > fill) {
	577	SvREFCNT_dec(ary[key]);
3280af22	578	ary[key--] = &PL_sv_undef;
a0d0e21e	579	}
	580	}
	581	else {
	582	while (key < fill)
3280af22	583	ary[++key] = &PL_sv_undef;
a0d0e21e	584	}
a0d0e21e	585
93965878	586	AvFILLp(av) = fill;
8990e307	587	if (SvSMAGICAL(av))
463ee0b2	588	mg_set((SV*)av);
463ee0b2	589	}
a0d0e21e	590	else
3280af22	591	(void)av_store(av,fill,&PL_sv_undef);
79072805	592	}
c750a3ec	593
57079c46	594
	595	/* AVHV: Support for treating arrays as if they were hashes. The
	596	* first element of the array should be a hash reference that maps
	597	* hash keys to array indices.
	598	*/
	599
72311751	600	STATIC I32
cea2e8a9	601	S_avhv_index_sv(pTHX_ SV* sv)
57079c46	602	{
	603	I32 index = SvIV(sv);
	604	if (index < 1)
cea2e8a9	605	Perl_croak(aTHX_ "Bad index while coercing array into hash");
57079c46	606	return index;
	607	}
	608
5d5aaa5e	609	HV*
864dbfa3	610	Perl_avhv_keys(pTHX_ AV *av)
5d5aaa5e	611	{
57079c46	612	SV **keysp = av_fetch(av, 0, FALSE);
5d5aaa5e	613	if (keysp) {
d627ae4e	614	SV sv = keysp;
	615	if (SvGMAGICAL(sv))
	616	mg_get(sv);
	617	if (SvROK(sv)) {
	618	sv = SvRV(sv);
	619	if (SvTYPE(sv) == SVt_PVHV)
57079c46	620	return (HV*)sv;
5d5aaa5e	621	}
5d5aaa5e	622	}
cea2e8a9	623	Perl_croak(aTHX_ "Can't coerce array into hash");
72311751	624	return Nullhv;
c750a3ec	625	}
	626
	627	SV**
864dbfa3	628	Perl_avhv_fetch_ent(pTHX_ AV av, SV keysv, I32 lval, U32 hash)
97fcbf96	629	{
5d5aaa5e	630	SV **indsvp;
5d5aaa5e	631	HV *keys = avhv_keys(av);
97fcbf96	632	HE *he;
5bc6513d	633
5d5aaa5e	634	he = hv_fetch_ent(keys, keysv, FALSE, hash);
57079c46	635	if (!he)
cea2e8a9	636	Perl_croak(aTHX_ "No such array field");
57079c46	637	return av_fetch(av, avhv_index_sv(HeVAL(he)), lval);
5bc6513d	638	}
5bc6513d	639
c750a3ec	640	bool
864dbfa3	641	Perl_avhv_exists_ent(pTHX_ AV av, SV keysv, U32 hash)
97fcbf96	642	{
5d5aaa5e	643	HV *keys = avhv_keys(av);
5d5aaa5e	644	return hv_exists_ent(keys, keysv, hash);
97fcbf96	645	}
97fcbf96	646
c750a3ec	647	HE *
864dbfa3	648	Perl_avhv_iternext(pTHX_ AV *av)
c750a3ec	649	{
5d5aaa5e	650	HV *keys = avhv_keys(av);
5d5aaa5e	651	return hv_iternext(keys);
c750a3ec	652	}
	653
	654	SV *
864dbfa3	655	Perl_avhv_iterval(pTHX_ AV av, register HE entry)
c750a3ec	656	{
57079c46	657	SV *sv = hv_iterval(avhv_keys(av), entry);
57079c46	658	return *av_fetch(av, avhv_index_sv(sv), TRUE);
c750a3ec	659	}