[perl5.git] / av.c

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

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

    if (AvREAL(av))
	return;
#ifdef DEBUGGING
    if (SvTIED_mg((SV*)av, 'P'))
	warn("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
av_extend(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;
	perl_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
		U32 bytes;
#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
		tmp = MALLOC_OVERHEAD;
		while (tmp - MALLOC_OVERHEAD < bytes)
		    tmp += tmp;
		tmp -= MALLOC_OVERHEAD;
		tmp /= sizeof(SV*);
		assert(tmp > newmax);
		newmax = tmp - 1;
		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**
av_fetch(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;
	if (AvREALISH(av))
	    sv = NEWSV(5,0);
	else
	    sv = sv_newmortal();
	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**
av_store(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))
	croak(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 *
newAV(void)
{
    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 *
av_make(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 *
av_fake(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
av_clear(register AV *av)
{
    register I32 key;
    SV** ary;

#ifdef DEBUGGING
    if (SvREFCNT(av) <= 0) {
	warn("Attempt to clear deleted array");
    }
#endif
    if (!av)
	return;
    /*SUPPRESS 560*/

    if (SvREADONLY(av))
	croak(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
av_undef(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
av_push(register AV *av, SV *val)
{             
    MAGIC *mg;
    if (!av)
	return;
    if (SvREADONLY(av))
	croak(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;
	perl_call_method("PUSH", G_SCALAR|G_DISCARD);
	LEAVE;
	POPSTACK;
	return;
    }
    av_store(av,AvFILLp(av)+1,val);
}

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

    if (!av || AvFILL(av) < 0)
	return &PL_sv_undef;
    if (SvREADONLY(av))
	croak(no_modify);
    if (mg = SvTIED_mg((SV*)av, 'P')) {
	dSP;    
	PUSHSTACKi(PERLSI_MAGIC);
	PUSHMARK(SP);
	XPUSHs(SvTIED_obj((SV*)av, mg));
	PUTBACK;
	ENTER;
	if (perl_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
av_unshift(register AV *av, register I32 num)
{
    register I32 i;
    register SV **ary;
    MAGIC* mg;

    if (!av || num <= 0)
	return;
    if (SvREADONLY(av))
	croak(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;
	perl_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 *
av_shift(register AV *av)
{
    SV *retval;
    MAGIC* mg;

    if (!av || AvFILL(av) < 0)
	return &PL_sv_undef;
    if (SvREADONLY(av))
	croak(no_modify);
    if (mg = SvTIED_mg((SV*)av, 'P')) {
	dSP;
	PUSHSTACKi(PERLSI_MAGIC);
	PUSHMARK(SP);
	XPUSHs(SvTIED_obj((SV*)av, mg));
	PUTBACK;
	ENTER;
	if (perl_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
av_len(register AV *av)
{
    return AvFILL(av);
}

void
av_fill(register AV *av, I32 fill)
{
    MAGIC *mg;
    if (!av)
	croak("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;
	perl_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
avhv_index_sv(SV* sv)
{
    I32 index = SvIV(sv);
    if (index < 1)
	croak("Bad index while coercing array into hash");
    return index;    
}

HV*
avhv_keys(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;
	}
    }
    croak("Can't coerce array into hash");
    return Nullhv;
}

SV**
avhv_fetch_ent(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)
        croak("No such array field");
    return av_fetch(av, avhv_index_sv(HeVAL(he)), lval);
}

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

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

SV *
avhv_iterval(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	*
9607fc9c	3	* Copyright (c) 1991-1997, Larry Wall
79072805 LW	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 LW	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 LW	13	*/
	14
	15	#include "EXTERN.h"
	16	#include "perl.h"
	17
fb73857a	18	void
8ac85365	19	av_reify(AV *av)
a0d0e21e LW	20	{
	21	I32 key;
	22	SV* sv;
fb73857a	23
3c78fafa GS	24	if (AvREAL(av))
3c78fafa GS	25	return;
93965878	26	#ifdef DEBUGGING
33c27489	27	if (SvTIED_mg((SV*)av, 'P'))
93965878 NIS	28	warn("av_reify called on tied array");
93965878 NIS	29	#endif
a0d0e21e	30	key = AvMAX(av) + 1;
93965878	31	while (key > AvFILLp(av) + 1)
3280af22	32	AvARRAY(av)[--key] = &PL_sv_undef;
a0d0e21e LW	33	while (key) {
	34	sv = AvARRAY(av)[--key];
	35	assert(sv);
3280af22	36	if (sv != &PL_sv_undef) {
11343788	37	dTHR;
a0d0e21e	38	(void)SvREFCNT_inc(sv);
11343788	39	}
a0d0e21e	40	}
29de640a CS	41	key = AvARRAY(av) - AvALLOC(av);
29de640a CS	42	while (key)
3280af22	43	AvALLOC(av)[--key] = &PL_sv_undef;
62b1ebc2	44	AvREIFY_off(av);
a0d0e21e LW	45	AvREAL_on(av);
	46	}
	47
	48	void
8ac85365	49	av_extend(AV *av, I32 key)
a0d0e21e	50	{
11343788	51	dTHR; /* only necessary if we have to extend stack */
93965878	52	MAGIC *mg;
33c27489	53	if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878 NIS	54	dSP;
	55	ENTER;
	56	SAVETMPS;
e788e7d3	57	PUSHSTACKi(PERLSI_MAGIC);
924508f0 GS	58	PUSHMARK(SP);
924508f0 GS	59	EXTEND(SP,2);
33c27489	60	PUSHs(SvTIED_obj((SV*)av, mg));
a60c0954	61	PUSHs(sv_2mortal(newSViv(key+1)));
93965878 NIS	62	PUTBACK;
93965878 NIS	63	perl_call_method("EXTEND", G_SCALAR\|G_DISCARD);
d3acc0f7	64	POPSTACK;
93965878 NIS	65	FREETMPS;
	66	LEAVE;
	67	return;
	68	}
a0d0e21e LW	69	if (key > AvMAX(av)) {
	70	SV** ary;
	71	I32 tmp;
	72	I32 newmax;
	73
	74	if (AvALLOC(av) != AvARRAY(av)) {
93965878	75	ary = AvALLOC(av) + AvFILLp(av) + 1;
a0d0e21e	76	tmp = AvARRAY(av) - AvALLOC(av);
93965878	77	Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*);
a0d0e21e LW	78	AvMAX(av) += tmp;
	79	SvPVX(av) = (char*)AvALLOC(av);
	80	if (AvREAL(av)) {
	81	while (tmp)
3280af22	82	ary[--tmp] = &PL_sv_undef;
a0d0e21e LW	83	}
	84
	85	if (key > AvMAX(av) - 10) {
	86	newmax = key + AvMAX(av);
	87	goto resize;
	88	}
	89	}
	90	else {
	91	if (AvALLOC(av)) {
c07a80fd	92	#ifndef STRANGE_MALLOC
4633a7c4	93	U32 bytes;
c07a80fd	94	#endif
4633a7c4	95
1fe09876	96	#if defined(MYMALLOC) && !defined(PURIFY) && !defined(LEAKTEST)
8d6dde3e IZ	97	newmax = malloced_size((void)AvALLOC(av))/sizeof(SV) - 1;
	98
	99	if (key <= newmax)
	100	goto resized;
	101	#endif
a0d0e21e LW	102	newmax = key + AvMAX(av) / 5;
a0d0e21e LW	103	resize:
8d6dde3e	104	#if defined(STRANGE_MALLOC) \|\| defined(MYMALLOC)
a0d0e21e	105	Renew(AvALLOC(av),newmax+1, SV*);
4633a7c4 LW	106	#else
	107	bytes = (newmax + 1) * sizeof(SV*);
	108	#define MALLOC_OVERHEAD 16
	109	tmp = MALLOC_OVERHEAD;
	110	while (tmp - MALLOC_OVERHEAD < bytes)
	111	tmp += tmp;
	112	tmp -= MALLOC_OVERHEAD;
	113	tmp /= sizeof(SV*);
	114	assert(tmp > newmax);
	115	newmax = tmp - 1;
	116	New(2,ary, newmax+1, SV*);
	117	Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
fba3b22e MB	118	if (AvMAX(av) > 64)
fba3b22e MB	119	offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*));
4633a7c4 LW	120	else
	121	Safefree(AvALLOC(av));
	122	AvALLOC(av) = ary;
	123	#endif
8d6dde3e	124	resized:
a0d0e21e LW	125	ary = AvALLOC(av) + AvMAX(av) + 1;
a0d0e21e LW	126	tmp = newmax - AvMAX(av);
3280af22 NIS	127	if (av == PL_curstack) { /* Oops, grew stack (via av_store()?) */
	128	PL_stack_sp = AvALLOC(av) + (PL_stack_sp - PL_stack_base);
	129	PL_stack_base = AvALLOC(av);
	130	PL_stack_max = PL_stack_base + newmax;
a0d0e21e LW	131	}
	132	}
	133	else {
8d6dde3e	134	newmax = key < 3 ? 3 : key;
a0d0e21e LW	135	New(2,AvALLOC(av), newmax+1, SV*);
	136	ary = AvALLOC(av) + 1;
	137	tmp = newmax;
3280af22	138	AvALLOC(av)[0] = &PL_sv_undef; /* For the stacks */
a0d0e21e LW	139	}
	140	if (AvREAL(av)) {
	141	while (tmp)
3280af22	142	ary[--tmp] = &PL_sv_undef;
a0d0e21e LW	143	}
	144
	145	SvPVX(av) = (char*)AvALLOC(av);
	146	AvMAX(av) = newmax;
	147	}
	148	}
	149	}
	150
79072805	151	SV**
8ac85365	152	av_fetch(register AV *av, I32 key, I32 lval)
79072805 LW	153	{
	154	SV *sv;
	155
a0d0e21e LW	156	if (!av)
	157	return 0;
	158
93965878 NIS	159	if (key < 0) {
	160	key += AvFILL(av) + 1;
	161	if (key < 0)
	162	return 0;
	163	}
	164
8990e307	165	if (SvRMAGICAL(av)) {
6cef1e77	166	if (mg_find((SV)av,'P') \|\| mg_find((SV)av,'D')) {
11343788	167	dTHR;
8990e307	168	sv = sv_newmortal();
463ee0b2	169	mg_copy((SV*)av, sv, 0, key);
3280af22 NIS	170	PL_av_fetch_sv = sv;
3280af22 NIS	171	return &PL_av_fetch_sv;
463ee0b2 LW	172	}
	173	}
	174
93965878	175	if (key > AvFILLp(av)) {
a0d0e21e LW	176	if (!lval)
	177	return 0;
	178	if (AvREALISH(av))
	179	sv = NEWSV(5,0);
	180	else
	181	sv = sv_newmortal();
	182	return av_store(av,key,sv);
79072805	183	}
3280af22	184	if (AvARRAY(av)[key] == &PL_sv_undef) {
4dbf4341	185	emptyness:
79072805 LW	186	if (lval) {
79072805 LW	187	sv = NEWSV(6,0);
463ee0b2	188	return av_store(av,key,sv);
79072805 LW	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 LW	199	}
	200
	201	SV**
8ac85365	202	av_store(register AV av, I32 key, SV val)
79072805	203	{
79072805	204	SV** ary;
93965878 NIS	205	U32 fill;
93965878 NIS	206
79072805	207
a0d0e21e LW	208	if (!av)
a0d0e21e LW	209	return 0;
43fcc5d2	210	if (!val)
3280af22	211	val = &PL_sv_undef;
463ee0b2	212
a0d0e21e LW	213	if (key < 0) {
	214	key += AvFILL(av) + 1;
	215	if (key < 0)
	216	return 0;
79072805	217	}
93965878	218
43fcc5d2 CS	219	if (SvREADONLY(av) && key >= AvFILL(av))
43fcc5d2 CS	220	croak(no_modify);
93965878 NIS	221
	222	if (SvRMAGICAL(av)) {
	223	if (mg_find((SV*)av,'P')) {
3280af22	224	if (val != &PL_sv_undef) {
93965878 NIS	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 LW	233	if (key > AvMAX(av))
a0d0e21e LW	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 NIS	239	if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
3280af22 NIS	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 LW	247	else if (AvREAL(av))
a0d0e21e LW	248	SvREFCNT_dec(ary[key]);
79072805	249	ary[key] = val;
8990e307	250	if (SvSMAGICAL(av)) {
3280af22	251	if (val != &PL_sv_undef) {
a0d0e21e LW	252	MAGIC* mg = SvMAGIC(av);
	253	sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
	254	}
463ee0b2 LW	255	mg_set((SV*)av);
463ee0b2 LW	256	}
79072805 LW	257	return &ary[key];
	258	}
	259
	260	AV *
8ac85365	261	newAV(void)
79072805	262	{
463ee0b2	263	register AV *av;
79072805	264
a0d0e21e LW	265	av = (AV*)NEWSV(3,0);
a0d0e21e LW	266	sv_upgrade((SV *)av, SVt_PVAV);
463ee0b2 LW	267	AvREAL_on(av);
	268	AvALLOC(av) = 0;
	269	SvPVX(av) = 0;
93965878	270	AvMAX(av) = AvFILLp(av) = -1;
463ee0b2	271	return av;
79072805 LW	272	}
	273
	274	AV *
8ac85365	275	av_make(register I32 size, register SV **strp)
79072805	276	{
463ee0b2	277	register AV *av;
79072805 LW	278	register I32 i;
	279	register SV** ary;
	280
a0d0e21e LW	281	av = (AV*)NEWSV(8,0);
a0d0e21e LW	282	sv_upgrade((SV *) av,SVt_PVAV);
a0d0e21e	283	AvFLAGS(av) = AVf_REAL;
573fa4ea TB	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 TB	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 LW	298	}
	299
	300	AV *
8ac85365	301	av_fake(register I32 size, register SV **strp)
79072805	302	{
463ee0b2	303	register AV *av;
79072805 LW	304	register SV** ary;
79072805 LW	305
a0d0e21e LW	306	av = (AV*)NEWSV(9,0);
a0d0e21e LW	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 LW	316	assert (*strp);
a0d0e21e LW	317	SvTEMP_off(*strp);
79072805 LW	318	strp++;
79072805 LW	319	}
463ee0b2	320	return av;
79072805 LW	321	}
	322
	323	void
8ac85365	324	av_clear(register AV *av)
79072805 LW	325	{
79072805 LW	326	register I32 key;
a0d0e21e	327	SV** ary;
79072805	328
7d55f622	329	#ifdef DEBUGGING
	330	if (SvREFCNT(av) <= 0) {
	331	warn("Attempt to clear deleted array");
	332	}
	333	#endif
a60c0954	334	if (!av)
79072805 LW	335	return;
79072805 LW	336	/SUPPRESS 560/
a0d0e21e	337
39caa665 JP	338	if (SvREADONLY(av))
	339	croak(no_modify);
	340
93965878 NIS	341	/* Give any tie a chance to cleanup first */
	342	if (SvRMAGICAL(av))
	343	mg_clear((SV*)av);
	344
a60c0954 NIS	345	if (AvMAX(av) < 0)
	346	return;
	347
a0d0e21e LW	348	if (AvREAL(av)) {
a0d0e21e LW	349	ary = AvARRAY(av);
93965878	350	key = AvFILLp(av) + 1;
a0d0e21e LW	351	while (key) {
a0d0e21e LW	352	SvREFCNT_dec(ary[--key]);
3280af22	353	ary[key] = &PL_sv_undef;
a0d0e21e LW	354	}
a0d0e21e LW	355	}
463ee0b2 LW	356	if (key = AvARRAY(av) - AvALLOC(av)) {
463ee0b2 LW	357	AvMAX(av) += key;
a0d0e21e	358	SvPVX(av) = (char*)AvALLOC(av);
79072805	359	}
93965878	360	AvFILLp(av) = -1;
fb73857a	361
79072805 LW	362	}
	363
	364	void
8ac85365	365	av_undef(register AV *av)
79072805 LW	366	{
	367	register I32 key;
	368
463ee0b2	369	if (!av)
79072805 LW	370	return;
79072805 LW	371	/SUPPRESS 560/
93965878 NIS	372
93965878 NIS	373	/* Give any tie a chance to cleanup first */
33c27489	374	if (SvTIED_mg((SV*)av, 'P'))
93965878 NIS	375	av_fill(av, -1); /* mg_clear() ? */
93965878 NIS	376
a0d0e21e	377	if (AvREAL(av)) {
93965878	378	key = AvFILLp(av) + 1;
a0d0e21e LW	379	while (key)
	380	SvREFCNT_dec(AvARRAY(av)[--key]);
	381	}
463ee0b2 LW	382	Safefree(AvALLOC(av));
	383	AvALLOC(av) = 0;
	384	SvPVX(av) = 0;
93965878	385	AvMAX(av) = AvFILLp(av) = -1;
748a9306 LW	386	if (AvARYLEN(av)) {
	387	SvREFCNT_dec(AvARYLEN(av));
	388	AvARYLEN(av) = 0;
	389	}
79072805 LW	390	}
79072805 LW	391
a0d0e21e	392	void
8ac85365	393	av_push(register AV av, SV val)
93965878 NIS	394	{
93965878 NIS	395	MAGIC *mg;
a0d0e21e LW	396	if (!av)
a0d0e21e LW	397	return;
93965878 NIS	398	if (SvREADONLY(av))
	399	croak(no_modify);
	400
33c27489	401	if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878	402	dSP;
e788e7d3	403	PUSHSTACKi(PERLSI_MAGIC);
924508f0 GS	404	PUSHMARK(SP);
924508f0 GS	405	EXTEND(SP,2);
33c27489	406	PUSHs(SvTIED_obj((SV*)av, mg));
93965878	407	PUSHs(val);
a60c0954 NIS	408	PUTBACK;
a60c0954 NIS	409	ENTER;
93965878	410	perl_call_method("PUSH", G_SCALAR\|G_DISCARD);
a60c0954	411	LEAVE;
d3acc0f7	412	POPSTACK;
93965878 NIS	413	return;
	414	}
	415	av_store(av,AvFILLp(av)+1,val);
79072805 LW	416	}
	417
	418	SV *
8ac85365	419	av_pop(register AV *av)
79072805 LW	420	{
79072805 LW	421	SV *retval;
93965878	422	MAGIC* mg;
79072805	423
a0d0e21e	424	if (!av \|\| AvFILL(av) < 0)
3280af22	425	return &PL_sv_undef;
43fcc5d2 CS	426	if (SvREADONLY(av))
43fcc5d2 CS	427	croak(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 NIS	433	PUTBACK;
a60c0954 NIS	434	ENTER;
93965878	435	if (perl_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 NIS	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 LW	448	return retval;
	449	}
	450
	451	void
8ac85365	452	av_unshift(register AV *av, register I32 num)
79072805 LW	453	{
79072805 LW	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 CS	460	if (SvREADONLY(av))
43fcc5d2 CS	461	croak(no_modify);
93965878	462
33c27489	463	if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878	464	dSP;
e788e7d3	465	PUSHSTACKi(PERLSI_MAGIC);
924508f0 GS	466	PUSHMARK(SP);
924508f0 GS	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 NIS	471	}
93965878 NIS	472	PUTBACK;
a60c0954	473	ENTER;
93965878	474	perl_call_method("UNSHIFT", G_SCALAR\|G_DISCARD);
a60c0954	475	LEAVE;
d3acc0f7	476	POPSTACK;
93965878 NIS	477	return;
	478	}
	479
49beac48 CS	480	if (!AvREAL(av) && AvREIFY(av))
49beac48 CS	481	av_reify(av);
a0d0e21e LW	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 LW	490	SvPVX(av) = (char*)(AvARRAY(av) - i);
a0d0e21e LW	491	}
d2719217	492	if (num) {
67a38de0 NIS	493	i = AvFILLp(av);
67a38de0 NIS	494	av_extend(av, i + num);
93965878	495	AvFILLp(av) += num;
67a38de0 NIS	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 LW	501	}
	502	}
	503
	504	SV *
8ac85365	505	av_shift(register AV *av)
79072805 LW	506	{
79072805 LW	507	SV *retval;
93965878	508	MAGIC* mg;
79072805	509
a0d0e21e	510	if (!av \|\| AvFILL(av) < 0)
3280af22	511	return &PL_sv_undef;
43fcc5d2 CS	512	if (SvREADONLY(av))
43fcc5d2 CS	513	croak(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 NIS	519	PUTBACK;
a60c0954 NIS	520	ENTER;
93965878	521	if (perl_call_method("SHIFT", G_SCALAR)) {
3280af22	522	retval = newSVsv(*PL_stack_sp--);
93965878	523	} else {
3280af22	524	retval = &PL_sv_undef;
a60c0954 NIS	525	}
a60c0954 NIS	526	LEAVE;
d3acc0f7	527	POPSTACK;
93965878 NIS	528	return retval;
93965878 NIS	529	}
463ee0b2	530	retval = *AvARRAY(av);
a0d0e21e	531	if (AvREAL(av))
3280af22	532	*AvARRAY(av) = &PL_sv_undef;
463ee0b2 LW	533	SvPVX(av) = (char*)(AvARRAY(av) + 1);
463ee0b2 LW	534	AvMAX(av)--;
93965878	535	AvFILLp(av)--;
8990e307	536	if (SvSMAGICAL(av))
463ee0b2	537	mg_set((SV*)av);
79072805 LW	538	return retval;
	539	}
	540
	541	I32
8ac85365	542	av_len(register AV *av)
79072805	543	{
463ee0b2	544	return AvFILL(av);
79072805 LW	545	}
	546
	547	void
8ac85365	548	av_fill(register AV *av, I32 fill)
79072805	549	{
93965878	550	MAGIC *mg;
a0d0e21e LW	551	if (!av)
a0d0e21e LW	552	croak("panic: null array");
79072805 LW	553	if (fill < 0)
79072805 LW	554	fill = -1;
33c27489	555	if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878 NIS	556	dSP;
	557	ENTER;
	558	SAVETMPS;
e788e7d3	559	PUSHSTACKi(PERLSI_MAGIC);
924508f0 GS	560	PUSHMARK(SP);
924508f0 GS	561	EXTEND(SP,2);
33c27489	562	PUSHs(SvTIED_obj((SV*)av, mg));
a60c0954	563	PUSHs(sv_2mortal(newSViv(fill+1)));
93965878 NIS	564	PUTBACK;
93965878 NIS	565	perl_call_method("STORESIZE", G_SCALAR\|G_DISCARD);
d3acc0f7	566	POPSTACK;
93965878 NIS	567	FREETMPS;
	568	LEAVE;
	569	return;
	570	}
463ee0b2	571	if (fill <= AvMAX(av)) {
93965878	572	I32 key = AvFILLp(av);
a0d0e21e LW	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 LW	579	}
	580	}
	581	else {
	582	while (key < fill)
3280af22	583	ary[++key] = &PL_sv_undef;
a0d0e21e LW	584	}
a0d0e21e LW	585
93965878	586	AvFILLp(av) = fill;
8990e307	587	if (SvSMAGICAL(av))
463ee0b2 LW	588	mg_set((SV*)av);
463ee0b2 LW	589	}
a0d0e21e	590	else
3280af22	591	(void)av_store(av,fill,&PL_sv_undef);
79072805	592	}
c750a3ec	593
57079c46 GA	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
57079c46 GA	601	avhv_index_sv(SV* sv)
	602	{
	603	I32 index = SvIV(sv);
	604	if (index < 1)
	605	croak("Bad index while coercing array into hash");
	606	return index;
	607	}
	608
5d5aaa5e JP	609	HV*
	610	avhv_keys(AV *av)
	611	{
57079c46	612	SV **keysp = av_fetch(av, 0, FALSE);
5d5aaa5e	613	if (keysp) {
d627ae4e MB	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 JP	621	}
5d5aaa5e JP	622	}
57079c46	623	croak("Can't coerce array into hash");
72311751	624	return Nullhv;
c750a3ec MB	625	}
	626
	627	SV**
8ac85365	628	avhv_fetch_ent(AV av, SV keysv, I32 lval, U32 hash)
97fcbf96	629	{
5d5aaa5e JP	630	SV **indsvp;
5d5aaa5e JP	631	HV *keys = avhv_keys(av);
97fcbf96	632	HE *he;
5bc6513d	633
5d5aaa5e	634	he = hv_fetch_ent(keys, keysv, FALSE, hash);
57079c46 GA	635	if (!he)
	636	croak("No such array field");
	637	return av_fetch(av, avhv_index_sv(HeVAL(he)), lval);
5bc6513d MB	638	}
5bc6513d MB	639
c750a3ec	640	bool
8ac85365	641	avhv_exists_ent(AV av, SV keysv, U32 hash)
97fcbf96	642	{
5d5aaa5e JP	643	HV *keys = avhv_keys(av);
5d5aaa5e JP	644	return hv_exists_ent(keys, keysv, hash);
97fcbf96 MB	645	}
97fcbf96 MB	646
c750a3ec	647	HE *
8ac85365	648	avhv_iternext(AV *av)
c750a3ec	649	{
5d5aaa5e JP	650	HV *keys = avhv_keys(av);
5d5aaa5e JP	651	return hv_iternext(keys);
c750a3ec MB	652	}
	653
	654	SV *
8ac85365	655	avhv_iterval(AV av, register HE entry)
c750a3ec	656	{
57079c46 GA	657	SV *sv = hv_iterval(avhv_keys(av), entry);
57079c46 GA	658	return *av_fetch(av, avhv_index_sv(sv), TRUE);
c750a3ec	659	}