sv.c

   1 /*    sv.c
   2  *
   3  *    Copyright (c) 1991-1994, 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  * "I wonder what the Entish is for 'yes' and 'no'," he thought.
  12  */
  13
  14 #include "EXTERN.h"
  15 #include "perl.h"
  16
  17 #ifdef OVR_DBL_DIG
  18 /* Use an overridden DBL_DIG */
  19 # ifdef DBL_DIG
  20 #  undef DBL_DIG
  21 # endif
  22 # define DBL_DIG OVR_DBL_DIG
  23 #else
  24 /* The following is all to get DBL_DIG, in order to pick a nice
  25    default value for printing floating point numbers in Gconvert.
  26    (see config.h)
  27 */
  28 #ifdef I_LIMITS
  29 #include <limits.h>
  30 #endif
  31 #ifdef I_FLOAT
  32 #include <float.h>
  33 #endif
  34 #ifndef HAS_DBL_DIG
  35 #define DBL_DIG 15   /* A guess that works lots of places */
  36 #endif
  37 #endif
  38
  39 #if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
  40 #  define FAST_SV_GETS
  41 #endif
  42
  43 static SV *more_sv _((void));
  44 static XPVIV *more_xiv _((void));
  45 static XPVNV *more_xnv _((void));
  46 static XPV *more_xpv _((void));
  47 static XRV *more_xrv _((void));
  48 static SV *new_sv _((void));
  49 static XPVIV *new_xiv _((void));
  50 static XPVNV *new_xnv _((void));
  51 static XPV *new_xpv _((void));
  52 static XRV *new_xrv _((void));
  53 static void del_xiv _((XPVIV* p));
  54 static void del_xnv _((XPVNV* p));
  55 static void del_xpv _((XPV* p));
  56 static void del_xrv _((XRV* p));
  57 static void sv_mortalgrow _((void));
  58
  59 static void sv_unglob _((SV* sv));
  60
  61 #ifdef PURIFY
  62
  63 #define new_SV() sv = (SV*)safemalloc(sizeof(SV))
  64 #define del_SV(p) free((char*)p)
  65
  66 void
  67 sv_add_arena(ptr, size, flags)
  68 char* ptr;
  69 U32 size;
  70 U32 flags;
  71 {
  72     if (!(flags & SVf_FAKE))
  73         free(ptr);
  74 }
  75
  76 #else
  77
  78 #define new_SV()                        \
  79     if (sv_root) {                      \
  80         sv = sv_root;                   \
  81         sv_root = (SV*)SvANY(sv);       \
  82         ++sv_count;                     \
  83     }                                   \
  84     else                                \
  85         sv = more_sv();
  86
  87 static SV*
  88 new_sv()
  89 {
  90     SV* sv;
  91     if (sv_root) {
  92         sv = sv_root;
  93         sv_root = (SV*)SvANY(sv);
  94         ++sv_count;
  95         return sv;
  96     }
  97     return more_sv();
  98 }
  99
 100 #ifdef DEBUGGING
 101 #define del_SV(p)                       \
 102     if (debug & 32768)                  \
 103         del_sv(p);                      \
 104     else {                              \
 105         SvANY(p) = (void *)sv_root;     \
 106         sv_root = p;                    \
 107         --sv_count;                     \
 108     }
 109
 110 static void
 111 del_sv(p)
 112 SV* p;
 113 {
 114     if (debug & 32768) {
 115         SV* sva;
 116         SV* sv;
 117         SV* svend;
 118         int ok = 0;
 119         for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
 120             sv = sva + 1;
 121             svend = &sva[SvREFCNT(sva)];
 122             if (p >= sv && p < svend)
 123                 ok = 1;
 124         }
 125         if (!ok) {
 126             warn("Attempt to free non-arena SV: 0x%lx", (unsigned long)p);
 127             return;
 128         }
 129     }
 130     SvANY(p) = (void *) sv_root;
 131     sv_root = p;
 132     --sv_count;
 133 }
 134 #else
 135 #define del_SV(p)                       \
 136     SvANY(p) = (void *)sv_root;         \
 137     sv_root = p;                        \
 138     --sv_count;
 139
 140 #endif
 141
 142 void
 143 sv_add_arena(ptr, size, flags)
 144 char* ptr;
 145 U32 size;
 146 U32 flags;
 147 {
 148     SV* sva = (SV*)ptr;
 149     register SV* sv;
 150     register SV* svend;
 151     Zero(sva, size, char);
 152
 153     /* The first SV in an arena isn't an SV. */
 154     SvANY(sva) = (void *) sv_arenaroot;         /* ptr to next arena */
 155     SvREFCNT(sva) = size / sizeof(SV);          /* number of SV slots */
 156     SvFLAGS(sva) = flags;                       /* FAKE if not to be freed */
 157
 158     sv_arenaroot = sva;
 159     sv_root = sva + 1;
 160
 161     svend = &sva[SvREFCNT(sva) - 1];
 162     sv = sva + 1;
 163     while (sv < svend) {
 164         SvANY(sv) = (void *)(SV*)(sv + 1);
 165         SvFLAGS(sv) = SVTYPEMASK;
 166         sv++;
 167     }
 168     SvANY(sv) = 0;
 169     SvFLAGS(sv) = SVTYPEMASK;
 170 }
 171
 172 static SV*
 173 more_sv()
 174 {
 175     if (nice_chunk) {
 176         sv_add_arena(nice_chunk, nice_chunk_size, 0);
 177         nice_chunk = Nullch;
 178     }
 179     else
 180         sv_add_arena(safemalloc(1008), 1008, 0);
 181     return new_sv();
 182 }
 183 #endif
 184
 185 void
 186 sv_report_used()
 187 {
 188     SV* sva;
 189     SV* sv;
 190     register SV* svend;
 191
 192     for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
 193         sv = sva + 1;
 194         svend = &sva[SvREFCNT(sva)];
 195         while (sv < svend) {
 196             if (SvTYPE(sv) != SVTYPEMASK) {
 197                 fprintf(stderr, "****\n");
 198                 sv_dump(sv);
 199             }
 200             ++sv;
 201         }
 202     }
 203 }
 204
 205 void
 206 sv_clean_objs()
 207 {
 208     SV* sva;
 209     register SV* sv;
 210     register SV* svend;
 211     SV* rv;
 212
 213 #ifndef DISABLE_DESTRUCTOR_KLUDGE
 214     register GV* gv;
 215     for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
 216         gv = sva + 1;
 217         svend = &sva[SvREFCNT(sva)];
 218         while (gv < svend) {
 219             if (SvTYPE(gv) == SVt_PVGV && (sv = GvSV(gv)) &&
 220                 SvROK(sv) && SvOBJECT(rv = SvRV(sv)))
 221             {
 222                 DEBUG_D((fprintf(stderr, "Cleaning object ref:\n "),
 223                          sv_dump(sv));)
 224                 SvROK_off(sv);
 225                 SvRV(sv) = 0;
 226                 SvREFCNT_dec(rv);
 227             }
 228             ++gv;
 229         }
 230     }
 231     if (!sv_objcount)
 232         return;
 233 #endif
 234     for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
 235         sv = sva + 1;
 236         svend = &sva[SvREFCNT(sva)];
 237         while (sv < svend) {
 238             if (SvROK(sv) && SvOBJECT(rv = SvRV(sv))) {
 239                 DEBUG_D((fprintf(stderr, "Cleaning object ref:\n "),
 240                          sv_dump(sv));)
 241                 SvROK_off(sv);
 242                 SvRV(sv) = 0;
 243                 SvREFCNT_dec(rv);
 244             }
 245             /* XXX Might want to check arrays, etc. */
 246             ++sv;
 247         }
 248     }
 249 }
 250
 251 void
 252 sv_clean_all()
 253 {
 254     SV* sva;
 255     register SV* sv;
 256     register SV* svend;
 257
 258     for (sva = sv_arenaroot; sva; sva = (SV*) SvANY(sva)) {
 259         sv = sva + 1;
 260         svend = &sva[SvREFCNT(sva)];
 261         while (sv < svend) {
 262             if (SvTYPE(sv) != SVTYPEMASK) {
 263                 DEBUG_D((fprintf(stderr, "Cleaning loops:\n "), sv_dump(sv));)
 264                 SvFLAGS(sv) |= SVf_BREAK;
 265                 SvREFCNT_dec(sv);
 266             }
 267             ++sv;
 268         }
 269     }
 270 }
 271
 272 void
 273 sv_free_arenas()
 274 {
 275     SV* sva;
 276     SV* svanext;
 277
 278     /* Free arenas here, but be careful about fake ones.  (We assume
 279        contiguity of the fake ones with the corresponding real ones.) */
 280
 281     for (sva = sv_arenaroot; sva; sva = svanext) {
 282         svanext = (SV*) SvANY(sva);
 283         while (svanext && SvFAKE(svanext))
 284             svanext = (SV*) SvANY(svanext);
 285
 286         if (!SvFAKE(sva))
 287             Safefree(sva);
 288     }
 289 }
 290
 291 static XPVIV*
 292 new_xiv()
 293 {
 294     IV** xiv;
 295     if (xiv_root) {
 296         xiv = xiv_root;
 297         /*
 298          * See comment in more_xiv() -- RAM.
 299          */
 300         xiv_root = (IV**)*xiv;
 301         return (XPVIV*)((char*)xiv - sizeof(XPV));
 302     }
 303     return more_xiv();
 304 }
 305
 306 static void
 307 del_xiv(p)
 308 XPVIV* p;
 309 {
 310     IV** xiv = (IV**)((char*)(p) + sizeof(XPV));
 311     *xiv = (IV *)xiv_root;
 312     xiv_root = xiv;
 313 }
 314
 315 static XPVIV*
 316 more_xiv()
 317 {
 318     register IV** xiv;
 319     register IV** xivend;
 320     XPV* ptr = (XPV*)safemalloc(1008);
 321     ptr->xpv_pv = (char*)xiv_arenaroot;         /* linked list of xiv arenas */
 322     xiv_arenaroot = ptr;                        /* to keep Purify happy */
 323
 324     xiv = (IV**) ptr;
 325     xivend = &xiv[1008 / sizeof(IV *) - 1];
 326     xiv += (sizeof(XPV) - 1) / sizeof(IV *) + 1;   /* fudge by size of XPV */
 327     xiv_root = xiv;
 328     while (xiv < xivend) {
 329         *xiv = (IV *)(xiv + 1);
 330         xiv++;
 331     }
 332     *xiv = 0;
 333     return new_xiv();
 334 }
 335
 336 static XPVNV*
 337 new_xnv()
 338 {
 339     double* xnv;
 340     if (xnv_root) {
 341         xnv = xnv_root;
 342         xnv_root = *(double**)xnv;
 343         return (XPVNV*)((char*)xnv - sizeof(XPVIV));
 344     }
 345     return more_xnv();
 346 }
 347
 348 static void
 349 del_xnv(p)
 350 XPVNV* p;
 351 {
 352     double* xnv = (double*)((char*)(p) + sizeof(XPVIV));
 353     *(double**)xnv = xnv_root;
 354     xnv_root = xnv;
 355 }
 356
 357 static XPVNV*
 358 more_xnv()
 359 {
 360     register double* xnv;
 361     register double* xnvend;
 362     xnv = (double*)safemalloc(1008);
 363     xnvend = &xnv[1008 / sizeof(double) - 1];
 364     xnv += (sizeof(XPVIV) - 1) / sizeof(double) + 1; /* fudge by sizeof XPVIV */
 365     xnv_root = xnv;
 366     while (xnv < xnvend) {
 367         *(double**)xnv = (double*)(xnv + 1);
 368         xnv++;
 369     }
 370     *(double**)xnv = 0;
 371     return new_xnv();
 372 }
 373
 374 static XRV*
 375 new_xrv()
 376 {
 377     XRV* xrv;
 378     if (xrv_root) {
 379         xrv = xrv_root;
 380         xrv_root = (XRV*)xrv->xrv_rv;
 381         return xrv;
 382     }
 383     return more_xrv();
 384 }
 385
 386 static void
 387 del_xrv(p)
 388 XRV* p;
 389 {
 390     p->xrv_rv = (SV*)xrv_root;
 391     xrv_root = p;
 392 }
 393
 394 static XRV*
 395 more_xrv()
 396 {
 397     register XRV* xrv;
 398     register XRV* xrvend;
 399     xrv_root = (XRV*)safemalloc(1008);
 400     xrv = xrv_root;
 401     xrvend = &xrv[1008 / sizeof(XRV) - 1];
 402     while (xrv < xrvend) {
 403         xrv->xrv_rv = (SV*)(xrv + 1);
 404         xrv++;
 405     }
 406     xrv->xrv_rv = 0;
 407     return new_xrv();
 408 }
 409
 410 static XPV*
 411 new_xpv()
 412 {
 413     XPV* xpv;
 414     if (xpv_root) {
 415         xpv = xpv_root;
 416         xpv_root = (XPV*)xpv->xpv_pv;
 417         return xpv;
 418     }
 419     return more_xpv();
 420 }
 421
 422 static void
 423 del_xpv(p)
 424 XPV* p;
 425 {
 426     p->xpv_pv = (char*)xpv_root;
 427     xpv_root = p;
 428 }
 429
 430 static XPV*
 431 more_xpv()
 432 {
 433     register XPV* xpv;
 434     register XPV* xpvend;
 435     xpv_root = (XPV*)safemalloc(1008);
 436     xpv = xpv_root;
 437     xpvend = &xpv[1008 / sizeof(XPV) - 1];
 438     while (xpv < xpvend) {
 439         xpv->xpv_pv = (char*)(xpv + 1);
 440         xpv++;
 441     }
 442     xpv->xpv_pv = 0;
 443     return new_xpv();
 444 }
 445
 446 #ifdef PURIFY
 447 #define new_XIV() (void*)safemalloc(sizeof(XPVIV))
 448 #define del_XIV(p) free((char*)p)
 449 #else
 450 #define new_XIV() (void*)new_xiv()
 451 #define del_XIV(p) del_xiv(p)
 452 #endif
 453
 454 #ifdef PURIFY
 455 #define new_XNV() (void*)safemalloc(sizeof(XPVNV))
 456 #define del_XNV(p) free((char*)p)
 457 #else
 458 #define new_XNV() (void*)new_xnv()
 459 #define del_XNV(p) del_xnv(p)
 460 #endif
 461
 462 #ifdef PURIFY
 463 #define new_XRV() (void*)safemalloc(sizeof(XRV))
 464 #define del_XRV(p) free((char*)p)
 465 #else
 466 #define new_XRV() (void*)new_xrv()
 467 #define del_XRV(p) del_xrv(p)
 468 #endif
 469
 470 #ifdef PURIFY
 471 #define new_XPV() (void*)safemalloc(sizeof(XPV))
 472 #define del_XPV(p) free((char*)p)
 473 #else
 474 #define new_XPV() (void*)new_xpv()
 475 #define del_XPV(p) del_xpv(p)
 476 #endif
 477
 478 #define new_XPVIV() (void*)safemalloc(sizeof(XPVIV))
 479 #define del_XPVIV(p) free((char*)p)
 480
 481 #define new_XPVNV() (void*)safemalloc(sizeof(XPVNV))
 482 #define del_XPVNV(p) free((char*)p)
 483
 484 #define new_XPVMG() (void*)safemalloc(sizeof(XPVMG))
 485 #define del_XPVMG(p) free((char*)p)
 486
 487 #define new_XPVLV() (void*)safemalloc(sizeof(XPVLV))
 488 #define del_XPVLV(p) free((char*)p)
 489
 490 #define new_XPVAV() (void*)safemalloc(sizeof(XPVAV))
 491 #define del_XPVAV(p) free((char*)p)
 492
 493 #define new_XPVHV() (void*)safemalloc(sizeof(XPVHV))
 494 #define del_XPVHV(p) free((char*)p)
 495
 496 #define new_XPVCV() (void*)safemalloc(sizeof(XPVCV))
 497 #define del_XPVCV(p) free((char*)p)
 498
 499 #define new_XPVGV() (void*)safemalloc(sizeof(XPVGV))
 500 #define del_XPVGV(p) free((char*)p)
 501
 502 #define new_XPVBM() (void*)safemalloc(sizeof(XPVBM))
 503 #define del_XPVBM(p) free((char*)p)
 504
 505 #define new_XPVFM() (void*)safemalloc(sizeof(XPVFM))
 506 #define del_XPVFM(p) free((char*)p)
 507
 508 #define new_XPVIO() (void*)safemalloc(sizeof(XPVIO))
 509 #define del_XPVIO(p) free((char*)p)
 510
 511 bool
 512 sv_upgrade(sv, mt)
 513 register SV* sv;
 514 U32 mt;
 515 {
 516     char*       pv;
 517     U32         cur;
 518     U32         len;
 519     IV          iv;
 520     double      nv;
 521     MAGIC*      magic;
 522     HV*         stash;
 523
 524     if (SvTYPE(sv) == mt)
 525         return TRUE;
 526
 527     if (mt < SVt_PVIV)
 528         (void)SvOOK_off(sv);
 529
 530     switch (SvTYPE(sv)) {
 531     case SVt_NULL:
 532         pv      = 0;
 533         cur     = 0;
 534         len     = 0;
 535         iv      = 0;
 536         nv      = 0.0;
 537         magic   = 0;
 538         stash   = 0;
 539         break;
 540     case SVt_IV:
 541         pv      = 0;
 542         cur     = 0;
 543         len     = 0;
 544         iv      = SvIVX(sv);
 545         nv      = (double)SvIVX(sv);
 546         del_XIV(SvANY(sv));
 547         magic   = 0;
 548         stash   = 0;
 549         if (mt == SVt_NV)
 550             mt = SVt_PVNV;
 551         else if (mt < SVt_PVIV)
 552             mt = SVt_PVIV;
 553         break;
 554     case SVt_NV:
 555         pv      = 0;
 556         cur     = 0;
 557         len     = 0;
 558         nv      = SvNVX(sv);
 559         iv      = I_32(nv);
 560         magic   = 0;
 561         stash   = 0;
 562         del_XNV(SvANY(sv));
 563         SvANY(sv) = 0;
 564         if (mt < SVt_PVNV)
 565             mt = SVt_PVNV;
 566         break;
 567     case SVt_RV:
 568         pv      = (char*)SvRV(sv);
 569         cur     = 0;
 570         len     = 0;
 571         iv      = (IV)pv;
 572         nv      = (double)(unsigned long)pv;
 573         del_XRV(SvANY(sv));
 574         magic   = 0;
 575         stash   = 0;
 576         break;
 577     case SVt_PV:
 578         nv = 0.0;
 579         pv      = SvPVX(sv);
 580         cur     = SvCUR(sv);
 581         len     = SvLEN(sv);
 582         iv      = 0;
 583         nv      = 0.0;
 584         magic   = 0;
 585         stash   = 0;
 586         del_XPV(SvANY(sv));
 587         if (mt <= SVt_IV)
 588             mt = SVt_PVIV;
 589         else if (mt == SVt_NV)
 590             mt = SVt_PVNV;
 591         break;
 592     case SVt_PVIV:
 593         nv = 0.0;
 594         pv      = SvPVX(sv);
 595         cur     = SvCUR(sv);
 596         len     = SvLEN(sv);
 597         iv      = SvIVX(sv);
 598         nv      = 0.0;
 599         magic   = 0;
 600         stash   = 0;
 601         del_XPVIV(SvANY(sv));
 602         break;
 603     case SVt_PVNV:
 604         nv = SvNVX(sv);
 605         pv      = SvPVX(sv);
 606         cur     = SvCUR(sv);
 607         len     = SvLEN(sv);
 608         iv      = SvIVX(sv);
 609         nv      = SvNVX(sv);
 610         magic   = 0;
 611         stash   = 0;
 612         del_XPVNV(SvANY(sv));
 613         break;
 614     case SVt_PVMG:
 615         pv      = SvPVX(sv);
 616         cur     = SvCUR(sv);
 617         len     = SvLEN(sv);
 618         iv      = SvIVX(sv);
 619         nv      = SvNVX(sv);
 620         magic   = SvMAGIC(sv);
 621         stash   = SvSTASH(sv);
 622         del_XPVMG(SvANY(sv));
 623         break;
 624     default:
 625         croak("Can't upgrade that kind of scalar");
 626     }
 627
 628     switch (mt) {
 629     case SVt_NULL:
 630         croak("Can't upgrade to undef");
 631     case SVt_IV:
 632         SvANY(sv) = new_XIV();
 633         SvIVX(sv)       = iv;
 634         break;
 635     case SVt_NV:
 636         SvANY(sv) = new_XNV();
 637         SvNVX(sv)       = nv;
 638         break;
 639     case SVt_RV:
 640         SvANY(sv) = new_XRV();
 641         SvRV(sv) = (SV*)pv;
 642         break;
 643     case SVt_PV:
 644         SvANY(sv) = new_XPV();
 645         SvPVX(sv)       = pv;
 646         SvCUR(sv)       = cur;
 647         SvLEN(sv)       = len;
 648         break;
 649     case SVt_PVIV:
 650         SvANY(sv) = new_XPVIV();
 651         SvPVX(sv)       = pv;
 652         SvCUR(sv)       = cur;
 653         SvLEN(sv)       = len;
 654         SvIVX(sv)       = iv;
 655         if (SvNIOK(sv))
 656             (void)SvIOK_on(sv);
 657         SvNOK_off(sv);
 658         break;
 659     case SVt_PVNV:
 660         SvANY(sv) = new_XPVNV();
 661         SvPVX(sv)       = pv;
 662         SvCUR(sv)       = cur;
 663         SvLEN(sv)       = len;
 664         SvIVX(sv)       = iv;
 665         SvNVX(sv)       = nv;
 666         break;
 667     case SVt_PVMG:
 668         SvANY(sv) = new_XPVMG();
 669         SvPVX(sv)       = pv;
 670         SvCUR(sv)       = cur;
 671         SvLEN(sv)       = len;
 672         SvIVX(sv)       = iv;
 673         SvNVX(sv)       = nv;
 674         SvMAGIC(sv)     = magic;
 675         SvSTASH(sv)     = stash;
 676         break;
 677     case SVt_PVLV:
 678         SvANY(sv) = new_XPVLV();
 679         SvPVX(sv)       = pv;
 680         SvCUR(sv)       = cur;
 681         SvLEN(sv)       = len;
 682         SvIVX(sv)       = iv;
 683         SvNVX(sv)       = nv;
 684         SvMAGIC(sv)     = magic;
 685         SvSTASH(sv)     = stash;
 686         LvTARGOFF(sv)   = 0;
 687         LvTARGLEN(sv)   = 0;
 688         LvTARG(sv)      = 0;
 689         LvTYPE(sv)      = 0;
 690         break;
 691     case SVt_PVAV:
 692         SvANY(sv) = new_XPVAV();
 693         if (pv)
 694             Safefree(pv);
 695         SvPVX(sv)       = 0;
 696         AvMAX(sv)       = 0;
 697         AvFILL(sv)      = 0;
 698         SvIVX(sv)       = 0;
 699         SvNVX(sv)       = 0.0;
 700         SvMAGIC(sv)     = magic;
 701         SvSTASH(sv)     = stash;
 702         AvALLOC(sv)     = 0;
 703         AvARYLEN(sv)    = 0;
 704         AvFLAGS(sv)     = 0;
 705         break;
 706     case SVt_PVHV:
 707         SvANY(sv) = new_XPVHV();
 708         if (pv)
 709             Safefree(pv);
 710         SvPVX(sv)       = 0;
 711         HvFILL(sv)      = 0;
 712         HvMAX(sv)       = 0;
 713         HvKEYS(sv)      = 0;
 714         SvNVX(sv)       = 0.0;
 715         SvMAGIC(sv)     = magic;
 716         SvSTASH(sv)     = stash;
 717         HvRITER(sv)     = 0;
 718         HvEITER(sv)     = 0;
 719         HvPMROOT(sv)    = 0;
 720         HvNAME(sv)      = 0;
 721         break;
 722     case SVt_PVCV:
 723         SvANY(sv) = new_XPVCV();
 724         Zero(SvANY(sv), 1, XPVCV);
 725         SvPVX(sv)       = pv;
 726         SvCUR(sv)       = cur;
 727         SvLEN(sv)       = len;
 728         SvIVX(sv)       = iv;
 729         SvNVX(sv)       = nv;
 730         SvMAGIC(sv)     = magic;
 731         SvSTASH(sv)     = stash;
 732         break;
 733     case SVt_PVGV:
 734         SvANY(sv) = new_XPVGV();
 735         SvPVX(sv)       = pv;
 736         SvCUR(sv)       = cur;
 737         SvLEN(sv)       = len;
 738         SvIVX(sv)       = iv;
 739         SvNVX(sv)       = nv;
 740         SvMAGIC(sv)     = magic;
 741         SvSTASH(sv)     = stash;
 742         GvGP(sv)        = 0;
 743         GvNAME(sv)      = 0;
 744         GvNAMELEN(sv)   = 0;
 745         GvSTASH(sv)     = 0;
 746         GvFLAGS(sv)     = 0;
 747         break;
 748     case SVt_PVBM:
 749         SvANY(sv) = new_XPVBM();
 750         SvPVX(sv)       = pv;
 751         SvCUR(sv)       = cur;
 752         SvLEN(sv)       = len;
 753         SvIVX(sv)       = iv;
 754         SvNVX(sv)       = nv;
 755         SvMAGIC(sv)     = magic;
 756         SvSTASH(sv)     = stash;
 757         BmRARE(sv)      = 0;
 758         BmUSEFUL(sv)    = 0;
 759         BmPREVIOUS(sv)  = 0;
 760         break;
 761     case SVt_PVFM:
 762         SvANY(sv) = new_XPVFM();
 763         Zero(SvANY(sv), 1, XPVFM);
 764         SvPVX(sv)       = pv;
 765         SvCUR(sv)       = cur;
 766         SvLEN(sv)       = len;
 767         SvIVX(sv)       = iv;
 768         SvNVX(sv)       = nv;
 769         SvMAGIC(sv)     = magic;
 770         SvSTASH(sv)     = stash;
 771         break;
 772     case SVt_PVIO:
 773         SvANY(sv) = new_XPVIO();
 774         Zero(SvANY(sv), 1, XPVIO);
 775         SvPVX(sv)       = pv;
 776         SvCUR(sv)       = cur;
 777         SvLEN(sv)       = len;
 778         SvIVX(sv)       = iv;
 779         SvNVX(sv)       = nv;
 780         SvMAGIC(sv)     = magic;
 781         SvSTASH(sv)     = stash;
 782         IoPAGE_LEN(sv)  = 60;
 783         break;
 784     }
 785     SvFLAGS(sv) &= ~SVTYPEMASK;
 786     SvFLAGS(sv) |= mt;
 787     return TRUE;
 788 }
 789
 790 #ifdef DEBUGGING
 791 char *
 792 sv_peek(sv)
 793 register SV *sv;
 794 {
 795     char *t = tokenbuf;
 796     int unref = 0;
 797
 798   retry:
 799     if (!sv) {
 800         strcpy(t, "VOID");
 801         goto finish;
 802     }
 803     else if (sv == (SV*)0x55555555 || SvTYPE(sv) == 'U') {
 804         strcpy(t, "WILD");
 805         goto finish;
 806     }
 807     else if (sv == &sv_undef || sv == &sv_no || sv == &sv_yes) {
 808         if (sv == &sv_undef) {
 809             strcpy(t, "SV_UNDEF");
 810             if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
 811                                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
 812                 SvREADONLY(sv))
 813                 goto finish;
 814         }
 815         else if (sv == &sv_no) {
 816             strcpy(t, "SV_NO");
 817             if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
 818                                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
 819                 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
 820                                   SVp_POK|SVp_NOK)) &&
 821                 SvCUR(sv) == 0 &&
 822                 SvNVX(sv) == 0.0)
 823                 goto finish;
 824         }
 825         else {
 826             strcpy(t, "SV_YES");
 827             if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
 828                                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
 829                 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
 830                                   SVp_POK|SVp_NOK)) &&
 831                 SvCUR(sv) == 1 &&
 832                 SvPVX(sv) && *SvPVX(sv) == '1' &&
 833                 SvNVX(sv) == 1.0)
 834                 goto finish;
 835         }
 836         t += strlen(t);
 837         *t++ = ':';
 838     }
 839     else if (SvREFCNT(sv) == 0) {
 840         *t++ = '(';
 841         unref++;
 842     }
 843     if (SvROK(sv)) {
 844         *t++ = '\\';
 845         if (t - tokenbuf + unref > 10) {
 846             strcpy(tokenbuf + unref + 3,"...");
 847             goto finish;
 848         }
 849         sv = (SV*)SvRV(sv);
 850         goto retry;
 851     }
 852     switch (SvTYPE(sv)) {
 853     default:
 854         strcpy(t,"FREED");
 855         goto finish;
 856
 857     case SVt_NULL:
 858         strcpy(t,"UNDEF");
 859         return tokenbuf;
 860     case SVt_IV:
 861         strcpy(t,"IV");
 862         break;
 863     case SVt_NV:
 864         strcpy(t,"NV");
 865         break;
 866     case SVt_RV:
 867         strcpy(t,"RV");
 868         break;
 869     case SVt_PV:
 870         strcpy(t,"PV");
 871         break;
 872     case SVt_PVIV:
 873         strcpy(t,"PVIV");
 874         break;
 875     case SVt_PVNV:
 876         strcpy(t,"PVNV");
 877         break;
 878     case SVt_PVMG:
 879         strcpy(t,"PVMG");
 880         break;
 881     case SVt_PVLV:
 882         strcpy(t,"PVLV");
 883         break;
 884     case SVt_PVAV:
 885         strcpy(t,"AV");
 886         break;
 887     case SVt_PVHV:
 888         strcpy(t,"HV");
 889         break;
 890     case SVt_PVCV:
 891         if (CvGV(sv))
 892             sprintf(t, "CV(%s)", GvNAME(CvGV(sv)));
 893         else
 894             strcpy(t, "CV()");
 895         goto finish;
 896     case SVt_PVGV:
 897         strcpy(t,"GV");
 898         break;
 899     case SVt_PVBM:
 900         strcpy(t,"BM");
 901         break;
 902     case SVt_PVFM:
 903         strcpy(t,"FM");
 904         break;
 905     case SVt_PVIO:
 906         strcpy(t,"IO");
 907         break;
 908     }
 909     t += strlen(t);
 910
 911     if (SvPOKp(sv)) {
 912         if (!SvPVX(sv))
 913             strcpy(t, "(null)");
 914         if (SvOOK(sv))
 915             sprintf(t,"(%ld+\"%.127s\")",(long)SvIVX(sv),SvPVX(sv));
 916         else
 917             sprintf(t,"(\"%.127s\")",SvPVX(sv));
 918     }
 919     else if (SvNOKp(sv))
 920         sprintf(t,"(%g)",SvNVX(sv));
 921     else if (SvIOKp(sv))
 922         sprintf(t,"(%ld)",(long)SvIVX(sv));
 923     else
 924         strcpy(t,"()");
 925
 926   finish:
 927     if (unref) {
 928         t += strlen(t);
 929         while (unref--)
 930             *t++ = ')';
 931         *t = '\0';
 932     }
 933     return tokenbuf;
 934 }
 935 #endif
 936
 937 int
 938 sv_backoff(sv)
 939 register SV *sv;
 940 {
 941     assert(SvOOK(sv));
 942     if (SvIVX(sv)) {
 943         char *s = SvPVX(sv);
 944         SvLEN(sv) += SvIVX(sv);
 945         SvPVX(sv) -= SvIVX(sv);
 946         SvIV_set(sv, 0);
 947         Move(s, SvPVX(sv), SvCUR(sv)+1, char);
 948     }
 949     SvFLAGS(sv) &= ~SVf_OOK;
 950     return 0;
 951 }
 952
 953 char *
 954 sv_grow(sv,newlen)
 955 register SV *sv;
 956 #ifndef DOSISH
 957 register I32 newlen;
 958 #else
 959 unsigned long newlen;
 960 #endif
 961 {
 962     register char *s;
 963
 964 #ifdef MSDOS
 965     if (newlen >= 0x10000) {
 966         fprintf(stderr, "Allocation too large: %lx\n", newlen);
 967         my_exit(1);
 968     }
 969 #endif /* MSDOS */
 970     if (SvROK(sv))
 971         sv_unref(sv);
 972     if (SvTYPE(sv) < SVt_PV) {
 973         sv_upgrade(sv, SVt_PV);
 974         s = SvPVX(sv);
 975     }
 976     else if (SvOOK(sv)) {       /* pv is offset? */
 977         sv_backoff(sv);
 978         s = SvPVX(sv);
 979         if (newlen > SvLEN(sv))
 980             newlen += 10 * (newlen - SvCUR(sv)); /* avoid copy each time */
 981     }
 982     else
 983         s = SvPVX(sv);
 984     if (newlen > SvLEN(sv)) {           /* need more room? */
 985         if (SvLEN(sv) && s)
 986             Renew(s,newlen,char);
 987         else
 988             New(703,s,newlen,char);
 989         SvPV_set(sv, s);
 990         SvLEN_set(sv, newlen);
 991     }
 992     return s;
 993 }
 994
 995 void
 996 sv_setiv(sv,i)
 997 register SV *sv;
 998 IV i;
 999 {
1000     if (SvTHINKFIRST(sv)) {
1001         if (SvREADONLY(sv) && curcop != &compiling)
1002             croak(no_modify);
1003         if (SvROK(sv))
1004             sv_unref(sv);
1005     }
1006     switch (SvTYPE(sv)) {
1007     case SVt_NULL:
1008         sv_upgrade(sv, SVt_IV);
1009         break;
1010     case SVt_NV:
1011         sv_upgrade(sv, SVt_PVNV);
1012         break;
1013     case SVt_RV:
1014     case SVt_PV:
1015         sv_upgrade(sv, SVt_PVIV);
1016         break;
1017
1018     case SVt_PVGV:
1019         if (SvFAKE(sv)) {
1020             sv_unglob(sv);
1021             break;
1022         }
1023         /* FALL THROUGH */
1024     case SVt_PVAV:
1025     case SVt_PVHV:
1026     case SVt_PVCV:
1027     case SVt_PVFM:
1028     case SVt_PVIO:
1029         croak("Can't coerce %s to integer in %s", sv_reftype(sv,0),
1030             op_name[op->op_type]);
1031     }
1032     (void)SvIOK_only(sv);                       /* validate number */
1033     SvIVX(sv) = i;
1034     SvTAINT(sv);
1035 }
1036
1037 void
1038 sv_setnv(sv,num)
1039 register SV *sv;
1040 double num;
1041 {
1042     if (SvTHINKFIRST(sv)) {
1043         if (SvREADONLY(sv) && curcop != &compiling)
1044             croak(no_modify);
1045         if (SvROK(sv))
1046             sv_unref(sv);
1047     }
1048     switch (SvTYPE(sv)) {
1049     case SVt_NULL:
1050     case SVt_IV:
1051         sv_upgrade(sv, SVt_NV);
1052         break;
1053     case SVt_NV:
1054     case SVt_RV:
1055     case SVt_PV:
1056     case SVt_PVIV:
1057         sv_upgrade(sv, SVt_PVNV);
1058         /* FALL THROUGH */
1059     case SVt_PVNV:
1060     case SVt_PVMG:
1061     case SVt_PVBM:
1062     case SVt_PVLV:
1063         if (SvOOK(sv))
1064             (void)SvOOK_off(sv);
1065         break;
1066     case SVt_PVGV:
1067         if (SvFAKE(sv)) {
1068             sv_unglob(sv);
1069             break;
1070         }
1071         /* FALL THROUGH */
1072     case SVt_PVAV:
1073     case SVt_PVHV:
1074     case SVt_PVCV:
1075     case SVt_PVFM:
1076     case SVt_PVIO:
1077         croak("Can't coerce %s to number in %s", sv_reftype(sv,0),
1078             op_name[op->op_type]);
1079     }
1080     SvNVX(sv) = num;
1081     (void)SvNOK_only(sv);                       /* validate number */
1082     SvTAINT(sv);
1083 }
1084
1085 static void
1086 not_a_number(sv)
1087 SV *sv;
1088 {
1089     char tmpbuf[64];
1090     char *d = tmpbuf;
1091     char *s;
1092     int i;
1093
1094     for (s = SvPVX(sv), i = 50; *s && i; s++,i--) {
1095         int ch = *s;
1096         if (ch & 128 && !isprint(ch)) {
1097             *d++ = 'M';
1098             *d++ = '-';
1099             ch &= 127;
1100         }
1101         if (isprint(ch))
1102             *d++ = ch;
1103         else {
1104             *d++ = '^';
1105             *d++ = ch ^ 64;
1106         }
1107     }
1108     if (*s) {
1109         *d++ = '.';
1110         *d++ = '.';
1111         *d++ = '.';
1112     }
1113     *d = '\0';
1114
1115     if (op)
1116         warn("Argument \"%s\" isn't numeric in %s", tmpbuf,
1117                 op_name[op->op_type]);
1118     else
1119         warn("Argument \"%s\" isn't numeric", tmpbuf);
1120 }
1121
1122 IV
1123 sv_2iv(sv)
1124 register SV *sv;
1125 {
1126     if (!sv)
1127         return 0;
1128     if (SvGMAGICAL(sv)) {
1129         mg_get(sv);
1130         if (SvIOKp(sv))
1131             return SvIVX(sv);
1132         if (SvNOKp(sv)) {
1133             if (SvNVX(sv) < 0.0)
1134                 return I_V(SvNVX(sv));
1135             else
1136                 return (IV) U_V(SvNVX(sv));
1137         }
1138         if (SvPOKp(sv) && SvLEN(sv)) {
1139             if (dowarn && !looks_like_number(sv))
1140                 not_a_number(sv);
1141             return (IV)atol(SvPVX(sv));
1142         }
1143         if (!SvROK(sv)) {
1144             return 0;
1145         }
1146     }
1147     if (SvTHINKFIRST(sv)) {
1148         if (SvROK(sv)) {
1149 #ifdef OVERLOAD
1150           SV* tmpstr;
1151           if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv, numer)))
1152             return SvIV(tmpstr);
1153 #endif /* OVERLOAD */
1154           return (IV)SvRV(sv);
1155         }
1156         if (SvREADONLY(sv)) {
1157             if (SvNOKp(sv)) {
1158                 if (SvNVX(sv) < 0.0)
1159                     return I_V(SvNVX(sv));
1160                 else
1161                     return (IV) U_V(SvNVX(sv));
1162             }
1163             if (SvPOKp(sv) && SvLEN(sv)) {
1164                 if (dowarn && !looks_like_number(sv))
1165                     not_a_number(sv);
1166                 return (IV)atol(SvPVX(sv));
1167             }
1168             if (dowarn)
1169                 warn(warn_uninit);
1170             return 0;
1171         }
1172     }
1173     switch (SvTYPE(sv)) {
1174     case SVt_NULL:
1175         sv_upgrade(sv, SVt_IV);
1176         return SvIVX(sv);
1177     case SVt_PV:
1178         sv_upgrade(sv, SVt_PVIV);
1179         break;
1180     case SVt_NV:
1181         sv_upgrade(sv, SVt_PVNV);
1182         break;
1183     }
1184     if (SvNOKp(sv)) {
1185         (void)SvIOK_on(sv);
1186         if (SvNVX(sv) < 0.0)
1187             SvIVX(sv) = I_V(SvNVX(sv));
1188         else
1189             SvIVX(sv) = (IV) U_V(SvNVX(sv));
1190     }
1191     else if (SvPOKp(sv) && SvLEN(sv)) {
1192         if (dowarn && !looks_like_number(sv))
1193             not_a_number(sv);
1194         (void)SvIOK_on(sv);
1195         SvIVX(sv) = (IV)atol(SvPVX(sv));
1196     }
1197     else  {
1198         if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
1199             warn(warn_uninit);
1200         return 0;
1201     }
1202     DEBUG_c(fprintf(stderr,"0x%lx 2iv(%ld)\n",
1203         (unsigned long)sv,(long)SvIVX(sv)));
1204     return SvIVX(sv);
1205 }
1206
1207 double
1208 sv_2nv(sv)
1209 register SV *sv;
1210 {
1211     if (!sv)
1212         return 0.0;
1213     if (SvGMAGICAL(sv)) {
1214         mg_get(sv);
1215         if (SvNOKp(sv))
1216             return SvNVX(sv);
1217         if (SvPOKp(sv) && SvLEN(sv)) {
1218             if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
1219                 not_a_number(sv);
1220             return atof(SvPVX(sv));
1221         }
1222         if (SvIOKp(sv))
1223             return (double)SvIVX(sv);
1224         if (!SvROK(sv)) {
1225             return 0;
1226         }
1227     }
1228     if (SvTHINKFIRST(sv)) {
1229         if (SvROK(sv)) {
1230 #ifdef OVERLOAD
1231           SV* tmpstr;
1232           if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)))
1233             return SvNV(tmpstr);
1234 #endif /* OVERLOAD */
1235           return (double)(unsigned long)SvRV(sv);
1236         }
1237         if (SvREADONLY(sv)) {
1238             if (SvPOKp(sv) && SvLEN(sv)) {
1239                 if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
1240                     not_a_number(sv);
1241                 return atof(SvPVX(sv));
1242             }
1243             if (SvIOKp(sv))
1244                 return (double)SvIVX(sv);
1245             if (dowarn)
1246                 warn(warn_uninit);
1247             return 0.0;
1248         }
1249     }
1250     if (SvTYPE(sv) < SVt_NV) {
1251         if (SvTYPE(sv) == SVt_IV)
1252             sv_upgrade(sv, SVt_PVNV);
1253         else
1254             sv_upgrade(sv, SVt_NV);
1255         DEBUG_c(fprintf(stderr,"0x%lx num(%g)\n",(unsigned long)sv,SvNVX(sv)));
1256     }
1257     else if (SvTYPE(sv) < SVt_PVNV)
1258         sv_upgrade(sv, SVt_PVNV);
1259     if (SvIOKp(sv) &&
1260             (!SvPOKp(sv) || !strchr(SvPVX(sv),'.') || !looks_like_number(sv)))
1261     {
1262         SvNVX(sv) = (double)SvIVX(sv);
1263     }
1264     else if (SvPOKp(sv) && SvLEN(sv)) {
1265         if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
1266             not_a_number(sv);
1267         SvNVX(sv) = atof(SvPVX(sv));
1268     }
1269     else  {
1270         if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
1271             warn(warn_uninit);
1272         return 0.0;
1273     }
1274     SvNOK_on(sv);
1275     DEBUG_c(fprintf(stderr,"0x%lx 2nv(%g)\n",(unsigned long)sv,SvNVX(sv)));
1276     return SvNVX(sv);
1277 }
1278
1279 char *
1280 sv_2pv(sv, lp)
1281 register SV *sv;
1282 STRLEN *lp;
1283 {
1284     register char *s;
1285     int olderrno;
1286
1287     if (!sv) {
1288         *lp = 0;
1289         return "";
1290     }
1291     if (SvGMAGICAL(sv)) {
1292         mg_get(sv);
1293         if (SvPOKp(sv)) {
1294             *lp = SvCUR(sv);
1295             return SvPVX(sv);
1296         }
1297         if (SvIOKp(sv)) {
1298             (void)sprintf(tokenbuf,"%ld",(long)SvIVX(sv));
1299             goto tokensave;
1300         }
1301         if (SvNOKp(sv)) {
1302             Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
1303             goto tokensave;
1304         }
1305         if (!SvROK(sv)) {
1306             *lp = 0;
1307             return "";
1308         }
1309     }
1310     if (SvTHINKFIRST(sv)) {
1311         if (SvROK(sv)) {
1312 #ifdef OVERLOAD
1313             SV* tmpstr;
1314             if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)))
1315               return SvPV(tmpstr,*lp);
1316 #endif /* OVERLOAD */
1317             sv = (SV*)SvRV(sv);
1318             if (!sv)
1319                 s = "NULLREF";
1320             else {
1321                 switch (SvTYPE(sv)) {
1322                 case SVt_NULL:
1323                 case SVt_IV:
1324                 case SVt_NV:
1325                 case SVt_RV:
1326                 case SVt_PV:
1327                 case SVt_PVIV:
1328                 case SVt_PVNV:
1329                 case SVt_PVBM:
1330                 case SVt_PVMG:  s = "SCALAR";                   break;
1331                 case SVt_PVLV:  s = "LVALUE";                   break;
1332                 case SVt_PVAV:  s = "ARRAY";                    break;
1333                 case SVt_PVHV:  s = "HASH";                     break;
1334                 case SVt_PVCV:  s = "CODE";                     break;
1335                 case SVt_PVGV:  s = "GLOB";                     break;
1336                 case SVt_PVFM:  s = "FORMATLINE";               break;
1337                 case SVt_PVIO:  s = "FILEHANDLE";               break;
1338                 default:        s = "UNKNOWN";                  break;
1339                 }
1340                 if (SvOBJECT(sv))
1341                     sprintf(tokenbuf, "%s=%s(0x%lx)",
1342                                 HvNAME(SvSTASH(sv)), s, (unsigned long)sv);
1343                 else
1344                     sprintf(tokenbuf, "%s(0x%lx)", s, (unsigned long)sv);
1345                 goto tokensaveref;
1346             }
1347             *lp = strlen(s);
1348             return s;
1349         }
1350         if (SvREADONLY(sv)) {
1351             if (SvNOKp(sv)) {
1352                 Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
1353                 goto tokensave;
1354             }
1355             if (SvIOKp(sv)) {
1356                 (void)sprintf(tokenbuf,"%ld",(long)SvIVX(sv));
1357                 goto tokensave;
1358             }
1359             if (dowarn)
1360                 warn(warn_uninit);
1361             *lp = 0;
1362             return "";
1363         }
1364     }
1365     if (!SvUPGRADE(sv, SVt_PV))
1366         return 0;
1367     if (SvNOKp(sv)) {
1368         if (SvTYPE(sv) < SVt_PVNV)
1369             sv_upgrade(sv, SVt_PVNV);
1370         SvGROW(sv, 28);
1371         s = SvPVX(sv);
1372         olderrno = errno;       /* some Xenix systems wipe out errno here */
1373 #ifdef apollo
1374         if (SvNVX(sv) == 0.0)
1375             (void)strcpy(s,"0");
1376         else
1377 #endif /*apollo*/
1378             Gconvert(SvNVX(sv), DBL_DIG, 0, s);
1379         errno = olderrno;
1380 #ifdef FIXNEGATIVEZERO
1381         if (*s == '-' && s[1] == '0' && !s[2])
1382             strcpy(s,"0");
1383 #endif
1384         while (*s) s++;
1385 #ifdef hcx
1386         if (s[-1] == '.')
1387             s--;
1388 #endif
1389     }
1390     else if (SvIOKp(sv)) {
1391         if (SvTYPE(sv) < SVt_PVIV)
1392             sv_upgrade(sv, SVt_PVIV);
1393         SvGROW(sv, 11);
1394         s = SvPVX(sv);
1395         olderrno = errno;       /* some Xenix systems wipe out errno here */
1396         (void)sprintf(s,"%ld",(long)SvIVX(sv));
1397         errno = olderrno;
1398         while (*s) s++;
1399     }
1400     else {
1401         if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
1402             warn(warn_uninit);
1403         *lp = 0;
1404         return "";
1405     }
1406     *s = '\0';
1407     *lp = s - SvPVX(sv);
1408     SvCUR_set(sv, *lp);
1409     SvPOK_on(sv);
1410     DEBUG_c(fprintf(stderr,"0x%lx 2pv(%s)\n",(unsigned long)sv,SvPVX(sv)));
1411     return SvPVX(sv);
1412
1413   tokensave:
1414     if (SvROK(sv)) {    /* XXX Skip this when sv_pvn_force calls */
1415         /* Sneaky stuff here */
1416
1417       tokensaveref:
1418         sv = sv_newmortal();
1419         *lp = strlen(tokenbuf);
1420         sv_setpvn(sv, tokenbuf, *lp);
1421         return SvPVX(sv);
1422     }
1423     else {
1424         STRLEN len;
1425
1426 #ifdef FIXNEGATIVEZERO
1427         if (*tokenbuf == '-' && tokenbuf[1] == '0' && !tokenbuf[2])
1428             strcpy(tokenbuf,"0");
1429 #endif
1430         (void)SvUPGRADE(sv, SVt_PV);
1431         len = *lp = strlen(tokenbuf);
1432         s = SvGROW(sv, len + 1);
1433         SvCUR_set(sv, len);
1434         (void)strcpy(s, tokenbuf);
1435         /* NO SvPOK_on(sv) here! */
1436         return s;
1437     }
1438 }
1439
1440 /* This function is only called on magical items */
1441 bool
1442 sv_2bool(sv)
1443 register SV *sv;
1444 {
1445     if (SvGMAGICAL(sv))
1446         mg_get(sv);
1447
1448     if (!SvOK(sv))
1449         return 0;
1450     if (SvROK(sv)) {
1451 #ifdef OVERLOAD
1452       {
1453         SV* tmpsv;
1454         if (SvAMAGIC(sv) && (tmpsv = AMG_CALLun(sv,bool_)))
1455           return SvTRUE(tmpsv);
1456       }
1457 #endif /* OVERLOAD */
1458       return SvRV(sv) != 0;
1459     }
1460     if (SvPOKp(sv)) {
1461         register XPV* Xpv;
1462         if ((Xpv = (XPV*)SvANY(sv)) &&
1463                 (*Xpv->xpv_pv > '0' ||
1464                 Xpv->xpv_cur > 1 ||
1465                 (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
1466             return 1;
1467         else
1468             return 0;
1469     }
1470     else {
1471         if (SvIOKp(sv))
1472             return SvIVX(sv) != 0;
1473         else {
1474             if (SvNOKp(sv))
1475                 return SvNVX(sv) != 0.0;
1476             else
1477                 return FALSE;
1478         }
1479     }
1480 }
1481
1482 /* Note: sv_setsv() should not be called with a source string that needs
1483  * to be reused, since it may destroy the source string if it is marked
1484  * as temporary.
1485  */
1486
1487 void
1488 sv_setsv(dstr,sstr)
1489 SV *dstr;
1490 register SV *sstr;
1491 {
1492     register U32 sflags;
1493     register int dtype;
1494     register int stype;
1495
1496     if (sstr == dstr)
1497         return;
1498     if (SvTHINKFIRST(dstr)) {
1499         if (SvREADONLY(dstr) && curcop != &compiling)
1500             croak(no_modify);
1501         if (SvROK(dstr))
1502             sv_unref(dstr);
1503     }
1504     if (!sstr)
1505         sstr = &sv_undef;
1506     stype = SvTYPE(sstr);
1507     dtype = SvTYPE(dstr);
1508
1509     if (dtype == SVt_PVGV && (SvFLAGS(dstr) & SVf_FAKE)) {
1510         sv_unglob(dstr);     /* so fake GLOB won't perpetuate */
1511         sv_setpvn(dstr, "", 0);
1512         (void)SvPOK_only(dstr);
1513         dtype = SvTYPE(dstr);
1514     }
1515
1516 #ifdef OVERLOAD
1517     SvAMAGIC_off(dstr);
1518 #endif /* OVERLOAD */
1519     /* There's a lot of redundancy below but we're going for speed here */
1520
1521     switch (stype) {
1522     case SVt_NULL:
1523         (void)SvOK_off(dstr);
1524         return;
1525     case SVt_IV:
1526         if (dtype <= SVt_PV) {
1527             if (dtype < SVt_IV)
1528                 sv_upgrade(dstr, SVt_IV);
1529             else if (dtype == SVt_NV)
1530                 sv_upgrade(dstr, SVt_PVNV);
1531             else if (dtype <= SVt_PV)
1532                 sv_upgrade(dstr, SVt_PVIV);
1533         }
1534         break;
1535     case SVt_NV:
1536         if (dtype <= SVt_PVIV) {
1537             if (dtype < SVt_NV)
1538                 sv_upgrade(dstr, SVt_NV);
1539             else if (dtype == SVt_PVIV)
1540                 sv_upgrade(dstr, SVt_PVNV);
1541             else if (dtype <= SVt_PV)
1542                 sv_upgrade(dstr, SVt_PVNV);
1543         }
1544         break;
1545     case SVt_RV:
1546         if (dtype < SVt_RV)
1547             sv_upgrade(dstr, SVt_RV);
1548         else if (dtype == SVt_PVGV &&
1549                  SvTYPE(SvRV(sstr)) == SVt_PVGV) {
1550             sstr = SvRV(sstr);
1551             if (sstr == dstr) {
1552                 if (curcop->cop_stash != GvSTASH(dstr))
1553                     GvIMPORTED_on(dstr);
1554                 GvMULTI_on(dstr);
1555                 return;
1556             }
1557             goto glob_assign;
1558         }
1559         break;
1560     case SVt_PV:
1561         if (dtype < SVt_PV)
1562             sv_upgrade(dstr, SVt_PV);
1563         break;
1564     case SVt_PVIV:
1565         if (dtype < SVt_PVIV)
1566             sv_upgrade(dstr, SVt_PVIV);
1567         break;
1568     case SVt_PVNV:
1569         if (dtype < SVt_PVNV)
1570             sv_upgrade(dstr, SVt_PVNV);
1571         break;
1572
1573     case SVt_PVLV:
1574         sv_upgrade(dstr, SVt_PVNV);
1575         break;
1576
1577     case SVt_PVAV:
1578     case SVt_PVHV:
1579     case SVt_PVCV:
1580     case SVt_PVIO:
1581         if (op)
1582             croak("Bizarre copy of %s in %s", sv_reftype(sstr, 0),
1583                 op_name[op->op_type]);
1584         else
1585             croak("Bizarre copy of %s", sv_reftype(sstr, 0));
1586         break;
1587
1588     case SVt_PVGV:
1589         if (dtype <= SVt_PVGV) {
1590   glob_assign:
1591             if (dtype != SVt_PVGV) {
1592                 char *name = GvNAME(sstr);
1593                 STRLEN len = GvNAMELEN(sstr);
1594                 sv_upgrade(dstr, SVt_PVGV);
1595                 sv_magic(dstr, dstr, '*', name, len);
1596                 GvSTASH(dstr) = GvSTASH(sstr);
1597                 GvNAME(dstr) = savepvn(name, len);
1598                 GvNAMELEN(dstr) = len;
1599                 SvFAKE_on(dstr);        /* can coerce to non-glob */
1600             }
1601             (void)SvOK_off(dstr);
1602             GvINTRO_off(dstr);          /* one-shot flag */
1603             gp_free(dstr);
1604             GvGP(dstr) = gp_ref(GvGP(sstr));
1605             SvTAINT(dstr);
1606             if (curcop->cop_stash != GvSTASH(dstr))
1607                 GvIMPORTED_on(dstr);
1608             GvMULTI_on(dstr);
1609             return;
1610         }
1611         /* FALL THROUGH */
1612
1613     default:
1614         if (dtype < stype)
1615             sv_upgrade(dstr, stype);
1616         if (SvGMAGICAL(sstr))
1617             mg_get(sstr);
1618     }
1619
1620     sflags = SvFLAGS(sstr);
1621
1622     if (sflags & SVf_ROK) {
1623         if (dtype >= SVt_PV) {
1624             if (dtype == SVt_PVGV) {
1625                 SV *sref = SvREFCNT_inc(SvRV(sstr));
1626                 SV *dref = 0;
1627                 int intro = GvINTRO(dstr);
1628
1629                 if (intro) {
1630                     GP *gp;
1631                     GvGP(dstr)->gp_refcnt--;
1632                     GvINTRO_off(dstr);  /* one-shot flag */
1633                     Newz(602,gp, 1, GP);
1634                     GvGP(dstr) = gp;
1635                     GvREFCNT(dstr) = 1;
1636                     GvSV(dstr) = NEWSV(72,0);
1637                     GvLINE(dstr) = curcop->cop_line;
1638                     GvEGV(dstr) = dstr;
1639                 }
1640                 GvMULTI_on(dstr);
1641                 switch (SvTYPE(sref)) {
1642                 case SVt_PVAV:
1643                     if (intro)
1644                         SAVESPTR(GvAV(dstr));
1645                     else
1646                         dref = (SV*)GvAV(dstr);
1647                     GvAV(dstr) = (AV*)sref;
1648                     if (curcop->cop_stash != GvSTASH(dstr))
1649                         GvIMPORTED_AV_on(dstr);
1650                     break;
1651                 case SVt_PVHV:
1652                     if (intro)
1653                         SAVESPTR(GvHV(dstr));
1654                     else
1655                         dref = (SV*)GvHV(dstr);
1656                     GvHV(dstr) = (HV*)sref;
1657                     if (curcop->cop_stash != GvSTASH(dstr))
1658                         GvIMPORTED_HV_on(dstr);
1659                     break;
1660                 case SVt_PVCV:
1661                     if (intro)
1662                         SAVESPTR(GvCV(dstr));
1663                     else {
1664                         CV* cv = GvCV(dstr);
1665                         if (cv) {
1666                             dref = (SV*)cv;
1667                             if (dowarn && sref != dref &&
1668                                     !GvCVGEN((GV*)dstr) &&
1669                                     (CvROOT(cv) || CvXSUB(cv)) )
1670                                 warn("Subroutine %s redefined",
1671                                     GvENAME((GV*)dstr));
1672                             SvFAKE_on(cv);
1673                         }
1674                     }
1675                     if (GvCV(dstr) != (CV*)sref) {
1676                         GvCV(dstr) = (CV*)sref;
1677                         GvASSUMECV_on(dstr);
1678                     }
1679                     if (curcop->cop_stash != GvSTASH(dstr))
1680                         GvIMPORTED_CV_on(dstr);
1681                     break;
1682                 case SVt_PVIO:
1683                     if (intro)
1684                         SAVESPTR(GvIOp(dstr));
1685                     else
1686                         dref = (SV*)GvIOp(dstr);
1687                     GvIOp(dstr) = (IO*)sref;
1688                     break;
1689                 default:
1690                     if (intro)
1691                         SAVESPTR(GvSV(dstr));
1692                     else
1693                         dref = (SV*)GvSV(dstr);
1694                     GvSV(dstr) = sref;
1695                     if (curcop->cop_stash != GvSTASH(dstr))
1696                         GvIMPORTED_SV_on(dstr);
1697                     break;
1698                 }
1699                 if (dref)
1700                     SvREFCNT_dec(dref);
1701                 if (intro)
1702                     SAVEFREESV(sref);
1703                 SvTAINT(dstr);
1704                 return;
1705             }
1706             if (SvPVX(dstr)) {
1707                 Safefree(SvPVX(dstr));
1708                 SvLEN(dstr)=SvCUR(dstr)=0;
1709             }
1710         }
1711         (void)SvOK_off(dstr);
1712         SvRV(dstr) = SvREFCNT_inc(SvRV(sstr));
1713         SvROK_on(dstr);
1714         if (sflags & SVp_NOK) {
1715             SvNOK_on(dstr);
1716             SvNVX(dstr) = SvNVX(sstr);
1717         }
1718         if (sflags & SVp_IOK) {
1719             (void)SvIOK_on(dstr);
1720             SvIVX(dstr) = SvIVX(sstr);
1721         }
1722 #ifdef OVERLOAD
1723         if (SvAMAGIC(sstr)) {
1724             SvAMAGIC_on(dstr);
1725         }
1726 #endif /* OVERLOAD */
1727     }
1728     else if (sflags & SVp_POK) {
1729
1730         /*
1731          * Check to see if we can just swipe the string.  If so, it's a
1732          * possible small lose on short strings, but a big win on long ones.
1733          * It might even be a win on short strings if SvPVX(dstr)
1734          * has to be allocated and SvPVX(sstr) has to be freed.
1735          */
1736
1737         if (SvTEMP(sstr) &&             /* slated for free anyway? */
1738             !(sflags & SVf_OOK))        /* and not involved in OOK hack? */
1739         {
1740             if (SvPVX(dstr)) {          /* we know that dtype >= SVt_PV */
1741                 if (SvOOK(dstr)) {
1742                     SvFLAGS(dstr) &= ~SVf_OOK;
1743                     Safefree(SvPVX(dstr) - SvIVX(dstr));
1744                 }
1745                 else
1746                     Safefree(SvPVX(dstr));
1747             }
1748             (void)SvPOK_only(dstr);
1749             SvPV_set(dstr, SvPVX(sstr));
1750             SvLEN_set(dstr, SvLEN(sstr));
1751             SvCUR_set(dstr, SvCUR(sstr));
1752             SvTEMP_off(dstr);
1753             (void)SvOK_off(sstr);
1754             SvPV_set(sstr, Nullch);
1755             SvLEN_set(sstr, 0);
1756             SvCUR_set(sstr, 0);
1757             SvTEMP_off(sstr);
1758         }
1759         else {                                  /* have to copy actual string */
1760             STRLEN len = SvCUR(sstr);
1761
1762             SvGROW(dstr, len + 1);              /* inlined from sv_setpvn */
1763             Move(SvPVX(sstr),SvPVX(dstr),len,char);
1764             SvCUR_set(dstr, len);
1765             *SvEND(dstr) = '\0';
1766             (void)SvPOK_only(dstr);
1767         }
1768         /*SUPPRESS 560*/
1769         if (sflags & SVp_NOK) {
1770             SvNOK_on(dstr);
1771             SvNVX(dstr) = SvNVX(sstr);
1772         }
1773         if (sflags & SVp_IOK) {
1774             (void)SvIOK_on(dstr);
1775             SvIVX(dstr) = SvIVX(sstr);
1776         }
1777     }
1778     else if (sflags & SVp_NOK) {
1779         SvNVX(dstr) = SvNVX(sstr);
1780         (void)SvNOK_only(dstr);
1781         if (SvIOK(sstr)) {
1782             (void)SvIOK_on(dstr);
1783             SvIVX(dstr) = SvIVX(sstr);
1784         }
1785     }
1786     else if (sflags & SVp_IOK) {
1787         (void)SvIOK_only(dstr);
1788         SvIVX(dstr) = SvIVX(sstr);
1789     }
1790     else {
1791         (void)SvOK_off(dstr);
1792     }
1793     SvTAINT(dstr);
1794 }
1795
1796 void
1797 sv_setpvn(sv,ptr,len)
1798 register SV *sv;
1799 register char *ptr;
1800 register STRLEN len;
1801 {
1802     assert(len >= 0);
1803     if (SvTHINKFIRST(sv)) {
1804         if (SvREADONLY(sv) && curcop != &compiling)
1805             croak(no_modify);
1806         if (SvROK(sv))
1807             sv_unref(sv);
1808     }
1809     if (!ptr) {
1810         (void)SvOK_off(sv);
1811         return;
1812     }
1813     if (SvTYPE(sv) >= SVt_PV) {
1814         if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
1815             sv_unglob(sv);
1816     }
1817     else if (!sv_upgrade(sv, SVt_PV))
1818         return;
1819     SvGROW(sv, len + 1);
1820     Move(ptr,SvPVX(sv),len,char);
1821     SvCUR_set(sv, len);
1822     *SvEND(sv) = '\0';
1823     (void)SvPOK_only(sv);               /* validate pointer */
1824     SvTAINT(sv);
1825 }
1826
1827 void
1828 sv_setpv(sv,ptr)
1829 register SV *sv;
1830 register char *ptr;
1831 {
1832     register STRLEN len;
1833
1834     if (SvTHINKFIRST(sv)) {
1835         if (SvREADONLY(sv) && curcop != &compiling)
1836             croak(no_modify);
1837         if (SvROK(sv))
1838             sv_unref(sv);
1839     }
1840     if (!ptr) {
1841         (void)SvOK_off(sv);
1842         return;
1843     }
1844     len = strlen(ptr);
1845     if (SvTYPE(sv) >= SVt_PV) {
1846         if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
1847             sv_unglob(sv);
1848     }
1849     else if (!sv_upgrade(sv, SVt_PV))
1850         return;
1851     SvGROW(sv, len + 1);
1852     Move(ptr,SvPVX(sv),len+1,char);
1853     SvCUR_set(sv, len);
1854     (void)SvPOK_only(sv);               /* validate pointer */
1855     SvTAINT(sv);
1856 }
1857
1858 void
1859 sv_usepvn(sv,ptr,len)
1860 register SV *sv;
1861 register char *ptr;
1862 register STRLEN len;
1863 {
1864     if (SvTHINKFIRST(sv)) {
1865         if (SvREADONLY(sv) && curcop != &compiling)
1866             croak(no_modify);
1867         if (SvROK(sv))
1868             sv_unref(sv);
1869     }
1870     if (!SvUPGRADE(sv, SVt_PV))
1871         return;
1872     if (!ptr) {
1873         (void)SvOK_off(sv);
1874         return;
1875     }
1876     if (SvPVX(sv))
1877         Safefree(SvPVX(sv));
1878     Renew(ptr, len+1, char);
1879     SvPVX(sv) = ptr;
1880     SvCUR_set(sv, len);
1881     SvLEN_set(sv, len+1);
1882     *SvEND(sv) = '\0';
1883     (void)SvPOK_only(sv);               /* validate pointer */
1884     SvTAINT(sv);
1885 }
1886
1887 void
1888 sv_chop(sv,ptr) /* like set but assuming ptr is in sv */
1889 register SV *sv;
1890 register char *ptr;
1891 {
1892     register STRLEN delta;
1893
1894     if (!ptr || !SvPOKp(sv))
1895         return;
1896     if (SvTHINKFIRST(sv)) {
1897         if (SvREADONLY(sv) && curcop != &compiling)
1898             croak(no_modify);
1899         if (SvROK(sv))
1900             sv_unref(sv);
1901     }
1902     if (SvTYPE(sv) < SVt_PVIV)
1903         sv_upgrade(sv,SVt_PVIV);
1904
1905     if (!SvOOK(sv)) {
1906         SvIVX(sv) = 0;
1907         SvFLAGS(sv) |= SVf_OOK;
1908     }
1909     SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVp_IOK|SVp_NOK);
1910     delta = ptr - SvPVX(sv);
1911     SvLEN(sv) -= delta;
1912     SvCUR(sv) -= delta;
1913     SvPVX(sv) += delta;
1914     SvIVX(sv) += delta;
1915 }
1916
1917 void
1918 sv_catpvn(sv,ptr,len)
1919 register SV *sv;
1920 register char *ptr;
1921 register STRLEN len;
1922 {
1923     STRLEN tlen;
1924     char *junk;
1925
1926     junk = SvPV_force(sv, tlen);
1927     SvGROW(sv, tlen + len + 1);
1928     if (ptr == junk)
1929         ptr = SvPVX(sv);
1930     Move(ptr,SvPVX(sv)+tlen,len,char);
1931     SvCUR(sv) += len;
1932     *SvEND(sv) = '\0';
1933     (void)SvPOK_only(sv);               /* validate pointer */
1934     SvTAINT(sv);
1935 }
1936
1937 void
1938 sv_catsv(dstr,sstr)
1939 SV *dstr;
1940 register SV *sstr;
1941 {
1942     char *s;
1943     STRLEN len;
1944     if (!sstr)
1945         return;
1946     if (s = SvPV(sstr, len))
1947         sv_catpvn(dstr,s,len);
1948 }
1949
1950 void
1951 sv_catpv(sv,ptr)
1952 register SV *sv;
1953 register char *ptr;
1954 {
1955     register STRLEN len;
1956     STRLEN tlen;
1957     char *junk;
1958
1959     if (!ptr)
1960         return;
1961     junk = SvPV_force(sv, tlen);
1962     len = strlen(ptr);
1963     SvGROW(sv, tlen + len + 1);
1964     if (ptr == junk)
1965         ptr = SvPVX(sv);
1966     Move(ptr,SvPVX(sv)+tlen,len+1,char);
1967     SvCUR(sv) += len;
1968     (void)SvPOK_only(sv);               /* validate pointer */
1969     SvTAINT(sv);
1970 }
1971
1972 SV *
1973 #ifdef LEAKTEST
1974 newSV(x,len)
1975 I32 x;
1976 #else
1977 newSV(len)
1978 #endif
1979 STRLEN len;
1980 {
1981     register SV *sv;
1982
1983     new_SV();
1984     SvANY(sv) = 0;
1985     SvREFCNT(sv) = 1;
1986     SvFLAGS(sv) = 0;
1987     if (len) {
1988         sv_upgrade(sv, SVt_PV);
1989         SvGROW(sv, len + 1);
1990     }
1991     return sv;
1992 }
1993
1994 void
1995 sv_magic(sv, obj, how, name, namlen)
1996 register SV *sv;
1997 SV *obj;
1998 int how;
1999 char *name;
2000 I32 namlen;
2001 {
2002     MAGIC* mg;
2003
2004     if (SvREADONLY(sv) && curcop != &compiling && !strchr("gB", how))
2005         croak(no_modify);
2006     if (SvMAGICAL(sv) || (how == 't' && SvTYPE(sv) >= SVt_PVMG)) {
2007         if (SvMAGIC(sv) && (mg = mg_find(sv, how))) {
2008             if (how == 't')
2009                 mg->mg_len |= 1;
2010             return;
2011         }
2012     }
2013     else {
2014         if (!SvUPGRADE(sv, SVt_PVMG))
2015             return;
2016     }
2017     Newz(702,mg, 1, MAGIC);
2018     mg->mg_moremagic = SvMAGIC(sv);
2019
2020     SvMAGIC(sv) = mg;
2021     if (!obj || obj == sv || how == '#')
2022         mg->mg_obj = obj;
2023     else {
2024         mg->mg_obj = SvREFCNT_inc(obj);
2025         mg->mg_flags |= MGf_REFCOUNTED;
2026     }
2027     mg->mg_type = how;
2028     mg->mg_len = namlen;
2029     if (name && namlen >= 0)
2030         mg->mg_ptr = savepvn(name, namlen);
2031     switch (how) {
2032     case 0:
2033         mg->mg_virtual = &vtbl_sv;
2034         break;
2035 #ifdef OVERLOAD
2036     case 'A':
2037         mg->mg_virtual = &vtbl_amagic;
2038         break;
2039     case 'a':
2040         mg->mg_virtual = &vtbl_amagicelem;
2041         break;
2042     case 'c':
2043         mg->mg_virtual = 0;
2044         break;
2045 #endif /* OVERLOAD */
2046     case 'B':
2047         mg->mg_virtual = &vtbl_bm;
2048         break;
2049     case 'E':
2050         mg->mg_virtual = &vtbl_env;
2051         break;
2052     case 'e':
2053         mg->mg_virtual = &vtbl_envelem;
2054         break;
2055     case 'g':
2056         mg->mg_virtual = &vtbl_mglob;
2057         break;
2058     case 'I':
2059         mg->mg_virtual = &vtbl_isa;
2060         break;
2061     case 'i':
2062         mg->mg_virtual = &vtbl_isaelem;
2063         break;
2064     case 'L':
2065         SvRMAGICAL_on(sv);
2066         mg->mg_virtual = 0;
2067         break;
2068     case 'l':
2069         mg->mg_virtual = &vtbl_dbline;
2070         break;
2071     case 'P':
2072         mg->mg_virtual = &vtbl_pack;
2073         break;
2074     case 'p':
2075     case 'q':
2076         mg->mg_virtual = &vtbl_packelem;
2077         break;
2078     case 'S':
2079         mg->mg_virtual = &vtbl_sig;
2080         break;
2081     case 's':
2082         mg->mg_virtual = &vtbl_sigelem;
2083         break;
2084     case 't':
2085         mg->mg_virtual = &vtbl_taint;
2086         mg->mg_len = 1;
2087         break;
2088     case 'U':
2089         mg->mg_virtual = &vtbl_uvar;
2090         break;
2091     case 'v':
2092         mg->mg_virtual = &vtbl_vec;
2093         break;
2094     case 'x':
2095         mg->mg_virtual = &vtbl_substr;
2096         break;
2097     case '*':
2098         mg->mg_virtual = &vtbl_glob;
2099         break;
2100     case '#':
2101         mg->mg_virtual = &vtbl_arylen;
2102         break;
2103     case '.':
2104         mg->mg_virtual = &vtbl_pos;
2105         break;
2106     case '~':   /* Reserved for use by extensions not perl internals.   */
2107         /* Useful for attaching extension internal data to perl vars.   */
2108         /* Note that multiple extensions may clash if magical scalars   */
2109         /* etc holding private data from one are passed to another.     */
2110         SvRMAGICAL_on(sv);
2111         break;
2112     default:
2113         croak("Don't know how to handle magic of type '%c'", how);
2114     }
2115     mg_magical(sv);
2116     if (SvGMAGICAL(sv))
2117         SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
2118 }
2119
2120 int
2121 sv_unmagic(sv, type)
2122 SV* sv;
2123 int type;
2124 {
2125     MAGIC* mg;
2126     MAGIC** mgp;
2127     if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv))
2128         return 0;
2129     mgp = &SvMAGIC(sv);
2130     for (mg = *mgp; mg; mg = *mgp) {
2131         if (mg->mg_type == type) {
2132             MGVTBL* vtbl = mg->mg_virtual;
2133             *mgp = mg->mg_moremagic;
2134             if (vtbl && vtbl->svt_free)
2135                 (*vtbl->svt_free)(sv, mg);
2136             if (mg->mg_ptr && mg->mg_type != 'g')
2137                 Safefree(mg->mg_ptr);
2138             if (mg->mg_flags & MGf_REFCOUNTED)
2139                 SvREFCNT_dec(mg->mg_obj);
2140             Safefree(mg);
2141         }
2142         else
2143             mgp = &mg->mg_moremagic;
2144     }
2145     if (!SvMAGIC(sv)) {
2146         SvMAGICAL_off(sv);
2147         SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
2148     }
2149
2150     return 0;
2151 }
2152
2153 void
2154 sv_insert(bigstr,offset,len,little,littlelen)
2155 SV *bigstr;
2156 STRLEN offset;
2157 STRLEN len;
2158 char *little;
2159 STRLEN littlelen;
2160 {
2161     register char *big;
2162     register char *mid;
2163     register char *midend;
2164     register char *bigend;
2165     register I32 i;
2166
2167     if (!bigstr)
2168         croak("Can't modify non-existent substring");
2169     SvPV_force(bigstr, na);
2170
2171     i = littlelen - len;
2172     if (i > 0) {                        /* string might grow */
2173         big = SvGROW(bigstr, SvCUR(bigstr) + i + 1);
2174         mid = big + offset + len;
2175         midend = bigend = big + SvCUR(bigstr);
2176         bigend += i;
2177         *bigend = '\0';
2178         while (midend > mid)            /* shove everything down */
2179             *--bigend = *--midend;
2180         Move(little,big+offset,littlelen,char);
2181         SvCUR(bigstr) += i;
2182         SvSETMAGIC(bigstr);
2183         return;
2184     }
2185     else if (i == 0) {
2186         Move(little,SvPVX(bigstr)+offset,len,char);
2187         SvSETMAGIC(bigstr);
2188         return;
2189     }
2190
2191     big = SvPVX(bigstr);
2192     mid = big + offset;
2193     midend = mid + len;
2194     bigend = big + SvCUR(bigstr);
2195
2196     if (midend > bigend)
2197         croak("panic: sv_insert");
2198
2199     if (mid - big > bigend - midend) {  /* faster to shorten from end */
2200         if (littlelen) {
2201             Move(little, mid, littlelen,char);
2202             mid += littlelen;
2203         }
2204         i = bigend - midend;
2205         if (i > 0) {
2206             Move(midend, mid, i,char);
2207             mid += i;
2208         }
2209         *mid = '\0';
2210         SvCUR_set(bigstr, mid - big);
2211     }
2212     /*SUPPRESS 560*/
2213     else if (i = mid - big) {   /* faster from front */
2214         midend -= littlelen;
2215         mid = midend;
2216         sv_chop(bigstr,midend-i);
2217         big += i;
2218         while (i--)
2219             *--midend = *--big;
2220         if (littlelen)
2221             Move(little, mid, littlelen,char);
2222     }
2223     else if (littlelen) {
2224         midend -= littlelen;
2225         sv_chop(bigstr,midend);
2226         Move(little,midend,littlelen,char);
2227     }
2228     else {
2229         sv_chop(bigstr,midend);
2230     }
2231     SvSETMAGIC(bigstr);
2232 }
2233
2234 /* make sv point to what nstr did */
2235
2236 void
2237 sv_replace(sv,nsv)
2238 register SV *sv;
2239 register SV *nsv;
2240 {
2241     U32 refcnt = SvREFCNT(sv);
2242     if (SvTHINKFIRST(sv)) {
2243         if (SvREADONLY(sv) && curcop != &compiling)
2244             croak(no_modify);
2245         if (SvROK(sv))
2246             sv_unref(sv);
2247     }
2248     if (SvREFCNT(nsv) != 1)
2249         warn("Reference miscount in sv_replace()");
2250     if (SvMAGICAL(sv)) {
2251         if (SvMAGICAL(nsv))
2252             mg_free(nsv);
2253         else
2254             sv_upgrade(nsv, SVt_PVMG);
2255         SvMAGIC(nsv) = SvMAGIC(sv);
2256         SvFLAGS(nsv) |= SvMAGICAL(sv);
2257         SvMAGICAL_off(sv);
2258         SvMAGIC(sv) = 0;
2259     }
2260     SvREFCNT(sv) = 0;
2261     sv_clear(sv);
2262     StructCopy(nsv,sv,SV);
2263     SvREFCNT(sv) = refcnt;
2264     del_SV(nsv);
2265 }
2266
2267 void
2268 sv_clear(sv)
2269 register SV *sv;
2270 {
2271     assert(sv);
2272     assert(SvREFCNT(sv) == 0);
2273
2274     if (SvOBJECT(sv)) {
2275         dSP;
2276         GV* destructor;
2277
2278         if (defstash) {         /* Still have a symbol table? */
2279             destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
2280
2281             ENTER;
2282             SAVEFREESV(SvSTASH(sv));
2283             if (destructor && GvCV(destructor)) {
2284                 SV ref;
2285
2286                 Zero(&ref, 1, SV);
2287                 sv_upgrade(&ref, SVt_RV);
2288                 SAVEI32(SvREFCNT(sv));
2289                 SvRV(&ref) = SvREFCNT_inc(sv);
2290                 SvROK_on(&ref);
2291
2292                 EXTEND(SP, 2);
2293                 PUSHMARK(SP);
2294                 PUSHs(&ref);
2295                 PUTBACK;
2296                 perl_call_sv((SV*)destructor, G_DISCARD|G_EVAL|G_KEEPERR);
2297                 del_XRV(SvANY(&ref));
2298             }
2299             LEAVE;
2300         }
2301         else
2302             SvREFCNT_dec(SvSTASH(sv));
2303         if (SvOBJECT(sv)) {
2304             SvOBJECT_off(sv);   /* Curse the object. */
2305             if (SvTYPE(sv) != SVt_PVIO)
2306                 --sv_objcount;  /* XXX Might want something more general */
2307         }
2308     }
2309     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
2310         mg_free(sv);
2311     switch (SvTYPE(sv)) {
2312     case SVt_PVIO:
2313         io_close((IO*)sv);
2314         Safefree(IoTOP_NAME(sv));
2315         Safefree(IoFMT_NAME(sv));
2316         Safefree(IoBOTTOM_NAME(sv));
2317         /* FALL THROUGH */
2318     case SVt_PVBM:
2319         goto freescalar;
2320     case SVt_PVCV:
2321     case SVt_PVFM:
2322         cv_undef((CV*)sv);
2323         goto freescalar;
2324     case SVt_PVHV:
2325         hv_undef((HV*)sv);
2326         break;
2327     case SVt_PVAV:
2328         av_undef((AV*)sv);
2329         break;
2330     case SVt_PVGV:
2331         gp_free(sv);
2332         Safefree(GvNAME(sv));
2333         /* FALL THROUGH */
2334     case SVt_PVLV:
2335     case SVt_PVMG:
2336     case SVt_PVNV:
2337     case SVt_PVIV:
2338       freescalar:
2339         (void)SvOOK_off(sv);
2340         /* FALL THROUGH */
2341     case SVt_PV:
2342     case SVt_RV:
2343         if (SvROK(sv))
2344             SvREFCNT_dec(SvRV(sv));
2345         else if (SvPVX(sv))
2346             Safefree(SvPVX(sv));
2347         break;
2348 /*
2349     case SVt_NV:
2350     case SVt_IV:
2351     case SVt_NULL:
2352         break;
2353 */
2354     }
2355
2356     switch (SvTYPE(sv)) {
2357     case SVt_NULL:
2358         break;
2359     case SVt_IV:
2360         del_XIV(SvANY(sv));
2361         break;
2362     case SVt_NV:
2363         del_XNV(SvANY(sv));
2364         break;
2365     case SVt_RV:
2366         del_XRV(SvANY(sv));
2367         break;
2368     case SVt_PV:
2369         del_XPV(SvANY(sv));
2370         break;
2371     case SVt_PVIV:
2372         del_XPVIV(SvANY(sv));
2373         break;
2374     case SVt_PVNV:
2375         del_XPVNV(SvANY(sv));
2376         break;
2377     case SVt_PVMG:
2378         del_XPVMG(SvANY(sv));
2379         break;
2380     case SVt_PVLV:
2381         del_XPVLV(SvANY(sv));
2382         break;
2383     case SVt_PVAV:
2384         del_XPVAV(SvANY(sv));
2385         break;
2386     case SVt_PVHV:
2387         del_XPVHV(SvANY(sv));
2388         break;
2389     case SVt_PVCV:
2390         del_XPVCV(SvANY(sv));
2391         break;
2392     case SVt_PVGV:
2393         del_XPVGV(SvANY(sv));
2394         break;
2395     case SVt_PVBM:
2396         del_XPVBM(SvANY(sv));
2397         break;
2398     case SVt_PVFM:
2399         del_XPVFM(SvANY(sv));
2400         break;
2401     case SVt_PVIO:
2402         del_XPVIO(SvANY(sv));
2403         break;
2404     }
2405     SvFLAGS(sv) &= SVf_BREAK;
2406     SvFLAGS(sv) |= SVTYPEMASK;
2407 }
2408
2409 SV *
2410 sv_newref(sv)
2411 SV* sv;
2412 {
2413     if (sv)
2414         SvREFCNT(sv)++;
2415     return sv;
2416 }
2417
2418 void
2419 sv_free(sv)
2420 SV *sv;
2421 {
2422     if (!sv)
2423         return;
2424     if (SvREADONLY(sv)) {
2425         if (sv == &sv_undef || sv == &sv_yes || sv == &sv_no)
2426             return;
2427     }
2428     if (SvREFCNT(sv) == 0) {
2429         if (SvFLAGS(sv) & SVf_BREAK)
2430             return;
2431         warn("Attempt to free unreferenced scalar");
2432         return;
2433     }
2434     if (--SvREFCNT(sv) > 0)
2435         return;
2436 #ifdef DEBUGGING
2437     if (SvTEMP(sv)) {
2438         warn("Attempt to free temp prematurely");
2439         return;
2440     }
2441 #endif
2442     sv_clear(sv);
2443     del_SV(sv);
2444 }
2445
2446 STRLEN
2447 sv_len(sv)
2448 register SV *sv;
2449 {
2450     char *junk;
2451     STRLEN len;
2452
2453     if (!sv)
2454         return 0;
2455
2456     if (SvGMAGICAL(sv))
2457         len = mg_len(sv);
2458     else
2459         junk = SvPV(sv, len);
2460     return len;
2461 }
2462
2463 I32
2464 sv_eq(str1,str2)
2465 register SV *str1;
2466 register SV *str2;
2467 {
2468     char *pv1;
2469     STRLEN cur1;
2470     char *pv2;
2471     STRLEN cur2;
2472
2473     if (!str1) {
2474         pv1 = "";
2475         cur1 = 0;
2476     }
2477     else
2478         pv1 = SvPV(str1, cur1);
2479
2480     if (!str2)
2481         return !cur1;
2482     else
2483         pv2 = SvPV(str2, cur2);
2484
2485     if (cur1 != cur2)
2486         return 0;
2487
2488     return !bcmp(pv1, pv2, cur1);
2489 }
2490
2491 I32
2492 sv_cmp(str1,str2)
2493 register SV *str1;
2494 register SV *str2;
2495 {
2496     I32 retval;
2497     char *pv1;
2498     STRLEN cur1;
2499     char *pv2;
2500     STRLEN cur2;
2501
2502     if (!str1) {
2503         pv1 = "";
2504         cur1 = 0;
2505     }
2506     else
2507         pv1 = SvPV(str1, cur1);
2508
2509     if (!str2) {
2510         pv2 = "";
2511         cur2 = 0;
2512     }
2513     else
2514         pv2 = SvPV(str2, cur2);
2515
2516     if (!cur1)
2517         return cur2 ? -1 : 0;
2518     if (!cur2)
2519         return 1;
2520
2521     if (cur1 < cur2) {
2522         /*SUPPRESS 560*/
2523         if (retval = memcmp((void*)pv1, (void*)pv2, cur1))
2524             return retval < 0 ? -1 : 1;
2525         else
2526             return -1;
2527     }
2528     /*SUPPRESS 560*/
2529     else if (retval = memcmp((void*)pv1, (void*)pv2, cur2))
2530         return retval < 0 ? -1 : 1;
2531     else if (cur1 == cur2)
2532         return 0;
2533     else
2534         return 1;
2535 }
2536
2537 char *
2538 sv_gets(sv,fp,append)
2539 register SV *sv;
2540 register FILE *fp;
2541 I32 append;
2542 {
2543     char *rsptr;
2544     STRLEN rslen;
2545     register STDCHAR rslast;
2546     register STDCHAR *bp;
2547     register I32 cnt;
2548     I32 i;
2549
2550 #ifdef FAST_SV_GETS
2551     /*
2552      * We're going to steal some values from the stdio struct
2553      * and put EVERYTHING in the innermost loop into registers.
2554      */
2555     register STDCHAR *ptr;
2556     STRLEN bpx;
2557     I32 shortbuffered;
2558 #endif
2559
2560     if (SvTHINKFIRST(sv)) {
2561         if (SvREADONLY(sv) && curcop != &compiling)
2562             croak(no_modify);
2563         if (SvROK(sv))
2564             sv_unref(sv);
2565     }
2566     if (!SvUPGRADE(sv, SVt_PV))
2567         return 0;
2568
2569     if (RsSNARF(rs)) {
2570         rsptr = NULL;
2571         rslen = 0;
2572     }
2573     else if (RsPARA(rs)) {
2574         rsptr = "\n\n";
2575         rslen = 2;
2576     }
2577     else
2578         rsptr = SvPV(rs, rslen);
2579     rslast = rslen ? rsptr[rslen - 1] : '\0';
2580
2581     if (RsPARA(rs)) {           /* have to do this both before and after */
2582         do {                    /* to make sure file boundaries work right */
2583             if (feof(fp))
2584                 return 0;
2585             i = getc(fp);
2586             if (i != '\n') {
2587                 if (i == -1)
2588                     return 0;
2589                 ungetc(i,fp);
2590                 break;
2591             }
2592         } while (i != EOF);
2593     }
2594
2595 #ifdef FAST_SV_GETS
2596
2597     /* Here is some breathtakingly efficient cheating */
2598
2599     cnt = FILE_cnt(fp);                 /* get count into register */
2600     (void)SvPOK_only(sv);               /* validate pointer */
2601     if (SvLEN(sv) - append <= cnt + 1) { /* make sure we have the room */
2602         if (cnt > 80 && SvLEN(sv) > append) {
2603             shortbuffered = cnt - SvLEN(sv) + append + 1;
2604             cnt -= shortbuffered;
2605         }
2606         else {
2607             shortbuffered = 0;
2608             SvGROW(sv, append+cnt+2);/* (remembering cnt can be -1) */
2609         }
2610     }
2611     else
2612         shortbuffered = 0;
2613     bp = (STDCHAR*)SvPVX(sv) + append;  /* move these two too to registers */
2614     ptr = FILE_ptr(fp);
2615     for (;;) {
2616       screamer:
2617         if (cnt > 0) {
2618             if (rslen) {
2619                 while (--cnt >= 0) {                 /* this     |  eat */
2620                     if ((*bp++ = *ptr++) == rslast)  /* really   |  dust */
2621                         goto thats_all_folks;        /* screams  |  sed :-) */
2622                 }
2623             }
2624             else {
2625                 memcpy((char*)bp, (char*)ptr, cnt);  /* this     |  eat */
2626                 bp += cnt;                           /* screams  |  dust */
2627                 ptr += cnt;                          /* louder   |  sed :-) */
2628                 cnt = 0;
2629             }
2630         }
2631
2632         if (shortbuffered) {            /* oh well, must extend */
2633             cnt = shortbuffered;
2634             shortbuffered = 0;
2635             bpx = bp - (STDCHAR*)SvPVX(sv); /* box up before relocation */
2636             SvCUR_set(sv, bpx);
2637             SvGROW(sv, SvLEN(sv) + append + cnt + 2);
2638             bp = (STDCHAR*)SvPVX(sv) + bpx; /* unbox after relocation */
2639             continue;
2640         }
2641
2642         FILE_cnt(fp) = cnt;             /* deregisterize cnt and ptr */
2643         FILE_ptr(fp) = ptr;
2644         i = _filbuf(fp);                /* get more characters */
2645         cnt = FILE_cnt(fp);
2646         ptr = FILE_ptr(fp);             /* reregisterize cnt and ptr */
2647
2648         if (i == EOF)                   /* all done for ever? */
2649             goto thats_really_all_folks;
2650
2651         bpx = bp - (STDCHAR*)SvPVX(sv); /* box up before relocation */
2652         SvCUR_set(sv, bpx);
2653         SvGROW(sv, bpx + cnt + 2);
2654         bp = (STDCHAR*)SvPVX(sv) + bpx; /* unbox after relocation */
2655
2656         *bp++ = i;                      /* store character from _filbuf */
2657
2658         if (rslen && (STDCHAR)i == rslast)  /* all done for now? */
2659             goto thats_all_folks;
2660     }
2661
2662 thats_all_folks:
2663     if ((rslen > 1 && (bp - (STDCHAR*)SvPVX(sv) < rslen)) ||
2664           bcmp((char*)bp - rslen, rsptr, rslen))
2665         goto screamer;                  /* go back to the fray */
2666 thats_really_all_folks:
2667     if (shortbuffered)
2668         cnt += shortbuffered;
2669     FILE_cnt(fp) = cnt;                 /* put these back or we're in trouble */
2670     FILE_ptr(fp) = ptr;
2671     *bp = '\0';
2672     SvCUR_set(sv, bp - (STDCHAR*)SvPVX(sv));  /* set length */
2673
2674 #else /* SV_FAST_GETS */
2675
2676     /*The big, slow, and stupid way */
2677
2678     {
2679         STDCHAR buf[8192];
2680
2681 screamer:
2682         if (rslen) {
2683             register STDCHAR *bpe = buf + sizeof(buf);
2684             bp = buf;
2685             while ((i = getc(fp)) != EOF && (*bp++ = i) != rslast && bp < bpe)
2686                 ; /* keep reading */
2687             cnt = bp - buf;
2688         }
2689         else {
2690             cnt = fread((char*)buf, 1, sizeof(buf), fp);
2691             i = cnt ? (U8)buf[cnt - 1] : EOF;
2692         }
2693
2694         if (append)
2695             sv_catpvn(sv, buf, cnt);
2696         else
2697             sv_setpvn(sv, buf, cnt);
2698
2699         if (i != EOF &&                 /* joy */
2700             (!rslen ||
2701              SvCUR(sv) < rslen ||
2702              bcmp(SvPVX(sv) + SvCUR(sv) - rslen, rsptr, rslen)))
2703         {
2704             append = -1;
2705             goto screamer;
2706         }
2707     }
2708
2709 #endif /* SV_FAST_GETS */
2710
2711     if (RsPARA(rs)) {           /* have to do this both before and after */
2712         while (i != EOF) {      /* to make sure file boundaries work right */
2713             i = getc(fp);
2714             if (i != '\n') {
2715                 ungetc(i,fp);
2716                 break;
2717             }
2718         }
2719     }
2720
2721     return (SvCUR(sv) - append) ? SvPVX(sv) : Nullch;
2722 }
2723
2724 void
2725 sv_inc(sv)
2726 register SV *sv;
2727 {
2728     register char *d;
2729     int flags;
2730
2731     if (!sv)
2732         return;
2733     if (SvTHINKFIRST(sv)) {
2734         if (SvREADONLY(sv) && curcop != &compiling)
2735             croak(no_modify);
2736         if (SvROK(sv)) {
2737 #ifdef OVERLOAD
2738           if (SvAMAGIC(sv) && AMG_CALLun(sv,inc)) return;
2739 #endif /* OVERLOAD */
2740           sv_unref(sv);
2741         }
2742     }
2743     if (SvGMAGICAL(sv))
2744         mg_get(sv);
2745     flags = SvFLAGS(sv);
2746     if (flags & SVp_IOK) {
2747         (void)SvIOK_only(sv);
2748         ++SvIVX(sv);
2749         return;
2750     }
2751     if (flags & SVp_NOK) {
2752         SvNVX(sv) += 1.0;
2753         (void)SvNOK_only(sv);
2754         return;
2755     }
2756     if (!(flags & SVp_POK) || !*SvPVX(sv)) {
2757         if ((flags & SVTYPEMASK) < SVt_PVNV)
2758             sv_upgrade(sv, SVt_NV);
2759         SvNVX(sv) = 1.0;
2760         (void)SvNOK_only(sv);
2761         return;
2762     }
2763     d = SvPVX(sv);
2764     while (isALPHA(*d)) d++;
2765     while (isDIGIT(*d)) d++;
2766     if (*d) {
2767         sv_setnv(sv,atof(SvPVX(sv)) + 1.0);  /* punt */
2768         return;
2769     }
2770     d--;
2771     while (d >= SvPVX(sv)) {
2772         if (isDIGIT(*d)) {
2773             if (++*d <= '9')
2774                 return;
2775             *(d--) = '0';
2776         }
2777         else {
2778             ++*d;
2779             if (isALPHA(*d))
2780                 return;
2781             *(d--) -= 'z' - 'a' + 1;
2782         }
2783     }
2784     /* oh,oh, the number grew */
2785     SvGROW(sv, SvCUR(sv) + 2);
2786     SvCUR(sv)++;
2787     for (d = SvPVX(sv) + SvCUR(sv); d > SvPVX(sv); d--)
2788         *d = d[-1];
2789     if (isDIGIT(d[1]))
2790         *d = '1';
2791     else
2792         *d = d[1];
2793 }
2794
2795 void
2796 sv_dec(sv)
2797 register SV *sv;
2798 {
2799     int flags;
2800
2801     if (!sv)
2802         return;
2803     if (SvTHINKFIRST(sv)) {
2804         if (SvREADONLY(sv) && curcop != &compiling)
2805             croak(no_modify);
2806         if (SvROK(sv)) {
2807 #ifdef OVERLOAD
2808           if (SvAMAGIC(sv) && AMG_CALLun(sv,dec)) return;
2809 #endif /* OVERLOAD */
2810           sv_unref(sv);
2811         }
2812     }
2813     if (SvGMAGICAL(sv))
2814         mg_get(sv);
2815     flags = SvFLAGS(sv);
2816     if (flags & SVp_IOK) {
2817         (void)SvIOK_only(sv);
2818         --SvIVX(sv);
2819         return;
2820     }
2821     if (flags & SVp_NOK) {
2822         SvNVX(sv) -= 1.0;
2823         (void)SvNOK_only(sv);
2824         return;
2825     }
2826     if (!(flags & SVp_POK)) {
2827         if ((flags & SVTYPEMASK) < SVt_PVNV)
2828             sv_upgrade(sv, SVt_NV);
2829         SvNVX(sv) = -1.0;
2830         (void)SvNOK_only(sv);
2831         return;
2832     }
2833     sv_setnv(sv,atof(SvPVX(sv)) - 1.0);
2834 }
2835
2836 /* Make a string that will exist for the duration of the expression
2837  * evaluation.  Actually, it may have to last longer than that, but
2838  * hopefully we won't free it until it has been assigned to a
2839  * permanent location. */
2840
2841 static void
2842 sv_mortalgrow()
2843 {
2844     tmps_max += 128;
2845     Renew(tmps_stack, tmps_max, SV*);
2846 }
2847
2848 SV *
2849 sv_mortalcopy(oldstr)
2850 SV *oldstr;
2851 {
2852     register SV *sv;
2853
2854     new_SV();
2855     SvANY(sv) = 0;
2856     SvREFCNT(sv) = 1;
2857     SvFLAGS(sv) = 0;
2858     sv_setsv(sv,oldstr);
2859     if (++tmps_ix >= tmps_max)
2860         sv_mortalgrow();
2861     tmps_stack[tmps_ix] = sv;
2862     SvTEMP_on(sv);
2863     return sv;
2864 }
2865
2866 SV *
2867 sv_newmortal()
2868 {
2869     register SV *sv;
2870
2871     new_SV();
2872     SvANY(sv) = 0;
2873     SvREFCNT(sv) = 1;
2874     SvFLAGS(sv) = SVs_TEMP;
2875     if (++tmps_ix >= tmps_max)
2876         sv_mortalgrow();
2877     tmps_stack[tmps_ix] = sv;
2878     return sv;
2879 }
2880
2881 /* same thing without the copying */
2882
2883 SV *
2884 sv_2mortal(sv)
2885 register SV *sv;
2886 {
2887     if (!sv)
2888         return sv;
2889     if (SvREADONLY(sv) && curcop != &compiling)
2890         croak(no_modify);
2891     if (++tmps_ix >= tmps_max)
2892         sv_mortalgrow();
2893     tmps_stack[tmps_ix] = sv;
2894     SvTEMP_on(sv);
2895     return sv;
2896 }
2897
2898 SV *
2899 newSVpv(s,len)
2900 char *s;
2901 STRLEN len;
2902 {
2903     register SV *sv;
2904
2905     new_SV();
2906     SvANY(sv) = 0;
2907     SvREFCNT(sv) = 1;
2908     SvFLAGS(sv) = 0;
2909     if (!len)
2910         len = strlen(s);
2911     sv_setpvn(sv,s,len);
2912     return sv;
2913 }
2914
2915 SV *
2916 newSVnv(n)
2917 double n;
2918 {
2919     register SV *sv;
2920
2921     new_SV();
2922     SvANY(sv) = 0;
2923     SvREFCNT(sv) = 1;
2924     SvFLAGS(sv) = 0;
2925     sv_setnv(sv,n);
2926     return sv;
2927 }
2928
2929 SV *
2930 newSViv(i)
2931 IV i;
2932 {
2933     register SV *sv;
2934
2935     new_SV();
2936     SvANY(sv) = 0;
2937     SvREFCNT(sv) = 1;
2938     SvFLAGS(sv) = 0;
2939     sv_setiv(sv,i);
2940     return sv;
2941 }
2942
2943 SV *
2944 newRV(ref)
2945 SV *ref;
2946 {
2947     register SV *sv;
2948
2949     new_SV();
2950     SvANY(sv) = 0;
2951     SvREFCNT(sv) = 1;
2952     SvFLAGS(sv) = 0;
2953     sv_upgrade(sv, SVt_RV);
2954     SvTEMP_off(ref);
2955     SvRV(sv) = SvREFCNT_inc(ref);
2956     SvROK_on(sv);
2957     return sv;
2958 }
2959
2960 /* make an exact duplicate of old */
2961
2962 SV *
2963 newSVsv(old)
2964 register SV *old;
2965 {
2966     register SV *sv;
2967
2968     if (!old)
2969         return Nullsv;
2970     if (SvTYPE(old) == SVTYPEMASK) {
2971         warn("semi-panic: attempt to dup freed string");
2972         return Nullsv;
2973     }
2974     new_SV();
2975     SvANY(sv) = 0;
2976     SvREFCNT(sv) = 1;
2977     SvFLAGS(sv) = 0;
2978     if (SvTEMP(old)) {
2979         SvTEMP_off(old);
2980         sv_setsv(sv,old);
2981         SvTEMP_on(old);
2982     }
2983     else
2984         sv_setsv(sv,old);
2985     return sv;
2986 }
2987
2988 void
2989 sv_reset(s,stash)
2990 register char *s;
2991 HV *stash;
2992 {
2993     register HE *entry;
2994     register GV *gv;
2995     register SV *sv;
2996     register I32 i;
2997     register PMOP *pm;
2998     register I32 max;
2999     char todo[256];
3000
3001     if (!*s) {          /* reset ?? searches */
3002         for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) {
3003             pm->op_pmflags &= ~PMf_USED;
3004         }
3005         return;
3006     }
3007
3008     /* reset variables */
3009
3010     if (!HvARRAY(stash))
3011         return;
3012
3013     Zero(todo, 256, char);
3014     while (*s) {
3015         i = *s;
3016         if (s[1] == '-') {
3017             s += 2;
3018         }
3019         max = *s++;
3020         for ( ; i <= max; i++) {
3021             todo[i] = 1;
3022         }
3023         for (i = 0; i <= (I32) HvMAX(stash); i++) {
3024             for (entry = HvARRAY(stash)[i];
3025               entry;
3026               entry = entry->hent_next) {
3027                 if (!todo[(U8)*entry->hent_key])
3028                     continue;
3029                 gv = (GV*)entry->hent_val;
3030                 sv = GvSV(gv);
3031                 (void)SvOK_off(sv);
3032                 if (SvTYPE(sv) >= SVt_PV) {
3033                     SvCUR_set(sv, 0);
3034                     SvTAINT(sv);
3035                     if (SvPVX(sv) != Nullch)
3036                         *SvPVX(sv) = '\0';
3037                 }
3038                 if (GvAV(gv)) {
3039                     av_clear(GvAV(gv));
3040                 }
3041                 if (GvHV(gv)) {
3042                     if (HvNAME(GvHV(gv)))
3043                         continue;
3044                     hv_clear(GvHV(gv));
3045 #ifndef VMS  /* VMS has no environ array */
3046                     if (gv == envgv)
3047                         environ[0] = Nullch;
3048 #endif
3049                 }
3050             }
3051         }
3052     }
3053 }
3054
3055 CV *
3056 sv_2cv(sv, st, gvp, lref)
3057 SV *sv;
3058 HV **st;
3059 GV **gvp;
3060 I32 lref;
3061 {
3062     GV *gv;
3063     CV *cv;
3064
3065     if (!sv)
3066         return *gvp = Nullgv, Nullcv;
3067     switch (SvTYPE(sv)) {
3068     case SVt_PVCV:
3069         *st = CvSTASH(sv);
3070         *gvp = Nullgv;
3071         return (CV*)sv;
3072     case SVt_PVHV:
3073     case SVt_PVAV:
3074         *gvp = Nullgv;
3075         return Nullcv;
3076     case SVt_PVGV:
3077         gv = (GV*)sv;
3078         *gvp = gv;
3079         *st = GvESTASH(gv);
3080         goto fix_gv;
3081
3082     default:
3083         if (SvGMAGICAL(sv))
3084             mg_get(sv);
3085         if (SvROK(sv)) {
3086             cv = (CV*)SvRV(sv);
3087             if (SvTYPE(cv) != SVt_PVCV)
3088                 croak("Not a subroutine reference");
3089             *gvp = Nullgv;
3090             *st = CvSTASH(cv);
3091             return cv;
3092         }
3093         if (isGV(sv))
3094             gv = (GV*)sv;
3095         else
3096             gv = gv_fetchpv(SvPV(sv, na), lref, SVt_PVCV);
3097         *gvp = gv;
3098         if (!gv)
3099             return Nullcv;
3100         *st = GvESTASH(gv);
3101     fix_gv:
3102         if (lref && !GvCV(gv)) {
3103             SV *tmpsv;
3104             ENTER;
3105             tmpsv = NEWSV(704,0);
3106             gv_efullname(tmpsv, gv);
3107             newSUB(start_subparse(),
3108                    newSVOP(OP_CONST, 0, tmpsv),
3109                    Nullop,
3110                    Nullop);
3111             LEAVE;
3112             if (!GvCV(gv))
3113                 croak("Unable to create sub named \"%s\"", SvPV(sv,na));
3114         }
3115         return GvCV(gv);
3116     }
3117 }
3118
3119 #ifndef SvTRUE
3120 I32
3121 SvTRUE(sv)
3122 register SV *sv;
3123 {
3124     if (!sv)
3125         return 0;
3126     if (SvGMAGICAL(sv))
3127         mg_get(sv);
3128     if (SvPOK(sv)) {
3129         register XPV* Xpv;
3130         if ((Xpv = (XPV*)SvANY(sv)) &&
3131                 (*Xpv->xpv_pv > '0' ||
3132                 Xpv->xpv_cur > 1 ||
3133                 (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
3134             return 1;
3135         else
3136             return 0;
3137     }
3138     else {
3139         if (SvIOK(sv))
3140             return SvIVX(sv) != 0;
3141         else {
3142             if (SvNOK(sv))
3143                 return SvNVX(sv) != 0.0;
3144             else
3145                 return sv_2bool(sv);
3146         }
3147     }
3148 }
3149 #endif /* SvTRUE */
3150
3151 #ifndef SvIV
3152 IV SvIV(Sv)
3153 register SV *Sv;
3154 {
3155     if (SvIOK(Sv))
3156         return SvIVX(Sv);
3157     return sv_2iv(Sv);
3158 }
3159 #endif /* SvIV */
3160
3161
3162 #ifndef SvNV
3163 double SvNV(Sv)
3164 register SV *Sv;
3165 {
3166     if (SvNOK(Sv))
3167         return SvNVX(Sv);
3168     if (SvIOK(Sv))
3169         return (double)SvIVX(Sv);
3170     return sv_2nv(Sv);
3171 }
3172 #endif /* SvNV */
3173
3174 #ifdef CRIPPLED_CC
3175 char *
3176 sv_pvn(sv, lp)
3177 SV *sv;
3178 STRLEN *lp;
3179 {
3180     if (SvPOK(sv)) {
3181         *lp = SvCUR(sv);
3182         return SvPVX(sv);
3183     }
3184     return sv_2pv(sv, lp);
3185 }
3186 #endif
3187
3188 char *
3189 sv_pvn_force(sv, lp)
3190 SV *sv;
3191 STRLEN *lp;
3192 {
3193     char *s;
3194
3195     if (SvREADONLY(sv) && curcop != &compiling)
3196         croak(no_modify);
3197
3198     if (SvPOK(sv)) {
3199         *lp = SvCUR(sv);
3200     }
3201     else {
3202         if (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM) {
3203             if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) {
3204                 sv_unglob(sv);
3205                 s = SvPVX(sv);
3206                 *lp = SvCUR(sv);
3207             }
3208             else
3209                 croak("Can't coerce %s to string in %s", sv_reftype(sv,0),
3210                     op_name[op->op_type]);
3211         }
3212         else
3213             s = sv_2pv(sv, lp);
3214         if (s != SvPVX(sv)) {   /* Almost, but not quite, sv_setpvn() */
3215             STRLEN len = *lp;
3216
3217             if (SvROK(sv))
3218                 sv_unref(sv);
3219             (void)SvUPGRADE(sv, SVt_PV);                /* Never FALSE */
3220             SvGROW(sv, len + 1);
3221             Move(s,SvPVX(sv),len,char);
3222             SvCUR_set(sv, len);
3223             *SvEND(sv) = '\0';
3224         }
3225         if (!SvPOK(sv)) {
3226             SvPOK_on(sv);               /* validate pointer */
3227             SvTAINT(sv);
3228             DEBUG_c(fprintf(stderr,"0x%lx 2pv(%s)\n",
3229                 (unsigned long)sv,SvPVX(sv)));
3230         }
3231     }
3232     return SvPVX(sv);
3233 }
3234
3235 char *
3236 sv_reftype(sv, ob)
3237 SV* sv;
3238 int ob;
3239 {
3240     if (ob && SvOBJECT(sv))
3241         return HvNAME(SvSTASH(sv));
3242     else {
3243         switch (SvTYPE(sv)) {
3244         case SVt_NULL:
3245         case SVt_IV:
3246         case SVt_NV:
3247         case SVt_RV:
3248         case SVt_PV:
3249         case SVt_PVIV:
3250         case SVt_PVNV:
3251         case SVt_PVMG:
3252         case SVt_PVBM:
3253                                 if (SvROK(sv))
3254                                     return "REF";
3255                                 else
3256                                     return "SCALAR";
3257         case SVt_PVLV:          return "LVALUE";
3258         case SVt_PVAV:          return "ARRAY";
3259         case SVt_PVHV:          return "HASH";
3260         case SVt_PVCV:          return "CODE";
3261         case SVt_PVGV:          return "GLOB";
3262         case SVt_PVFM:          return "FORMLINE";
3263         default:                return "UNKNOWN";
3264         }
3265     }
3266 }
3267
3268 int
3269 sv_isobject(sv)
3270 SV *sv;
3271 {
3272     if (!SvROK(sv))
3273         return 0;
3274     sv = (SV*)SvRV(sv);
3275     if (!SvOBJECT(sv))
3276         return 0;
3277     return 1;
3278 }
3279
3280 int
3281 sv_isa(sv, name)
3282 SV *sv;
3283 char *name;
3284 {
3285     if (!SvROK(sv))
3286         return 0;
3287     sv = (SV*)SvRV(sv);
3288     if (!SvOBJECT(sv))
3289         return 0;
3290
3291     return strEQ(HvNAME(SvSTASH(sv)), name);
3292 }
3293
3294 SV*
3295 newSVrv(rv, classname)
3296 SV *rv;
3297 char *classname;
3298 {
3299     SV *sv;
3300
3301     new_SV();
3302     SvANY(sv) = 0;
3303     SvREFCNT(sv) = 0;
3304     SvFLAGS(sv) = 0;
3305     sv_upgrade(rv, SVt_RV);
3306     SvRV(rv) = SvREFCNT_inc(sv);
3307     SvROK_on(rv);
3308
3309     if (classname) {
3310         HV* stash = gv_stashpv(classname, TRUE);
3311         (void)sv_bless(rv, stash);
3312     }
3313     return sv;
3314 }
3315
3316 SV*
3317 sv_setref_pv(rv, classname, pv)
3318 SV *rv;
3319 char *classname;
3320 void* pv;
3321 {
3322     if (!pv)
3323         sv_setsv(rv, &sv_undef);
3324     else
3325         sv_setiv(newSVrv(rv,classname), (IV)pv);
3326     return rv;
3327 }
3328
3329 SV*
3330 sv_setref_iv(rv, classname, iv)
3331 SV *rv;
3332 char *classname;
3333 IV iv;
3334 {
3335     sv_setiv(newSVrv(rv,classname), iv);
3336     return rv;
3337 }
3338
3339 SV*
3340 sv_setref_nv(rv, classname, nv)
3341 SV *rv;
3342 char *classname;
3343 double nv;
3344 {
3345     sv_setnv(newSVrv(rv,classname), nv);
3346     return rv;
3347 }
3348
3349 SV*
3350 sv_setref_pvn(rv, classname, pv, n)
3351 SV *rv;
3352 char *classname;
3353 char* pv;
3354 I32 n;
3355 {
3356     sv_setpvn(newSVrv(rv,classname), pv, n);
3357     return rv;
3358 }
3359
3360 SV*
3361 sv_bless(sv,stash)
3362 SV* sv;
3363 HV* stash;
3364 {
3365     SV *ref;
3366     if (!SvROK(sv))
3367         croak("Can't bless non-reference value");
3368     ref = SvRV(sv);
3369     if (SvFLAGS(ref) & (SVs_OBJECT|SVf_READONLY)) {
3370         if (SvREADONLY(ref))
3371             croak(no_modify);
3372         if (SvOBJECT(ref) && SvTYPE(ref) != SVt_PVIO)
3373             --sv_objcount;
3374     }
3375     SvOBJECT_on(ref);
3376     ++sv_objcount;
3377     (void)SvUPGRADE(ref, SVt_PVMG);
3378     SvSTASH(ref) = (HV*)SvREFCNT_inc(stash);
3379
3380 #ifdef OVERLOAD
3381     SvAMAGIC_off(sv);
3382     if (Gv_AMG(stash)) {
3383       SvAMAGIC_on(sv);
3384     }
3385 #endif /* OVERLOAD */
3386
3387     return sv;
3388 }
3389
3390 static void
3391 sv_unglob(sv)
3392 SV* sv;
3393 {
3394     assert(SvTYPE(sv) == SVt_PVGV);
3395     SvFAKE_off(sv);
3396     if (GvGP(sv))
3397         gp_free(sv);
3398     sv_unmagic(sv, '*');
3399     Safefree(GvNAME(sv));
3400     GvMULTI_off(sv);
3401     SvFLAGS(sv) &= ~SVTYPEMASK;
3402     SvFLAGS(sv) |= SVt_PVMG;
3403 }
3404
3405 void
3406 sv_unref(sv)
3407 SV* sv;
3408 {
3409     SV* rv = SvRV(sv);
3410
3411     SvRV(sv) = 0;
3412     SvROK_off(sv);
3413     if (SvREFCNT(rv) != 1 || SvREADONLY(rv))
3414         SvREFCNT_dec(rv);
3415     else
3416         sv_2mortal(rv);         /* Schedule for freeing later */
3417 }
3418
3419 #ifdef DEBUGGING
3420 void
3421 sv_dump(sv)
3422 SV* sv;
3423 {
3424     char tmpbuf[1024];
3425     char *d = tmpbuf;
3426     U32 flags;
3427     U32 type;
3428
3429     if (!sv) {
3430         fprintf(stderr, "SV = 0\n");
3431         return;
3432     }
3433
3434     flags = SvFLAGS(sv);
3435     type = SvTYPE(sv);
3436
3437     sprintf(d, "(0x%lx)\n  REFCNT = %ld\n  FLAGS = (",
3438         (unsigned long)SvANY(sv), (long)SvREFCNT(sv));
3439     d += strlen(d);
3440     if (flags & SVs_PADBUSY)    strcat(d, "PADBUSY,");
3441     if (flags & SVs_PADTMP)     strcat(d, "PADTMP,");
3442     if (flags & SVs_PADMY)      strcat(d, "PADMY,");
3443     if (flags & SVs_TEMP)       strcat(d, "TEMP,");
3444     if (flags & SVs_OBJECT)     strcat(d, "OBJECT,");
3445     if (flags & SVs_GMG)        strcat(d, "GMG,");
3446     if (flags & SVs_SMG)        strcat(d, "SMG,");
3447     if (flags & SVs_RMG)        strcat(d, "RMG,");
3448     d += strlen(d);
3449
3450     if (flags & SVf_IOK)        strcat(d, "IOK,");
3451     if (flags & SVf_NOK)        strcat(d, "NOK,");
3452     if (flags & SVf_POK)        strcat(d, "POK,");
3453     if (flags & SVf_ROK)        strcat(d, "ROK,");
3454     if (flags & SVf_OOK)        strcat(d, "OOK,");
3455     if (flags & SVf_FAKE)       strcat(d, "FAKE,");
3456     if (flags & SVf_READONLY)   strcat(d, "READONLY,");
3457     d += strlen(d);
3458
3459     if (flags & SVp_IOK)        strcat(d, "pIOK,");
3460     if (flags & SVp_NOK)        strcat(d, "pNOK,");
3461     if (flags & SVp_POK)        strcat(d, "pPOK,");
3462     if (flags & SVp_SCREAM)     strcat(d, "SCREAM,");
3463     d += strlen(d);
3464     if (d[-1] == ',')
3465         d--;
3466     *d++ = ')';
3467     *d = '\0';
3468
3469     fprintf(stderr, "SV = ");
3470     switch (type) {
3471     case SVt_NULL:
3472         fprintf(stderr,"NULL%s\n", tmpbuf);
3473         return;
3474     case SVt_IV:
3475         fprintf(stderr,"IV%s\n", tmpbuf);
3476         break;
3477     case SVt_NV:
3478         fprintf(stderr,"NV%s\n", tmpbuf);
3479         break;
3480     case SVt_RV:
3481         fprintf(stderr,"RV%s\n", tmpbuf);
3482         break;
3483     case SVt_PV:
3484         fprintf(stderr,"PV%s\n", tmpbuf);
3485         break;
3486     case SVt_PVIV:
3487         fprintf(stderr,"PVIV%s\n", tmpbuf);
3488         break;
3489     case SVt_PVNV:
3490         fprintf(stderr,"PVNV%s\n", tmpbuf);
3491         break;
3492     case SVt_PVBM:
3493         fprintf(stderr,"PVBM%s\n", tmpbuf);
3494         break;
3495     case SVt_PVMG:
3496         fprintf(stderr,"PVMG%s\n", tmpbuf);
3497         break;
3498     case SVt_PVLV:
3499         fprintf(stderr,"PVLV%s\n", tmpbuf);
3500         break;
3501     case SVt_PVAV:
3502         fprintf(stderr,"PVAV%s\n", tmpbuf);
3503         break;
3504     case SVt_PVHV:
3505         fprintf(stderr,"PVHV%s\n", tmpbuf);
3506         break;
3507     case SVt_PVCV:
3508         fprintf(stderr,"PVCV%s\n", tmpbuf);
3509         break;
3510     case SVt_PVGV:
3511         fprintf(stderr,"PVGV%s\n", tmpbuf);
3512         break;
3513     case SVt_PVFM:
3514         fprintf(stderr,"PVFM%s\n", tmpbuf);
3515         break;
3516     case SVt_PVIO:
3517         fprintf(stderr,"PVIO%s\n", tmpbuf);
3518         break;
3519     default:
3520         fprintf(stderr,"UNKNOWN%s\n", tmpbuf);
3521         return;
3522     }
3523     if (type >= SVt_PVIV || type == SVt_IV)
3524         fprintf(stderr, "  IV = %ld\n", (long)SvIVX(sv));
3525     if (type >= SVt_PVNV || type == SVt_NV)
3526         fprintf(stderr, "  NV = %.*g\n", DBL_DIG, SvNVX(sv));
3527     if (SvROK(sv)) {
3528         fprintf(stderr, "  RV = 0x%lx\n", (long)SvRV(sv));
3529         sv_dump(SvRV(sv));
3530         return;
3531     }
3532     if (type < SVt_PV)
3533         return;
3534     if (type <= SVt_PVLV) {
3535         if (SvPVX(sv))
3536             fprintf(stderr, "  PV = 0x%lx \"%s\"\n  CUR = %ld\n  LEN = %ld\n",
3537                 (long)SvPVX(sv), SvPVX(sv), (long)SvCUR(sv), (long)SvLEN(sv));
3538         else
3539             fprintf(stderr, "  PV = 0\n");
3540     }
3541     if (type >= SVt_PVMG) {
3542         if (SvMAGIC(sv)) {
3543             fprintf(stderr, "  MAGIC = 0x%lx\n", (long)SvMAGIC(sv));
3544         }
3545         if (SvSTASH(sv))
3546             fprintf(stderr, "  STASH = %s\n", HvNAME(SvSTASH(sv)));
3547     }
3548     switch (type) {
3549     case SVt_PVLV:
3550         fprintf(stderr, "  TYPE = %c\n", LvTYPE(sv));
3551         fprintf(stderr, "  TARGOFF = %ld\n", (long)LvTARGOFF(sv));
3552         fprintf(stderr, "  TARGLEN = %ld\n", (long)LvTARGLEN(sv));
3553         fprintf(stderr, "  TARG = 0x%lx\n", (long)LvTARG(sv));
3554         sv_dump(LvTARG(sv));
3555         break;
3556     case SVt_PVAV:
3557         fprintf(stderr, "  ARRAY = 0x%lx\n", (long)AvARRAY(sv));
3558         fprintf(stderr, "  ALLOC = 0x%lx\n", (long)AvALLOC(sv));
3559         fprintf(stderr, "  FILL = %ld\n", (long)AvFILL(sv));
3560         fprintf(stderr, "  MAX = %ld\n", (long)AvMAX(sv));
3561         fprintf(stderr, "  ARYLEN = 0x%lx\n", (long)AvARYLEN(sv));
3562         flags = AvFLAGS(sv);
3563         d = tmpbuf;
3564         if (flags & AVf_REAL)   strcat(d, "REAL,");
3565         if (flags & AVf_REIFY)  strcat(d, "REIFY,");
3566         if (flags & AVf_REUSED) strcat(d, "REUSED,");
3567         if (*d)
3568             d[strlen(d)-1] = '\0';
3569         fprintf(stderr, "  FLAGS = (%s)\n", d);
3570         break;
3571     case SVt_PVHV:
3572         fprintf(stderr, "  ARRAY = 0x%lx\n",(long)HvARRAY(sv));
3573         fprintf(stderr, "  KEYS = %ld\n", (long)HvKEYS(sv));
3574         fprintf(stderr, "  FILL = %ld\n", (long)HvFILL(sv));
3575         fprintf(stderr, "  MAX = %ld\n", (long)HvMAX(sv));
3576         fprintf(stderr, "  RITER = %ld\n", (long)HvRITER(sv));
3577         fprintf(stderr, "  EITER = 0x%lx\n",(long) HvEITER(sv));
3578         if (HvPMROOT(sv))
3579             fprintf(stderr, "  PMROOT = 0x%lx\n",(long)HvPMROOT(sv));
3580         if (HvNAME(sv))
3581             fprintf(stderr, "  NAME = \"%s\"\n", HvNAME(sv));
3582         break;
3583     case SVt_PVFM:
3584     case SVt_PVCV:
3585         fprintf(stderr, "  STASH = 0x%lx\n", (long)CvSTASH(sv));
3586         fprintf(stderr, "  START = 0x%lx\n", (long)CvSTART(sv));
3587         fprintf(stderr, "  ROOT = 0x%lx\n", (long)CvROOT(sv));
3588         fprintf(stderr, "  XSUB = 0x%lx\n", (long)CvXSUB(sv));
3589         fprintf(stderr, "  XSUBANY = %ld\n", (long)CvXSUBANY(sv).any_i32);
3590         fprintf(stderr, "  FILEGV = 0x%lx\n", (long)CvFILEGV(sv));
3591         fprintf(stderr, "  DEPTH = %ld\n", (long)CvDEPTH(sv));
3592         fprintf(stderr, "  PADLIST = 0x%lx\n", (long)CvPADLIST(sv));
3593         fprintf(stderr, "  OUTSIDE = 0x%lx\n", (long)CvOUTSIDE(sv));
3594         if (type == SVt_PVFM)
3595             fprintf(stderr, "  LINES = %ld\n", (long)FmLINES(sv));
3596         break;
3597     case SVt_PVGV:
3598         fprintf(stderr, "  NAME = %s\n", GvNAME(sv));
3599         fprintf(stderr, "  NAMELEN = %ld\n", (long)GvNAMELEN(sv));
3600         fprintf(stderr, "  STASH = 0x%lx\n", (long)GvSTASH(sv));
3601         fprintf(stderr, "  GP = 0x%lx\n", (long)GvGP(sv));
3602         fprintf(stderr, "    SV = 0x%lx\n", (long)GvSV(sv));
3603         fprintf(stderr, "    REFCNT = %ld\n", (long)GvREFCNT(sv));
3604         fprintf(stderr, "    IO = 0x%lx\n", (long)GvIOp(sv));
3605         fprintf(stderr, "    FORM = 0x%lx\n", (long)GvFORM(sv));
3606         fprintf(stderr, "    AV = 0x%lx\n", (long)GvAV(sv));
3607         fprintf(stderr, "    HV = 0x%lx\n", (long)GvHV(sv));
3608         fprintf(stderr, "    CV = 0x%lx\n", (long)GvCV(sv));
3609         fprintf(stderr, "    CVGEN = 0x%lx\n", (long)GvCVGEN(sv));
3610         fprintf(stderr, "    LASTEXPR = %ld\n", (long)GvLASTEXPR(sv));
3611         fprintf(stderr, "    LINE = %ld\n", (long)GvLINE(sv));
3612         fprintf(stderr, "    FLAGS = 0x%x\n", (int)GvFLAGS(sv));
3613         fprintf(stderr, "    STASH = 0x%lx\n", (long)GvSTASH(sv));
3614         fprintf(stderr, "    EGV = 0x%lx\n", (long)GvEGV(sv));
3615         break;
3616     case SVt_PVIO:
3617         fprintf(stderr, "  IFP = 0x%lx\n", (long)IoIFP(sv));
3618         fprintf(stderr, "  OFP = 0x%lx\n", (long)IoOFP(sv));
3619         fprintf(stderr, "  DIRP = 0x%lx\n", (long)IoDIRP(sv));
3620         fprintf(stderr, "  LINES = %ld\n", (long)IoLINES(sv));
3621         fprintf(stderr, "  PAGE = %ld\n", (long)IoPAGE(sv));
3622         fprintf(stderr, "  PAGE_LEN = %ld\n", (long)IoPAGE_LEN(sv));
3623         fprintf(stderr, "  LINES_LEFT = %ld\n", (long)IoLINES_LEFT(sv));
3624         fprintf(stderr, "  TOP_NAME = %s\n", IoTOP_NAME(sv));
3625         fprintf(stderr, "  TOP_GV = 0x%lx\n", (long)IoTOP_GV(sv));
3626         fprintf(stderr, "  FMT_NAME = %s\n", IoFMT_NAME(sv));
3627         fprintf(stderr, "  FMT_GV = 0x%lx\n", (long)IoFMT_GV(sv));
3628         fprintf(stderr, "  BOTTOM_NAME = %s\n", IoBOTTOM_NAME(sv));
3629         fprintf(stderr, "  BOTTOM_GV = 0x%lx\n", (long)IoBOTTOM_GV(sv));
3630         fprintf(stderr, "  SUBPROCESS = %ld\n", (long)IoSUBPROCESS(sv));
3631         fprintf(stderr, "  TYPE = %c\n", IoTYPE(sv));
3632         fprintf(stderr, "  FLAGS = 0x%lx\n", (long)IoFLAGS(sv));
3633         break;
3634     }
3635 }
3636 #else
3637 void
3638 sv_dump(sv)
3639 SV* sv;
3640 {
3641 }
3642 #endif
3643
3644 IO*
3645 sv_2io(sv)
3646 SV *sv;
3647 {
3648     IO* io;
3649     GV* gv;
3650
3651     switch (SvTYPE(sv)) {
3652     case SVt_PVIO:
3653         io = (IO*)sv;
3654         break;
3655     case SVt_PVGV:
3656         gv = (GV*)sv;
3657         io = GvIO(gv);
3658         if (!io)
3659             croak("Bad filehandle: %s", GvNAME(gv));
3660         break;
3661     default:
3662         if (!SvOK(sv))
3663             croak(no_usym, "filehandle");
3664         if (SvROK(sv))
3665             return sv_2io(SvRV(sv));
3666         gv = gv_fetchpv(SvPV(sv,na), FALSE, SVt_PVIO);
3667         if (gv)
3668             io = GvIO(gv);
3669         else
3670             io = 0;
3671         if (!io)
3672             croak("Bad filehandle: %s", SvPV(sv,na));
3673         break;
3674     }
3675     return io;
3676 }
3677