[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;
	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**
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(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 *
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(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
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(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;
	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(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 (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(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;
	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(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 (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)
a0d0e21e LW	177	return 0;
352edd90	178	sv = NEWSV(5,0);
a0d0e21e	179	return av_store(av,key,sv);
79072805	180	}
3280af22	181	if (AvARRAY(av)[key] == &PL_sv_undef) {
4dbf4341	182	emptyness:
79072805 LW	183	if (lval) {
79072805 LW	184	sv = NEWSV(6,0);
463ee0b2	185	return av_store(av,key,sv);
79072805 LW	186	}
	187	return 0;
	188	}
4dbf4341	189	else if (AvREIFY(av)
	190	&& (!AvARRAY(av)[key] /* eg. @_ could have freed elts */
	191	\|\| SvTYPE(AvARRAY(av)[key]) == SVTYPEMASK)) {
3280af22	192	AvARRAY(av)[key] = &PL_sv_undef; /* 1/2 reify */
4dbf4341	193	goto emptyness;
4dbf4341	194	}
463ee0b2	195	return &AvARRAY(av)[key];
79072805 LW	196	}
	197
	198	SV**
8ac85365	199	av_store(register AV av, I32 key, SV val)
79072805	200	{
79072805	201	SV** ary;
93965878 NIS	202	U32 fill;
93965878 NIS	203
79072805	204
a0d0e21e LW	205	if (!av)
a0d0e21e LW	206	return 0;
43fcc5d2	207	if (!val)
3280af22	208	val = &PL_sv_undef;
463ee0b2	209
a0d0e21e LW	210	if (key < 0) {
	211	key += AvFILL(av) + 1;
	212	if (key < 0)
	213	return 0;
79072805	214	}
93965878	215
43fcc5d2	216	if (SvREADONLY(av) && key >= AvFILL(av))
22c35a8c	217	croak(PL_no_modify);
93965878 NIS	218
	219	if (SvRMAGICAL(av)) {
	220	if (mg_find((SV*)av,'P')) {
3280af22	221	if (val != &PL_sv_undef) {
93965878 NIS	222	mg_copy((SV*)av, val, 0, key);
	223	}
	224	return 0;
	225	}
	226	}
	227
49beac48	228	if (!AvREAL(av) && AvREIFY(av))
a0d0e21e	229	av_reify(av);
a0d0e21e LW	230	if (key > AvMAX(av))
a0d0e21e LW	231	av_extend(av,key);
463ee0b2	232	ary = AvARRAY(av);
93965878	233	if (AvFILLp(av) < key) {
a0d0e21e	234	if (!AvREAL(av)) {
11343788	235	dTHR;
3280af22 NIS	236	if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
3280af22 NIS	237	PL_stack_sp = PL_stack_base + key; /* XPUSH in disguise */
a0d0e21e	238	do
3280af22	239	ary[++AvFILLp(av)] = &PL_sv_undef;
93965878	240	while (AvFILLp(av) < key);
79072805	241	}
93965878	242	AvFILLp(av) = key;
79072805	243	}
a0d0e21e LW	244	else if (AvREAL(av))
a0d0e21e LW	245	SvREFCNT_dec(ary[key]);
79072805	246	ary[key] = val;
8990e307	247	if (SvSMAGICAL(av)) {
3280af22	248	if (val != &PL_sv_undef) {
a0d0e21e LW	249	MAGIC* mg = SvMAGIC(av);
	250	sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
	251	}
463ee0b2 LW	252	mg_set((SV*)av);
463ee0b2 LW	253	}
79072805 LW	254	return &ary[key];
	255	}
	256
	257	AV *
8ac85365	258	newAV(void)
79072805	259	{
463ee0b2	260	register AV *av;
79072805	261
a0d0e21e LW	262	av = (AV*)NEWSV(3,0);
a0d0e21e LW	263	sv_upgrade((SV *)av, SVt_PVAV);
463ee0b2 LW	264	AvREAL_on(av);
	265	AvALLOC(av) = 0;
	266	SvPVX(av) = 0;
93965878	267	AvMAX(av) = AvFILLp(av) = -1;
463ee0b2	268	return av;
79072805 LW	269	}
	270
	271	AV *
8ac85365	272	av_make(register I32 size, register SV **strp)
79072805	273	{
463ee0b2	274	register AV *av;
79072805 LW	275	register I32 i;
	276	register SV** ary;
	277
a0d0e21e LW	278	av = (AV*)NEWSV(8,0);
a0d0e21e LW	279	sv_upgrade((SV *) av,SVt_PVAV);
a0d0e21e	280	AvFLAGS(av) = AVf_REAL;
573fa4ea TB	281	if (size) { /* `defined' was returning undef for size==0 anyway. */
	282	New(4,ary,size,SV*);
	283	AvALLOC(av) = ary;
	284	SvPVX(av) = (char*)ary;
93965878	285	AvFILLp(av) = size - 1;
573fa4ea TB	286	AvMAX(av) = size - 1;
	287	for (i = 0; i < size; i++) {
	288	assert (*strp);
	289	ary[i] = NEWSV(7,0);
	290	sv_setsv(ary[i], *strp);
	291	strp++;
	292	}
79072805	293	}
463ee0b2	294	return av;
79072805 LW	295	}
	296
	297	AV *
8ac85365	298	av_fake(register I32 size, register SV **strp)
79072805	299	{
463ee0b2	300	register AV *av;
79072805 LW	301	register SV** ary;
79072805 LW	302
a0d0e21e LW	303	av = (AV*)NEWSV(9,0);
a0d0e21e LW	304	sv_upgrade((SV *)av, SVt_PVAV);
79072805	305	New(4,ary,size+1,SV*);
463ee0b2	306	AvALLOC(av) = ary;
79072805	307	Copy(strp,ary,size,SV*);
a0d0e21e	308	AvFLAGS(av) = AVf_REIFY;
463ee0b2	309	SvPVX(av) = (char*)ary;
93965878	310	AvFILLp(av) = size - 1;
463ee0b2	311	AvMAX(av) = size - 1;
79072805	312	while (size--) {
a0d0e21e LW	313	assert (*strp);
a0d0e21e LW	314	SvTEMP_off(*strp);
79072805 LW	315	strp++;
79072805 LW	316	}
463ee0b2	317	return av;
79072805 LW	318	}
	319
	320	void
8ac85365	321	av_clear(register AV *av)
79072805 LW	322	{
79072805 LW	323	register I32 key;
a0d0e21e	324	SV** ary;
79072805	325
7d55f622	326	#ifdef DEBUGGING
	327	if (SvREFCNT(av) <= 0) {
	328	warn("Attempt to clear deleted array");
	329	}
	330	#endif
a60c0954	331	if (!av)
79072805 LW	332	return;
79072805 LW	333	/SUPPRESS 560/
a0d0e21e	334
39caa665	335	if (SvREADONLY(av))
22c35a8c	336	croak(PL_no_modify);
39caa665	337
93965878 NIS	338	/* Give any tie a chance to cleanup first */
	339	if (SvRMAGICAL(av))
	340	mg_clear((SV*)av);
	341
a60c0954 NIS	342	if (AvMAX(av) < 0)
	343	return;
	344
a0d0e21e LW	345	if (AvREAL(av)) {
a0d0e21e LW	346	ary = AvARRAY(av);
93965878	347	key = AvFILLp(av) + 1;
a0d0e21e LW	348	while (key) {
a0d0e21e LW	349	SvREFCNT_dec(ary[--key]);
3280af22	350	ary[key] = &PL_sv_undef;
a0d0e21e LW	351	}
a0d0e21e LW	352	}
463ee0b2 LW	353	if (key = AvARRAY(av) - AvALLOC(av)) {
463ee0b2 LW	354	AvMAX(av) += key;
a0d0e21e	355	SvPVX(av) = (char*)AvALLOC(av);
79072805	356	}
93965878	357	AvFILLp(av) = -1;
fb73857a	358
79072805 LW	359	}
	360
	361	void
8ac85365	362	av_undef(register AV *av)
79072805 LW	363	{
	364	register I32 key;
	365
463ee0b2	366	if (!av)
79072805 LW	367	return;
79072805 LW	368	/SUPPRESS 560/
93965878 NIS	369
93965878 NIS	370	/* Give any tie a chance to cleanup first */
33c27489	371	if (SvTIED_mg((SV*)av, 'P'))
93965878 NIS	372	av_fill(av, -1); /* mg_clear() ? */
93965878 NIS	373
a0d0e21e	374	if (AvREAL(av)) {
93965878	375	key = AvFILLp(av) + 1;
a0d0e21e LW	376	while (key)
	377	SvREFCNT_dec(AvARRAY(av)[--key]);
	378	}
463ee0b2 LW	379	Safefree(AvALLOC(av));
	380	AvALLOC(av) = 0;
	381	SvPVX(av) = 0;
93965878	382	AvMAX(av) = AvFILLp(av) = -1;
748a9306 LW	383	if (AvARYLEN(av)) {
	384	SvREFCNT_dec(AvARYLEN(av));
	385	AvARYLEN(av) = 0;
	386	}
79072805 LW	387	}
79072805 LW	388
a0d0e21e	389	void
8ac85365	390	av_push(register AV av, SV val)
93965878 NIS	391	{
93965878 NIS	392	MAGIC *mg;
a0d0e21e LW	393	if (!av)
a0d0e21e LW	394	return;
93965878	395	if (SvREADONLY(av))
22c35a8c	396	croak(PL_no_modify);
93965878	397
33c27489	398	if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878	399	dSP;
e788e7d3	400	PUSHSTACKi(PERLSI_MAGIC);
924508f0 GS	401	PUSHMARK(SP);
924508f0 GS	402	EXTEND(SP,2);
33c27489	403	PUSHs(SvTIED_obj((SV*)av, mg));
93965878	404	PUSHs(val);
a60c0954 NIS	405	PUTBACK;
a60c0954 NIS	406	ENTER;
93965878	407	perl_call_method("PUSH", G_SCALAR\|G_DISCARD);
a60c0954	408	LEAVE;
d3acc0f7	409	POPSTACK;
93965878 NIS	410	return;
	411	}
	412	av_store(av,AvFILLp(av)+1,val);
79072805 LW	413	}
	414
	415	SV *
8ac85365	416	av_pop(register AV *av)
79072805 LW	417	{
79072805 LW	418	SV *retval;
93965878	419	MAGIC* mg;
79072805	420
a0d0e21e	421	if (!av \|\| AvFILL(av) < 0)
3280af22	422	return &PL_sv_undef;
43fcc5d2	423	if (SvREADONLY(av))
22c35a8c	424	croak(PL_no_modify);
33c27489	425	if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878	426	dSP;
e788e7d3	427	PUSHSTACKi(PERLSI_MAGIC);
924508f0	428	PUSHMARK(SP);
33c27489	429	XPUSHs(SvTIED_obj((SV*)av, mg));
a60c0954 NIS	430	PUTBACK;
a60c0954 NIS	431	ENTER;
93965878	432	if (perl_call_method("POP", G_SCALAR)) {
3280af22	433	retval = newSVsv(*PL_stack_sp--);
93965878	434	} else {
3280af22	435	retval = &PL_sv_undef;
93965878	436	}
a60c0954	437	LEAVE;
d3acc0f7	438	POPSTACK;
93965878 NIS	439	return retval;
	440	}
	441	retval = AvARRAY(av)[AvFILLp(av)];
3280af22	442	AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
8990e307	443	if (SvSMAGICAL(av))
463ee0b2	444	mg_set((SV*)av);
79072805 LW	445	return retval;
	446	}
	447
	448	void
8ac85365	449	av_unshift(register AV *av, register I32 num)
79072805 LW	450	{
79072805 LW	451	register I32 i;
67a38de0	452	register SV **ary;
93965878	453	MAGIC* mg;
79072805	454
a0d0e21e	455	if (!av \|\| num <= 0)
79072805	456	return;
43fcc5d2	457	if (SvREADONLY(av))
22c35a8c	458	croak(PL_no_modify);
93965878	459
33c27489	460	if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878	461	dSP;
e788e7d3	462	PUSHSTACKi(PERLSI_MAGIC);
924508f0 GS	463	PUSHMARK(SP);
924508f0 GS	464	EXTEND(SP,1+num);
33c27489	465	PUSHs(SvTIED_obj((SV*)av, mg));
93965878	466	while (num-- > 0) {
3280af22	467	PUSHs(&PL_sv_undef);
93965878 NIS	468	}
93965878 NIS	469	PUTBACK;
a60c0954	470	ENTER;
93965878	471	perl_call_method("UNSHIFT", G_SCALAR\|G_DISCARD);
a60c0954	472	LEAVE;
d3acc0f7	473	POPSTACK;
93965878 NIS	474	return;
	475	}
	476
49beac48 CS	477	if (!AvREAL(av) && AvREIFY(av))
49beac48 CS	478	av_reify(av);
a0d0e21e LW	479	i = AvARRAY(av) - AvALLOC(av);
	480	if (i) {
	481	if (i > num)
	482	i = num;
	483	num -= i;
	484
	485	AvMAX(av) += i;
93965878	486	AvFILLp(av) += i;
a0d0e21e LW	487	SvPVX(av) = (char*)(AvARRAY(av) - i);
a0d0e21e LW	488	}
d2719217	489	if (num) {
67a38de0 NIS	490	i = AvFILLp(av);
67a38de0 NIS	491	av_extend(av, i + num);
93965878	492	AvFILLp(av) += num;
67a38de0 NIS	493	ary = AvARRAY(av);
	494	Move(ary, ary + num, i + 1, SV*);
	495	do {
3280af22	496	ary[--num] = &PL_sv_undef;
67a38de0	497	} while (num);
79072805 LW	498	}
	499	}
	500
	501	SV *
8ac85365	502	av_shift(register AV *av)
79072805 LW	503	{
79072805 LW	504	SV *retval;
93965878	505	MAGIC* mg;
79072805	506
a0d0e21e	507	if (!av \|\| AvFILL(av) < 0)
3280af22	508	return &PL_sv_undef;
43fcc5d2	509	if (SvREADONLY(av))
22c35a8c	510	croak(PL_no_modify);
33c27489	511	if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878	512	dSP;
e788e7d3	513	PUSHSTACKi(PERLSI_MAGIC);
924508f0	514	PUSHMARK(SP);
33c27489	515	XPUSHs(SvTIED_obj((SV*)av, mg));
a60c0954 NIS	516	PUTBACK;
a60c0954 NIS	517	ENTER;
93965878	518	if (perl_call_method("SHIFT", G_SCALAR)) {
3280af22	519	retval = newSVsv(*PL_stack_sp--);
93965878	520	} else {
3280af22	521	retval = &PL_sv_undef;
a60c0954 NIS	522	}
a60c0954 NIS	523	LEAVE;
d3acc0f7	524	POPSTACK;
93965878 NIS	525	return retval;
93965878 NIS	526	}
463ee0b2	527	retval = *AvARRAY(av);
a0d0e21e	528	if (AvREAL(av))
3280af22	529	*AvARRAY(av) = &PL_sv_undef;
463ee0b2 LW	530	SvPVX(av) = (char*)(AvARRAY(av) + 1);
463ee0b2 LW	531	AvMAX(av)--;
93965878	532	AvFILLp(av)--;
8990e307	533	if (SvSMAGICAL(av))
463ee0b2	534	mg_set((SV*)av);
79072805 LW	535	return retval;
	536	}
	537
	538	I32
8ac85365	539	av_len(register AV *av)
79072805	540	{
463ee0b2	541	return AvFILL(av);
79072805 LW	542	}
	543
	544	void
8ac85365	545	av_fill(register AV *av, I32 fill)
79072805	546	{
93965878	547	MAGIC *mg;
a0d0e21e LW	548	if (!av)
a0d0e21e LW	549	croak("panic: null array");
79072805 LW	550	if (fill < 0)
79072805 LW	551	fill = -1;
33c27489	552	if (mg = SvTIED_mg((SV*)av, 'P')) {
93965878 NIS	553	dSP;
	554	ENTER;
	555	SAVETMPS;
e788e7d3	556	PUSHSTACKi(PERLSI_MAGIC);
924508f0 GS	557	PUSHMARK(SP);
924508f0 GS	558	EXTEND(SP,2);
33c27489	559	PUSHs(SvTIED_obj((SV*)av, mg));
a60c0954	560	PUSHs(sv_2mortal(newSViv(fill+1)));
93965878 NIS	561	PUTBACK;
93965878 NIS	562	perl_call_method("STORESIZE", G_SCALAR\|G_DISCARD);
d3acc0f7	563	POPSTACK;
93965878 NIS	564	FREETMPS;
	565	LEAVE;
	566	return;
	567	}
463ee0b2	568	if (fill <= AvMAX(av)) {
93965878	569	I32 key = AvFILLp(av);
a0d0e21e LW	570	SV** ary = AvARRAY(av);
	571
	572	if (AvREAL(av)) {
	573	while (key > fill) {
	574	SvREFCNT_dec(ary[key]);
3280af22	575	ary[key--] = &PL_sv_undef;
a0d0e21e LW	576	}
	577	}
	578	else {
	579	while (key < fill)
3280af22	580	ary[++key] = &PL_sv_undef;
a0d0e21e LW	581	}
a0d0e21e LW	582
93965878	583	AvFILLp(av) = fill;
8990e307	584	if (SvSMAGICAL(av))
463ee0b2 LW	585	mg_set((SV*)av);
463ee0b2 LW	586	}
a0d0e21e	587	else
3280af22	588	(void)av_store(av,fill,&PL_sv_undef);
79072805	589	}
c750a3ec	590
57079c46 GA	591
	592	/* AVHV: Support for treating arrays as if they were hashes. The
	593	* first element of the array should be a hash reference that maps
	594	* hash keys to array indices.
	595	*/
	596
72311751	597	STATIC I32
57079c46 GA	598	avhv_index_sv(SV* sv)
	599	{
	600	I32 index = SvIV(sv);
	601	if (index < 1)
	602	croak("Bad index while coercing array into hash");
	603	return index;
	604	}
	605
5d5aaa5e JP	606	HV*
	607	avhv_keys(AV *av)
	608	{
57079c46	609	SV **keysp = av_fetch(av, 0, FALSE);
5d5aaa5e	610	if (keysp) {
d627ae4e MB	611	SV sv = keysp;
	612	if (SvGMAGICAL(sv))
	613	mg_get(sv);
	614	if (SvROK(sv)) {
	615	sv = SvRV(sv);
	616	if (SvTYPE(sv) == SVt_PVHV)
57079c46	617	return (HV*)sv;
5d5aaa5e JP	618	}
5d5aaa5e JP	619	}
57079c46	620	croak("Can't coerce array into hash");
72311751	621	return Nullhv;
c750a3ec MB	622	}
	623
	624	SV**
8ac85365	625	avhv_fetch_ent(AV av, SV keysv, I32 lval, U32 hash)
97fcbf96	626	{
5d5aaa5e JP	627	SV **indsvp;
5d5aaa5e JP	628	HV *keys = avhv_keys(av);
97fcbf96	629	HE *he;
5bc6513d	630
5d5aaa5e	631	he = hv_fetch_ent(keys, keysv, FALSE, hash);
57079c46 GA	632	if (!he)
	633	croak("No such array field");
	634	return av_fetch(av, avhv_index_sv(HeVAL(he)), lval);
5bc6513d MB	635	}
5bc6513d MB	636
c750a3ec	637	bool
8ac85365	638	avhv_exists_ent(AV av, SV keysv, U32 hash)
97fcbf96	639	{
5d5aaa5e JP	640	HV *keys = avhv_keys(av);
5d5aaa5e JP	641	return hv_exists_ent(keys, keysv, hash);
97fcbf96 MB	642	}
97fcbf96 MB	643
c750a3ec	644	HE *
8ac85365	645	avhv_iternext(AV *av)
c750a3ec	646	{
5d5aaa5e JP	647	HV *keys = avhv_keys(av);
5d5aaa5e JP	648	return hv_iternext(keys);
c750a3ec MB	649	}
	650
	651	SV *
8ac85365	652	avhv_iterval(AV av, register HE entry)
c750a3ec	653	{
57079c46 GA	654	SV *sv = hv_iterval(avhv_keys(av), entry);
57079c46 GA	655	return *av_fetch(av, avhv_index_sv(sv), TRUE);
c750a3ec	656	}