av.c

   1 /*    av.c
   2  *
   3  *    Copyright (c) 1991-1997, 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 #include "perl.h"
  17
  18 void
  19 av_reify(AV *av)
  20 {
  21     I32 key;
  22     SV* sv;
  23
  24     if (AvREAL(av))
  25         return;
  26     key = AvMAX(av) + 1;
  27     while (key > AvFILL(av) + 1)
  28         AvARRAY(av)[--key] = &sv_undef;
  29     while (key) {
  30         sv = AvARRAY(av)[--key];
  31         assert(sv);
  32         if (sv != &sv_undef) {
  33             dTHR;
  34             (void)SvREFCNT_inc(sv);
  35         }
  36     }
  37     key = AvARRAY(av) - AvALLOC(av);
  38     while (key)
  39         AvALLOC(av)[--key] = &sv_undef;
  40     AvREAL_on(av);
  41 }
  42
  43 void
  44 av_extend(AV *av, I32 key)
  45 {
  46     dTHR;                       /* only necessary if we have to extend stack */
  47     if (key > AvMAX(av)) {
  48         SV** ary;
  49         I32 tmp;
  50         I32 newmax;
  51
  52         if (AvALLOC(av) != AvARRAY(av)) {
  53             ary = AvALLOC(av) + AvFILL(av) + 1;
  54             tmp = AvARRAY(av) - AvALLOC(av);
  55             Move(AvARRAY(av), AvALLOC(av), AvFILL(av)+1, SV*);
  56             AvMAX(av) += tmp;
  57             SvPVX(av) = (char*)AvALLOC(av);
  58             if (AvREAL(av)) {
  59                 while (tmp)
  60                     ary[--tmp] = &sv_undef;
  61             }
  62
  63             if (key > AvMAX(av) - 10) {
  64                 newmax = key + AvMAX(av);
  65                 goto resize;
  66             }
  67         }
  68         else {
  69             if (AvALLOC(av)) {
  70 #ifndef STRANGE_MALLOC
  71                 U32 bytes;
  72 #endif
  73
  74                 newmax = key + AvMAX(av) / 5;
  75               resize:
  76 #ifdef STRANGE_MALLOC
  77                 Renew(AvALLOC(av),newmax+1, SV*);
  78 #else
  79                 bytes = (newmax + 1) * sizeof(SV*);
  80 #define MALLOC_OVERHEAD 16
  81                 tmp = MALLOC_OVERHEAD;
  82                 while (tmp - MALLOC_OVERHEAD < bytes)
  83                     tmp += tmp;
  84                 tmp -= MALLOC_OVERHEAD;
  85                 tmp /= sizeof(SV*);
  86                 assert(tmp > newmax);
  87                 newmax = tmp - 1;
  88                 New(2,ary, newmax+1, SV*);
  89                 Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
  90                 if (AvMAX(av) > 64)
  91                     offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*));
  92                 else
  93                     Safefree(AvALLOC(av));
  94                 AvALLOC(av) = ary;
  95 #endif
  96                 ary = AvALLOC(av) + AvMAX(av) + 1;
  97                 tmp = newmax - AvMAX(av);
  98                 if (av == curstack) {   /* Oops, grew stack (via av_store()?) */
  99                     stack_sp = AvALLOC(av) + (stack_sp - stack_base);
 100                     stack_base = AvALLOC(av);
 101                     stack_max = stack_base + newmax;
 102                 }
 103             }
 104             else {
 105                 newmax = key < 4 ? 4 : key;
 106                 New(2,AvALLOC(av), newmax+1, SV*);
 107                 ary = AvALLOC(av) + 1;
 108                 tmp = newmax;
 109                 AvALLOC(av)[0] = &sv_undef;     /* For the stacks */
 110             }
 111             if (AvREAL(av)) {
 112                 while (tmp)
 113                     ary[--tmp] = &sv_undef;
 114             }
 115
 116             SvPVX(av) = (char*)AvALLOC(av);
 117             AvMAX(av) = newmax;
 118         }
 119     }
 120 }
 121
 122 SV**
 123 av_fetch(register AV *av, I32 key, I32 lval)
 124 {
 125     SV *sv;
 126
 127     if (!av)
 128         return 0;
 129
 130     if (SvRMAGICAL(av)) {
 131         if (mg_find((SV*)av,'P')) {
 132             dTHR;
 133             sv = sv_newmortal();
 134             mg_copy((SV*)av, sv, 0, key);
 135             Sv = sv;
 136             return &Sv;
 137         }
 138     }
 139
 140     if (key < 0) {
 141         key += AvFILL(av) + 1;
 142         if (key < 0)
 143             return 0;
 144     }
 145     else if (key > AvFILL(av)) {
 146         if (!lval)
 147             return 0;
 148         if (AvREALISH(av))
 149             sv = NEWSV(5,0);
 150         else
 151             sv = sv_newmortal();
 152         return av_store(av,key,sv);
 153     }
 154     if (AvARRAY(av)[key] == &sv_undef) {
 155     emptyness:
 156         if (lval) {
 157             sv = NEWSV(6,0);
 158             return av_store(av,key,sv);
 159         }
 160         return 0;
 161     }
 162     else if (AvREIFY(av)
 163              && (!AvARRAY(av)[key]      /* eg. @_ could have freed elts */
 164                  || SvTYPE(AvARRAY(av)[key]) == SVTYPEMASK)) {
 165         AvARRAY(av)[key] = &sv_undef;   /* 1/2 reify */
 166         goto emptyness;
 167     }
 168     return &AvARRAY(av)[key];
 169 }
 170
 171 SV**
 172 av_store(register AV *av, I32 key, SV *val)
 173 {
 174     SV** ary;
 175
 176     if (!av)
 177         return 0;
 178     if (!val)
 179         val = &sv_undef;
 180
 181     if (SvRMAGICAL(av)) {
 182         if (mg_find((SV*)av,'P')) {
 183             if (val != &sv_undef)
 184                 mg_copy((SV*)av, val, 0, key);
 185             return 0;
 186         }
 187     }
 188
 189     if (key < 0) {
 190         key += AvFILL(av) + 1;
 191         if (key < 0)
 192             return 0;
 193     }
 194     if (SvREADONLY(av) && key >= AvFILL(av))
 195         croak(no_modify);
 196     if (!AvREAL(av) && AvREIFY(av))
 197         av_reify(av);
 198     if (key > AvMAX(av))
 199         av_extend(av,key);
 200     ary = AvARRAY(av);
 201     if (AvFILL(av) < key) {
 202         if (!AvREAL(av)) {
 203             dTHR;
 204             if (av == curstack && key > stack_sp - stack_base)
 205                 stack_sp = stack_base + key;    /* XPUSH in disguise */
 206             do
 207                 ary[++AvFILL(av)] = &sv_undef;
 208             while (AvFILL(av) < key);
 209         }
 210         AvFILL(av) = key;
 211     }
 212     else if (AvREAL(av))
 213         SvREFCNT_dec(ary[key]);
 214     ary[key] = val;
 215     if (SvSMAGICAL(av)) {
 216         if (val != &sv_undef) {
 217             MAGIC* mg = SvMAGIC(av);
 218             sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
 219         }
 220         mg_set((SV*)av);
 221     }
 222     return &ary[key];
 223 }
 224
 225 AV *
 226 newAV(void)
 227 {
 228     register AV *av;
 229
 230     av = (AV*)NEWSV(3,0);
 231     sv_upgrade((SV *)av, SVt_PVAV);
 232     AvREAL_on(av);
 233     AvALLOC(av) = 0;
 234     SvPVX(av) = 0;
 235     AvMAX(av) = AvFILL(av) = -1;
 236     return av;
 237 }
 238
 239 AV *
 240 av_make(register I32 size, register SV **strp)
 241 {
 242     register AV *av;
 243     register I32 i;
 244     register SV** ary;
 245
 246     av = (AV*)NEWSV(8,0);
 247     sv_upgrade((SV *) av,SVt_PVAV);
 248     AvFLAGS(av) = AVf_REAL;
 249     if (size) {         /* `defined' was returning undef for size==0 anyway. */
 250         New(4,ary,size,SV*);
 251         AvALLOC(av) = ary;
 252         SvPVX(av) = (char*)ary;
 253         AvFILL(av) = size - 1;
 254         AvMAX(av) = size - 1;
 255         for (i = 0; i < size; i++) {
 256             assert (*strp);
 257             ary[i] = NEWSV(7,0);
 258             sv_setsv(ary[i], *strp);
 259             strp++;
 260         }
 261     }
 262     return av;
 263 }
 264
 265 AV *
 266 av_fake(register I32 size, register SV **strp)
 267 {
 268     register AV *av;
 269     register SV** ary;
 270
 271     av = (AV*)NEWSV(9,0);
 272     sv_upgrade((SV *)av, SVt_PVAV);
 273     New(4,ary,size+1,SV*);
 274     AvALLOC(av) = ary;
 275     Copy(strp,ary,size,SV*);
 276     AvFLAGS(av) = AVf_REIFY;
 277     SvPVX(av) = (char*)ary;
 278     AvFILL(av) = size - 1;
 279     AvMAX(av) = size - 1;
 280     while (size--) {
 281         assert (*strp);
 282         SvTEMP_off(*strp);
 283         strp++;
 284     }
 285     return av;
 286 }
 287
 288 void
 289 av_clear(register AV *av)
 290 {
 291     register I32 key;
 292     SV** ary;
 293
 294 #ifdef DEBUGGING
 295     if (SvREFCNT(av) <= 0) {
 296         warn("Attempt to clear deleted array");
 297     }
 298 #endif
 299     if (!av || AvMAX(av) < 0)
 300         return;
 301     /*SUPPRESS 560*/
 302
 303     if (AvREAL(av)) {
 304         ary = AvARRAY(av);
 305         key = AvFILL(av) + 1;
 306         while (key) {
 307             SvREFCNT_dec(ary[--key]);
 308             ary[key] = &sv_undef;
 309         }
 310     }
 311     if (key = AvARRAY(av) - AvALLOC(av)) {
 312         AvMAX(av) += key;
 313         SvPVX(av) = (char*)AvALLOC(av);
 314     }
 315     AvFILL(av) = -1;
 316
 317     if (SvRMAGICAL(av))
 318         mg_clear((SV*)av);
 319 }
 320
 321 void
 322 av_undef(register AV *av)
 323 {
 324     register I32 key;
 325
 326     if (!av)
 327         return;
 328     /*SUPPRESS 560*/
 329     if (AvREAL(av)) {
 330         key = AvFILL(av) + 1;
 331         while (key)
 332             SvREFCNT_dec(AvARRAY(av)[--key]);
 333     }
 334     Safefree(AvALLOC(av));
 335     AvALLOC(av) = 0;
 336     SvPVX(av) = 0;
 337     AvMAX(av) = AvFILL(av) = -1;
 338     if (AvARYLEN(av)) {
 339         SvREFCNT_dec(AvARYLEN(av));
 340         AvARYLEN(av) = 0;
 341     }
 342 }
 343
 344 void
 345 av_push(register AV *av, SV *val)
 346 {
 347     if (!av)
 348         return;
 349     av_store(av,AvFILL(av)+1,val);
 350 }
 351
 352 SV *
 353 av_pop(register AV *av)
 354 {
 355     SV *retval;
 356
 357     if (!av || AvFILL(av) < 0)
 358         return &sv_undef;
 359     if (SvREADONLY(av))
 360         croak(no_modify);
 361     retval = AvARRAY(av)[AvFILL(av)];
 362     AvARRAY(av)[AvFILL(av)--] = &sv_undef;
 363     if (SvSMAGICAL(av))
 364         mg_set((SV*)av);
 365     return retval;
 366 }
 367
 368 void
 369 av_unshift(register AV *av, register I32 num)
 370 {
 371     register I32 i;
 372     register SV **sstr,**dstr;
 373
 374     if (!av || num <= 0)
 375         return;
 376     if (SvREADONLY(av))
 377         croak(no_modify);
 378     if (!AvREAL(av) && AvREIFY(av))
 379         av_reify(av);
 380     i = AvARRAY(av) - AvALLOC(av);
 381     if (i) {
 382         if (i > num)
 383             i = num;
 384         num -= i;
 385
 386         AvMAX(av) += i;
 387         AvFILL(av) += i;
 388         SvPVX(av) = (char*)(AvARRAY(av) - i);
 389     }
 390     if (num) {
 391         av_extend(av,AvFILL(av)+num);
 392         AvFILL(av) += num;
 393         dstr = AvARRAY(av) + AvFILL(av);
 394         sstr = dstr - num;
 395 #ifdef BUGGY_MSC5
 396  # pragma loop_opt(off) /* don't loop-optimize the following code */
 397 #endif /* BUGGY_MSC5 */
 398         for (i = AvFILL(av) - num; i >= 0; --i) {
 399             *dstr-- = *sstr--;
 400 #ifdef BUGGY_MSC5
 401  # pragma loop_opt()    /* loop-optimization back to command-line setting */
 402 #endif /* BUGGY_MSC5 */
 403         }
 404         while (num)
 405             AvARRAY(av)[--num] = &sv_undef;
 406     }
 407 }
 408
 409 SV *
 410 av_shift(register AV *av)
 411 {
 412     SV *retval;
 413
 414     if (!av || AvFILL(av) < 0)
 415         return &sv_undef;
 416     if (SvREADONLY(av))
 417         croak(no_modify);
 418     retval = *AvARRAY(av);
 419     if (AvREAL(av))
 420         *AvARRAY(av) = &sv_undef;
 421     SvPVX(av) = (char*)(AvARRAY(av) + 1);
 422     AvMAX(av)--;
 423     AvFILL(av)--;
 424     if (SvSMAGICAL(av))
 425         mg_set((SV*)av);
 426     return retval;
 427 }
 428
 429 I32
 430 av_len(register AV *av)
 431 {
 432     return AvFILL(av);
 433 }
 434
 435 void
 436 av_fill(register AV *av, I32 fill)
 437 {
 438     if (!av)
 439         croak("panic: null array");
 440     if (fill < 0)
 441         fill = -1;
 442     if (fill <= AvMAX(av)) {
 443         I32 key = AvFILL(av);
 444         SV** ary = AvARRAY(av);
 445
 446         if (AvREAL(av)) {
 447             while (key > fill) {
 448                 SvREFCNT_dec(ary[key]);
 449                 ary[key--] = &sv_undef;
 450             }
 451         }
 452         else {
 453             while (key < fill)
 454                 ary[++key] = &sv_undef;
 455         }
 456
 457         AvFILL(av) = fill;
 458         if (SvSMAGICAL(av))
 459             mg_set((SV*)av);
 460     }
 461     else
 462         (void)av_store(av,fill,&sv_undef);
 463 }
 464
 465 SV**
 466 avhv_fetch(AV *av, char *key, U32 klen, I32 lval)
 467 {
 468     SV **keys, **indsvp;
 469     I32 ind;
 470
 471     keys = av_fetch(av, 0, FALSE);
 472     if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV)
 473         croak("Can't coerce array into hash");
 474     indsvp = hv_fetch((HV*)SvRV(*keys), key, klen, FALSE);
 475     if (indsvp) {
 476         ind = SvIV(*indsvp);
 477         if (ind < 1)
 478             croak("Bad index while coercing array into hash");
 479     } else {
 480         if (!lval)
 481             return 0;
 482
 483         ind = AvFILL(av) + 1;
 484         hv_store((HV*)SvRV(*keys), key, klen, newSViv(ind), 0);
 485     }
 486     return av_fetch(av, ind, lval);
 487 }
 488
 489 SV**
 490 avhv_fetch_ent(AV *av, SV *keysv, I32 lval, U32 hash)
 491 {
 492     SV **keys, **indsvp;
 493     HE *he;
 494     I32 ind;
 495
 496     keys = av_fetch(av, 0, FALSE);
 497     if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV)
 498         croak("Can't coerce array into hash");
 499     he = hv_fetch_ent((HV*)SvRV(*keys), keysv, FALSE, hash);
 500     if (he) {
 501         ind = SvIV(HeVAL(he));
 502         if (ind < 1)
 503             croak("Bad index while coercing array into hash");
 504     } else {
 505         if (!lval)
 506             return 0;
 507
 508         ind = AvFILL(av) + 1;
 509         hv_store_ent((HV*)SvRV(*keys), keysv, newSViv(ind), 0);
 510     }
 511     return av_fetch(av, ind, lval);
 512 }
 513
 514 SV**
 515 avhv_store(AV *av, char *key, U32 klen, SV *val, U32 hash)
 516 {
 517     SV **keys, **indsvp;
 518     I32 ind;
 519
 520     keys = av_fetch(av, 0, FALSE);
 521     if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV)
 522         croak("Can't coerce array into hash");
 523     indsvp = hv_fetch((HV*)SvRV(*keys), key, klen, FALSE);
 524     if (indsvp) {
 525         ind = SvIV(*indsvp);
 526         if (ind < 1)
 527             croak("Bad index while coercing array into hash");
 528     } else {
 529         ind = AvFILL(av) + 1;
 530         hv_store((HV*)SvRV(*keys), key, klen, newSViv(ind), hash);
 531     }
 532     return av_store(av, ind, val);
 533 }
 534
 535 SV**
 536 avhv_store_ent(AV *av, SV *keysv, SV *val, U32 hash)
 537 {
 538     SV **keys;
 539     HE *he;
 540     I32 ind;
 541
 542     keys = av_fetch(av, 0, FALSE);
 543     if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV)
 544         croak("Can't coerce array into hash");
 545     he = hv_fetch_ent((HV*)SvRV(*keys), keysv, FALSE, hash);
 546     if (he) {
 547         ind = SvIV(HeVAL(he));
 548         if (ind < 1)
 549             croak("Bad index while coercing array into hash");
 550     } else {
 551         ind = AvFILL(av) + 1;
 552         hv_store_ent((HV*)SvRV(*keys), keysv, newSViv(ind), hash);
 553     }
 554     return av_store(av, ind, val);
 555 }
 556
 557 bool
 558 avhv_exists_ent(AV *av, SV *keysv, U32 hash)
 559 {
 560     SV **keys;
 561
 562     keys = av_fetch(av, 0, FALSE);
 563     if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV)
 564         croak("Can't coerce array into hash");
 565     return hv_exists_ent((HV*)SvRV(*keys), keysv, hash);
 566 }
 567
 568 bool
 569 avhv_exists(AV *av, char *key, U32 klen)
 570 {
 571     SV **keys;
 572
 573     keys = av_fetch(av, 0, FALSE);
 574     if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV)
 575         croak("Can't coerce array into hash");
 576     return hv_exists((HV*)SvRV(*keys), key, klen);
 577 }
 578
 579 /* avhv_delete leaks. Caller can re-index and compress if so desired. */
 580 SV *
 581 avhv_delete(AV *av, char *key, U32 klen, I32 flags)
 582 {
 583     SV **keys;
 584     SV *sv;
 585     SV **svp;
 586     I32 ind;
 587
 588     keys = av_fetch(av, 0, FALSE);
 589     if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV)
 590         croak("Can't coerce array into hash");
 591     sv = hv_delete((HV*)SvRV(*keys), key, klen, 0);
 592     if (!sv)
 593         return Nullsv;
 594     ind = SvIV(sv);
 595     if (ind < 1)
 596         croak("Bad index while coercing array into hash");
 597     svp = av_fetch(av, ind, FALSE);
 598     if (!svp)
 599         return Nullsv;
 600     if (flags & G_DISCARD) {
 601         sv = Nullsv;
 602         SvREFCNT_dec(*svp);
 603     } else {
 604         sv = sv_2mortal(*svp);
 605     }
 606     *svp = &sv_undef;
 607     return sv;
 608 }
 609
 610 /* avhv_delete_ent leaks. Caller can re-index and compress if so desired. */
 611 SV *
 612 avhv_delete_ent(AV *av, SV *keysv, I32 flags, U32 hash)
 613 {
 614     SV **keys;
 615     SV *sv;
 616     SV **svp;
 617     I32 ind;
 618
 619     keys = av_fetch(av, 0, FALSE);
 620     if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV)
 621         croak("Can't coerce array into hash");
 622     sv = hv_delete_ent((HV*)SvRV(*keys), keysv, 0, hash);
 623     if (!sv)
 624         return Nullsv;
 625     ind = SvIV(sv);
 626     if (ind < 1)
 627         croak("Bad index while coercing array into hash");
 628     svp = av_fetch(av, ind, FALSE);
 629     if (!svp)
 630         return Nullsv;
 631     if (flags & G_DISCARD) {
 632         sv = Nullsv;
 633         SvREFCNT_dec(*svp);
 634     } else {
 635         sv = sv_2mortal(*svp);
 636     }
 637     *svp = &sv_undef;
 638     return sv;
 639 }
 640
 641 I32
 642 avhv_iterinit(AV *av)
 643 {
 644     SV **keys;
 645
 646     keys = av_fetch(av, 0, FALSE);
 647     if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV)
 648         croak("Can't coerce array into hash");
 649     return hv_iterinit((HV*)SvRV(*keys));
 650 }
 651
 652 HE *
 653 avhv_iternext(AV *av)
 654 {
 655     SV **keys;
 656
 657     keys = av_fetch(av, 0, FALSE);
 658     if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV)
 659         croak("Can't coerce array into hash");
 660     return hv_iternext((HV*)SvRV(*keys));
 661 }
 662
 663 SV *
 664 avhv_iterval(AV *av, register HE *entry)
 665 {
 666     SV **keys;
 667     SV *sv;
 668     I32 ind;
 669
 670     keys = av_fetch(av, 0, FALSE);
 671     if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV)
 672         croak("Can't coerce array into hash");
 673     sv = hv_iterval((HV*)SvRV(*keys), entry);
 674     ind = SvIV(sv);
 675     if (ind < 1)
 676         croak("Bad index while coercing array into hash");
 677     return *av_fetch(av, ind, TRUE);
 678 }
 679
 680 SV *
 681 avhv_iternextsv(AV *av, char **key, I32 *retlen)
 682 {
 683     SV **keys;
 684     HE *he;
 685     SV *sv;
 686     I32 ind;
 687
 688     keys = av_fetch(av, 0, FALSE);
 689     if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV)
 690         croak("Can't coerce array into hash");
 691     if ( (he = hv_iternext((HV*)SvRV(*keys))) == NULL)
 692         return NULL;
 693     *key = hv_iterkey(he, retlen);
 694     sv = hv_iterval((HV*)SvRV(*keys), he);
 695     ind = SvIV(sv);
 696     if (ind < 1)
 697         croak("Bad index while coercing array into hash");
 698     return *av_fetch(av, ind, TRUE);
 699 }