home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / av.c next >
C/C++ Source or Header  |  2000-03-04  |  18KB  |  892 lines
  1. /*    av.c
  2.  *
  3.  *    Copyright (c) 1991-2000, Larry Wall
  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.  *
  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
  13.  */
  14.  
  15. #include "EXTERN.h"
  16. #define PERL_IN_AV_C
  17. #include "perl.h"
  18.  
  19. void
  20. Perl_av_reify(pTHX_ AV *av)
  21. {
  22.     I32 key;
  23.     SV* sv;
  24.  
  25.     if (AvREAL(av))
  26.     return;
  27. #ifdef DEBUGGING
  28.     if (SvTIED_mg((SV*)av, 'P') && ckWARN_d(WARN_DEBUGGING))
  29.     Perl_warner(aTHX_ WARN_DEBUGGING, "av_reify called on tied array");
  30. #endif
  31.     key = AvMAX(av) + 1;
  32.     while (key > AvFILLp(av) + 1)
  33.     AvARRAY(av)[--key] = &PL_sv_undef;
  34.     while (key) {
  35.     sv = AvARRAY(av)[--key];
  36.     assert(sv);
  37.     if (sv != &PL_sv_undef) {
  38.         dTHR;
  39.         (void)SvREFCNT_inc(sv);
  40.     }
  41.     }
  42.     key = AvARRAY(av) - AvALLOC(av);
  43.     while (key)
  44.     AvALLOC(av)[--key] = &PL_sv_undef;
  45.     AvREIFY_off(av);
  46.     AvREAL_on(av);
  47. }
  48.  
  49. /*
  50. =for apidoc av_extend
  51.  
  52. Pre-extend an array.  The C<key> is the index to which the array should be
  53. extended.
  54.  
  55. =cut
  56. */
  57.  
  58. void
  59. Perl_av_extend(pTHX_ AV *av, I32 key)
  60. {
  61.     dTHR;            /* only necessary if we have to extend stack */
  62.     MAGIC *mg;
  63.     if ((mg = SvTIED_mg((SV*)av, 'P'))) {
  64.     dSP;
  65.     ENTER;
  66.     SAVETMPS;
  67.     PUSHSTACKi(PERLSI_MAGIC);
  68.     PUSHMARK(SP);
  69.     EXTEND(SP,2);
  70.     PUSHs(SvTIED_obj((SV*)av, mg));
  71.     PUSHs(sv_2mortal(newSViv(key+1)));
  72.         PUTBACK;
  73.     call_method("EXTEND", G_SCALAR|G_DISCARD);
  74.     POPSTACK;
  75.     FREETMPS;
  76.     LEAVE;
  77.     return;
  78.     }
  79.     if (key > AvMAX(av)) {
  80.     SV** ary;
  81.     I32 tmp;
  82.     I32 newmax;
  83.  
  84.     if (AvALLOC(av) != AvARRAY(av)) {
  85.         ary = AvALLOC(av) + AvFILLp(av) + 1;
  86.         tmp = AvARRAY(av) - AvALLOC(av);
  87.         Move(AvARRAY(av), AvALLOC(av), AvFILLp(av)+1, SV*);
  88.         AvMAX(av) += tmp;
  89.         SvPVX(av) = (char*)AvALLOC(av);
  90.         if (AvREAL(av)) {
  91.         while (tmp)
  92.             ary[--tmp] = &PL_sv_undef;
  93.         }
  94.         
  95.         if (key > AvMAX(av) - 10) {
  96.         newmax = key + AvMAX(av);
  97.         goto resize;
  98.         }
  99.     }
  100.     else {
  101.         if (AvALLOC(av)) {
  102. #ifndef STRANGE_MALLOC
  103.         MEM_SIZE bytes;
  104.         IV itmp;
  105. #endif
  106.  
  107. #if defined(MYMALLOC) && !defined(LEAKTEST)
  108.         newmax = malloced_size((void*)AvALLOC(av))/sizeof(SV*) - 1;
  109.  
  110.         if (key <= newmax) 
  111.             goto resized;
  112. #endif 
  113.         newmax = key + AvMAX(av) / 5;
  114.           resize:
  115. #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
  116.         Renew(AvALLOC(av),newmax+1, SV*);
  117. #else
  118.         bytes = (newmax + 1) * sizeof(SV*);
  119. #define MALLOC_OVERHEAD 16
  120.         itmp = MALLOC_OVERHEAD;
  121.         while (itmp - MALLOC_OVERHEAD < bytes)
  122.             itmp += itmp;
  123.         itmp -= MALLOC_OVERHEAD;
  124.         itmp /= sizeof(SV*);
  125.         assert(itmp > newmax);
  126.         newmax = itmp - 1;
  127.         assert(newmax >= AvMAX(av));
  128.         New(2,ary, newmax+1, SV*);
  129.         Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
  130.         if (AvMAX(av) > 64)
  131.             offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*));
  132.         else
  133.             Safefree(AvALLOC(av));
  134.         AvALLOC(av) = ary;
  135. #endif
  136.           resized:
  137.         ary = AvALLOC(av) + AvMAX(av) + 1;
  138.         tmp = newmax - AvMAX(av);
  139.         if (av == PL_curstack) {    /* Oops, grew stack (via av_store()?) */
  140.             PL_stack_sp = AvALLOC(av) + (PL_stack_sp - PL_stack_base);
  141.             PL_stack_base = AvALLOC(av);
  142.             PL_stack_max = PL_stack_base + newmax;
  143.         }
  144.         }
  145.         else {
  146.         newmax = key < 3 ? 3 : key;
  147.         New(2,AvALLOC(av), newmax+1, SV*);
  148.         ary = AvALLOC(av) + 1;
  149.         tmp = newmax;
  150.         AvALLOC(av)[0] = &PL_sv_undef;    /* For the stacks */
  151.         }
  152.         if (AvREAL(av)) {
  153.         while (tmp)
  154.             ary[--tmp] = &PL_sv_undef;
  155.         }
  156.         
  157.         SvPVX(av) = (char*)AvALLOC(av);
  158.         AvMAX(av) = newmax;
  159.     }
  160.     }
  161. }
  162.  
  163. /*
  164. =for apidoc av_fetch
  165.  
  166. Returns the SV at the specified index in the array.  The C<key> is the
  167. index.  If C<lval> is set then the fetch will be part of a store.  Check
  168. that the return value is non-null before dereferencing it to a C<SV*>.
  169.  
  170. See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
  171. more information on how to use this function on tied arrays. 
  172.  
  173. =cut
  174. */
  175.  
  176. SV**
  177. Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
  178. {
  179.     SV *sv;
  180.  
  181.     if (!av)
  182.     return 0;
  183.  
  184.     if (key < 0) {
  185.     key += AvFILL(av) + 1;
  186.     if (key < 0)
  187.         return 0;
  188.     }
  189.  
  190.     if (SvRMAGICAL(av)) {
  191.     if (mg_find((SV*)av,'P') || mg_find((SV*)av,'D')) {
  192.         dTHR;
  193.         sv = sv_newmortal();
  194.         mg_copy((SV*)av, sv, 0, key);
  195.         PL_av_fetch_sv = sv;
  196.         return &PL_av_fetch_sv;
  197.     }
  198.     }
  199.  
  200.     if (key > AvFILLp(av)) {
  201.     if (!lval)
  202.         return 0;
  203.     sv = NEWSV(5,0);
  204.     return av_store(av,key,sv);
  205.     }
  206.     if (AvARRAY(av)[key] == &PL_sv_undef) {
  207.     emptyness:
  208.     if (lval) {
  209.         sv = NEWSV(6,0);
  210.         return av_store(av,key,sv);
  211.     }
  212.     return 0;
  213.     }
  214.     else if (AvREIFY(av)
  215.          && (!AvARRAY(av)[key]    /* eg. @_ could have freed elts */
  216.          || SvTYPE(AvARRAY(av)[key]) == SVTYPEMASK)) {
  217.     AvARRAY(av)[key] = &PL_sv_undef;    /* 1/2 reify */
  218.     goto emptyness;
  219.     }
  220.     return &AvARRAY(av)[key];
  221. }
  222.  
  223. /*
  224. =for apidoc av_store
  225.  
  226. Stores an SV in an array.  The array index is specified as C<key>.  The
  227. return value will be NULL if the operation failed or if the value did not
  228. need to be actually stored within the array (as in the case of tied
  229. arrays). Otherwise it can be dereferenced to get the original C<SV*>.  Note
  230. that the caller is responsible for suitably incrementing the reference
  231. count of C<val> before the call, and decrementing it if the function
  232. returned NULL.
  233.  
  234. See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
  235. more information on how to use this function on tied arrays.
  236.  
  237. =cut
  238. */
  239.  
  240. SV**
  241. Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
  242. {
  243.     SV** ary;
  244.  
  245.     if (!av)
  246.     return 0;
  247.     if (!val)
  248.     val = &PL_sv_undef;
  249.  
  250.     if (key < 0) {
  251.     key += AvFILL(av) + 1;
  252.     if (key < 0)
  253.         return 0;
  254.     }
  255.  
  256.     if (SvREADONLY(av) && key >= AvFILL(av))
  257.     Perl_croak(aTHX_ PL_no_modify);
  258.  
  259.     if (SvRMAGICAL(av)) {
  260.     if (mg_find((SV*)av,'P')) {
  261.         if (val != &PL_sv_undef) {
  262.         mg_copy((SV*)av, val, 0, key);
  263.         }
  264.         return 0;
  265.     }
  266.     }
  267.  
  268.     if (!AvREAL(av) && AvREIFY(av))
  269.     av_reify(av);
  270.     if (key > AvMAX(av))
  271.     av_extend(av,key);
  272.     ary = AvARRAY(av);
  273.     if (AvFILLp(av) < key) {
  274.     if (!AvREAL(av)) {
  275.         dTHR;
  276.         if (av == PL_curstack && key > PL_stack_sp - PL_stack_base)
  277.         PL_stack_sp = PL_stack_base + key;    /* XPUSH in disguise */
  278.         do
  279.         ary[++AvFILLp(av)] = &PL_sv_undef;
  280.         while (AvFILLp(av) < key);
  281.     }
  282.     AvFILLp(av) = key;
  283.     }
  284.     else if (AvREAL(av))
  285.     SvREFCNT_dec(ary[key]);
  286.     ary[key] = val;
  287.     if (SvSMAGICAL(av)) {
  288.     if (val != &PL_sv_undef) {
  289.         MAGIC* mg = SvMAGIC(av);
  290.         sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
  291.     }
  292.     mg_set((SV*)av);
  293.     }
  294.     return &ary[key];
  295. }
  296.  
  297. /*
  298. =for apidoc newAV
  299.  
  300. Creates a new AV.  The reference count is set to 1.
  301.  
  302. =cut
  303. */
  304.  
  305. AV *
  306. Perl_newAV(pTHX)
  307. {
  308.     register AV *av;
  309.  
  310.     av = (AV*)NEWSV(3,0);
  311.     sv_upgrade((SV *)av, SVt_PVAV);
  312.     AvREAL_on(av);
  313.     AvALLOC(av) = 0;
  314.     SvPVX(av) = 0;
  315.     AvMAX(av) = AvFILLp(av) = -1;
  316.     return av;
  317. }
  318.  
  319. /*
  320. =for apidoc av_make
  321.  
  322. Creates a new AV and populates it with a list of SVs.  The SVs are copied
  323. into the array, so they may be freed after the call to av_make.  The new AV
  324. will have a reference count of 1.
  325.  
  326. =cut
  327. */
  328.  
  329. AV *
  330. Perl_av_make(pTHX_ register I32 size, register SV **strp)
  331. {
  332.     register AV *av;
  333.     register I32 i;
  334.     register SV** ary;
  335.  
  336.     av = (AV*)NEWSV(8,0);
  337.     sv_upgrade((SV *) av,SVt_PVAV);
  338.     AvFLAGS(av) = AVf_REAL;
  339.     if (size) {        /* `defined' was returning undef for size==0 anyway. */
  340.     New(4,ary,size,SV*);
  341.     AvALLOC(av) = ary;
  342.     SvPVX(av) = (char*)ary;
  343.     AvFILLp(av) = size - 1;
  344.     AvMAX(av) = size - 1;
  345.     for (i = 0; i < size; i++) {
  346.         assert (*strp);
  347.         ary[i] = NEWSV(7,0);
  348.         sv_setsv(ary[i], *strp);
  349.         strp++;
  350.     }
  351.     }
  352.     return av;
  353. }
  354.  
  355. AV *
  356. Perl_av_fake(pTHX_ register I32 size, register SV **strp)
  357. {
  358.     register AV *av;
  359.     register SV** ary;
  360.  
  361.     av = (AV*)NEWSV(9,0);
  362.     sv_upgrade((SV *)av, SVt_PVAV);
  363.     New(4,ary,size+1,SV*);
  364.     AvALLOC(av) = ary;
  365.     Copy(strp,ary,size,SV*);
  366.     AvFLAGS(av) = AVf_REIFY;
  367.     SvPVX(av) = (char*)ary;
  368.     AvFILLp(av) = size - 1;
  369.     AvMAX(av) = size - 1;
  370.     while (size--) {
  371.     assert (*strp);
  372.     SvTEMP_off(*strp);
  373.     strp++;
  374.     }
  375.     return av;
  376. }
  377.  
  378. /*
  379. =for apidoc av_clear
  380.  
  381. Clears an array, making it empty.  Does not free the memory used by the
  382. array itself.
  383.  
  384. =cut
  385. */
  386.  
  387. void
  388. Perl_av_clear(pTHX_ register AV *av)
  389. {
  390.     register I32 key;
  391.     SV** ary;
  392.  
  393. #ifdef DEBUGGING
  394.     if (SvREFCNT(av) == 0 && ckWARN_d(WARN_DEBUGGING)) {
  395.     Perl_warner(aTHX_ WARN_DEBUGGING, "Attempt to clear deleted array");
  396.     }
  397. #endif
  398.     if (!av)
  399.     return;
  400.     /*SUPPRESS 560*/
  401.  
  402.     if (SvREADONLY(av))
  403.     Perl_croak(aTHX_ PL_no_modify);
  404.  
  405.     /* Give any tie a chance to cleanup first */
  406.     if (SvRMAGICAL(av))
  407.     mg_clear((SV*)av); 
  408.  
  409.     if (AvMAX(av) < 0)
  410.     return;
  411.  
  412.     if (AvREAL(av)) {
  413.     ary = AvARRAY(av);
  414.     key = AvFILLp(av) + 1;
  415.     while (key) {
  416.         SvREFCNT_dec(ary[--key]);
  417.         ary[key] = &PL_sv_undef;
  418.     }
  419.     }
  420.     if ((key = AvARRAY(av) - AvALLOC(av))) {
  421.     AvMAX(av) += key;
  422.     SvPVX(av) = (char*)AvALLOC(av);
  423.     }
  424.     AvFILLp(av) = -1;
  425.  
  426. }
  427.  
  428. /*
  429. =for apidoc av_undef
  430.  
  431. Undefines the array.  Frees the memory used by the array itself.
  432.  
  433. =cut
  434. */
  435.  
  436. void
  437. Perl_av_undef(pTHX_ register AV *av)
  438. {
  439.     register I32 key;
  440.  
  441.     if (!av)
  442.     return;
  443.     /*SUPPRESS 560*/
  444.  
  445.     /* Give any tie a chance to cleanup first */
  446.     if (SvTIED_mg((SV*)av, 'P')) 
  447.     av_fill(av, -1);   /* mg_clear() ? */
  448.  
  449.     if (AvREAL(av)) {
  450.     key = AvFILLp(av) + 1;
  451.     while (key)
  452.         SvREFCNT_dec(AvARRAY(av)[--key]);
  453.     }
  454.     Safefree(AvALLOC(av));
  455.     AvALLOC(av) = 0;
  456.     SvPVX(av) = 0;
  457.     AvMAX(av) = AvFILLp(av) = -1;
  458.     if (AvARYLEN(av)) {
  459.     SvREFCNT_dec(AvARYLEN(av));
  460.     AvARYLEN(av) = 0;
  461.     }
  462. }
  463.  
  464. /*
  465. =for apidoc av_push
  466.  
  467. Pushes an SV onto the end of the array.  The array will grow automatically
  468. to accommodate the addition.
  469.  
  470. =cut
  471. */
  472.  
  473. void
  474. Perl_av_push(pTHX_ register AV *av, SV *val)
  475. {             
  476.     MAGIC *mg;
  477.     if (!av)
  478.     return;
  479.     if (SvREADONLY(av))
  480.     Perl_croak(aTHX_ PL_no_modify);
  481.  
  482.     if ((mg = SvTIED_mg((SV*)av, 'P'))) {
  483.     dSP;
  484.     PUSHSTACKi(PERLSI_MAGIC);
  485.     PUSHMARK(SP);
  486.     EXTEND(SP,2);
  487.     PUSHs(SvTIED_obj((SV*)av, mg));
  488.     PUSHs(val);
  489.     PUTBACK;
  490.     ENTER;
  491.     call_method("PUSH", G_SCALAR|G_DISCARD);
  492.     LEAVE;
  493.     POPSTACK;
  494.     return;
  495.     }
  496.     av_store(av,AvFILLp(av)+1,val);
  497. }
  498.  
  499. /*
  500. =for apidoc av_pop
  501.  
  502. Pops an SV off the end of the array.  Returns C<&PL_sv_undef> if the array
  503. is empty.
  504.  
  505. =cut
  506. */
  507.  
  508. SV *
  509. Perl_av_pop(pTHX_ register AV *av)
  510. {
  511.     SV *retval;
  512.     MAGIC* mg;
  513.  
  514.     if (!av || AvFILL(av) < 0)
  515.     return &PL_sv_undef;
  516.     if (SvREADONLY(av))
  517.     Perl_croak(aTHX_ PL_no_modify);
  518.     if ((mg = SvTIED_mg((SV*)av, 'P'))) {
  519.     dSP;    
  520.     PUSHSTACKi(PERLSI_MAGIC);
  521.     PUSHMARK(SP);
  522.     XPUSHs(SvTIED_obj((SV*)av, mg));
  523.     PUTBACK;
  524.     ENTER;
  525.     if (call_method("POP", G_SCALAR)) {
  526.         retval = newSVsv(*PL_stack_sp--);    
  527.     } else {    
  528.         retval = &PL_sv_undef;
  529.     }
  530.     LEAVE;
  531.     POPSTACK;
  532.     return retval;
  533.     }
  534.     retval = AvARRAY(av)[AvFILLp(av)];
  535.     AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
  536.     if (SvSMAGICAL(av))
  537.     mg_set((SV*)av);
  538.     return retval;
  539. }
  540.  
  541. /*
  542. =for apidoc av_unshift
  543.  
  544. Unshift the given number of C<undef> values onto the beginning of the
  545. array.  The array will grow automatically to accommodate the addition.  You
  546. must then use C<av_store> to assign values to these new elements.
  547.  
  548. =cut
  549. */
  550.  
  551. void
  552. Perl_av_unshift(pTHX_ register AV *av, register I32 num)
  553. {
  554.     register I32 i;
  555.     register SV **ary;
  556.     MAGIC* mg;
  557.  
  558.     if (!av || num <= 0)
  559.     return;
  560.     if (SvREADONLY(av))
  561.     Perl_croak(aTHX_ PL_no_modify);
  562.  
  563.     if ((mg = SvTIED_mg((SV*)av, 'P'))) {
  564.     dSP;
  565.     PUSHSTACKi(PERLSI_MAGIC);
  566.     PUSHMARK(SP);
  567.     EXTEND(SP,1+num);
  568.     PUSHs(SvTIED_obj((SV*)av, mg));
  569.     while (num-- > 0) {
  570.         PUSHs(&PL_sv_undef);
  571.     }
  572.     PUTBACK;
  573.     ENTER;
  574.     call_method("UNSHIFT", G_SCALAR|G_DISCARD);
  575.     LEAVE;
  576.     POPSTACK;
  577.     return;
  578.     }
  579.  
  580.     if (!AvREAL(av) && AvREIFY(av))
  581.     av_reify(av);
  582.     i = AvARRAY(av) - AvALLOC(av);
  583.     if (i) {
  584.     if (i > num)
  585.         i = num;
  586.     num -= i;
  587.     
  588.     AvMAX(av) += i;
  589.     AvFILLp(av) += i;
  590.     SvPVX(av) = (char*)(AvARRAY(av) - i);
  591.     }
  592.     if (num) {
  593.     i = AvFILLp(av);
  594.     av_extend(av, i + num);
  595.     AvFILLp(av) += num;
  596.     ary = AvARRAY(av);
  597.     Move(ary, ary + num, i + 1, SV*);
  598.     do {
  599.         ary[--num] = &PL_sv_undef;
  600.     } while (num);
  601.     }
  602. }
  603.  
  604. /*
  605. =for apidoc av_shift
  606.  
  607. Shifts an SV off the beginning of the array.
  608.  
  609. =cut
  610. */
  611.  
  612. SV *
  613. Perl_av_shift(pTHX_ register AV *av)
  614. {
  615.     SV *retval;
  616.     MAGIC* mg;
  617.  
  618.     if (!av || AvFILL(av) < 0)
  619.     return &PL_sv_undef;
  620.     if (SvREADONLY(av))
  621.     Perl_croak(aTHX_ PL_no_modify);
  622.     if ((mg = SvTIED_mg((SV*)av, 'P'))) {
  623.     dSP;
  624.     PUSHSTACKi(PERLSI_MAGIC);
  625.     PUSHMARK(SP);
  626.     XPUSHs(SvTIED_obj((SV*)av, mg));
  627.     PUTBACK;
  628.     ENTER;
  629.     if (call_method("SHIFT", G_SCALAR)) {
  630.         retval = newSVsv(*PL_stack_sp--);            
  631.     } else {    
  632.         retval = &PL_sv_undef;
  633.     }     
  634.     LEAVE;
  635.     POPSTACK;
  636.     return retval;
  637.     }
  638.     retval = *AvARRAY(av);
  639.     if (AvREAL(av))
  640.     *AvARRAY(av) = &PL_sv_undef;
  641.     SvPVX(av) = (char*)(AvARRAY(av) + 1);
  642.     AvMAX(av)--;
  643.     AvFILLp(av)--;
  644.     if (SvSMAGICAL(av))
  645.     mg_set((SV*)av);
  646.     return retval;
  647. }
  648.  
  649. /*
  650. =for apidoc av_len
  651.  
  652. Returns the highest index in the array.  Returns -1 if the array is
  653. empty.
  654.  
  655. =cut
  656. */
  657.  
  658. I32
  659. Perl_av_len(pTHX_ register AV *av)
  660. {
  661.     return AvFILL(av);
  662. }
  663.  
  664. void
  665. Perl_av_fill(pTHX_ register AV *av, I32 fill)
  666. {
  667.     MAGIC *mg;
  668.     if (!av)
  669.     Perl_croak(aTHX_ "panic: null array");
  670.     if (fill < 0)
  671.     fill = -1;
  672.     if ((mg = SvTIED_mg((SV*)av, 'P'))) {
  673.     dSP;            
  674.     ENTER;
  675.     SAVETMPS;
  676.     PUSHSTACKi(PERLSI_MAGIC);
  677.     PUSHMARK(SP);
  678.     EXTEND(SP,2);
  679.     PUSHs(SvTIED_obj((SV*)av, mg));
  680.     PUSHs(sv_2mortal(newSViv(fill+1)));
  681.     PUTBACK;
  682.     call_method("STORESIZE", G_SCALAR|G_DISCARD);
  683.     POPSTACK;
  684.     FREETMPS;
  685.     LEAVE;
  686.     return;
  687.     }
  688.     if (fill <= AvMAX(av)) {
  689.     I32 key = AvFILLp(av);
  690.     SV** ary = AvARRAY(av);
  691.  
  692.     if (AvREAL(av)) {
  693.         while (key > fill) {
  694.         SvREFCNT_dec(ary[key]);
  695.         ary[key--] = &PL_sv_undef;
  696.         }
  697.     }
  698.     else {
  699.         while (key < fill)
  700.         ary[++key] = &PL_sv_undef;
  701.     }
  702.         
  703.     AvFILLp(av) = fill;
  704.     if (SvSMAGICAL(av))
  705.         mg_set((SV*)av);
  706.     }
  707.     else
  708.     (void)av_store(av,fill,&PL_sv_undef);
  709. }
  710.  
  711. SV *
  712. Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
  713. {
  714.     SV *sv;
  715.  
  716.     if (!av)
  717.     return Nullsv;
  718.     if (SvREADONLY(av))
  719.     Perl_croak(aTHX_ PL_no_modify);
  720.     if (key < 0) {
  721.     key += AvFILL(av) + 1;
  722.     if (key < 0)
  723.         return Nullsv;
  724.     }
  725.     if (SvRMAGICAL(av)) {
  726.     SV **svp;
  727.     if ((mg_find((SV*)av,'P') || mg_find((SV*)av,'D'))
  728.         && (svp = av_fetch(av, key, TRUE)))
  729.     {
  730.         sv = *svp;
  731.         mg_clear(sv);
  732.         if (mg_find(sv, 'p')) {
  733.         sv_unmagic(sv, 'p');        /* No longer an element */
  734.         return sv;
  735.         }
  736.         return Nullsv;            /* element cannot be deleted */
  737.     }
  738.     }
  739.     if (key > AvFILLp(av))
  740.     return Nullsv;
  741.     else {
  742.     sv = AvARRAY(av)[key];
  743.     if (key == AvFILLp(av)) {
  744.         do {
  745.         AvFILLp(av)--;
  746.         } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef);
  747.     }
  748.     else
  749.         AvARRAY(av)[key] = &PL_sv_undef;
  750.     if (SvSMAGICAL(av))
  751.         mg_set((SV*)av);
  752.     }
  753.     if (flags & G_DISCARD) {
  754.     SvREFCNT_dec(sv);
  755.     sv = Nullsv;
  756.     }
  757.     return sv;
  758. }
  759.  
  760. /*
  761.  * This relies on the fact that uninitialized array elements
  762.  * are set to &PL_sv_undef.
  763.  */
  764.  
  765. bool
  766. Perl_av_exists(pTHX_ AV *av, I32 key)
  767. {
  768.     if (!av)
  769.     return FALSE;
  770.     if (key < 0) {
  771.     key += AvFILL(av) + 1;
  772.     if (key < 0)
  773.         return FALSE;
  774.     }
  775.     if (SvRMAGICAL(av)) {
  776.     if (mg_find((SV*)av,'P') || mg_find((SV*)av,'D')) {
  777.         SV *sv = sv_newmortal();
  778.         mg_copy((SV*)av, sv, 0, key);
  779.         magic_existspack(sv, mg_find(sv, 'p'));
  780.         return SvTRUE(sv);
  781.     }
  782.     }
  783.     if (key <= AvFILLp(av) && AvARRAY(av)[key] != &PL_sv_undef
  784.     && AvARRAY(av)[key])
  785.     {
  786.     return TRUE;
  787.     }
  788.     else
  789.     return FALSE;
  790. }
  791.  
  792. /* AVHV: Support for treating arrays as if they were hashes.  The
  793.  * first element of the array should be a hash reference that maps
  794.  * hash keys to array indices.
  795.  */
  796.  
  797. STATIC I32
  798. S_avhv_index_sv(pTHX_ SV* sv)
  799. {
  800.     I32 index = SvIV(sv);
  801.     if (index < 1)
  802.     Perl_croak(aTHX_ "Bad index while coercing array into hash");
  803.     return index;    
  804. }
  805.  
  806. STATIC I32
  807. S_avhv_index(pTHX_ AV *av, SV *keysv, U32 hash)
  808. {
  809.     HV *keys;
  810.     HE *he;
  811.     STRLEN n_a;
  812.  
  813.     keys = avhv_keys(av);
  814.     he = hv_fetch_ent(keys, keysv, FALSE, hash);
  815.     if (!he)
  816.         Perl_croak(aTHX_ "No such pseudo-hash field \"%s\"", SvPV(keysv,n_a));
  817.     return avhv_index_sv(HeVAL(he));
  818. }
  819.  
  820. HV*
  821. Perl_avhv_keys(pTHX_ AV *av)
  822. {
  823.     SV **keysp = av_fetch(av, 0, FALSE);
  824.     if (keysp) {
  825.     SV *sv = *keysp;
  826.     if (SvGMAGICAL(sv))
  827.         mg_get(sv);
  828.     if (SvROK(sv)) {
  829.         sv = SvRV(sv);
  830.         if (SvTYPE(sv) == SVt_PVHV)
  831.         return (HV*)sv;
  832.     }
  833.     }
  834.     Perl_croak(aTHX_ "Can't coerce array into hash");
  835.     return Nullhv;
  836. }
  837.  
  838. SV**
  839. Perl_avhv_store_ent(pTHX_ AV *av, SV *keysv, SV *val, U32 hash)
  840. {
  841.     return av_store(av, avhv_index(av, keysv, hash), val);
  842. }
  843.  
  844. SV**
  845. Perl_avhv_fetch_ent(pTHX_ AV *av, SV *keysv, I32 lval, U32 hash)
  846. {
  847.     return av_fetch(av, avhv_index(av, keysv, hash), lval);
  848. }
  849.  
  850. SV *
  851. Perl_avhv_delete_ent(pTHX_ AV *av, SV *keysv, I32 flags, U32 hash)
  852. {
  853.     HV *keys = avhv_keys(av);
  854.     HE *he;
  855.     
  856.     he = hv_fetch_ent(keys, keysv, FALSE, hash);
  857.     if (!he || !SvOK(HeVAL(he)))
  858.     return Nullsv;
  859.  
  860.     return av_delete(av, avhv_index_sv(HeVAL(he)), flags);
  861. }
  862.  
  863. /* Check for the existence of an element named by a given key.
  864.  *
  865.  */
  866. bool
  867. Perl_avhv_exists_ent(pTHX_ AV *av, SV *keysv, U32 hash)
  868. {
  869.     HV *keys = avhv_keys(av);
  870.     HE *he;
  871.     
  872.     he = hv_fetch_ent(keys, keysv, FALSE, hash);
  873.     if (!he || !SvOK(HeVAL(he)))
  874.     return FALSE;
  875.  
  876.     return av_exists(av, avhv_index_sv(HeVAL(he)));
  877. }
  878.  
  879. HE *
  880. Perl_avhv_iternext(pTHX_ AV *av)
  881. {
  882.     HV *keys = avhv_keys(av);
  883.     return hv_iternext(keys);
  884. }
  885.  
  886. SV *
  887. Perl_avhv_iterval(pTHX_ AV *av, register HE *entry)
  888. {
  889.     SV *sv = hv_iterval(avhv_keys(av), entry);
  890.     return *av_fetch(av, avhv_index_sv(sv), TRUE);
  891. }
  892.