1			/*    av.c
     2			 *
     3			 *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
     4			 *    2000, 2001, 2002, 2003, 2004, 2005 by Larry Wall and others
     5			 *
     6			 *    You may distribute under the terms of either the GNU General Public
     7			 *    License or the Artistic License, as specified in the README file.
     8			 *
     9			 */
    10			
    11			/*
    12			 * "...for the Entwives desired order, and plenty, and peace (by which they
    13			 * meant that things should remain where they had set them)." --Treebeard
    14			 */
    15			
    16			/*
    17			=head1 Array Manipulation Functions
    18			*/
    19			
    20			#include "EXTERN.h"
    21			#define PERL_IN_AV_C
    22			#include "perl.h"
    23			
    24			void
    25			Perl_av_reify(pTHX_ AV *av)
    26	       13087    {
    27	       13087        I32 key;
    28			
    29	       13087        if (AvREAL(av))
    30	      ######    	return;
    31			#ifdef DEBUGGING
    32	       13087        if (SvTIED_mg((SV*)av, PERL_MAGIC_tied) && ckWARN_d(WARN_DEBUGGING))
    33	      ######    	Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "av_reify called on tied array");
    34			#endif
    35	       13087        key = AvMAX(av) + 1;
    36	       91730        while (key > AvFILLp(av) + 1)
    37	       78643    	AvARRAY(av)[--key] = &PL_sv_undef;
    38	       14448        while (key) {
    39	        1361    	SV * const sv = AvARRAY(av)[--key];
    40	        1361    	assert(sv);
    41	        1361    	if (sv != &PL_sv_undef)
    42	        1359    	    (void)SvREFCNT_inc(sv);
    43			    }
    44	       13087        key = AvARRAY(av) - AvALLOC(av);
    45	       16643        while (key)
    46	        3556    	AvALLOC(av)[--key] = &PL_sv_undef;
    47	       13087        AvREIFY_off(av);
    48	       13087        AvREAL_on(av);
    49			}
    50			
    51			/*
    52			=for apidoc av_extend
    53			
    54			Pre-extend an array.  The C<key> is the index to which the array should be
    55			extended.
    56			
    57			=cut
    58			*/
    59			
    60			void
    61			Perl_av_extend(pTHX_ AV *av, I32 key)
    62	     4460176    {
    63	     4460176        MAGIC *mg;
    64	     4460176        if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
    65	         123    	dSP;
    66	         123    	ENTER;
    67	         123    	SAVETMPS;
    68	         123    	PUSHSTACKi(PERLSI_MAGIC);
    69	         123    	PUSHMARK(SP);
    70	         123    	EXTEND(SP,2);
    71	         123    	PUSHs(SvTIED_obj((SV*)av, mg));
    72	         123    	PUSHs(sv_2mortal(newSViv(key+1)));
    73	         123            PUTBACK;
    74	         123    	call_method("EXTEND", G_SCALAR|G_DISCARD);
    75	         123    	POPSTACK;
    76	         123    	FREETMPS;
    77	         123    	LEAVE;
    78	         123    	return;
    79			    }
    80	     4460053        if (key > AvMAX(av)) {
    81	     3481376    	SV** ary;
    82	     3481376    	I32 tmp;
    83	     3481376    	I32 newmax;
    84			
    85	     3481376    	if (AvALLOC(av) != AvARRAY(av)) {
    86	        8082    	    ary = AvALLOC(av) + AvFILLp(av) + 1;
    87	        8082    	    tmp = AvARRAY(av) - AvALLOC(av);
    88	        8082    	    Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*);
    89	        8082    	    AvMAX(av) += tmp;
    90	        8082    	    SvPV_set(av, (char*)AvALLOC(av));
    91	        8082    	    if (AvREAL(av)) {
    92	       46366    		while (tmp)
    93	       38284    		    ary[--tmp] = &PL_sv_undef;
    94				    }
    95				    
    96	        8082    	    if (key > AvMAX(av) - 10) {
    97	        7752    		newmax = key + AvMAX(av);
    98	        7752    		goto resize;
    99				    }
   100				}
   101				else {
   102			#ifdef PERL_MALLOC_WRAP
   103				    static const char oom_array_extend[] =
   104	     3473294    	      "Out of memory during array extend"; /* Duplicated in pp_hot.c */
   105			#endif
   106			
   107	     3473294    	    if (AvALLOC(av)) {
   108			#if !defined(STRANGE_MALLOC) && !defined(MYMALLOC)
   109	      873733    		MEM_SIZE bytes;
   110	      873733    		IV itmp;
   111			#endif
   112			
   113			#ifdef MYMALLOC
   114					newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1;
   115			
   116					if (key <= newmax) 
   117					    goto resized;
   118			#endif 
   119	      873733    		newmax = key + AvMAX(av) / 5;
   120				      resize:
   121	      881485    		MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend);
   122			#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
   123					Renew(AvALLOC(av),newmax+1, SV*);
   124			#else
   125	      881485    		bytes = (newmax + 1) * sizeof(SV*);
   126			#define MALLOC_OVERHEAD 16
   127	      881485    		itmp = MALLOC_OVERHEAD;
   128	     3222859    		while ((MEM_SIZE)(itmp - MALLOC_OVERHEAD) < bytes)
   129	     2341374    		    itmp += itmp;
   130	      881485    		itmp -= MALLOC_OVERHEAD;
   131	      881485    		itmp /= sizeof(SV*);
   132	      881485    		assert(itmp > newmax);
   133	      881485    		newmax = itmp - 1;
   134	      881485    		assert(newmax >= AvMAX(av));
   135	      881485    		New(2,ary, newmax+1, SV*);
   136	      881485    		Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
   137	      881485    		if (AvMAX(av) > 64)
   138	       10729    		    offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*));
   139					else
   140	      870756    		    Safefree(AvALLOC(av));
   141	      881485    		AvALLOC(av) = ary;
   142			#endif
   143			#ifdef MYMALLOC
   144				      resized:
   145			#endif
   146	      881485    		ary = AvALLOC(av) + AvMAX(av) + 1;
   147	      881485    		tmp = newmax - AvMAX(av);
   148	      881485    		if (av == PL_curstack) {	/* Oops, grew stack (via av_store()?) */
   149	        1207    		    PL_stack_sp = AvALLOC(av) + (PL_stack_sp - PL_stack_base);
   150	        1207    		    PL_stack_base = AvALLOC(av);
   151	        1207    		    PL_stack_max = PL_stack_base + newmax;
   152					}
   153				    }
   154				    else {
   155	     2599561    		newmax = key < 3 ? 3 : key;
   156	     2599561    		MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend);
   157	     2599560    		New(2,AvALLOC(av), newmax+1, SV*);
   158	     2599560    		ary = AvALLOC(av) + 1;
   159	     2599560    		tmp = newmax;
   160	     2599560    		AvALLOC(av)[0] = &PL_sv_undef;	/* For the stacks */
   161				    }
   162	     3481045    	    if (AvREAL(av)) {
   163	    25347561    		while (tmp)
   164	    22402603    		    ary[--tmp] = &PL_sv_undef;
   165				    }
   166				    
   167	     3481045    	    SvPV_set(av, (char*)AvALLOC(av));
   168	     3481045    	    AvMAX(av) = newmax;
   169				}
   170			    }
   171			}
   172			
   173			/*
   174			=for apidoc av_fetch
   175			
   176			Returns the SV at the specified index in the array.  The C<key> is the
   177			index.  If C<lval> is set then the fetch will be part of a store.  Check
   178			that the return value is non-null before dereferencing it to a C<SV*>.
   179			
   180			See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
   181			more information on how to use this function on tied arrays. 
   182			
   183			=cut
   184			*/
   185			
   186			SV**
   187			Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
   188	    22091294    {
   189	    22091294        SV *sv;
   190			
   191	    22091294        if (!av)
   192	      ######    	return 0;
   193			
   194	    22091294        if (SvRMAGICAL(av)) {
   195	     1237353            const MAGIC * const tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
   196	     1237353            if (tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata)) {
   197	        3773                U32 adjust_index = 1;
   198			
   199	        3773                if (tied_magic && key < 0) {
   200			                /* Handle negative array indices 20020222 MJD */
   201	          10                    SV **negative_indices_glob = 
   202			                    hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, 
   203			                                                     tied_magic))), 
   204	          10                                 NEGATIVE_INDICES_VAR, 16, 0);
   205			
   206	          10                    if (negative_indices_glob
   207	      ######                        && SvTRUE(GvSV(*negative_indices_glob)))
   208	          10                        adjust_index = 0;
   209			            }
   210			
   211	        3773                if (key < 0 && adjust_index) {
   212	      ######                    key += AvFILL(av) + 1;
   213	      ######                    if (key < 0)
   214	      ######                        return 0;
   215			            }
   216			
   217	        3773                sv = sv_newmortal();
   218	        3773    	    sv_upgrade(sv, SVt_PVLV);
   219	        3773    	    mg_copy((SV*)av, sv, 0, key);
   220	        3773    	    LvTYPE(sv) = 't';
   221	        3773    	    LvTARG(sv) = sv; /* fake (SV**) */
   222	        3773    	    return &(LvTARG(sv));
   223			        }
   224			    }
   225			
   226	    22087521        if (key < 0) {
   227	      822389    	key += AvFILL(av) + 1;
   228	      822389    	if (key < 0)
   229	       18016    	    return 0;
   230			    }
   231			
   232	    22069505        if (key > AvFILLp(av)) {
   233	     5274714    	if (!lval)
   234	       58669    	    return 0;
   235	     5216045    	sv = NEWSV(5,0);
   236	     5216045    	return av_store(av,key,sv);
   237			    }
   238	    16794791        if (AvARRAY(av)[key] == &PL_sv_undef) {
   239			    emptyness:
   240	       79114    	if (lval) {
   241	       78303    	    sv = NEWSV(6,0);
   242	       78303    	    return av_store(av,key,sv);
   243				}
   244	         811    	return 0;
   245			    }
   246	    16715686        else if (AvREIFY(av)
   247				     && (!AvARRAY(av)[key]	/* eg. @_ could have freed elts */
   248					 || SvTYPE(AvARRAY(av)[key]) == SVTYPEMASK)) {
   249	           9    	AvARRAY(av)[key] = &PL_sv_undef;	/* 1/2 reify */
   250	           9    	goto emptyness;
   251			    }
   252	    16715677        return &AvARRAY(av)[key];
   253			}
   254			
   255			/*
   256			=for apidoc av_store
   257			
   258			Stores an SV in an array.  The array index is specified as C<key>.  The
   259			return value will be NULL if the operation failed or if the value did not
   260			need to be actually stored within the array (as in the case of tied
   261			arrays). Otherwise it can be dereferenced to get the original C<SV*>.  Note
   262			that the caller is responsible for suitably incrementing the reference
   263			count of C<val> before the call, and decrementing it if the function
   264			returned NULL.
   265			
   266			See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
   267			more information on how to use this function on tied arrays.
   268			
   269			=cut
   270			*/
   271			
   272			SV**
   273			Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
   274	    14689558    {
   275	    14689558        SV** ary;
   276			
   277	    14689558        if (!av)
   278	      ######    	return 0;
   279	    14689558        if (!val)
   280	     1009386    	val = &PL_sv_undef;
   281			
   282	    14689558        if (SvRMAGICAL(av)) {
   283	      243722            const MAGIC * const tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
   284	      243722            if (tied_magic) {
   285			            /* Handle negative array indices 20020222 MJD */
   286	         528                if (key < 0) {
   287	      ######                    unsigned adjust_index = 1;
   288	      ######                    SV **negative_indices_glob = 
   289			                    hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, 
   290			                                                     tied_magic))), 
   291	      ######                                 NEGATIVE_INDICES_VAR, 16, 0);
   292	      ######                    if (negative_indices_glob
   293	      ######                        && SvTRUE(GvSV(*negative_indices_glob)))
   294	      ######                        adjust_index = 0;
   295	      ######                    if (adjust_index) {
   296	      ######                        key += AvFILL(av) + 1;
   297	      ######                        if (key < 0)
   298	      ######                            return 0;
   299			                }
   300			            }
   301	         528    	    if (val != &PL_sv_undef) {
   302	         528    		mg_copy((SV*)av, val, 0, key);
   303				    }
   304	         528    	    return 0;
   305			        }
   306			    }
   307			
   308			
   309	    14689030        if (key < 0) {
   310	      ######    	key += AvFILL(av) + 1;
   311	      ######    	if (key < 0)
   312	      ######    	    return 0;
   313			    }
   314			
   315	    14689030        if (SvREADONLY(av) && key >= AvFILL(av))
   316	      ######    	Perl_croak(aTHX_ PL_no_modify);
   317			
   318	    14689030        if (!AvREAL(av) && AvREIFY(av))
   319	       11924    	av_reify(av);
   320	    14689030        if (key > AvMAX(av))
   321	     2540875    	av_extend(av,key);
   322	    14689029        ary = AvARRAY(av);
   323	    14689029        if (AvFILLp(av) < key) {
   324	    13517319    	if (!AvREAL(av)) {
   325	     1125037    	    if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
   326	      ######    		PL_stack_sp = PL_stack_base + key;	/* XPUSH in disguise */
   327	     1125037    	    do
   328	     1125037    		ary[++AvFILLp(av)] = &PL_sv_undef;
   329				    while (AvFILLp(av) < key);
   330				}
   331	    13517319    	AvFILLp(av) = key;
   332			    }
   333	     1171710        else if (AvREAL(av))
   334	     1171710    	SvREFCNT_dec(ary[key]);
   335	    14689029        ary[key] = val;
   336	    14689029        if (SvSMAGICAL(av)) {
   337	       14782    	if (val != &PL_sv_undef) {
   338	       14782    	    MAGIC* mg = SvMAGIC(av);
   339	       14782    	    sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
   340				}
   341	       14782    	mg_set((SV*)av);
   342			    }
   343	    14689029        return &ary[key];
   344			}
   345			
   346			/*
   347			=for apidoc newAV
   348			
   349			Creates a new AV.  The reference count is set to 1.
   350			
   351			=cut
   352			*/
   353			
   354			AV *
   355			Perl_newAV(pTHX)
   356	     2866498    {
   357	     2866498        register AV *av;
   358			
   359	     2866498        av = (AV*)NEWSV(3,0);
   360	     2866498        sv_upgrade((SV *)av, SVt_PVAV);
   361			    /* sv_upgrade does AvREAL_only()  */
   362	     2866498        AvALLOC(av) = 0;
   363	     2866498        SvPV_set(av, (char*)0);
   364	     2866498        AvMAX(av) = AvFILLp(av) = -1;
   365	     2866498        return av;
   366			}
   367			
   368			/*
   369			=for apidoc av_make
   370			
   371			Creates a new AV and populates it with a list of SVs.  The SVs are copied
   372			into the array, so they may be freed after the call to av_make.  The new AV
   373			will have a reference count of 1.
   374			
   375			=cut
   376			*/
   377			
   378			AV *
   379			Perl_av_make(pTHX_ register I32 size, register SV **strp)
   380	     1199280    {
   381	     1199280        register AV *av;
   382			
   383	     1199280        av = (AV*)NEWSV(8,0);
   384	     1199280        sv_upgrade((SV *) av,SVt_PVAV);
   385			    /* sv_upgrade does AvREAL_only()  */
   386	     1199280        if (size) {		/* "defined" was returning undef for size==0 anyway. */
   387	     1154734            register SV** ary;
   388	     1154734            register I32 i;
   389	     1154734    	New(4,ary,size,SV*);
   390	     1154734    	AvALLOC(av) = ary;
   391	     1154734    	SvPV_set(av, (char*)ary);
   392	     1154734    	AvFILLp(av) = size - 1;
   393	     1154734    	AvMAX(av) = size - 1;
   394	     5434476    	for (i = 0; i < size; i++) {
   395	     4279742    	    assert (*strp);
   396	     4279742    	    ary[i] = NEWSV(7,0);
   397	     4279742    	    sv_setsv(ary[i], *strp);
   398	     4279742    	    strp++;
   399				}
   400			    }
   401	     1199280        return av;
   402			}
   403			
   404			AV *
   405			Perl_av_fake(pTHX_ register I32 size, register SV **strp)
   406	      ######    {
   407	      ######        register AV *av;
   408	      ######        register SV** ary;
   409			
   410	      ######        av = (AV*)NEWSV(9,0);
   411	      ######        sv_upgrade((SV *)av, SVt_PVAV);
   412	      ######        New(4,ary,size+1,SV*);
   413	      ######        AvALLOC(av) = ary;
   414	      ######        Copy(strp,ary,size,SV*);
   415	      ######        AvREIFY_only(av);
   416	      ######        SvPV_set(av, (char*)ary);
   417	      ######        AvFILLp(av) = size - 1;
   418	      ######        AvMAX(av) = size - 1;
   419	      ######        while (size--) {
   420	      ######    	assert (*strp);
   421	      ######    	SvTEMP_off(*strp);
   422	      ######    	strp++;
   423			    }
   424	      ######        return av;
   425			}
   426			
   427			/*
   428			=for apidoc av_clear
   429			
   430			Clears an array, making it empty.  Does not free the memory used by the
   431			array itself.
   432			
   433			=cut
   434			*/
   435			
   436			void
   437			Perl_av_clear(pTHX_ register AV *av)
   438	     2270433    {
   439	     2270433        register I32 key;
   440			
   441			#ifdef DEBUGGING
   442	     2270433        if (SvREFCNT(av) == 0 && ckWARN_d(WARN_DEBUGGING)) {
   443	      ######    	Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array");
   444			    }
   445			#endif
   446	     2270433        if (!av)
   447	      ######    	return;
   448			
   449	     2270433        if (SvREADONLY(av))
   450	           2    	Perl_croak(aTHX_ PL_no_modify);
   451			
   452			    /* Give any tie a chance to cleanup first */
   453	     2270431        if (SvRMAGICAL(av))
   454	       23538    	mg_clear((SV*)av); 
   455			
   456	     2270431        if (AvMAX(av) < 0)
   457	      443712    	return;
   458			
   459	     1826719        if (AvREAL(av)) {
   460	     1816780            SV** ary = AvARRAY(av);
   461	     1816780    	key = AvFILLp(av) + 1;
   462	     4669833    	while (key) {
   463	     2853053    	    SV * sv = ary[--key];
   464				    /* undef the slot before freeing the value, because a
   465				     * destructor might try to modify this arrray */
   466	     2853053    	    ary[key] = &PL_sv_undef;
   467	     2853053    	    SvREFCNT_dec(sv);
   468				}
   469			    }
   470	     1826719        if ((key = AvARRAY(av) - AvALLOC(av))) {
   471	       25294    	AvMAX(av) += key;
   472	       25294    	SvPV_set(av, (char*)AvALLOC(av));
   473			    }
   474	     1826719        AvFILLp(av) = -1;
   475			
   476			}
   477			
   478			/*
   479			=for apidoc av_undef
   480			
   481			Undefines the array.  Frees the memory used by the array itself.
   482			
   483			=cut
   484			*/
   485			
   486			void
   487			Perl_av_undef(pTHX_ register AV *av)
   488	     4083372    {
   489	     4083372        if (!av)
   490	      ######    	return;
   491			
   492			    /* Give any tie a chance to cleanup first */
   493	     4083372        if (SvTIED_mg((SV*)av, PERL_MAGIC_tied)) 
   494	      ######    	av_fill(av, -1);   /* mg_clear() ? */
   495			
   496	     4083372        if (AvREAL(av)) {
   497	     3111524    	register I32 key = AvFILLp(av) + 1;
   498	    21700511    	while (key)
   499	    18588987    	    SvREFCNT_dec(AvARRAY(av)[--key]);
   500			    }
   501	     4083372        Safefree(AvALLOC(av));
   502	     4083372        AvALLOC(av) = 0;
   503	     4083372        SvPV_set(av, (char*)0);
   504	     4083372        AvMAX(av) = AvFILLp(av) = -1;
   505			    /* It's in magic - it must already be gone.  */
   506	     4083372        assert (!AvARYLEN(av));
   507			}
   508			
   509			/*
   510			=for apidoc av_push
   511			
   512			Pushes an SV onto the end of the array.  The array will grow automatically
   513			to accommodate the addition.
   514			
   515			=cut
   516			*/
   517			
   518			void
   519			Perl_av_push(pTHX_ register AV *av, SV *val)
   520	     1710536    {             
   521			    dVAR;
   522	     1710536        MAGIC *mg;
   523	     1710536        if (!av)
   524	      ######    	return;
   525	     1710536        if (SvREADONLY(av))
   526	      ######    	Perl_croak(aTHX_ PL_no_modify);
   527			
   528	     1710536        if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
   529	      ######    	dSP;
   530	      ######    	PUSHSTACKi(PERLSI_MAGIC);
   531	      ######    	PUSHMARK(SP);
   532	      ######    	EXTEND(SP,2);
   533	      ######    	PUSHs(SvTIED_obj((SV*)av, mg));
   534	      ######    	PUSHs(val);
   535	      ######    	PUTBACK;
   536	      ######    	ENTER;
   537	      ######    	call_method("PUSH", G_SCALAR|G_DISCARD);
   538	      ######    	LEAVE;
   539	      ######    	POPSTACK;
   540	      ######    	return;
   541			    }
   542	     1710536        av_store(av,AvFILLp(av)+1,val);
   543			}
   544			
   545			/*
   546			=for apidoc av_pop
   547			
   548			Pops an SV off the end of the array.  Returns C<&PL_sv_undef> if the array
   549			is empty.
   550			
   551			=cut
   552			*/
   553			
   554			SV *
   555			Perl_av_pop(pTHX_ register AV *av)
   556	       68683    {
   557			    dVAR;
   558	       68683        SV *retval;
   559	       68683        MAGIC* mg;
   560			
   561	       68683        if (!av)
   562	      ######          return &PL_sv_undef;
   563	       68683        if (SvREADONLY(av))
   564	      ######    	Perl_croak(aTHX_ PL_no_modify);
   565	       68683        if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
   566	           9    	dSP;    
   567	           9    	PUSHSTACKi(PERLSI_MAGIC);
   568	           9    	PUSHMARK(SP);
   569	           9    	XPUSHs(SvTIED_obj((SV*)av, mg));
   570	           9    	PUTBACK;
   571	           9    	ENTER;
   572	           9    	if (call_method("POP", G_SCALAR)) {
   573	           9    	    retval = newSVsv(*PL_stack_sp--);    
   574				} else {    
   575	      ######    	    retval = &PL_sv_undef;
   576				}
   577	           9    	LEAVE;
   578	           9    	POPSTACK;
   579	           9    	return retval;
   580			    }
   581	       68674        if (AvFILL(av) < 0)
   582	        1291    	return &PL_sv_undef;
   583	       67383        retval = AvARRAY(av)[AvFILLp(av)];
   584	       67383        AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
   585	       67383        if (SvSMAGICAL(av))
   586	      ######    	mg_set((SV*)av);
   587	       67383        return retval;
   588			}
   589			
   590			/*
   591			=for apidoc av_unshift
   592			
   593			Unshift the given number of C<undef> values onto the beginning of the
   594			array.  The array will grow automatically to accommodate the addition.  You
   595			must then use C<av_store> to assign values to these new elements.
   596			
   597			=cut
   598			*/
   599			
   600			void
   601			Perl_av_unshift(pTHX_ register AV *av, register I32 num)
   602	       52910    {
   603			    dVAR;
   604	       52910        register I32 i;
   605	       52910        MAGIC* mg;
   606			
   607	       52910        if (!av)
   608	      ######    	return;
   609	       52910        if (SvREADONLY(av))
   610	      ######    	Perl_croak(aTHX_ PL_no_modify);
   611			
   612	       52910        if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
   613	      ######    	dSP;
   614	      ######    	PUSHSTACKi(PERLSI_MAGIC);
   615	      ######    	PUSHMARK(SP);
   616	      ######    	EXTEND(SP,1+num);
   617	      ######    	PUSHs(SvTIED_obj((SV*)av, mg));
   618	      ######    	while (num-- > 0) {
   619	      ######    	    PUSHs(&PL_sv_undef);
   620				}
   621	      ######    	PUTBACK;
   622	      ######    	ENTER;
   623	      ######    	call_method("UNSHIFT", G_SCALAR|G_DISCARD);
   624	      ######    	LEAVE;
   625	      ######    	POPSTACK;
   626	      ######    	return;
   627			    }
   628			
   629	       52910        if (num <= 0)
   630	          62          return;
   631	       52848        if (!AvREAL(av) && AvREIFY(av))
   632	        1073    	av_reify(av);
   633	       52848        i = AvARRAY(av) - AvALLOC(av);
   634	       52848        if (i) {
   635	       19547    	if (i > num)
   636	       11929    	    i = num;
   637	       19547    	num -= i;
   638			    
   639	       19547    	AvMAX(av) += i;
   640	       19547    	AvFILLp(av) += i;
   641	       19547    	SvPV_set(av, (char*)(AvARRAY(av) - i));
   642			    }
   643	       52848        if (num) {
   644	       33472    	register SV **ary;
   645	       33472    	I32 slide;
   646	       33472    	i = AvFILLp(av);
   647				/* Create extra elements */
   648	       33472    	slide = i > 0 ? i : 0;
   649	       33472    	num += slide;
   650	       33472    	av_extend(av, i + num);
   651	       33472    	AvFILLp(av) += num;
   652	       33472    	ary = AvARRAY(av);
   653	       33472    	Move(ary, ary + num, i + 1, SV*);
   654	       96019    	do {
   655	       96019    	    ary[--num] = &PL_sv_undef;
   656	       96019    	} while (num);
   657				/* Make extra elements into a buffer */
   658	       33472    	AvMAX(av) -= slide;
   659	       33472    	AvFILLp(av) -= slide;
   660	       33472    	SvPV_set(av, (char*)(AvARRAY(av) + slide));
   661			    }
   662			}
   663			
   664			/*
   665			=for apidoc av_shift
   666			
   667			Shifts an SV off the beginning of the array.
   668			
   669			=cut
   670			*/
   671			
   672			SV *
   673			Perl_av_shift(pTHX_ register AV *av)
   674	    16087131    {
   675			    dVAR;
   676	    16087131        SV *retval;
   677	    16087131        MAGIC* mg;
   678			
   679	    16087131        if (!av)
   680	      ######    	return &PL_sv_undef;
   681	    16087131        if (SvREADONLY(av))
   682	      ######    	Perl_croak(aTHX_ PL_no_modify);
   683	    16087131        if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
   684	           9    	dSP;
   685	           9    	PUSHSTACKi(PERLSI_MAGIC);
   686	           9    	PUSHMARK(SP);
   687	           9    	XPUSHs(SvTIED_obj((SV*)av, mg));
   688	           9    	PUTBACK;
   689	           9    	ENTER;
   690	           9    	if (call_method("SHIFT", G_SCALAR)) {
   691	           9    	    retval = newSVsv(*PL_stack_sp--);            
   692				} else {    
   693	      ######    	    retval = &PL_sv_undef;
   694				}     
   695	           9    	LEAVE;
   696	           9    	POPSTACK;
   697	           9    	return retval;
   698			    }
   699	    16087122        if (AvFILL(av) < 0)
   700	      189257          return &PL_sv_undef;
   701	    15897865        retval = *AvARRAY(av);
   702	    15897865        if (AvREAL(av))
   703	      151422    	*AvARRAY(av) = &PL_sv_undef;
   704	    15897865        SvPV_set(av, (char*)(AvARRAY(av) + 1));
   705	    15897865        AvMAX(av)--;
   706	    15897865        AvFILLp(av)--;
   707	    15897865        if (SvSMAGICAL(av))
   708	      ######    	mg_set((SV*)av);
   709	    15897865        return retval;
   710			}
   711			
   712			/*
   713			=for apidoc av_len
   714			
   715			Returns the highest index in the array.  Returns -1 if the array is
   716			empty.
   717			
   718			=cut
   719			*/
   720			
   721			I32
   722			Perl_av_len(pTHX_ const register AV *av)
   723	      844748    {
   724	      844748        return AvFILL(av);
   725			}
   726			
   727			/*
   728			=for apidoc av_fill
   729			
   730			Ensure than an array has a given number of elements, equivalent to
   731			Perl's C<$#array = $fill;>.
   732			
   733			=cut
   734			*/
   735			void
   736			Perl_av_fill(pTHX_ register AV *av, I32 fill)
   737	       15849    {
   738			    dVAR;
   739	       15849        MAGIC *mg;
   740	       15849        if (!av)
   741	      ######    	Perl_croak(aTHX_ "panic: null array");
   742	       15849        if (fill < 0)
   743	          46    	fill = -1;
   744	       15849        if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
   745	          20    	dSP;            
   746	          20    	ENTER;
   747	          20    	SAVETMPS;
   748	          20    	PUSHSTACKi(PERLSI_MAGIC);
   749	          20    	PUSHMARK(SP);
   750	          20    	EXTEND(SP,2);
   751	          20    	PUSHs(SvTIED_obj((SV*)av, mg));
   752	          20    	PUSHs(sv_2mortal(newSViv(fill+1)));
   753	          20    	PUTBACK;
   754	          20    	call_method("STORESIZE", G_SCALAR|G_DISCARD);
   755	          20    	POPSTACK;
   756	          20    	FREETMPS;
   757	          20    	LEAVE;
   758	          20    	return;
   759			    }
   760	       15829        if (fill <= AvMAX(av)) {
   761	        8626    	I32 key = AvFILLp(av);
   762	        8626    	SV** ary = AvARRAY(av);
   763			
   764	        8626    	if (AvREAL(av)) {
   765	        9975    	    while (key > fill) {
   766	        1349    		SvREFCNT_dec(ary[key]);
   767	        1349    		ary[key--] = &PL_sv_undef;
   768				    }
   769				}
   770				else {
   771	      ######    	    while (key < fill)
   772	      ######    		ary[++key] = &PL_sv_undef;
   773				}
   774				    
   775	        8626    	AvFILLp(av) = fill;
   776	        8626    	if (SvSMAGICAL(av))
   777	           1    	    mg_set((SV*)av);
   778			    }
   779			    else
   780	        7203    	(void)av_store(av,fill,&PL_sv_undef);
   781			}
   782			
   783			/*
   784			=for apidoc av_delete
   785			
   786			Deletes the element indexed by C<key> from the array.  Returns the
   787			deleted element. If C<flags> equals C<G_DISCARD>, the element is freed
   788			and null is returned.
   789			
   790			=cut
   791			*/
   792			SV *
   793			Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
   794	          33    {
   795	          33        SV *sv;
   796			
   797	          33        if (!av)
   798	      ######    	return Nullsv;
   799	          33        if (SvREADONLY(av))
   800	      ######    	Perl_croak(aTHX_ PL_no_modify);
   801			
   802	          33        if (SvRMAGICAL(av)) {
   803	          18            const MAGIC * const tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
   804	          18            if ((tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata))) {
   805			            /* Handle negative array indices 20020222 MJD */
   806	          14                SV **svp;
   807	          14                if (key < 0) {
   808	           2                    unsigned adjust_index = 1;
   809	           2                    if (tied_magic) {
   810	           2                        SV **negative_indices_glob = 
   811			                        hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, 
   812			                                                         tied_magic))), 
   813	           2                                     NEGATIVE_INDICES_VAR, 16, 0);
   814	           2                        if (negative_indices_glob
   815	      ######                            && SvTRUE(GvSV(*negative_indices_glob)))
   816	           2                            adjust_index = 0;
   817			                }
   818	           2                    if (adjust_index) {
   819	      ######                        key += AvFILL(av) + 1;
   820	      ######                        if (key < 0)
   821	      ######                            return Nullsv;
   822			                }
   823			            }
   824	          14                svp = av_fetch(av, key, TRUE);
   825	          14                if (svp) {
   826	          14                    sv = *svp;
   827	          14                    mg_clear(sv);
   828	          14                    if (mg_find(sv, PERL_MAGIC_tiedelem)) {
   829	          14                        sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */
   830	          14                        return sv;
   831			                }
   832	      ######                    return Nullsv;     
   833			            }
   834			        }
   835			    }
   836			
   837	          19        if (key < 0) {
   838	      ######    	key += AvFILL(av) + 1;
   839	      ######    	if (key < 0)
   840	      ######    	    return Nullsv;
   841			    }
   842			
   843	          19        if (key > AvFILLp(av))
   844	           3    	return Nullsv;
   845			    else {
   846	          16    	if (!AvREAL(av) && AvREIFY(av))
   847	           1    	    av_reify(av);
   848	          16    	sv = AvARRAY(av)[key];
   849	          16    	if (key == AvFILLp(av)) {
   850	           7    	    AvARRAY(av)[key] = &PL_sv_undef;
   851	          17    	    do {
   852	          17    		AvFILLp(av)--;
   853	          17    	    } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef);
   854				}
   855				else
   856	           9    	    AvARRAY(av)[key] = &PL_sv_undef;
   857	          16    	if (SvSMAGICAL(av))
   858	      ######    	    mg_set((SV*)av);
   859			    }
   860	          16        if (flags & G_DISCARD) {
   861	           6    	SvREFCNT_dec(sv);
   862	           6    	sv = Nullsv;
   863			    }
   864	          10        else if (AvREAL(av))
   865	          10    	sv = sv_2mortal(sv);
   866	          16        return sv;
   867			}
   868			
   869			/*
   870			=for apidoc av_exists
   871			
   872			Returns true if the element indexed by C<key> has been initialized.
   873			
   874			This relies on the fact that uninitialized array elements are set to
   875			C<&PL_sv_undef>.
   876			
   877			=cut
   878			*/
   879			bool
   880			Perl_av_exists(pTHX_ AV *av, I32 key)
   881	         124    {
   882	         124        if (!av)
   883	      ######    	return FALSE;
   884			
   885			
   886	         124        if (SvRMAGICAL(av)) {
   887	         109            const MAGIC * const tied_magic = mg_find((SV*)av, PERL_MAGIC_tied);
   888	         109            if (tied_magic || mg_find((SV*)av, PERL_MAGIC_regdata)) {
   889	          22                SV *sv = sv_newmortal();
   890	          22                MAGIC *mg;
   891			            /* Handle negative array indices 20020222 MJD */
   892	          22                if (key < 0) {
   893	           8                    unsigned adjust_index = 1;
   894	           8                    if (tied_magic) {
   895	           8                        SV **negative_indices_glob = 
   896			                        hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, 
   897			                                                         tied_magic))), 
   898	           8                                     NEGATIVE_INDICES_VAR, 16, 0);
   899	           8                        if (negative_indices_glob
   900	      ######                            && SvTRUE(GvSV(*negative_indices_glob)))
   901	           4                            adjust_index = 0;
   902			                }
   903	           8                    if (adjust_index) {
   904	           4                        key += AvFILL(av) + 1;
   905	           4                        if (key < 0)
   906	           1                            return FALSE;
   907			                }
   908			            }
   909			
   910	          21                mg_copy((SV*)av, sv, 0, key);
   911	          21                mg = mg_find(sv, PERL_MAGIC_tiedelem);
   912	          21                if (mg) {
   913	          21                    magic_existspack(sv, mg);
   914	          21                    return (bool)SvTRUE(sv);
   915			            }
   916			
   917			        }
   918			    }
   919			
   920	         102        if (key < 0) {
   921	      ######    	key += AvFILL(av) + 1;
   922	      ######    	if (key < 0)
   923	      ######    	    return FALSE;
   924			    }
   925			
   926	         102        if (key <= AvFILLp(av) && AvARRAY(av)[key] != &PL_sv_undef
   927				&& AvARRAY(av)[key])
   928			    {
   929	          88    	return TRUE;
   930			    }
   931			    else
   932	          14    	return FALSE;
   933			}
   934			
   935			SV **
   936	     4468046    Perl_av_arylen_p(pTHX_ AV *av) {
   937			    dVAR;
   938	     4468046        MAGIC *mg = mg_find((SV*)av, PERL_MAGIC_arylen_p);
   939			
   940	     4468046        if (!mg) {
   941	     4098018    	mg = sv_magicext((SV*)av, 0, PERL_MAGIC_arylen_p, &PL_vtbl_arylen_p,
   942						 0, 0);
   943			
   944	     4098018    	if (!mg) {
   945	      ######    	    Perl_die(aTHX_ "panic: av_arylen_p");
   946				}
   947				/* sv_magicext won't set this for us because we pass in a NULL obj  */
   948	     4098018    	mg->mg_flags |= MGf_REFCOUNTED;
   949			    }
   950	     4468046        return &(mg->mg_obj);
   951			}
   952			
   953			/*
   954			 * Local variables:
   955			 * c-indentation-style: bsd
   956			 * c-basic-offset: 4
   957			 * indent-tabs-mode: t
   958			 * End:
   959			 *
   960			 * ex: set ts=8 sts=4 sw=4 noet:
   961			 */