[p5sagit/p5-mst-13.2.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 (SvRMAGICAL(av) && mg_find((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;
    AvREAL_on(av);
}

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