sv.c

   1 /*    sv.c
   2  *
   3  *    Copyright (c) 1991-1997, Larry Wall
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  */
   9
  10 /*
  11  * "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) && !defined(__QNX__)
  40 #  define FAST_SV_GETS
  41 #endif
  42
  43 static IV asIV _((SV* sv));
  44 static UV asUV _((SV* sv));
  45 static SV *more_sv _((void));
  46 static XPVIV *more_xiv _((void));
  47 static XPVNV *more_xnv _((void));
  48 static XPV *more_xpv _((void));
  49 static XRV *more_xrv _((void));
  50 static XPVIV *new_xiv _((void));
  51 static XPVNV *new_xnv _((void));
  52 static XPV *new_xpv _((void));
  53 static XRV *new_xrv _((void));
  54 static void del_xiv _((XPVIV* p));
  55 static void del_xnv _((XPVNV* p));
  56 static void del_xpv _((XPV* p));
  57 static void del_xrv _((XRV* p));
  58 static void sv_mortalgrow _((void));
  59 static void sv_unglob _((SV* sv));
  60
  61 typedef void (*SVFUNC) _((SV*));
  62
  63 #ifdef PURIFY
  64
  65 #define new_SV(p)                       \
  66     do {                                \
  67         (p) = (SV*)safemalloc(sizeof(SV)); \
  68         reg_add(p);                     \
  69     } while (0)
  70
  71 #define del_SV(p)                       \
  72     do {                                \
  73         reg_remove(p);                  \
  74         free((char*)(p));               \
  75     } while (0)
  76
  77 static SV **registry;
  78 static I32 regsize;
  79
  80 #define REGHASH(sv,size)  ((((U32)(sv)) >> 2) % (size))
  81
  82 #define REG_REPLACE(sv,a,b) \
  83     do {                                \
  84         void* p = sv->sv_any;           \
  85         I32 h = REGHASH(sv, regsize);   \
  86         I32 i = h;                      \
  87         while (registry[i] != (a)) {    \
  88             if (++i >= regsize)         \
  89                 i = 0;                  \
  90             if (i == h)                 \
  91                 die("SV registry bug"); \
  92         }                               \
  93         registry[i] = (b);              \
  94     } while (0)
  95
  96 #define REG_ADD(sv)     REG_REPLACE(sv,Nullsv,sv)
  97 #define REG_REMOVE(sv)  REG_REPLACE(sv,sv,Nullsv)
  98
  99 static void
 100 reg_add(sv)
 101 SV* sv;
 102 {
 103     if (sv_count >= (regsize >> 1))
 104     {
 105         SV **oldreg = registry;
 106         I32 oldsize = regsize;
 107
 108         regsize = regsize ? ((regsize << 2) + 1) : 2037;
 109         registry = (SV**)safemalloc(regsize * sizeof(SV*));
 110         memzero(registry, regsize * sizeof(SV*));
 111
 112         if (oldreg) {
 113             I32 i;
 114
 115             for (i = 0; i < oldsize; ++i) {
 116                 SV* oldsv = oldreg[i];
 117                 if (oldsv)
 118                     REG_ADD(oldsv);
 119             }
 120             Safefree(oldreg);
 121         }
 122     }
 123
 124     REG_ADD(sv);
 125     ++sv_count;
 126 }
 127
 128 static void
 129 reg_remove(sv)
 130 SV* sv;
 131 {
 132     REG_REMOVE(sv);
 133     --sv_count;
 134 }
 135
 136 static void
 137 visit(f)
 138 SVFUNC f;
 139 {
 140     I32 i;
 141
 142     for (i = 0; i < regsize; ++i) {
 143         SV* sv = registry[i];
 144         if (sv)
 145             (*f)(sv);
 146     }
 147 }
 148
 149 void
 150 sv_add_arena(ptr, size, flags)
 151 char* ptr;
 152 U32 size;
 153 U32 flags;
 154 {
 155     if (!(flags & SVf_FAKE))
 156         free(ptr);
 157 }
 158
 159 #else /* ! PURIFY */
 160
 161 /*
 162  * "A time to plant, and a time to uproot what was planted..."
 163  */
 164
 165 #define plant_SV(p)                     \
 166     do {                                \
 167         SvANY(p) = (void *)sv_root;     \
 168         SvFLAGS(p) = SVTYPEMASK;        \
 169         sv_root = (p);                  \
 170         --sv_count;                     \
 171     } while (0)
 172
 173 #define uproot_SV(p)                    \
 174     do {                                \
 175         (p) = sv_root;                  \
 176         sv_root = (SV*)SvANY(p);        \
 177         ++sv_count;                     \
 178     } while (0)
 179
 180 #define new_SV(p)                       \
 181     if (sv_root)                        \
 182         uproot_SV(p);                   \
 183     else                                \
 184         (p) = more_sv()
 185
 186 #ifdef DEBUGGING
 187
 188 #define del_SV(p)                       \
 189     if (debug & 32768)                  \
 190         del_sv(p);                      \
 191     else                                \
 192         plant_SV(p)
 193
 194 static void
 195 del_sv(p)
 196 SV* p;
 197 {
 198     if (debug & 32768) {
 199         SV* sva;
 200         SV* sv;
 201         SV* svend;
 202         int ok = 0;
 203         for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
 204             sv = sva + 1;
 205             svend = &sva[SvREFCNT(sva)];
 206             if (p >= sv && p < svend)
 207                 ok = 1;
 208         }
 209         if (!ok) {
 210             warn("Attempt to free non-arena SV: 0x%lx", (unsigned long)p);
 211             return;
 212         }
 213     }
 214     plant_SV(p);
 215 }
 216
 217 #else /* ! DEBUGGING */
 218
 219 #define del_SV(p)   plant_SV(p)
 220
 221 #endif /* DEBUGGING */
 222
 223 void
 224 sv_add_arena(ptr, size, flags)
 225 char* ptr;
 226 U32 size;
 227 U32 flags;
 228 {
 229     SV* sva = (SV*)ptr;
 230     register SV* sv;
 231     register SV* svend;
 232     Zero(sva, size, char);
 233
 234     /* The first SV in an arena isn't an SV. */
 235     SvANY(sva) = (void *) sv_arenaroot;         /* ptr to next arena */
 236     SvREFCNT(sva) = size / sizeof(SV);          /* number of SV slots */
 237     SvFLAGS(sva) = flags;                       /* FAKE if not to be freed */
 238
 239     sv_arenaroot = sva;
 240     sv_root = sva + 1;
 241
 242     svend = &sva[SvREFCNT(sva) - 1];
 243     sv = sva + 1;
 244     while (sv < svend) {
 245         SvANY(sv) = (void *)(SV*)(sv + 1);
 246         SvFLAGS(sv) = SVTYPEMASK;
 247         sv++;
 248     }
 249     SvANY(sv) = 0;
 250     SvFLAGS(sv) = SVTYPEMASK;
 251 }
 252
 253 static SV*
 254 more_sv()
 255 {
 256     register SV* sv;
 257
 258     if (nice_chunk) {
 259         sv_add_arena(nice_chunk, nice_chunk_size, 0);
 260         nice_chunk = Nullch;
 261     }
 262     else {
 263         char *chunk;                /* must use New here to match call to */
 264         New(704,chunk,1008,char);   /* Safefree() in sv_free_arenas()     */
 265         sv_add_arena(chunk, 1008, 0);
 266     }
 267     uproot_SV(sv);
 268     return sv;
 269 }
 270
 271 static void
 272 visit(f)
 273 SVFUNC f;
 274 {
 275     SV* sva;
 276     SV* sv;
 277     register SV* svend;
 278
 279     for (sva = sv_arenaroot; sva; sva = (SV*)SvANY(sva)) {
 280         svend = &sva[SvREFCNT(sva)];
 281         for (sv = sva + 1; sv < svend; ++sv) {
 282             if (SvTYPE(sv) != SVTYPEMASK)
 283                 (*f)(sv);
 284         }
 285     }
 286 }
 287
 288 #endif /* PURIFY */
 289
 290 static void
 291 do_report_used(sv)
 292 SV* sv;
 293 {
 294     if (SvTYPE(sv) != SVTYPEMASK) {
 295         /* XXX Perhaps this ought to go to Perl_debug_log, if DEBUGGING. */
 296         PerlIO_printf(PerlIO_stderr(), "****\n");
 297         sv_dump(sv);
 298     }
 299 }
 300
 301 void
 302 sv_report_used()
 303 {
 304     visit(do_report_used);
 305 }
 306
 307 static void
 308 do_clean_objs(sv)
 309 SV* sv;
 310 {
 311     SV* rv;
 312
 313     if (SvROK(sv) && SvOBJECT(rv = SvRV(sv))) {
 314         DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning object ref:\n "), sv_dump(sv));)
 315         SvROK_off(sv);
 316         SvRV(sv) = 0;
 317         SvREFCNT_dec(rv);
 318     }
 319
 320     /* XXX Might want to check arrays, etc. */
 321 }
 322
 323 #ifndef DISABLE_DESTRUCTOR_KLUDGE
 324 static void
 325 do_clean_named_objs(sv)
 326 SV* sv;
 327 {
 328     if (SvTYPE(sv) == SVt_PVGV && GvSV(sv))
 329         do_clean_objs(GvSV(sv));
 330 }
 331 #endif
 332
 333 static bool in_clean_objs = FALSE;
 334
 335 void
 336 sv_clean_objs()
 337 {
 338     in_clean_objs = TRUE;
 339 #ifndef DISABLE_DESTRUCTOR_KLUDGE
 340     visit(do_clean_named_objs);
 341 #endif
 342     visit(do_clean_objs);
 343     in_clean_objs = FALSE;
 344 }
 345
 346 static void
 347 do_clean_all(sv)
 348 SV* sv;
 349 {
 350     DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops:\n "), sv_dump(sv));)
 351     SvFLAGS(sv) |= SVf_BREAK;
 352     SvREFCNT_dec(sv);
 353 }
 354
 355 static bool in_clean_all = FALSE;
 356
 357 void
 358 sv_clean_all()
 359 {
 360     in_clean_all = TRUE;
 361     visit(do_clean_all);
 362     in_clean_all = FALSE;
 363 }
 364
 365 void
 366 sv_free_arenas()
 367 {
 368     SV* sva;
 369     SV* svanext;
 370
 371     /* Free arenas here, but be careful about fake ones.  (We assume
 372        contiguity of the fake ones with the corresponding real ones.) */
 373
 374     for (sva = sv_arenaroot; sva; sva = svanext) {
 375         svanext = (SV*) SvANY(sva);
 376         while (svanext && SvFAKE(svanext))
 377             svanext = (SV*) SvANY(svanext);
 378
 379         if (!SvFAKE(sva))
 380             Safefree((void *)sva);
 381     }
 382
 383     sv_arenaroot = 0;
 384     sv_root = 0;
 385 }
 386
 387 static XPVIV*
 388 new_xiv()
 389 {
 390     IV** xiv;
 391     if (xiv_root) {
 392         xiv = xiv_root;
 393         /*
 394          * See comment in more_xiv() -- RAM.
 395          */
 396         xiv_root = (IV**)*xiv;
 397         return (XPVIV*)((char*)xiv - sizeof(XPV));
 398     }
 399     return more_xiv();
 400 }
 401
 402 static void
 403 del_xiv(p)
 404 XPVIV* p;
 405 {
 406     IV** xiv = (IV**)((char*)(p) + sizeof(XPV));
 407     *xiv = (IV *)xiv_root;
 408     xiv_root = xiv;
 409 }
 410
 411 static XPVIV*
 412 more_xiv()
 413 {
 414     register IV** xiv;
 415     register IV** xivend;
 416     XPV* ptr = (XPV*)safemalloc(1008);
 417     ptr->xpv_pv = (char*)xiv_arenaroot;         /* linked list of xiv arenas */
 418     xiv_arenaroot = ptr;                        /* to keep Purify happy */
 419
 420     xiv = (IV**) ptr;
 421     xivend = &xiv[1008 / sizeof(IV *) - 1];
 422     xiv += (sizeof(XPV) - 1) / sizeof(IV *) + 1;   /* fudge by size of XPV */
 423     xiv_root = xiv;
 424     while (xiv < xivend) {
 425         *xiv = (IV *)(xiv + 1);
 426         xiv++;
 427     }
 428     *xiv = 0;
 429     return new_xiv();
 430 }
 431
 432 static XPVNV*
 433 new_xnv()
 434 {
 435     double* xnv;
 436     if (xnv_root) {
 437         xnv = xnv_root;
 438         xnv_root = *(double**)xnv;
 439         return (XPVNV*)((char*)xnv - sizeof(XPVIV));
 440     }
 441     return more_xnv();
 442 }
 443
 444 static void
 445 del_xnv(p)
 446 XPVNV* p;
 447 {
 448     double* xnv = (double*)((char*)(p) + sizeof(XPVIV));
 449     *(double**)xnv = xnv_root;
 450     xnv_root = xnv;
 451 }
 452
 453 static XPVNV*
 454 more_xnv()
 455 {
 456     register double* xnv;
 457     register double* xnvend;
 458     xnv = (double*)safemalloc(1008);
 459     xnvend = &xnv[1008 / sizeof(double) - 1];
 460     xnv += (sizeof(XPVIV) - 1) / sizeof(double) + 1; /* fudge by sizeof XPVIV */
 461     xnv_root = xnv;
 462     while (xnv < xnvend) {
 463         *(double**)xnv = (double*)(xnv + 1);
 464         xnv++;
 465     }
 466     *(double**)xnv = 0;
 467     return new_xnv();
 468 }
 469
 470 static XRV*
 471 new_xrv()
 472 {
 473     XRV* xrv;
 474     if (xrv_root) {
 475         xrv = xrv_root;
 476         xrv_root = (XRV*)xrv->xrv_rv;
 477         return xrv;
 478     }
 479     return more_xrv();
 480 }
 481
 482 static void
 483 del_xrv(p)
 484 XRV* p;
 485 {
 486     p->xrv_rv = (SV*)xrv_root;
 487     xrv_root = p;
 488 }
 489
 490 static XRV*
 491 more_xrv()
 492 {
 493     register XRV* xrv;
 494     register XRV* xrvend;
 495     xrv_root = (XRV*)safemalloc(1008);
 496     xrv = xrv_root;
 497     xrvend = &xrv[1008 / sizeof(XRV) - 1];
 498     while (xrv < xrvend) {
 499         xrv->xrv_rv = (SV*)(xrv + 1);
 500         xrv++;
 501     }
 502     xrv->xrv_rv = 0;
 503     return new_xrv();
 504 }
 505
 506 static XPV*
 507 new_xpv()
 508 {
 509     XPV* xpv;
 510     if (xpv_root) {
 511         xpv = xpv_root;
 512         xpv_root = (XPV*)xpv->xpv_pv;
 513         return xpv;
 514     }
 515     return more_xpv();
 516 }
 517
 518 static void
 519 del_xpv(p)
 520 XPV* p;
 521 {
 522     p->xpv_pv = (char*)xpv_root;
 523     xpv_root = p;
 524 }
 525
 526 static XPV*
 527 more_xpv()
 528 {
 529     register XPV* xpv;
 530     register XPV* xpvend;
 531     xpv_root = (XPV*)safemalloc(1008);
 532     xpv = xpv_root;
 533     xpvend = &xpv[1008 / sizeof(XPV) - 1];
 534     while (xpv < xpvend) {
 535         xpv->xpv_pv = (char*)(xpv + 1);
 536         xpv++;
 537     }
 538     xpv->xpv_pv = 0;
 539     return new_xpv();
 540 }
 541
 542 #ifdef PURIFY
 543 #define new_XIV() (void*)safemalloc(sizeof(XPVIV))
 544 #define del_XIV(p) free((char*)p)
 545 #else
 546 #define new_XIV() (void*)new_xiv()
 547 #define del_XIV(p) del_xiv(p)
 548 #endif
 549
 550 #ifdef PURIFY
 551 #define new_XNV() (void*)safemalloc(sizeof(XPVNV))
 552 #define del_XNV(p) free((char*)p)
 553 #else
 554 #define new_XNV() (void*)new_xnv()
 555 #define del_XNV(p) del_xnv(p)
 556 #endif
 557
 558 #ifdef PURIFY
 559 #define new_XRV() (void*)safemalloc(sizeof(XRV))
 560 #define del_XRV(p) free((char*)p)
 561 #else
 562 #define new_XRV() (void*)new_xrv()
 563 #define del_XRV(p) del_xrv(p)
 564 #endif
 565
 566 #ifdef PURIFY
 567 #define new_XPV() (void*)safemalloc(sizeof(XPV))
 568 #define del_XPV(p) free((char*)p)
 569 #else
 570 #define new_XPV() (void*)new_xpv()
 571 #define del_XPV(p) del_xpv(p)
 572 #endif
 573
 574 #define new_XPVIV() (void*)safemalloc(sizeof(XPVIV))
 575 #define del_XPVIV(p) free((char*)p)
 576
 577 #define new_XPVNV() (void*)safemalloc(sizeof(XPVNV))
 578 #define del_XPVNV(p) free((char*)p)
 579
 580 #define new_XPVMG() (void*)safemalloc(sizeof(XPVMG))
 581 #define del_XPVMG(p) free((char*)p)
 582
 583 #define new_XPVLV() (void*)safemalloc(sizeof(XPVLV))
 584 #define del_XPVLV(p) free((char*)p)
 585
 586 #define new_XPVAV() (void*)safemalloc(sizeof(XPVAV))
 587 #define del_XPVAV(p) free((char*)p)
 588
 589 #define new_XPVHV() (void*)safemalloc(sizeof(XPVHV))
 590 #define del_XPVHV(p) free((char*)p)
 591
 592 #define new_XPVCV() (void*)safemalloc(sizeof(XPVCV))
 593 #define del_XPVCV(p) free((char*)p)
 594
 595 #define new_XPVGV() (void*)safemalloc(sizeof(XPVGV))
 596 #define del_XPVGV(p) free((char*)p)
 597
 598 #define new_XPVBM() (void*)safemalloc(sizeof(XPVBM))
 599 #define del_XPVBM(p) free((char*)p)
 600
 601 #define new_XPVFM() (void*)safemalloc(sizeof(XPVFM))
 602 #define del_XPVFM(p) free((char*)p)
 603
 604 #define new_XPVIO() (void*)safemalloc(sizeof(XPVIO))
 605 #define del_XPVIO(p) free((char*)p)
 606
 607 bool
 608 sv_upgrade(sv, mt)
 609 register SV* sv;
 610 U32 mt;
 611 {
 612     char*       pv;
 613     U32         cur;
 614     U32         len;
 615     IV          iv;
 616     double      nv;
 617     MAGIC*      magic;
 618     HV*         stash;
 619
 620     if (SvTYPE(sv) == mt)
 621         return TRUE;
 622
 623     if (mt < SVt_PVIV)
 624         (void)SvOOK_off(sv);
 625
 626     switch (SvTYPE(sv)) {
 627     case SVt_NULL:
 628         pv      = 0;
 629         cur     = 0;
 630         len     = 0;
 631         iv      = 0;
 632         nv      = 0.0;
 633         magic   = 0;
 634         stash   = 0;
 635         break;
 636     case SVt_IV:
 637         pv      = 0;
 638         cur     = 0;
 639         len     = 0;
 640         iv      = SvIVX(sv);
 641         nv      = (double)SvIVX(sv);
 642         del_XIV(SvANY(sv));
 643         magic   = 0;
 644         stash   = 0;
 645         if (mt == SVt_NV)
 646             mt = SVt_PVNV;
 647         else if (mt < SVt_PVIV)
 648             mt = SVt_PVIV;
 649         break;
 650     case SVt_NV:
 651         pv      = 0;
 652         cur     = 0;
 653         len     = 0;
 654         nv      = SvNVX(sv);
 655         iv      = I_32(nv);
 656         magic   = 0;
 657         stash   = 0;
 658         del_XNV(SvANY(sv));
 659         SvANY(sv) = 0;
 660         if (mt < SVt_PVNV)
 661             mt = SVt_PVNV;
 662         break;
 663     case SVt_RV:
 664         pv      = (char*)SvRV(sv);
 665         cur     = 0;
 666         len     = 0;
 667         iv      = (IV)pv;
 668         nv      = (double)(unsigned long)pv;
 669         del_XRV(SvANY(sv));
 670         magic   = 0;
 671         stash   = 0;
 672         break;
 673     case SVt_PV:
 674         pv      = SvPVX(sv);
 675         cur     = SvCUR(sv);
 676         len     = SvLEN(sv);
 677         iv      = 0;
 678         nv      = 0.0;
 679         magic   = 0;
 680         stash   = 0;
 681         del_XPV(SvANY(sv));
 682         if (mt <= SVt_IV)
 683             mt = SVt_PVIV;
 684         else if (mt == SVt_NV)
 685             mt = SVt_PVNV;
 686         break;
 687     case SVt_PVIV:
 688         pv      = SvPVX(sv);
 689         cur     = SvCUR(sv);
 690         len     = SvLEN(sv);
 691         iv      = SvIVX(sv);
 692         nv      = 0.0;
 693         magic   = 0;
 694         stash   = 0;
 695         del_XPVIV(SvANY(sv));
 696         break;
 697     case SVt_PVNV:
 698         pv      = SvPVX(sv);
 699         cur     = SvCUR(sv);
 700         len     = SvLEN(sv);
 701         iv      = SvIVX(sv);
 702         nv      = SvNVX(sv);
 703         magic   = 0;
 704         stash   = 0;
 705         del_XPVNV(SvANY(sv));
 706         break;
 707     case SVt_PVMG:
 708         pv      = SvPVX(sv);
 709         cur     = SvCUR(sv);
 710         len     = SvLEN(sv);
 711         iv      = SvIVX(sv);
 712         nv      = SvNVX(sv);
 713         magic   = SvMAGIC(sv);
 714         stash   = SvSTASH(sv);
 715         del_XPVMG(SvANY(sv));
 716         break;
 717     default:
 718         croak("Can't upgrade that kind of scalar");
 719     }
 720
 721     switch (mt) {
 722     case SVt_NULL:
 723         croak("Can't upgrade to undef");
 724     case SVt_IV:
 725         SvANY(sv) = new_XIV();
 726         SvIVX(sv)       = iv;
 727         break;
 728     case SVt_NV:
 729         SvANY(sv) = new_XNV();
 730         SvNVX(sv)       = nv;
 731         break;
 732     case SVt_RV:
 733         SvANY(sv) = new_XRV();
 734         SvRV(sv) = (SV*)pv;
 735         break;
 736     case SVt_PV:
 737         SvANY(sv) = new_XPV();
 738         SvPVX(sv)       = pv;
 739         SvCUR(sv)       = cur;
 740         SvLEN(sv)       = len;
 741         break;
 742     case SVt_PVIV:
 743         SvANY(sv) = new_XPVIV();
 744         SvPVX(sv)       = pv;
 745         SvCUR(sv)       = cur;
 746         SvLEN(sv)       = len;
 747         SvIVX(sv)       = iv;
 748         if (SvNIOK(sv))
 749             (void)SvIOK_on(sv);
 750         SvNOK_off(sv);
 751         break;
 752     case SVt_PVNV:
 753         SvANY(sv) = new_XPVNV();
 754         SvPVX(sv)       = pv;
 755         SvCUR(sv)       = cur;
 756         SvLEN(sv)       = len;
 757         SvIVX(sv)       = iv;
 758         SvNVX(sv)       = nv;
 759         break;
 760     case SVt_PVMG:
 761         SvANY(sv) = new_XPVMG();
 762         SvPVX(sv)       = pv;
 763         SvCUR(sv)       = cur;
 764         SvLEN(sv)       = len;
 765         SvIVX(sv)       = iv;
 766         SvNVX(sv)       = nv;
 767         SvMAGIC(sv)     = magic;
 768         SvSTASH(sv)     = stash;
 769         break;
 770     case SVt_PVLV:
 771         SvANY(sv) = new_XPVLV();
 772         SvPVX(sv)       = pv;
 773         SvCUR(sv)       = cur;
 774         SvLEN(sv)       = len;
 775         SvIVX(sv)       = iv;
 776         SvNVX(sv)       = nv;
 777         SvMAGIC(sv)     = magic;
 778         SvSTASH(sv)     = stash;
 779         LvTARGOFF(sv)   = 0;
 780         LvTARGLEN(sv)   = 0;
 781         LvTARG(sv)      = 0;
 782         LvTYPE(sv)      = 0;
 783         break;
 784     case SVt_PVAV:
 785         SvANY(sv) = new_XPVAV();
 786         if (pv)
 787             Safefree(pv);
 788         SvPVX(sv)       = 0;
 789         AvMAX(sv)       = -1;
 790         AvFILL(sv)      = -1;
 791         SvIVX(sv)       = 0;
 792         SvNVX(sv)       = 0.0;
 793         SvMAGIC(sv)     = magic;
 794         SvSTASH(sv)     = stash;
 795         AvALLOC(sv)     = 0;
 796         AvARYLEN(sv)    = 0;
 797         AvFLAGS(sv)     = 0;
 798         break;
 799     case SVt_PVHV:
 800         SvANY(sv) = new_XPVHV();
 801         if (pv)
 802             Safefree(pv);
 803         SvPVX(sv)       = 0;
 804         HvFILL(sv)      = 0;
 805         HvMAX(sv)       = 0;
 806         HvKEYS(sv)      = 0;
 807         SvNVX(sv)       = 0.0;
 808         SvMAGIC(sv)     = magic;
 809         SvSTASH(sv)     = stash;
 810         HvRITER(sv)     = 0;
 811         HvEITER(sv)     = 0;
 812         HvPMROOT(sv)    = 0;
 813         HvNAME(sv)      = 0;
 814         break;
 815     case SVt_PVCV:
 816         SvANY(sv) = new_XPVCV();
 817         Zero(SvANY(sv), 1, XPVCV);
 818         SvPVX(sv)       = pv;
 819         SvCUR(sv)       = cur;
 820         SvLEN(sv)       = len;
 821         SvIVX(sv)       = iv;
 822         SvNVX(sv)       = nv;
 823         SvMAGIC(sv)     = magic;
 824         SvSTASH(sv)     = stash;
 825         break;
 826     case SVt_PVGV:
 827         SvANY(sv) = new_XPVGV();
 828         SvPVX(sv)       = pv;
 829         SvCUR(sv)       = cur;
 830         SvLEN(sv)       = len;
 831         SvIVX(sv)       = iv;
 832         SvNVX(sv)       = nv;
 833         SvMAGIC(sv)     = magic;
 834         SvSTASH(sv)     = stash;
 835         GvGP(sv)        = 0;
 836         GvNAME(sv)      = 0;
 837         GvNAMELEN(sv)   = 0;
 838         GvSTASH(sv)     = 0;
 839         GvFLAGS(sv)     = 0;
 840         break;
 841     case SVt_PVBM:
 842         SvANY(sv) = new_XPVBM();
 843         SvPVX(sv)       = pv;
 844         SvCUR(sv)       = cur;
 845         SvLEN(sv)       = len;
 846         SvIVX(sv)       = iv;
 847         SvNVX(sv)       = nv;
 848         SvMAGIC(sv)     = magic;
 849         SvSTASH(sv)     = stash;
 850         BmRARE(sv)      = 0;
 851         BmUSEFUL(sv)    = 0;
 852         BmPREVIOUS(sv)  = 0;
 853         break;
 854     case SVt_PVFM:
 855         SvANY(sv) = new_XPVFM();
 856         Zero(SvANY(sv), 1, XPVFM);
 857         SvPVX(sv)       = pv;
 858         SvCUR(sv)       = cur;
 859         SvLEN(sv)       = len;
 860         SvIVX(sv)       = iv;
 861         SvNVX(sv)       = nv;
 862         SvMAGIC(sv)     = magic;
 863         SvSTASH(sv)     = stash;
 864         break;
 865     case SVt_PVIO:
 866         SvANY(sv) = new_XPVIO();
 867         Zero(SvANY(sv), 1, XPVIO);
 868         SvPVX(sv)       = pv;
 869         SvCUR(sv)       = cur;
 870         SvLEN(sv)       = len;
 871         SvIVX(sv)       = iv;
 872         SvNVX(sv)       = nv;
 873         SvMAGIC(sv)     = magic;
 874         SvSTASH(sv)     = stash;
 875         IoPAGE_LEN(sv)  = 60;
 876         break;
 877     }
 878     SvFLAGS(sv) &= ~SVTYPEMASK;
 879     SvFLAGS(sv) |= mt;
 880     return TRUE;
 881 }
 882
 883 #ifdef DEBUGGING
 884 char *
 885 sv_peek(sv)
 886 register SV *sv;
 887 {
 888     SV *t = sv_newmortal();
 889     STRLEN prevlen;
 890     int unref = 0;
 891
 892   retry:
 893     if (!sv) {
 894         sv_catpv(t, "VOID");
 895         goto finish;
 896     }
 897     else if (sv == (SV*)0x55555555 || SvTYPE(sv) == 'U') {
 898         sv_catpv(t, "WILD");
 899         goto finish;
 900     }
 901     else if (sv == &sv_undef || sv == &sv_no || sv == &sv_yes) {
 902         if (sv == &sv_undef) {
 903             sv_catpv(t, "SV_UNDEF");
 904             if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
 905                                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
 906                 SvREADONLY(sv))
 907                 goto finish;
 908         }
 909         else if (sv == &sv_no) {
 910             sv_catpv(t, "SV_NO");
 911             if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
 912                                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
 913                 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
 914                                   SVp_POK|SVp_NOK)) &&
 915                 SvCUR(sv) == 0 &&
 916                 SvNVX(sv) == 0.0)
 917                 goto finish;
 918         }
 919         else {
 920             sv_catpv(t, "SV_YES");
 921             if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
 922                                  SVs_GMG|SVs_SMG|SVs_RMG)) &&
 923                 !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
 924                                   SVp_POK|SVp_NOK)) &&
 925                 SvCUR(sv) == 1 &&
 926                 SvPVX(sv) && *SvPVX(sv) == '1' &&
 927                 SvNVX(sv) == 1.0)
 928                 goto finish;
 929         }
 930         sv_catpv(t, ":");
 931     }
 932     else if (SvREFCNT(sv) == 0) {
 933         sv_catpv(t, "(");
 934         unref++;
 935     }
 936     if (SvROK(sv)) {
 937         sv_catpv(t, "\\");
 938         if (SvCUR(t) + unref > 10) {
 939             SvCUR(t) = unref + 3;
 940             *SvEND(t) = '\0';
 941             sv_catpv(t, "...");
 942             goto finish;
 943         }
 944         sv = (SV*)SvRV(sv);
 945         goto retry;
 946     }
 947     switch (SvTYPE(sv)) {
 948     default:
 949         sv_catpv(t, "FREED");
 950         goto finish;
 951
 952     case SVt_NULL:
 953         sv_catpv(t, "UNDEF");
 954         return tokenbuf;
 955     case SVt_IV:
 956         sv_catpv(t, "IV");
 957         break;
 958     case SVt_NV:
 959         sv_catpv(t, "NV");
 960         break;
 961     case SVt_RV:
 962         sv_catpv(t, "RV");
 963         break;
 964     case SVt_PV:
 965         sv_catpv(t, "PV");
 966         break;
 967     case SVt_PVIV:
 968         sv_catpv(t, "PVIV");
 969         break;
 970     case SVt_PVNV:
 971         sv_catpv(t, "PVNV");
 972         break;
 973     case SVt_PVMG:
 974         sv_catpv(t, "PVMG");
 975         break;
 976     case SVt_PVLV:
 977         sv_catpv(t, "PVLV");
 978         break;
 979     case SVt_PVAV:
 980         sv_catpv(t, "AV");
 981         break;
 982     case SVt_PVHV:
 983         sv_catpv(t, "HV");
 984         break;
 985     case SVt_PVCV:
 986         if (CvGV(sv))
 987             sv_catpvf(t, "CV(%s)", GvNAME(CvGV(sv)));
 988         else
 989             sv_catpv(t, "CV()");
 990         goto finish;
 991     case SVt_PVGV:
 992         sv_catpv(t, "GV");
 993         break;
 994     case SVt_PVBM:
 995         sv_catpv(t, "BM");
 996         break;
 997     case SVt_PVFM:
 998         sv_catpv(t, "FM");
 999         break;
1000     case SVt_PVIO:
1001         sv_catpv(t, "IO");
1002         break;
1003     }
1004
1005     if (SvPOKp(sv)) {
1006         if (!SvPVX(sv))
1007             sv_catpv(t, "(null)");
1008         if (SvOOK(sv))
1009             sv_catpvf(t, "(%ld+\"%.127s\")",(long)SvIVX(sv),SvPVX(sv));
1010         else
1011             sv_catpvf(t, "(\"%.127s\")",SvPVX(sv));
1012     }
1013     else if (SvNOKp(sv)) {
1014         SET_NUMERIC_STANDARD();
1015         sv_catpvf(t, "(%g)",SvNVX(sv));
1016     }
1017     else if (SvIOKp(sv))
1018         sv_catpvf(t, "(%ld)",(long)SvIVX(sv));
1019     else
1020         sv_catpv(t, "()");
1021
1022   finish:
1023     if (unref) {
1024         while (unref--)
1025             sv_catpv(t, ")");
1026     }
1027     return SvPV(t, na);
1028 }
1029 #endif
1030
1031 int
1032 sv_backoff(sv)
1033 register SV *sv;
1034 {
1035     assert(SvOOK(sv));
1036     if (SvIVX(sv)) {
1037         char *s = SvPVX(sv);
1038         SvLEN(sv) += SvIVX(sv);
1039         SvPVX(sv) -= SvIVX(sv);
1040         SvIV_set(sv, 0);
1041         Move(s, SvPVX(sv), SvCUR(sv)+1, char);
1042     }
1043     SvFLAGS(sv) &= ~SVf_OOK;
1044     return 0;
1045 }
1046
1047 char *
1048 sv_grow(sv,newlen)
1049 register SV *sv;
1050 #ifndef DOSISH
1051 register I32 newlen;
1052 #else
1053 unsigned long newlen;
1054 #endif
1055 {
1056     register char *s;
1057
1058 #ifdef HAS_64K_LIMIT
1059     if (newlen >= 0x10000) {
1060         PerlIO_printf(Perl_debug_log, "Allocation too large: %lx\n", newlen);
1061         my_exit(1);
1062     }
1063 #endif /* HAS_64K_LIMIT */
1064     if (SvROK(sv))
1065         sv_unref(sv);
1066     if (SvTYPE(sv) < SVt_PV) {
1067         sv_upgrade(sv, SVt_PV);
1068         s = SvPVX(sv);
1069     }
1070     else if (SvOOK(sv)) {       /* pv is offset? */
1071         sv_backoff(sv);
1072         s = SvPVX(sv);
1073         if (newlen > SvLEN(sv))
1074             newlen += 10 * (newlen - SvCUR(sv)); /* avoid copy each time */
1075     }
1076     else
1077         s = SvPVX(sv);
1078     if (newlen > SvLEN(sv)) {           /* need more room? */
1079         if (SvLEN(sv) && s)
1080             Renew(s,newlen,char);
1081         else
1082             New(703,s,newlen,char);
1083         SvPV_set(sv, s);
1084         SvLEN_set(sv, newlen);
1085     }
1086     return s;
1087 }
1088
1089 void
1090 sv_setiv(sv,i)
1091 register SV *sv;
1092 IV i;
1093 {
1094     if (SvTHINKFIRST(sv)) {
1095         if (SvREADONLY(sv) && curcop != &compiling)
1096             croak(no_modify);
1097         if (SvROK(sv))
1098             sv_unref(sv);
1099     }
1100     switch (SvTYPE(sv)) {
1101     case SVt_NULL:
1102         sv_upgrade(sv, SVt_IV);
1103         break;
1104     case SVt_NV:
1105         sv_upgrade(sv, SVt_PVNV);
1106         break;
1107     case SVt_RV:
1108     case SVt_PV:
1109         sv_upgrade(sv, SVt_PVIV);
1110         break;
1111
1112     case SVt_PVGV:
1113         if (SvFAKE(sv)) {
1114             sv_unglob(sv);
1115             break;
1116         }
1117         /* FALL THROUGH */
1118     case SVt_PVAV:
1119     case SVt_PVHV:
1120     case SVt_PVCV:
1121     case SVt_PVFM:
1122     case SVt_PVIO:
1123         croak("Can't coerce %s to integer in %s", sv_reftype(sv,0),
1124             op_desc[op->op_type]);
1125     }
1126     (void)SvIOK_only(sv);                       /* validate number */
1127     SvIVX(sv) = i;
1128     SvTAINT(sv);
1129 }
1130
1131 void
1132 sv_setuv(sv,u)
1133 register SV *sv;
1134 UV u;
1135 {
1136     if (u <= IV_MAX)
1137         sv_setiv(sv, u);
1138     else
1139         sv_setnv(sv, (double)u);
1140 }
1141
1142 void
1143 sv_setnv(sv,num)
1144 register SV *sv;
1145 double num;
1146 {
1147     if (SvTHINKFIRST(sv)) {
1148         if (SvREADONLY(sv) && curcop != &compiling)
1149             croak(no_modify);
1150         if (SvROK(sv))
1151             sv_unref(sv);
1152     }
1153     switch (SvTYPE(sv)) {
1154     case SVt_NULL:
1155     case SVt_IV:
1156         sv_upgrade(sv, SVt_NV);
1157         break;
1158     case SVt_NV:
1159     case SVt_RV:
1160     case SVt_PV:
1161     case SVt_PVIV:
1162         sv_upgrade(sv, SVt_PVNV);
1163         /* FALL THROUGH */
1164     case SVt_PVNV:
1165     case SVt_PVMG:
1166     case SVt_PVBM:
1167     case SVt_PVLV:
1168         if (SvOOK(sv))
1169             (void)SvOOK_off(sv);
1170         break;
1171     case SVt_PVGV:
1172         if (SvFAKE(sv)) {
1173             sv_unglob(sv);
1174             break;
1175         }
1176         /* FALL THROUGH */
1177     case SVt_PVAV:
1178     case SVt_PVHV:
1179     case SVt_PVCV:
1180     case SVt_PVFM:
1181     case SVt_PVIO:
1182         croak("Can't coerce %s to number in %s", sv_reftype(sv,0),
1183             op_name[op->op_type]);
1184     }
1185     SvNVX(sv) = num;
1186     (void)SvNOK_only(sv);                       /* validate number */
1187     SvTAINT(sv);
1188 }
1189
1190 static void
1191 not_a_number(sv)
1192 SV *sv;
1193 {
1194     char tmpbuf[64];
1195     char *d = tmpbuf;
1196     char *s;
1197     char *limit = tmpbuf + sizeof(tmpbuf) - 8;
1198                   /* each *s can expand to 4 chars + "...\0",
1199                      i.e. need room for 8 chars */
1200
1201     for (s = SvPVX(sv); *s && d < limit; s++) {
1202         int ch = *s & 0xFF;
1203         if (ch & 128 && !isPRINT_LC(ch)) {
1204             *d++ = 'M';
1205             *d++ = '-';
1206             ch &= 127;
1207         }
1208         if (ch == '\n') {
1209             *d++ = '\\';
1210             *d++ = 'n';
1211         }
1212         else if (ch == '\r') {
1213             *d++ = '\\';
1214             *d++ = 'r';
1215         }
1216         else if (ch == '\f') {
1217             *d++ = '\\';
1218             *d++ = 'f';
1219         }
1220         else if (ch == '\\') {
1221             *d++ = '\\';
1222             *d++ = '\\';
1223         }
1224         else if (isPRINT_LC(ch))
1225             *d++ = ch;
1226         else {
1227             *d++ = '^';
1228             *d++ = toCTRL(ch);
1229         }
1230     }
1231     if (*s) {
1232         *d++ = '.';
1233         *d++ = '.';
1234         *d++ = '.';
1235     }
1236     *d = '\0';
1237
1238     if (op)
1239         warn("Argument \"%s\" isn't numeric in %s", tmpbuf,
1240                 op_name[op->op_type]);
1241     else
1242         warn("Argument \"%s\" isn't numeric", tmpbuf);
1243 }
1244
1245 IV
1246 sv_2iv(sv)
1247 register SV *sv;
1248 {
1249     if (!sv)
1250         return 0;
1251     if (SvGMAGICAL(sv)) {
1252         mg_get(sv);
1253         if (SvIOKp(sv))
1254             return SvIVX(sv);
1255         if (SvNOKp(sv)) {
1256             if (SvNVX(sv) < 0.0)
1257                 return I_V(SvNVX(sv));
1258             else
1259                 return (IV) U_V(SvNVX(sv));
1260         }
1261         if (SvPOKp(sv) && SvLEN(sv))
1262             return asIV(sv);
1263         if (!SvROK(sv)) {
1264             if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
1265                 warn(warn_uninit);
1266             return 0;
1267         }
1268     }
1269     if (SvTHINKFIRST(sv)) {
1270         if (SvROK(sv)) {
1271 #ifdef OVERLOAD
1272           SV* tmpstr;
1273           if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv, numer)))
1274             return SvIV(tmpstr);
1275 #endif /* OVERLOAD */
1276           return (IV)SvRV(sv);
1277         }
1278         if (SvREADONLY(sv)) {
1279             if (SvNOKp(sv)) {
1280                 if (SvNVX(sv) < 0.0)
1281                     return I_V(SvNVX(sv));
1282                 else
1283                     return (IV) U_V(SvNVX(sv));
1284             }
1285             if (SvPOKp(sv) && SvLEN(sv))
1286                 return asIV(sv);
1287             if (dowarn)
1288                 warn(warn_uninit);
1289             return 0;
1290         }
1291     }
1292     switch (SvTYPE(sv)) {
1293     case SVt_NULL:
1294         sv_upgrade(sv, SVt_IV);
1295         break;
1296     case SVt_PV:
1297         sv_upgrade(sv, SVt_PVIV);
1298         break;
1299     case SVt_NV:
1300         sv_upgrade(sv, SVt_PVNV);
1301         break;
1302     }
1303     if (SvNOKp(sv)) {
1304         (void)SvIOK_on(sv);
1305         if (SvNVX(sv) < 0.0)
1306             SvIVX(sv) = I_V(SvNVX(sv));
1307         else
1308             SvUVX(sv) = U_V(SvNVX(sv));
1309     }
1310     else if (SvPOKp(sv) && SvLEN(sv)) {
1311         (void)SvIOK_on(sv);
1312         SvIVX(sv) = asIV(sv);
1313     }
1314     else  {
1315         if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
1316             warn(warn_uninit);
1317         return 0;
1318     }
1319     DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2iv(%ld)\n",
1320         (unsigned long)sv,(long)SvIVX(sv)));
1321     return SvIVX(sv);
1322 }
1323
1324 UV
1325 sv_2uv(sv)
1326 register SV *sv;
1327 {
1328     if (!sv)
1329         return 0;
1330     if (SvGMAGICAL(sv)) {
1331         mg_get(sv);
1332         if (SvIOKp(sv))
1333             return SvUVX(sv);
1334         if (SvNOKp(sv))
1335             return U_V(SvNVX(sv));
1336         if (SvPOKp(sv) && SvLEN(sv))
1337             return asUV(sv);
1338         if (!SvROK(sv)) {
1339             if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
1340                 warn(warn_uninit);
1341             return 0;
1342         }
1343     }
1344     if (SvTHINKFIRST(sv)) {
1345         if (SvROK(sv)) {
1346 #ifdef OVERLOAD
1347           SV* tmpstr;
1348           if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv, numer)))
1349             return SvUV(tmpstr);
1350 #endif /* OVERLOAD */
1351           return (UV)SvRV(sv);
1352         }
1353         if (SvREADONLY(sv)) {
1354             if (SvNOKp(sv)) {
1355                 return U_V(SvNVX(sv));
1356             }
1357             if (SvPOKp(sv) && SvLEN(sv))
1358                 return asUV(sv);
1359             if (dowarn)
1360                 warn(warn_uninit);
1361             return 0;
1362         }
1363     }
1364     switch (SvTYPE(sv)) {
1365     case SVt_NULL:
1366         sv_upgrade(sv, SVt_IV);
1367         break;
1368     case SVt_PV:
1369         sv_upgrade(sv, SVt_PVIV);
1370         break;
1371     case SVt_NV:
1372         sv_upgrade(sv, SVt_PVNV);
1373         break;
1374     }
1375     if (SvNOKp(sv)) {
1376         (void)SvIOK_on(sv);
1377         SvUVX(sv) = U_V(SvNVX(sv));
1378     }
1379     else if (SvPOKp(sv) && SvLEN(sv)) {
1380         (void)SvIOK_on(sv);
1381         SvUVX(sv) = asUV(sv);
1382     }
1383     else  {
1384         if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
1385             warn(warn_uninit);
1386         return 0;
1387     }
1388     DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2uv(%lu)\n",
1389         (unsigned long)sv,SvUVX(sv)));
1390     return SvUVX(sv);
1391 }
1392
1393 double
1394 sv_2nv(sv)
1395 register SV *sv;
1396 {
1397     if (!sv)
1398         return 0.0;
1399     if (SvGMAGICAL(sv)) {
1400         mg_get(sv);
1401         if (SvNOKp(sv))
1402             return SvNVX(sv);
1403         if (SvPOKp(sv) && SvLEN(sv)) {
1404             if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
1405                 not_a_number(sv);
1406             SET_NUMERIC_STANDARD();
1407             return atof(SvPVX(sv));
1408         }
1409         if (SvIOKp(sv))
1410             return (double)SvIVX(sv);
1411         if (!SvROK(sv)) {
1412             if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
1413                 warn(warn_uninit);
1414             return 0;
1415         }
1416     }
1417     if (SvTHINKFIRST(sv)) {
1418         if (SvROK(sv)) {
1419 #ifdef OVERLOAD
1420           SV* tmpstr;
1421           if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)))
1422             return SvNV(tmpstr);
1423 #endif /* OVERLOAD */
1424           return (double)(unsigned long)SvRV(sv);
1425         }
1426         if (SvREADONLY(sv)) {
1427             if (SvPOKp(sv) && SvLEN(sv)) {
1428                 if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
1429                     not_a_number(sv);
1430                 SET_NUMERIC_STANDARD();
1431                 return atof(SvPVX(sv));
1432             }
1433             if (SvIOKp(sv))
1434                 return (double)SvIVX(sv);
1435             if (dowarn)
1436                 warn(warn_uninit);
1437             return 0.0;
1438         }
1439     }
1440     if (SvTYPE(sv) < SVt_NV) {
1441         if (SvTYPE(sv) == SVt_IV)
1442             sv_upgrade(sv, SVt_PVNV);
1443         else
1444             sv_upgrade(sv, SVt_NV);
1445         DEBUG_c(SET_NUMERIC_STANDARD());
1446         DEBUG_c(PerlIO_printf(Perl_debug_log,
1447                               "0x%lx num(%g)\n",(unsigned long)sv,SvNVX(sv)));
1448     }
1449     else if (SvTYPE(sv) < SVt_PVNV)
1450         sv_upgrade(sv, SVt_PVNV);
1451     if (SvIOKp(sv) &&
1452             (!SvPOKp(sv) || !strchr(SvPVX(sv),'.') || !looks_like_number(sv)))
1453     {
1454         SvNVX(sv) = (double)SvIVX(sv);
1455     }
1456     else if (SvPOKp(sv) && SvLEN(sv)) {
1457         if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
1458             not_a_number(sv);
1459         SET_NUMERIC_STANDARD();
1460         SvNVX(sv) = atof(SvPVX(sv));
1461     }
1462     else  {
1463         if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
1464             warn(warn_uninit);
1465         return 0.0;
1466     }
1467     SvNOK_on(sv);
1468     DEBUG_c(SET_NUMERIC_STANDARD());
1469     DEBUG_c(PerlIO_printf(Perl_debug_log,
1470                           "0x%lx 2nv(%g)\n",(unsigned long)sv,SvNVX(sv)));
1471     return SvNVX(sv);
1472 }
1473
1474 static IV
1475 asIV(sv)
1476 SV *sv;
1477 {
1478     I32 numtype = looks_like_number(sv);
1479     double d;
1480
1481     if (numtype == 1)
1482         return atol(SvPVX(sv));
1483     if (!numtype && dowarn)
1484         not_a_number(sv);
1485     SET_NUMERIC_STANDARD();
1486     d = atof(SvPVX(sv));
1487     if (d < 0.0)
1488         return I_V(d);
1489     else
1490         return (IV) U_V(d);
1491 }
1492
1493 static UV
1494 asUV(sv)
1495 SV *sv;
1496 {
1497     I32 numtype = looks_like_number(sv);
1498
1499     if (numtype == 1)
1500         return atol(SvPVX(sv));
1501     if (!numtype && dowarn)
1502         not_a_number(sv);
1503     SET_NUMERIC_STANDARD();
1504     return U_V(atof(SvPVX(sv)));
1505 }
1506
1507 I32
1508 looks_like_number(sv)
1509 SV *sv;
1510 {
1511     register char *s;
1512     register char *send;
1513     register char *sbegin;
1514     I32 numtype;
1515     STRLEN len;
1516
1517     if (SvPOK(sv)) {
1518         sbegin = SvPVX(sv);
1519         len = SvCUR(sv);
1520     }
1521     else if (SvPOKp(sv))
1522         sbegin = SvPV(sv, len);
1523     else
1524         return 1;
1525     send = sbegin + len;
1526
1527     s = sbegin;
1528     while (isSPACE(*s))
1529         s++;
1530     if (*s == '+' || *s == '-')
1531         s++;
1532
1533     /* next must be digit or '.' */
1534     if (isDIGIT(*s)) {
1535         do {
1536             s++;
1537         } while (isDIGIT(*s));
1538         if (*s == '.') {
1539             s++;
1540             while (isDIGIT(*s))  /* optional digits after "." */
1541                 s++;
1542         }
1543     }
1544     else if (*s == '.') {
1545         s++;
1546         /* no digits before '.' means we need digits after it */
1547         if (isDIGIT(*s)) {
1548             do {
1549                 s++;
1550             } while (isDIGIT(*s));
1551         }
1552         else
1553             return 0;
1554     }
1555     else
1556         return 0;
1557
1558     /*
1559      * we return 1 if the number can be converted to _integer_ with atol()
1560      * and 2 if you need (int)atof().
1561      */
1562     numtype = 1;
1563
1564     /* we can have an optional exponent part */
1565     if (*s == 'e' || *s == 'E') {
1566         numtype = 2;
1567         s++;
1568         if (*s == '+' || *s == '-')
1569             s++;
1570         if (isDIGIT(*s)) {
1571             do {
1572                 s++;
1573             } while (isDIGIT(*s));
1574         }
1575         else
1576             return 0;
1577     }
1578     while (isSPACE(*s))
1579         s++;
1580     if (s >= send)
1581         return numtype;
1582     if (len == 10 && memEQ(sbegin, "0 but true", 10))
1583         return 1;
1584     return 0;
1585 }
1586
1587 char *
1588 sv_2pv(sv, lp)
1589 register SV *sv;
1590 STRLEN *lp;
1591 {
1592     register char *s;
1593     int olderrno;
1594     SV *tsv;
1595
1596     if (!sv) {
1597         *lp = 0;
1598         return "";
1599     }
1600     if (SvGMAGICAL(sv)) {
1601         mg_get(sv);
1602         if (SvPOKp(sv)) {
1603             *lp = SvCUR(sv);
1604             return SvPVX(sv);
1605         }
1606         if (SvIOKp(sv)) {
1607             (void)sprintf(tokenbuf,"%ld",(long)SvIVX(sv));
1608             tsv = Nullsv;
1609             goto tokensave;
1610         }
1611         if (SvNOKp(sv)) {
1612             SET_NUMERIC_STANDARD();
1613             Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
1614             tsv = Nullsv;
1615             goto tokensave;
1616         }
1617         if (!SvROK(sv)) {
1618             if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
1619                 warn(warn_uninit);
1620             *lp = 0;
1621             return "";
1622         }
1623     }
1624     if (SvTHINKFIRST(sv)) {
1625         if (SvROK(sv)) {
1626 #ifdef OVERLOAD
1627             SV* tmpstr;
1628             if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)))
1629               return SvPV(tmpstr,*lp);
1630 #endif /* OVERLOAD */
1631             sv = (SV*)SvRV(sv);
1632             if (!sv)
1633                 s = "NULLREF";
1634             else {
1635                 switch (SvTYPE(sv)) {
1636                 case SVt_NULL:
1637                 case SVt_IV:
1638                 case SVt_NV:
1639                 case SVt_RV:
1640                 case SVt_PV:
1641                 case SVt_PVIV:
1642                 case SVt_PVNV:
1643                 case SVt_PVBM:
1644                 case SVt_PVMG:  s = "SCALAR";                   break;
1645                 case SVt_PVLV:  s = "LVALUE";                   break;
1646                 case SVt_PVAV:  s = "ARRAY";                    break;
1647                 case SVt_PVHV:  s = "HASH";                     break;
1648                 case SVt_PVCV:  s = "CODE";                     break;
1649                 case SVt_PVGV:  s = "GLOB";                     break;
1650                 case SVt_PVFM:  s = "FORMATLINE";               break;
1651                 case SVt_PVIO:  s = "IO";                       break;
1652                 default:        s = "UNKNOWN";                  break;
1653                 }
1654                 tsv = NEWSV(0,0);
1655                 if (SvOBJECT(sv))
1656                     sv_setpvf(tsv, "%s=%s", HvNAME(SvSTASH(sv)), s);
1657                 else
1658                     sv_setpv(tsv, s);
1659                 sv_catpvf(tsv, "(0x%lx)", (unsigned long)sv);
1660                 goto tokensaveref;
1661             }
1662             *lp = strlen(s);
1663             return s;
1664         }
1665         if (SvREADONLY(sv)) {
1666             if (SvNOKp(sv)) {
1667                 SET_NUMERIC_STANDARD();
1668                 Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
1669                 tsv = Nullsv;
1670                 goto tokensave;
1671             }
1672             if (SvIOKp(sv)) {
1673                 (void)sprintf(tokenbuf,"%ld",(long)SvIVX(sv));
1674                 tsv = Nullsv;
1675                 goto tokensave;
1676             }
1677             if (dowarn)
1678                 warn(warn_uninit);
1679             *lp = 0;
1680             return "";
1681         }
1682     }
1683     if (!SvUPGRADE(sv, SVt_PV))
1684         return 0;
1685     if (SvNOKp(sv)) {
1686         if (SvTYPE(sv) < SVt_PVNV)
1687             sv_upgrade(sv, SVt_PVNV);
1688         SvGROW(sv, 28);
1689         s = SvPVX(sv);
1690         olderrno = errno;       /* some Xenix systems wipe out errno here */
1691 #ifdef apollo
1692         if (SvNVX(sv) == 0.0)
1693             (void)strcpy(s,"0");
1694         else
1695 #endif /*apollo*/
1696         {
1697             SET_NUMERIC_STANDARD();
1698             Gconvert(SvNVX(sv), DBL_DIG, 0, s);
1699         }
1700         errno = olderrno;
1701 #ifdef FIXNEGATIVEZERO
1702         if (*s == '-' && s[1] == '0' && !s[2])
1703             strcpy(s,"0");
1704 #endif
1705         while (*s) s++;
1706 #ifdef hcx
1707         if (s[-1] == '.')
1708             *--s = '\0';
1709 #endif
1710     }
1711     else if (SvIOKp(sv)) {
1712         if (SvTYPE(sv) < SVt_PVIV)
1713             sv_upgrade(sv, SVt_PVIV);
1714         olderrno = errno;       /* some Xenix systems wipe out errno here */
1715         sv_setpvf(sv, "%Vd", SvIVX(sv));
1716         errno = olderrno;
1717         s = SvEND(sv);
1718     }
1719     else {
1720         if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
1721             warn(warn_uninit);
1722         *lp = 0;
1723         return "";
1724     }
1725     *lp = s - SvPVX(sv);
1726     SvCUR_set(sv, *lp);
1727     SvPOK_on(sv);
1728     DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2pv(%s)\n",(unsigned long)sv,SvPVX(sv)));
1729     return SvPVX(sv);
1730
1731   tokensave:
1732     if (SvROK(sv)) {    /* XXX Skip this when sv_pvn_force calls */
1733         /* Sneaky stuff here */
1734
1735       tokensaveref:
1736         if (!tsv)
1737             tsv = newSVpv(tokenbuf, 0);
1738         sv_2mortal(tsv);
1739         *lp = SvCUR(tsv);
1740         return SvPVX(tsv);
1741     }
1742     else {
1743         STRLEN len;
1744         char *t;
1745
1746         if (tsv) {
1747             sv_2mortal(tsv);
1748             t = SvPVX(tsv);
1749             len = SvCUR(tsv);
1750         }
1751         else {
1752             t = tokenbuf;
1753             len = strlen(tokenbuf);
1754         }
1755 #ifdef FIXNEGATIVEZERO
1756         if (len == 2 && t[0] == '-' && t[1] == '0') {
1757             t = "0";
1758             len = 1;
1759         }
1760 #endif
1761         (void)SvUPGRADE(sv, SVt_PV);
1762         *lp = len;
1763         s = SvGROW(sv, len + 1);
1764         SvCUR_set(sv, len);
1765         (void)strcpy(s, t);
1766         SvPOKp_on(sv);
1767         return s;
1768     }
1769 }
1770
1771 /* This function is only called on magical items */
1772 bool
1773 sv_2bool(sv)
1774 register SV *sv;
1775 {
1776     if (SvGMAGICAL(sv))
1777         mg_get(sv);
1778
1779     if (!SvOK(sv))
1780         return 0;
1781     if (SvROK(sv)) {
1782 #ifdef OVERLOAD
1783       {
1784         SV* tmpsv;
1785         if (SvAMAGIC(sv) && (tmpsv = AMG_CALLun(sv,bool_)))
1786           return SvTRUE(tmpsv);
1787       }
1788 #endif /* OVERLOAD */
1789       return SvRV(sv) != 0;
1790     }
1791     if (SvPOKp(sv)) {
1792         register XPV* Xpv;
1793         if ((Xpv = (XPV*)SvANY(sv)) &&
1794                 (*Xpv->xpv_pv > '0' ||
1795                 Xpv->xpv_cur > 1 ||
1796                 (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
1797             return 1;
1798         else
1799             return 0;
1800     }
1801     else {
1802         if (SvIOKp(sv))
1803             return SvIVX(sv) != 0;
1804         else {
1805             if (SvNOKp(sv))
1806                 return SvNVX(sv) != 0.0;
1807             else
1808                 return FALSE;
1809         }
1810     }
1811 }
1812
1813 /* Note: sv_setsv() should not be called with a source string that needs
1814  * to be reused, since it may destroy the source string if it is marked
1815  * as temporary.
1816  */
1817
1818 void
1819 sv_setsv(dstr,sstr)
1820 SV *dstr;
1821 register SV *sstr;
1822 {
1823     register U32 sflags;
1824     register int dtype;
1825     register int stype;
1826
1827     if (sstr == dstr)
1828         return;
1829     if (SvTHINKFIRST(dstr)) {
1830         if (SvREADONLY(dstr) && curcop != &compiling)
1831             croak(no_modify);
1832         if (SvROK(dstr))
1833             sv_unref(dstr);
1834     }
1835     if (!sstr)
1836         sstr = &sv_undef;
1837     stype = SvTYPE(sstr);
1838     dtype = SvTYPE(dstr);
1839
1840     if (dtype == SVt_PVGV && (SvFLAGS(dstr) & SVf_FAKE)) {
1841         sv_unglob(dstr);     /* so fake GLOB won't perpetuate */
1842         sv_setpvn(dstr, "", 0);
1843         (void)SvPOK_only(dstr);
1844         dtype = SvTYPE(dstr);
1845     }
1846
1847 #ifdef OVERLOAD
1848     SvAMAGIC_off(dstr);
1849 #endif /* OVERLOAD */
1850     /* There's a lot of redundancy below but we're going for speed here */
1851
1852     switch (stype) {
1853     case SVt_NULL:
1854         (void)SvOK_off(dstr);
1855         return;
1856     case SVt_IV:
1857         if (dtype != SVt_IV && dtype < SVt_PVIV) {
1858             if (dtype < SVt_IV)
1859                 sv_upgrade(dstr, SVt_IV);
1860             else if (dtype == SVt_NV)
1861                 sv_upgrade(dstr, SVt_PVNV);
1862             else
1863                 sv_upgrade(dstr, SVt_PVIV);
1864         }
1865         break;
1866     case SVt_NV:
1867         if (dtype != SVt_NV && dtype < SVt_PVNV) {
1868             if (dtype < SVt_NV)
1869                 sv_upgrade(dstr, SVt_NV);
1870             else
1871                 sv_upgrade(dstr, SVt_PVNV);
1872         }
1873         break;
1874     case SVt_RV:
1875         if (dtype < SVt_RV)
1876             sv_upgrade(dstr, SVt_RV);
1877         else if (dtype == SVt_PVGV &&
1878                  SvTYPE(SvRV(sstr)) == SVt_PVGV) {
1879             sstr = SvRV(sstr);
1880             if (sstr == dstr) {
1881                 if (curcop->cop_stash != GvSTASH(dstr))
1882                     GvIMPORTED_on(dstr);
1883                 GvMULTI_on(dstr);
1884                 return;
1885             }
1886             goto glob_assign;
1887         }
1888         break;
1889     case SVt_PV:
1890     case SVt_PVFM:
1891         if (dtype < SVt_PV)
1892             sv_upgrade(dstr, SVt_PV);
1893         break;
1894     case SVt_PVIV:
1895         if (dtype < SVt_PVIV)
1896             sv_upgrade(dstr, SVt_PVIV);
1897         break;
1898     case SVt_PVNV:
1899         if (dtype < SVt_PVNV)
1900             sv_upgrade(dstr, SVt_PVNV);
1901         break;
1902
1903     case SVt_PVLV:
1904         sv_upgrade(dstr, SVt_PVLV);
1905         break;
1906
1907     case SVt_PVAV:
1908     case SVt_PVHV:
1909     case SVt_PVCV:
1910     case SVt_PVIO:
1911         if (op)
1912             croak("Bizarre copy of %s in %s", sv_reftype(sstr, 0),
1913                 op_name[op->op_type]);
1914         else
1915             croak("Bizarre copy of %s", sv_reftype(sstr, 0));
1916         break;
1917
1918     case SVt_PVGV:
1919         if (dtype <= SVt_PVGV) {
1920   glob_assign:
1921             if (dtype != SVt_PVGV) {
1922                 char *name = GvNAME(sstr);
1923                 STRLEN len = GvNAMELEN(sstr);
1924                 sv_upgrade(dstr, SVt_PVGV);
1925                 sv_magic(dstr, dstr, '*', name, len);
1926                 GvSTASH(dstr) = GvSTASH(sstr);
1927                 GvNAME(dstr) = savepvn(name, len);
1928                 GvNAMELEN(dstr) = len;
1929                 SvFAKE_on(dstr);        /* can coerce to non-glob */
1930             }
1931             /* ahem, death to those who redefine active sort subs */
1932             else if (curstack == sortstack
1933                      && GvCV(dstr) && sortcop == CvSTART(GvCV(dstr)))
1934                 croak("Can't redefine active sort subroutine %s",
1935                       GvNAME(dstr));
1936             (void)SvOK_off(dstr);
1937             GvINTRO_off(dstr);          /* one-shot flag */
1938             gp_free((GV*)dstr);
1939             GvGP(dstr) = gp_ref(GvGP(sstr));
1940             SvTAINT(dstr);
1941             if (curcop->cop_stash != GvSTASH(dstr))
1942                 GvIMPORTED_on(dstr);
1943             GvMULTI_on(dstr);
1944             return;
1945         }
1946         /* FALL THROUGH */
1947
1948     default:
1949         if (SvGMAGICAL(sstr)) {
1950             mg_get(sstr);
1951             if (SvTYPE(sstr) != stype) {
1952                 stype = SvTYPE(sstr);
1953                 if (stype == SVt_PVGV && dtype <= SVt_PVGV)
1954                     goto glob_assign;
1955             }
1956         }
1957         if (dtype < stype)
1958             sv_upgrade(dstr, stype);
1959     }
1960
1961     sflags = SvFLAGS(sstr);
1962
1963     if (sflags & SVf_ROK) {
1964         if (dtype >= SVt_PV) {
1965             if (dtype == SVt_PVGV) {
1966                 SV *sref = SvREFCNT_inc(SvRV(sstr));
1967                 SV *dref = 0;
1968                 int intro = GvINTRO(dstr);
1969
1970                 if (intro) {
1971                     GP *gp;
1972                     GvGP(dstr)->gp_refcnt--;
1973                     GvINTRO_off(dstr);  /* one-shot flag */
1974                     Newz(602,gp, 1, GP);
1975                     GvGP(dstr) = gp_ref(gp);
1976                     GvSV(dstr) = NEWSV(72,0);
1977                     GvLINE(dstr) = curcop->cop_line;
1978                     GvEGV(dstr) = (GV*)dstr;
1979                 }
1980                 GvMULTI_on(dstr);
1981                 switch (SvTYPE(sref)) {
1982                 case SVt_PVAV:
1983                     if (intro)
1984                         SAVESPTR(GvAV(dstr));
1985                     else
1986                         dref = (SV*)GvAV(dstr);
1987                     GvAV(dstr) = (AV*)sref;
1988                     if (curcop->cop_stash != GvSTASH(dstr))
1989                         GvIMPORTED_AV_on(dstr);
1990                     break;
1991                 case SVt_PVHV:
1992                     if (intro)
1993                         SAVESPTR(GvHV(dstr));
1994                     else
1995                         dref = (SV*)GvHV(dstr);
1996                     GvHV(dstr) = (HV*)sref;
1997                     if (curcop->cop_stash != GvSTASH(dstr))
1998                         GvIMPORTED_HV_on(dstr);
1999                     break;
2000                 case SVt_PVCV:
2001                     if (intro) {
2002                         if (GvCVGEN(dstr) && GvCV(dstr) != (CV*)sref) {
2003                             SvREFCNT_dec(GvCV(dstr));
2004                             GvCV(dstr) = Nullcv;
2005                             GvCVGEN(dstr) = 0; /* Switch off cacheness. */
2006                             sub_generation++;
2007                         }
2008                         SAVESPTR(GvCV(dstr));
2009                     }
2010                     else
2011                         dref = (SV*)GvCV(dstr);
2012                     if (GvCV(dstr) != (CV*)sref) {
2013                         CV* cv = GvCV(dstr);
2014                         if (cv) {
2015                             if (!GvCVGEN((GV*)dstr) &&
2016                                 (CvROOT(cv) || CvXSUB(cv)))
2017                             {
2018                                 /* ahem, death to those who redefine
2019                                  * active sort subs */
2020                                 if (curstack == sortstack &&
2021                                       sortcop == CvSTART(cv))
2022                                     croak(
2023                                     "Can't redefine active sort subroutine %s",
2024                                           GvENAME((GV*)dstr));
2025                                 if (cv_const_sv(cv))
2026                                     warn("Constant subroutine %s redefined",
2027                                          GvENAME((GV*)dstr));
2028                                 else if (dowarn)
2029                                     warn("Subroutine %s redefined",
2030                                          GvENAME((GV*)dstr));
2031                             }
2032                             cv_ckproto(cv, (GV*)dstr,
2033                                        SvPOK(sref) ? SvPVX(sref) : Nullch);
2034                         }
2035                         GvCV(dstr) = (CV*)sref;
2036                         GvCVGEN(dstr) = 0; /* Switch off cacheness. */
2037                         GvASSUMECV_on(dstr);
2038                         sub_generation++;
2039                     }
2040                     if (curcop->cop_stash != GvSTASH(dstr))
2041                         GvIMPORTED_CV_on(dstr);
2042                     break;
2043                 case SVt_PVIO:
2044                     if (intro)
2045                         SAVESPTR(GvIOp(dstr));
2046                     else
2047                         dref = (SV*)GvIOp(dstr);
2048                     GvIOp(dstr) = (IO*)sref;
2049                     break;
2050                 default:
2051                     if (intro)
2052                         SAVESPTR(GvSV(dstr));
2053                     else
2054                         dref = (SV*)GvSV(dstr);
2055                     GvSV(dstr) = sref;
2056                     if (curcop->cop_stash != GvSTASH(dstr))
2057                         GvIMPORTED_SV_on(dstr);
2058                     break;
2059                 }
2060                 if (dref)
2061                     SvREFCNT_dec(dref);
2062                 if (intro)
2063                     SAVEFREESV(sref);
2064                 SvTAINT(dstr);
2065                 return;
2066             }
2067             if (SvPVX(dstr)) {
2068                 (void)SvOOK_off(dstr);          /* backoff */
2069                 Safefree(SvPVX(dstr));
2070                 SvLEN(dstr)=SvCUR(dstr)=0;
2071             }
2072         }
2073         (void)SvOK_off(dstr);
2074         SvRV(dstr) = SvREFCNT_inc(SvRV(sstr));
2075         SvROK_on(dstr);
2076         if (sflags & SVp_NOK) {
2077             SvNOK_on(dstr);
2078             SvNVX(dstr) = SvNVX(sstr);
2079         }
2080         if (sflags & SVp_IOK) {
2081             (void)SvIOK_on(dstr);
2082             SvIVX(dstr) = SvIVX(sstr);
2083         }
2084 #ifdef OVERLOAD
2085         if (SvAMAGIC(sstr)) {
2086             SvAMAGIC_on(dstr);
2087         }
2088 #endif /* OVERLOAD */
2089     }
2090     else if (sflags & SVp_POK) {
2091
2092         /*
2093          * Check to see if we can just swipe the string.  If so, it's a
2094          * possible small lose on short strings, but a big win on long ones.
2095          * It might even be a win on short strings if SvPVX(dstr)
2096          * has to be allocated and SvPVX(sstr) has to be freed.
2097          */
2098
2099         if (SvTEMP(sstr) &&             /* slated for free anyway? */
2100             !(sflags & SVf_OOK))        /* and not involved in OOK hack? */
2101         {
2102             if (SvPVX(dstr)) {          /* we know that dtype >= SVt_PV */
2103                 if (SvOOK(dstr)) {
2104                     SvFLAGS(dstr) &= ~SVf_OOK;
2105                     Safefree(SvPVX(dstr) - SvIVX(dstr));
2106                 }
2107                 else
2108                     Safefree(SvPVX(dstr));
2109             }
2110             (void)SvPOK_only(dstr);
2111             SvPV_set(dstr, SvPVX(sstr));
2112             SvLEN_set(dstr, SvLEN(sstr));
2113             SvCUR_set(dstr, SvCUR(sstr));
2114             SvTEMP_off(dstr);
2115             (void)SvOK_off(sstr);
2116             SvPV_set(sstr, Nullch);
2117             SvLEN_set(sstr, 0);
2118             SvCUR_set(sstr, 0);
2119             SvTEMP_off(sstr);
2120         }
2121         else {                                  /* have to copy actual string */
2122             STRLEN len = SvCUR(sstr);
2123
2124             SvGROW(dstr, len + 1);              /* inlined from sv_setpvn */
2125             Move(SvPVX(sstr),SvPVX(dstr),len,char);
2126             SvCUR_set(dstr, len);
2127             *SvEND(dstr) = '\0';
2128             (void)SvPOK_only(dstr);
2129         }
2130         /*SUPPRESS 560*/
2131         if (sflags & SVp_NOK) {
2132             SvNOK_on(dstr);
2133             SvNVX(dstr) = SvNVX(sstr);
2134         }
2135         if (sflags & SVp_IOK) {
2136             (void)SvIOK_on(dstr);
2137             SvIVX(dstr) = SvIVX(sstr);
2138         }
2139     }
2140     else if (sflags & SVp_NOK) {
2141         SvNVX(dstr) = SvNVX(sstr);
2142         (void)SvNOK_only(dstr);
2143         if (SvIOK(sstr)) {
2144             (void)SvIOK_on(dstr);
2145             SvIVX(dstr) = SvIVX(sstr);
2146         }
2147     }
2148     else if (sflags & SVp_IOK) {
2149         (void)SvIOK_only(dstr);
2150         SvIVX(dstr) = SvIVX(sstr);
2151     }
2152     else {
2153         (void)SvOK_off(dstr);
2154     }
2155     SvTAINT(dstr);
2156 }
2157
2158 void
2159 sv_setpvn(sv,ptr,len)
2160 register SV *sv;
2161 register const char *ptr;
2162 register STRLEN len;
2163 {
2164     assert(len >= 0);  /* STRLEN is probably unsigned, so this may
2165                           elicit a warning, but it won't hurt. */
2166     if (SvTHINKFIRST(sv)) {
2167         if (SvREADONLY(sv) && curcop != &compiling)
2168             croak(no_modify);
2169         if (SvROK(sv))
2170             sv_unref(sv);
2171     }
2172     if (!ptr) {
2173         (void)SvOK_off(sv);
2174         return;
2175     }
2176     if (SvTYPE(sv) >= SVt_PV) {
2177         if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
2178             sv_unglob(sv);
2179     }
2180     else if (!sv_upgrade(sv, SVt_PV))
2181         return;
2182     SvGROW(sv, len + 1);
2183     Move(ptr,SvPVX(sv),len,char);
2184     SvCUR_set(sv, len);
2185     *SvEND(sv) = '\0';
2186     (void)SvPOK_only(sv);               /* validate pointer */
2187     SvTAINT(sv);
2188 }
2189
2190 void
2191 sv_setpv(sv,ptr)
2192 register SV *sv;
2193 register const char *ptr;
2194 {
2195     register STRLEN len;
2196
2197     if (SvTHINKFIRST(sv)) {
2198         if (SvREADONLY(sv) && curcop != &compiling)
2199             croak(no_modify);
2200         if (SvROK(sv))
2201             sv_unref(sv);
2202     }
2203     if (!ptr) {
2204         (void)SvOK_off(sv);
2205         return;
2206     }
2207     len = strlen(ptr);
2208     if (SvTYPE(sv) >= SVt_PV) {
2209         if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
2210             sv_unglob(sv);
2211     }
2212     else if (!sv_upgrade(sv, SVt_PV))
2213         return;
2214     SvGROW(sv, len + 1);
2215     Move(ptr,SvPVX(sv),len+1,char);
2216     SvCUR_set(sv, len);
2217     (void)SvPOK_only(sv);               /* validate pointer */
2218     SvTAINT(sv);
2219 }
2220
2221 void
2222 sv_usepvn(sv,ptr,len)
2223 register SV *sv;
2224 register char *ptr;
2225 register STRLEN len;
2226 {
2227     if (SvTHINKFIRST(sv)) {
2228         if (SvREADONLY(sv) && curcop != &compiling)
2229             croak(no_modify);
2230         if (SvROK(sv))
2231             sv_unref(sv);
2232     }
2233     if (!SvUPGRADE(sv, SVt_PV))
2234         return;
2235     if (!ptr) {
2236         (void)SvOK_off(sv);
2237         return;
2238     }
2239     if (SvPVX(sv))
2240         Safefree(SvPVX(sv));
2241     Renew(ptr, len+1, char);
2242     SvPVX(sv) = ptr;
2243     SvCUR_set(sv, len);
2244     SvLEN_set(sv, len+1);
2245     *SvEND(sv) = '\0';
2246     (void)SvPOK_only(sv);               /* validate pointer */
2247     SvTAINT(sv);
2248 }
2249
2250 void
2251 sv_chop(sv,ptr) /* like set but assuming ptr is in sv */
2252 register SV *sv;
2253 register char *ptr;
2254 {
2255     register STRLEN delta;
2256
2257     if (!ptr || !SvPOKp(sv))
2258         return;
2259     if (SvTHINKFIRST(sv)) {
2260         if (SvREADONLY(sv) && curcop != &compiling)
2261             croak(no_modify);
2262         if (SvROK(sv))
2263             sv_unref(sv);
2264     }
2265     if (SvTYPE(sv) < SVt_PVIV)
2266         sv_upgrade(sv,SVt_PVIV);
2267
2268     if (!SvOOK(sv)) {
2269         SvIVX(sv) = 0;
2270         SvFLAGS(sv) |= SVf_OOK;
2271     }
2272     SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVp_IOK|SVp_NOK);
2273     delta = ptr - SvPVX(sv);
2274     SvLEN(sv) -= delta;
2275     SvCUR(sv) -= delta;
2276     SvPVX(sv) += delta;
2277     SvIVX(sv) += delta;
2278 }
2279
2280 void
2281 sv_catpvn(sv,ptr,len)
2282 register SV *sv;
2283 register char *ptr;
2284 register STRLEN len;
2285 {
2286     STRLEN tlen;
2287     char *junk;
2288
2289     junk = SvPV_force(sv, tlen);
2290     SvGROW(sv, tlen + len + 1);
2291     if (ptr == junk)
2292         ptr = SvPVX(sv);
2293     Move(ptr,SvPVX(sv)+tlen,len,char);
2294     SvCUR(sv) += len;
2295     *SvEND(sv) = '\0';
2296     (void)SvPOK_only(sv);               /* validate pointer */
2297     SvTAINT(sv);
2298 }
2299
2300 void
2301 sv_catsv(dstr,sstr)
2302 SV *dstr;
2303 register SV *sstr;
2304 {
2305     char *s;
2306     STRLEN len;
2307     if (!sstr)
2308         return;
2309     if (s = SvPV(sstr, len))
2310         sv_catpvn(dstr,s,len);
2311 }
2312
2313 void
2314 sv_catpv(sv,ptr)
2315 register SV *sv;
2316 register char *ptr;
2317 {
2318     register STRLEN len;
2319     STRLEN tlen;
2320     char *junk;
2321
2322     if (!ptr)
2323         return;
2324     junk = SvPV_force(sv, tlen);
2325     len = strlen(ptr);
2326     SvGROW(sv, tlen + len + 1);
2327     if (ptr == junk)
2328         ptr = SvPVX(sv);
2329     Move(ptr,SvPVX(sv)+tlen,len+1,char);
2330     SvCUR(sv) += len;
2331     (void)SvPOK_only(sv);               /* validate pointer */
2332     SvTAINT(sv);
2333 }
2334
2335 SV *
2336 #ifdef LEAKTEST
2337 newSV(x,len)
2338 I32 x;
2339 #else
2340 newSV(len)
2341 #endif
2342 STRLEN len;
2343 {
2344     register SV *sv;
2345
2346     new_SV(sv);
2347     SvANY(sv) = 0;
2348     SvREFCNT(sv) = 1;
2349     SvFLAGS(sv) = 0;
2350     if (len) {
2351         sv_upgrade(sv, SVt_PV);
2352         SvGROW(sv, len + 1);
2353     }
2354     return sv;
2355 }
2356
2357 /* name is assumed to contain an SV* if (name && namelen == HEf_SVKEY) */
2358
2359 void
2360 sv_magic(sv, obj, how, name, namlen)
2361 register SV *sv;
2362 SV *obj;
2363 int how;
2364 char *name;
2365 I32 namlen;
2366 {
2367     MAGIC* mg;
2368
2369     if (SvREADONLY(sv) && curcop != &compiling && !strchr("gBf", how))
2370         croak(no_modify);
2371     if (SvMAGICAL(sv) || (how == 't' && SvTYPE(sv) >= SVt_PVMG)) {
2372         if (SvMAGIC(sv) && (mg = mg_find(sv, how))) {
2373             if (how == 't')
2374                 mg->mg_len |= 1;
2375             return;
2376         }
2377     }
2378     else {
2379         if (!SvUPGRADE(sv, SVt_PVMG))
2380             return;
2381     }
2382     Newz(702,mg, 1, MAGIC);
2383     mg->mg_moremagic = SvMAGIC(sv);
2384
2385     SvMAGIC(sv) = mg;
2386     if (!obj || obj == sv || how == '#')
2387         mg->mg_obj = obj;
2388     else {
2389         mg->mg_obj = SvREFCNT_inc(obj);
2390         mg->mg_flags |= MGf_REFCOUNTED;
2391     }
2392     mg->mg_type = how;
2393     mg->mg_len = namlen;
2394     if (name)
2395         if (namlen >= 0)
2396             mg->mg_ptr = savepvn(name, namlen);
2397         else if (namlen == HEf_SVKEY)
2398             mg->mg_ptr = (char*)SvREFCNT_inc((SV*)name);
2399
2400     switch (how) {
2401     case 0:
2402         mg->mg_virtual = &vtbl_sv;
2403         break;
2404 #ifdef OVERLOAD
2405     case 'A':
2406         mg->mg_virtual = &vtbl_amagic;
2407         break;
2408     case 'a':
2409         mg->mg_virtual = &vtbl_amagicelem;
2410         break;
2411     case 'c':
2412         mg->mg_virtual = 0;
2413         break;
2414 #endif /* OVERLOAD */
2415     case 'B':
2416         mg->mg_virtual = &vtbl_bm;
2417         break;
2418     case 'E':
2419         mg->mg_virtual = &vtbl_env;
2420         break;
2421     case 'f':
2422         mg->mg_virtual = &vtbl_fm;
2423         break;
2424     case 'e':
2425         mg->mg_virtual = &vtbl_envelem;
2426         break;
2427     case 'g':
2428         mg->mg_virtual = &vtbl_mglob;
2429         break;
2430     case 'I':
2431         mg->mg_virtual = &vtbl_isa;
2432         break;
2433     case 'i':
2434         mg->mg_virtual = &vtbl_isaelem;
2435         break;
2436     case 'k':
2437         mg->mg_virtual = &vtbl_nkeys;
2438         break;
2439     case 'L':
2440         SvRMAGICAL_on(sv);
2441         mg->mg_virtual = 0;
2442         break;
2443     case 'l':
2444         mg->mg_virtual = &vtbl_dbline;
2445         break;
2446 #ifdef USE_LOCALE_COLLATE
2447     case 'o':
2448         mg->mg_virtual = &vtbl_collxfrm;
2449         break;
2450 #endif /* USE_LOCALE_COLLATE */
2451     case 'P':
2452         mg->mg_virtual = &vtbl_pack;
2453         break;
2454     case 'p':
2455     case 'q':
2456         mg->mg_virtual = &vtbl_packelem;
2457         break;
2458     case 'S':
2459         mg->mg_virtual = &vtbl_sig;
2460         break;
2461     case 's':
2462         mg->mg_virtual = &vtbl_sigelem;
2463         break;
2464     case 't':
2465         mg->mg_virtual = &vtbl_taint;
2466         mg->mg_len = 1;
2467         break;
2468     case 'U':
2469         mg->mg_virtual = &vtbl_uvar;
2470         break;
2471     case 'v':
2472         mg->mg_virtual = &vtbl_vec;
2473         break;
2474     case 'x':
2475         mg->mg_virtual = &vtbl_substr;
2476         break;
2477     case 'y':
2478         mg->mg_virtual = &vtbl_defelem;
2479         break;
2480     case '*':
2481         mg->mg_virtual = &vtbl_glob;
2482         break;
2483     case '#':
2484         mg->mg_virtual = &vtbl_arylen;
2485         break;
2486     case '.':
2487         mg->mg_virtual = &vtbl_pos;
2488         break;
2489     case '~':   /* Reserved for use by extensions not perl internals.   */
2490         /* Useful for attaching extension internal data to perl vars.   */
2491         /* Note that multiple extensions may clash if magical scalars   */
2492         /* etc holding private data from one are passed to another.     */
2493         SvRMAGICAL_on(sv);
2494         break;
2495     default:
2496         croak("Don't know how to handle magic of type '%c'", how);
2497     }
2498     mg_magical(sv);
2499     if (SvGMAGICAL(sv))
2500         SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
2501 }
2502
2503 int
2504 sv_unmagic(sv, type)
2505 SV* sv;
2506 int type;
2507 {
2508     MAGIC* mg;
2509     MAGIC** mgp;
2510     if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv))
2511         return 0;
2512     mgp = &SvMAGIC(sv);
2513     for (mg = *mgp; mg; mg = *mgp) {
2514         if (mg->mg_type == type) {
2515             MGVTBL* vtbl = mg->mg_virtual;
2516             *mgp = mg->mg_moremagic;
2517             if (vtbl && vtbl->svt_free)
2518                 (*vtbl->svt_free)(sv, mg);
2519             if (mg->mg_ptr && mg->mg_type != 'g')
2520                 if (mg->mg_len >= 0)
2521                     Safefree(mg->mg_ptr);
2522                 else if (mg->mg_len == HEf_SVKEY)
2523                     SvREFCNT_dec((SV*)mg->mg_ptr);
2524             if (mg->mg_flags & MGf_REFCOUNTED)
2525                 SvREFCNT_dec(mg->mg_obj);
2526             Safefree(mg);
2527         }
2528         else
2529             mgp = &mg->mg_moremagic;
2530     }
2531     if (!SvMAGIC(sv)) {
2532         SvMAGICAL_off(sv);
2533         SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
2534     }
2535
2536     return 0;
2537 }
2538
2539 void
2540 sv_insert(bigstr,offset,len,little,littlelen)
2541 SV *bigstr;
2542 STRLEN offset;
2543 STRLEN len;
2544 char *little;
2545 STRLEN littlelen;
2546 {
2547     register char *big;
2548     register char *mid;
2549     register char *midend;
2550     register char *bigend;
2551     register I32 i;
2552
2553     if (!bigstr)
2554         croak("Can't modify non-existent substring");
2555     SvPV_force(bigstr, na);
2556
2557     i = littlelen - len;
2558     if (i > 0) {                        /* string might grow */
2559         big = SvGROW(bigstr, SvCUR(bigstr) + i + 1);
2560         mid = big + offset + len;
2561         midend = bigend = big + SvCUR(bigstr);
2562         bigend += i;
2563         *bigend = '\0';
2564         while (midend > mid)            /* shove everything down */
2565             *--bigend = *--midend;
2566         Move(little,big+offset,littlelen,char);
2567         SvCUR(bigstr) += i;
2568         SvSETMAGIC(bigstr);
2569         return;
2570     }
2571     else if (i == 0) {
2572         Move(little,SvPVX(bigstr)+offset,len,char);
2573         SvSETMAGIC(bigstr);
2574         return;
2575     }
2576
2577     big = SvPVX(bigstr);
2578     mid = big + offset;
2579     midend = mid + len;
2580     bigend = big + SvCUR(bigstr);
2581
2582     if (midend > bigend)
2583         croak("panic: sv_insert");
2584
2585     if (mid - big > bigend - midend) {  /* faster to shorten from end */
2586         if (littlelen) {
2587             Move(little, mid, littlelen,char);
2588             mid += littlelen;
2589         }
2590         i = bigend - midend;
2591         if (i > 0) {
2592             Move(midend, mid, i,char);
2593             mid += i;
2594         }
2595         *mid = '\0';
2596         SvCUR_set(bigstr, mid - big);
2597     }
2598     /*SUPPRESS 560*/
2599     else if (i = mid - big) {   /* faster from front */
2600         midend -= littlelen;
2601         mid = midend;
2602         sv_chop(bigstr,midend-i);
2603         big += i;
2604         while (i--)
2605             *--midend = *--big;
2606         if (littlelen)
2607             Move(little, mid, littlelen,char);
2608     }
2609     else if (littlelen) {
2610         midend -= littlelen;
2611         sv_chop(bigstr,midend);
2612         Move(little,midend,littlelen,char);
2613     }
2614     else {
2615         sv_chop(bigstr,midend);
2616     }
2617     SvSETMAGIC(bigstr);
2618 }
2619
2620 /* make sv point to what nstr did */
2621
2622 void
2623 sv_replace(sv,nsv)
2624 register SV *sv;
2625 register SV *nsv;
2626 {
2627     U32 refcnt = SvREFCNT(sv);
2628     if (SvTHINKFIRST(sv)) {
2629         if (SvREADONLY(sv) && curcop != &compiling)
2630             croak(no_modify);
2631         if (SvROK(sv))
2632             sv_unref(sv);
2633     }
2634     if (SvREFCNT(nsv) != 1)
2635         warn("Reference miscount in sv_replace()");
2636     if (SvMAGICAL(sv)) {
2637         if (SvMAGICAL(nsv))
2638             mg_free(nsv);
2639         else
2640             sv_upgrade(nsv, SVt_PVMG);
2641         SvMAGIC(nsv) = SvMAGIC(sv);
2642         SvFLAGS(nsv) |= SvMAGICAL(sv);
2643         SvMAGICAL_off(sv);
2644         SvMAGIC(sv) = 0;
2645     }
2646     SvREFCNT(sv) = 0;
2647     sv_clear(sv);
2648     assert(!SvREFCNT(sv));
2649     StructCopy(nsv,sv,SV);
2650     SvREFCNT(sv) = refcnt;
2651     SvFLAGS(nsv) |= SVTYPEMASK;         /* Mark as freed */
2652     del_SV(nsv);
2653 }
2654
2655 void
2656 sv_clear(sv)
2657 register SV *sv;
2658 {
2659     assert(sv);
2660     assert(SvREFCNT(sv) == 0);
2661
2662     if (SvOBJECT(sv)) {
2663         if (defstash) {         /* Still have a symbol table? */
2664             dSP;
2665             GV* destructor;
2666
2667             ENTER;
2668             SAVEFREESV(SvSTASH(sv));
2669
2670             destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
2671             if (destructor) {
2672                 SV ref;
2673
2674                 Zero(&ref, 1, SV);
2675                 sv_upgrade(&ref, SVt_RV);
2676                 SvRV(&ref) = SvREFCNT_inc(sv);
2677                 SvROK_on(&ref);
2678                 SvREFCNT(&ref) = 1;     /* Fake, but otherwise
2679                                            creating+destructing a ref
2680                                            leads to disaster. */
2681
2682                 EXTEND(SP, 2);
2683                 PUSHMARK(SP);
2684                 PUSHs(&ref);
2685                 PUTBACK;
2686                 perl_call_sv((SV*)GvCV(destructor),
2687                              G_DISCARD|G_EVAL|G_KEEPERR);
2688                 del_XRV(SvANY(&ref));
2689                 SvREFCNT(sv)--;
2690             }
2691
2692             LEAVE;
2693         }
2694         else
2695             SvREFCNT_dec(SvSTASH(sv));
2696         if (SvOBJECT(sv)) {
2697             SvOBJECT_off(sv);   /* Curse the object. */
2698             if (SvTYPE(sv) != SVt_PVIO)
2699                 --sv_objcount;  /* XXX Might want something more general */
2700         }
2701         if (SvREFCNT(sv)) {
2702             SV *ret;
2703             if ( perldb
2704                  && (ret = perl_get_sv("DB::ret", FALSE))
2705                  && SvROK(ret) && SvRV(ret) == sv && SvREFCNT(sv) == 1) {
2706                 /* Debugger is prone to dangling references. */
2707                 SvRV(ret) = 0;
2708                 SvROK_off(ret);
2709                 SvREFCNT(sv) = 0;
2710             }
2711             else {
2712                 if (in_clean_objs)
2713                     croak("DESTROY created new reference to dead object");
2714                 /* DESTROY gave object new lease on life */
2715                 return;
2716             }
2717         }
2718     }
2719     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
2720         mg_free(sv);
2721     switch (SvTYPE(sv)) {
2722     case SVt_PVIO:
2723         if (IoIFP(sv) != PerlIO_stdin() &&
2724             IoIFP(sv) != PerlIO_stdout() &&
2725             IoIFP(sv) != PerlIO_stderr())
2726           io_close((IO*)sv);
2727         Safefree(IoTOP_NAME(sv));
2728         Safefree(IoFMT_NAME(sv));
2729         Safefree(IoBOTTOM_NAME(sv));
2730         /* FALL THROUGH */
2731     case SVt_PVBM:
2732         goto freescalar;
2733     case SVt_PVCV:
2734     case SVt_PVFM:
2735         cv_undef((CV*)sv);
2736         goto freescalar;
2737     case SVt_PVHV:
2738         hv_undef((HV*)sv);
2739         break;
2740     case SVt_PVAV:
2741         av_undef((AV*)sv);
2742         break;
2743     case SVt_PVGV:
2744         gp_free((GV*)sv);
2745         Safefree(GvNAME(sv));
2746         /* FALL THROUGH */
2747     case SVt_PVLV:
2748     case SVt_PVMG:
2749     case SVt_PVNV:
2750     case SVt_PVIV:
2751       freescalar:
2752         (void)SvOOK_off(sv);
2753         /* FALL THROUGH */
2754     case SVt_PV:
2755     case SVt_RV:
2756         if (SvROK(sv))
2757             SvREFCNT_dec(SvRV(sv));
2758         else if (SvPVX(sv) && SvLEN(sv))
2759             Safefree(SvPVX(sv));
2760         break;
2761 /*
2762     case SVt_NV:
2763     case SVt_IV:
2764     case SVt_NULL:
2765         break;
2766 */
2767     }
2768
2769     switch (SvTYPE(sv)) {
2770     case SVt_NULL:
2771         break;
2772     case SVt_IV:
2773         del_XIV(SvANY(sv));
2774         break;
2775     case SVt_NV:
2776         del_XNV(SvANY(sv));
2777         break;
2778     case SVt_RV:
2779         del_XRV(SvANY(sv));
2780         break;
2781     case SVt_PV:
2782         del_XPV(SvANY(sv));
2783         break;
2784     case SVt_PVIV:
2785         del_XPVIV(SvANY(sv));
2786         break;
2787     case SVt_PVNV:
2788         del_XPVNV(SvANY(sv));
2789         break;
2790     case SVt_PVMG:
2791         del_XPVMG(SvANY(sv));
2792         break;
2793     case SVt_PVLV:
2794         del_XPVLV(SvANY(sv));
2795         break;
2796     case SVt_PVAV:
2797         del_XPVAV(SvANY(sv));
2798         break;
2799     case SVt_PVHV:
2800         del_XPVHV(SvANY(sv));
2801         break;
2802     case SVt_PVCV:
2803         del_XPVCV(SvANY(sv));
2804         break;
2805     case SVt_PVGV:
2806         del_XPVGV(SvANY(sv));
2807         break;
2808     case SVt_PVBM:
2809         del_XPVBM(SvANY(sv));
2810         break;
2811     case SVt_PVFM:
2812         del_XPVFM(SvANY(sv));
2813         break;
2814     case SVt_PVIO:
2815         del_XPVIO(SvANY(sv));
2816         break;
2817     }
2818     SvFLAGS(sv) &= SVf_BREAK;
2819     SvFLAGS(sv) |= SVTYPEMASK;
2820 }
2821
2822 SV *
2823 sv_newref(sv)
2824 SV* sv;
2825 {
2826     if (sv)
2827         SvREFCNT(sv)++;
2828     return sv;
2829 }
2830
2831 void
2832 sv_free(sv)
2833 SV *sv;
2834 {
2835     if (!sv)
2836         return;
2837     if (SvREADONLY(sv)) {
2838         if (sv == &sv_undef || sv == &sv_yes || sv == &sv_no)
2839             return;
2840     }
2841     if (SvREFCNT(sv) == 0) {
2842         if (SvFLAGS(sv) & SVf_BREAK)
2843             return;
2844         if (in_clean_all) /* All is fair */
2845             return;
2846         warn("Attempt to free unreferenced scalar");
2847         return;
2848     }
2849     if (--SvREFCNT(sv) > 0)
2850         return;
2851 #ifdef DEBUGGING
2852     if (SvTEMP(sv)) {
2853         warn("Attempt to free temp prematurely");
2854         return;
2855     }
2856 #endif
2857     sv_clear(sv);
2858     if (! SvREFCNT(sv))
2859         del_SV(sv);
2860 }
2861
2862 STRLEN
2863 sv_len(sv)
2864 register SV *sv;
2865 {
2866     char *junk;
2867     STRLEN len;
2868
2869     if (!sv)
2870         return 0;
2871
2872     if (SvGMAGICAL(sv))
2873         len = mg_len(sv);
2874     else
2875         junk = SvPV(sv, len);
2876     return len;
2877 }
2878
2879 I32
2880 sv_eq(str1,str2)
2881 register SV *str1;
2882 register SV *str2;
2883 {
2884     char *pv1;
2885     STRLEN cur1;
2886     char *pv2;
2887     STRLEN cur2;
2888
2889     if (!str1) {
2890         pv1 = "";
2891         cur1 = 0;
2892     }
2893     else
2894         pv1 = SvPV(str1, cur1);
2895
2896     if (!str2)
2897         return !cur1;
2898     else
2899         pv2 = SvPV(str2, cur2);
2900
2901     if (cur1 != cur2)
2902         return 0;
2903
2904     return memEQ(pv1, pv2, cur1);
2905 }
2906
2907 I32
2908 sv_cmp(str1, str2)
2909 register SV *str1;
2910 register SV *str2;
2911 {
2912     STRLEN cur1 = 0;
2913     char *pv1 = str1 ? SvPV(str1, cur1) : NULL;
2914     STRLEN cur2 = 0;
2915     char *pv2 = str2 ? SvPV(str2, cur2) : NULL;
2916     I32 retval;
2917
2918     if (!cur1)
2919         return cur2 ? -1 : 0;
2920
2921     if (!cur2)
2922         return 1;
2923
2924     retval = memcmp((void*)pv1, (void*)pv2, cur1 < cur2 ? cur1 : cur2);
2925
2926     if (retval)
2927         return retval < 0 ? -1 : 1;
2928
2929     if (cur1 == cur2)
2930         return 0;
2931     else
2932         return cur1 < cur2 ? -1 : 1;
2933 }
2934
2935 I32
2936 sv_cmp_locale(sv1, sv2)
2937 register SV *sv1;
2938 register SV *sv2;
2939 {
2940 #ifdef USE_LOCALE_COLLATE
2941
2942     char *pv1, *pv2;
2943     STRLEN len1, len2;
2944     I32 retval;
2945
2946     if (collation_standard)
2947         goto raw_compare;
2948
2949     len1 = 0;
2950     pv1 = sv1 ? sv_collxfrm(sv1, &len1) : NULL;
2951     len2 = 0;
2952     pv2 = sv2 ? sv_collxfrm(sv2, &len2) : NULL;
2953
2954     if (!pv1 || !len1) {
2955         if (pv2 && len2)
2956             return -1;
2957         else
2958             goto raw_compare;
2959     }
2960     else {
2961         if (!pv2 || !len2)
2962             return 1;
2963     }
2964
2965     retval = memcmp((void*)pv1, (void*)pv2, len1 < len2 ? len1 : len2);
2966
2967     if (retval)
2968         return retval < 0 ? -1 : 1;
2969
2970     /*
2971      * When the result of collation is equality, that doesn't mean
2972      * that there are no differences -- some locales exclude some
2973      * characters from consideration.  So to avoid false equalities,
2974      * we use the raw string as a tiebreaker.
2975      */
2976
2977   raw_compare:
2978     /* FALL THROUGH */
2979
2980 #endif /* USE_LOCALE_COLLATE */
2981
2982     return sv_cmp(sv1, sv2);
2983 }
2984
2985 #ifdef USE_LOCALE_COLLATE
2986 /*
2987  * Any scalar variable may carry an 'o' magic that contains the
2988  * scalar data of the variable transformed to such a format that
2989  * a normal memory comparison can be used to compare the data
2990  * according to the locale settings.
2991  */
2992 char *
2993 sv_collxfrm(sv, nxp)
2994      SV *sv;
2995      STRLEN *nxp;
2996 {
2997     MAGIC *mg;
2998
2999     mg = SvMAGICAL(sv) ? mg_find(sv, 'o') : NULL;
3000     if (!mg || !mg->mg_ptr || *(U32*)mg->mg_ptr != collation_ix) {
3001         char *s, *xf;
3002         STRLEN len, xlen;
3003
3004         if (mg)
3005             Safefree(mg->mg_ptr);
3006         s = SvPV(sv, len);
3007         if ((xf = mem_collxfrm(s, len, &xlen))) {
3008             if (SvREADONLY(sv)) {
3009                 SAVEFREEPV(xf);
3010                 *nxp = xlen;
3011                 return xf;
3012             }
3013             if (! mg) {
3014                 sv_magic(sv, 0, 'o', 0, 0);
3015                 mg = mg_find(sv, 'o');
3016                 assert(mg);
3017             }
3018             mg->mg_ptr = xf;
3019             mg->mg_len = xlen;
3020         }
3021         else {
3022             if (mg) {
3023                 mg->mg_ptr = NULL;
3024                 mg->mg_len = -1;
3025             }
3026         }
3027     }
3028     if (mg && mg->mg_ptr) {
3029         *nxp = mg->mg_len;
3030         return mg->mg_ptr + sizeof(collation_ix);
3031     }
3032     else {
3033         *nxp = 0;
3034         return NULL;
3035     }
3036 }
3037
3038 #endif /* USE_LOCALE_COLLATE */
3039
3040 char *
3041 sv_gets(sv,fp,append)
3042 register SV *sv;
3043 register PerlIO *fp;
3044 I32 append;
3045 {
3046     char *rsptr;
3047     STRLEN rslen;
3048     register STDCHAR rslast;
3049     register STDCHAR *bp;
3050     register I32 cnt;
3051     I32 i;
3052
3053     if (SvTHINKFIRST(sv)) {
3054         if (SvREADONLY(sv) && curcop != &compiling)
3055             croak(no_modify);
3056         if (SvROK(sv))
3057             sv_unref(sv);
3058     }
3059     if (!SvUPGRADE(sv, SVt_PV))
3060         return 0;
3061     SvSCREAM_off(sv);
3062
3063     if (RsSNARF(rs)) {
3064         rsptr = NULL;
3065         rslen = 0;
3066     }
3067     else if (RsPARA(rs)) {
3068         rsptr = "\n\n";
3069         rslen = 2;
3070     }
3071     else
3072         rsptr = SvPV(rs, rslen);
3073     rslast = rslen ? rsptr[rslen - 1] : '\0';
3074
3075     if (RsPARA(rs)) {           /* have to do this both before and after */
3076         do {                    /* to make sure file boundaries work right */
3077             if (PerlIO_eof(fp))
3078                 return 0;
3079             i = PerlIO_getc(fp);
3080             if (i != '\n') {
3081                 if (i == -1)
3082                     return 0;
3083                 PerlIO_ungetc(fp,i);
3084                 break;
3085             }
3086         } while (i != EOF);
3087     }
3088
3089     /* See if we know enough about I/O mechanism to cheat it ! */
3090
3091     /* This used to be #ifdef test - it is made run-time test for ease
3092        of abstracting out stdio interface. One call should be cheap
3093        enough here - and may even be a macro allowing compile
3094        time optimization.
3095      */
3096
3097     if (PerlIO_fast_gets(fp)) {
3098
3099     /*
3100      * We're going to steal some values from the stdio struct
3101      * and put EVERYTHING in the innermost loop into registers.
3102      */
3103     register STDCHAR *ptr;
3104     STRLEN bpx;
3105     I32 shortbuffered;
3106
3107 #if defined(VMS) && defined(PERLIO_IS_STDIO)
3108     /* An ungetc()d char is handled separately from the regular
3109      * buffer, so we getc() it back out and stuff it in the buffer.
3110      */
3111     i = PerlIO_getc(fp);
3112     if (i == EOF) return 0;
3113     *(--((*fp)->_ptr)) = (unsigned char) i;
3114     (*fp)->_cnt++;
3115 #endif
3116
3117     /* Here is some breathtakingly efficient cheating */
3118
3119     cnt = PerlIO_get_cnt(fp);                   /* get count into register */
3120     (void)SvPOK_only(sv);               /* validate pointer */
3121     if (SvLEN(sv) - append <= cnt + 1) { /* make sure we have the room */
3122         if (cnt > 80 && SvLEN(sv) > append) {
3123             shortbuffered = cnt - SvLEN(sv) + append + 1;
3124             cnt -= shortbuffered;
3125         }
3126         else {
3127             shortbuffered = 0;
3128             /* remember that cnt can be negative */
3129             SvGROW(sv, append + (cnt <= 0 ? 2 : (cnt + 1)));
3130         }
3131     }
3132     else
3133         shortbuffered = 0;
3134     bp = (STDCHAR*)SvPVX(sv) + append;  /* move these two too to registers */
3135     ptr = (STDCHAR*)PerlIO_get_ptr(fp);
3136     DEBUG_P(PerlIO_printf(Perl_debug_log,
3137         "Screamer: entering, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt));
3138     DEBUG_P(PerlIO_printf(Perl_debug_log,
3139         "Screamer: entering: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n",
3140                (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp),
3141                (long)(PerlIO_has_base(fp) ? PerlIO_get_base(fp) : 0)));
3142     for (;;) {
3143       screamer:
3144         if (cnt > 0) {
3145             if (rslen) {
3146                 while (cnt > 0) {                    /* this     |  eat */
3147                     cnt--;
3148                     if ((*bp++ = *ptr++) == rslast)  /* really   |  dust */
3149                         goto thats_all_folks;        /* screams  |  sed :-) */
3150                 }
3151             }
3152             else {
3153                 Copy(ptr, bp, cnt, char);            /* this     |  eat */
3154                 bp += cnt;                           /* screams  |  dust */
3155                 ptr += cnt;                          /* louder   |  sed :-) */
3156                 cnt = 0;
3157             }
3158         }
3159
3160         if (shortbuffered) {            /* oh well, must extend */
3161             cnt = shortbuffered;
3162             shortbuffered = 0;
3163             bpx = bp - (STDCHAR*)SvPVX(sv); /* box up before relocation */
3164             SvCUR_set(sv, bpx);
3165             SvGROW(sv, SvLEN(sv) + append + cnt + 2);
3166             bp = (STDCHAR*)SvPVX(sv) + bpx; /* unbox after relocation */
3167             continue;
3168         }
3169
3170         DEBUG_P(PerlIO_printf(Perl_debug_log,
3171             "Screamer: going to getc, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt));
3172         PerlIO_set_ptrcnt(fp, ptr, cnt); /* deregisterize cnt and ptr */
3173         DEBUG_P(PerlIO_printf(Perl_debug_log,
3174             "Screamer: pre: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n",
3175             (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp),
3176             (long)(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)));
3177         /* This used to call 'filbuf' in stdio form, but as that behaves like
3178            getc when cnt <= 0 we use PerlIO_getc here to avoid introducing
3179            another abstraction.  */
3180         i   = PerlIO_getc(fp);          /* get more characters */
3181         DEBUG_P(PerlIO_printf(Perl_debug_log,
3182             "Screamer: post: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n",
3183             (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp),
3184             (long)(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)));
3185         cnt = PerlIO_get_cnt(fp);
3186         ptr = (STDCHAR*)PerlIO_get_ptr(fp);     /* reregisterize cnt and ptr */
3187         DEBUG_P(PerlIO_printf(Perl_debug_log,
3188             "Screamer: after getc, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt));
3189
3190         if (i == EOF)                   /* all done for ever? */
3191             goto thats_really_all_folks;
3192
3193         bpx = bp - (STDCHAR*)SvPVX(sv); /* box up before relocation */
3194         SvCUR_set(sv, bpx);
3195         SvGROW(sv, bpx + cnt + 2);
3196         bp = (STDCHAR*)SvPVX(sv) + bpx; /* unbox after relocation */
3197
3198         *bp++ = i;                      /* store character from PerlIO_getc */
3199
3200         if (rslen && (STDCHAR)i == rslast)  /* all done for now? */
3201             goto thats_all_folks;
3202     }
3203
3204 thats_all_folks:
3205     if ((rslen > 1 && (bp - (STDCHAR*)SvPVX(sv) < rslen)) ||
3206           memNE((char*)bp - rslen, rsptr, rslen))
3207         goto screamer;                          /* go back to the fray */
3208 thats_really_all_folks:
3209     if (shortbuffered)
3210         cnt += shortbuffered;
3211         DEBUG_P(PerlIO_printf(Perl_debug_log,
3212             "Screamer: quitting, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt));
3213     PerlIO_set_ptrcnt(fp, ptr, cnt);    /* put these back or we're in trouble */
3214     DEBUG_P(PerlIO_printf(Perl_debug_log,
3215         "Screamer: end: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n",
3216         (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp),
3217         (long)(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0)));
3218     *bp = '\0';
3219     SvCUR_set(sv, bp - (STDCHAR*)SvPVX(sv));    /* set length */
3220     DEBUG_P(PerlIO_printf(Perl_debug_log,
3221         "Screamer: done, len=%d, string=|%.*s|\n",
3222         SvCUR(sv),(int)SvCUR(sv),SvPVX(sv)));
3223     }
3224    else
3225     {
3226        /*The big, slow, and stupid way */
3227         STDCHAR buf[8192];
3228
3229 screamer2:
3230         if (rslen) {
3231             register STDCHAR *bpe = buf + sizeof(buf);
3232             bp = buf;
3233             while ((i = PerlIO_getc(fp)) != EOF && (*bp++ = i) != rslast && bp < bpe)
3234                 ; /* keep reading */
3235             cnt = bp - buf;
3236         }
3237         else {
3238             cnt = PerlIO_read(fp,(char*)buf, sizeof(buf));
3239             /* Accomodate broken VAXC compiler, which applies U8 cast to
3240              * both args of ?: operator, causing EOF to change into 255
3241              */
3242             if (cnt) { i = (U8)buf[cnt - 1]; } else { i = EOF; }
3243         }
3244
3245         if (append)
3246             sv_catpvn(sv, (char *) buf, cnt);
3247         else
3248             sv_setpvn(sv, (char *) buf, cnt);
3249
3250         if (i != EOF &&                 /* joy */
3251             (!rslen ||
3252              SvCUR(sv) < rslen ||
3253              memNE(SvPVX(sv) + SvCUR(sv) - rslen, rsptr, rslen)))
3254         {
3255             append = -1;
3256             /*
3257               If we're reading from a TTY and we get a short read,
3258               indicating that the user hit his EOF character, we need
3259               to notice it now, because if we try to read from the TTY
3260               again, the EOF condition will disappear.
3261
3262               The "(cnt == sizeof(buf))" check is an optimization to
3263               prevent unnecessary calls to feof().  It seems safe
3264               because as far as I can tell, whenever fread() returns a
3265               full buffer, right before EOF, it will correctly return
3266               0 bytes on the next call, even when reading from a TTY.
3267               However, I've only tested this on Linux; other platforms
3268               may vary, so it might be easier just to remove the
3269               optimization and just check for "! feof(fp)".
3270
3271                 - jik 9/25/96
3272             */
3273             if ((cnt == sizeof(buf)) || ! PerlIO_eof(fp))
3274                 goto screamer2;
3275         }
3276     }
3277
3278     if (RsPARA(rs)) {           /* have to do this both before and after */
3279         while (i != EOF) {      /* to make sure file boundaries work right */
3280             i = PerlIO_getc(fp);
3281             if (i != '\n') {
3282                 PerlIO_ungetc(fp,i);
3283                 break;
3284             }
3285         }
3286     }
3287
3288     return (SvCUR(sv) - append) ? SvPVX(sv) : Nullch;
3289 }
3290
3291
3292 void
3293 sv_inc(sv)
3294 register SV *sv;
3295 {
3296     register char *d;
3297     int flags;
3298
3299     if (!sv)
3300         return;
3301     if (SvTHINKFIRST(sv)) {
3302         if (SvREADONLY(sv) && curcop != &compiling)
3303             croak(no_modify);
3304         if (SvROK(sv)) {
3305 #ifdef OVERLOAD
3306           if (SvAMAGIC(sv) && AMG_CALLun(sv,inc)) return;
3307 #endif /* OVERLOAD */
3308           sv_unref(sv);
3309         }
3310     }
3311     if (SvGMAGICAL(sv))
3312         mg_get(sv);
3313     flags = SvFLAGS(sv);
3314     if (flags & SVp_NOK) {
3315         (void)SvNOK_only(sv);
3316         SvNVX(sv) += 1.0;
3317         return;
3318     }
3319     if (flags & SVp_IOK) {
3320         if (SvIVX(sv) == IV_MAX)
3321             sv_setnv(sv, (double)IV_MAX + 1.0);
3322         else {
3323             (void)SvIOK_only(sv);
3324             ++SvIVX(sv);
3325         }
3326         return;
3327     }
3328     if (!(flags & SVp_POK) || !*SvPVX(sv)) {
3329         if ((flags & SVTYPEMASK) < SVt_PVNV)
3330             sv_upgrade(sv, SVt_NV);
3331         SvNVX(sv) = 1.0;
3332         (void)SvNOK_only(sv);
3333         return;
3334     }
3335     d = SvPVX(sv);
3336     while (isALPHA(*d)) d++;
3337     while (isDIGIT(*d)) d++;
3338     if (*d) {
3339         SET_NUMERIC_STANDARD();
3340         sv_setnv(sv,atof(SvPVX(sv)) + 1.0);  /* punt */
3341         return;
3342     }
3343     d--;
3344     while (d >= SvPVX(sv)) {
3345         if (isDIGIT(*d)) {
3346             if (++*d <= '9')
3347                 return;
3348             *(d--) = '0';
3349         }
3350         else {
3351             ++*d;
3352             if (isALPHA(*d))
3353                 return;
3354             *(d--) -= 'z' - 'a' + 1;
3355         }
3356     }
3357     /* oh,oh, the number grew */
3358     SvGROW(sv, SvCUR(sv) + 2);
3359     SvCUR(sv)++;
3360     for (d = SvPVX(sv) + SvCUR(sv); d > SvPVX(sv); d--)
3361         *d = d[-1];
3362     if (isDIGIT(d[1]))
3363         *d = '1';
3364     else
3365         *d = d[1];
3366 }
3367
3368 void
3369 sv_dec(sv)
3370 register SV *sv;
3371 {
3372     int flags;
3373
3374     if (!sv)
3375         return;
3376     if (SvTHINKFIRST(sv)) {
3377         if (SvREADONLY(sv) && curcop != &compiling)
3378             croak(no_modify);
3379         if (SvROK(sv)) {
3380 #ifdef OVERLOAD
3381           if (SvAMAGIC(sv) && AMG_CALLun(sv,dec)) return;
3382 #endif /* OVERLOAD */
3383           sv_unref(sv);
3384         }
3385     }
3386     if (SvGMAGICAL(sv))
3387         mg_get(sv);
3388     flags = SvFLAGS(sv);
3389     if (flags & SVp_NOK) {
3390         SvNVX(sv) -= 1.0;
3391         (void)SvNOK_only(sv);
3392         return;
3393     }
3394     if (flags & SVp_IOK) {
3395         if (SvIVX(sv) == IV_MIN)
3396             sv_setnv(sv, (double)IV_MIN - 1.0);
3397         else {
3398             (void)SvIOK_only(sv);
3399             --SvIVX(sv);
3400         }
3401         return;
3402     }
3403     if (!(flags & SVp_POK)) {
3404         if ((flags & SVTYPEMASK) < SVt_PVNV)
3405             sv_upgrade(sv, SVt_NV);
3406         SvNVX(sv) = -1.0;
3407         (void)SvNOK_only(sv);
3408         return;
3409     }
3410     SET_NUMERIC_STANDARD();
3411     sv_setnv(sv,atof(SvPVX(sv)) - 1.0); /* punt */
3412 }
3413
3414 /* Make a string that will exist for the duration of the expression
3415  * evaluation.  Actually, it may have to last longer than that, but
3416  * hopefully we won't free it until it has been assigned to a
3417  * permanent location. */
3418
3419 static void
3420 sv_mortalgrow()
3421 {
3422     tmps_max += (tmps_max < 512) ? 128 : 512;
3423     Renew(tmps_stack, tmps_max, SV*);
3424 }
3425
3426 SV *
3427 sv_mortalcopy(oldstr)
3428 SV *oldstr;
3429 {
3430     register SV *sv;
3431
3432     new_SV(sv);
3433     SvANY(sv) = 0;
3434     SvREFCNT(sv) = 1;
3435     SvFLAGS(sv) = 0;
3436     sv_setsv(sv,oldstr);
3437     if (++tmps_ix >= tmps_max)
3438         sv_mortalgrow();
3439     tmps_stack[tmps_ix] = sv;
3440     SvTEMP_on(sv);
3441     return sv;
3442 }
3443
3444 SV *
3445 sv_newmortal()
3446 {
3447     register SV *sv;
3448
3449     new_SV(sv);
3450     SvANY(sv) = 0;
3451     SvREFCNT(sv) = 1;
3452     SvFLAGS(sv) = SVs_TEMP;
3453     if (++tmps_ix >= tmps_max)
3454         sv_mortalgrow();
3455     tmps_stack[tmps_ix] = sv;
3456     return sv;
3457 }
3458
3459 /* same thing without the copying */
3460
3461 SV *
3462 sv_2mortal(sv)
3463 register SV *sv;
3464 {
3465     if (!sv)
3466         return sv;
3467     if (SvREADONLY(sv) && curcop != &compiling)
3468         croak(no_modify);
3469     if (++tmps_ix >= tmps_max)
3470         sv_mortalgrow();
3471     tmps_stack[tmps_ix] = sv;
3472     SvTEMP_on(sv);
3473     return sv;
3474 }
3475
3476 SV *
3477 newSVpv(s,len)
3478 char *s;
3479 STRLEN len;
3480 {
3481     register SV *sv;
3482
3483     new_SV(sv);
3484     SvANY(sv) = 0;
3485     SvREFCNT(sv) = 1;
3486     SvFLAGS(sv) = 0;
3487     if (!len)
3488         len = strlen(s);
3489     sv_setpvn(sv,s,len);
3490     return sv;
3491 }
3492
3493 #ifdef I_STDARG
3494 SV *
3495 newSVpvf(const char* pat, ...)
3496 #else
3497 /*VARARGS0*/
3498 SV *
3499 newSVpvf(pat, va_alist)
3500 const char *pat;
3501 va_dcl
3502 #endif
3503 {
3504     register SV *sv;
3505     va_list args;
3506
3507     new_SV(sv);
3508     SvANY(sv) = 0;
3509     SvREFCNT(sv) = 1;
3510     SvFLAGS(sv) = 0;
3511 #ifdef I_STDARG
3512     va_start(args, pat);
3513 #else
3514     va_start(args);
3515 #endif
3516     sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
3517     va_end(args);
3518     return sv;
3519 }
3520
3521
3522 SV *
3523 newSVnv(n)
3524 double n;
3525 {
3526     register SV *sv;
3527
3528     new_SV(sv);
3529     SvANY(sv) = 0;
3530     SvREFCNT(sv) = 1;
3531     SvFLAGS(sv) = 0;
3532     sv_setnv(sv,n);
3533     return sv;
3534 }
3535
3536 SV *
3537 newSViv(i)
3538 IV i;
3539 {
3540     register SV *sv;
3541
3542     new_SV(sv);
3543     SvANY(sv) = 0;
3544     SvREFCNT(sv) = 1;
3545     SvFLAGS(sv) = 0;
3546     sv_setiv(sv,i);
3547     return sv;
3548 }
3549
3550 SV *
3551 newRV(ref)
3552 SV *ref;
3553 {
3554     register SV *sv;
3555
3556     new_SV(sv);
3557     SvANY(sv) = 0;
3558     SvREFCNT(sv) = 1;
3559     SvFLAGS(sv) = 0;
3560     sv_upgrade(sv, SVt_RV);
3561     SvTEMP_off(ref);
3562     SvRV(sv) = SvREFCNT_inc(ref);
3563     SvROK_on(sv);
3564     return sv;
3565 }
3566
3567 #ifdef CRIPPLED_CC
3568 SV *
3569 newRV_noinc(ref)
3570 SV *ref;
3571 {
3572     register SV *sv;
3573
3574     sv = newRV(ref);
3575     SvREFCNT_dec(ref);
3576     return sv;
3577 }
3578 #endif /* CRIPPLED_CC */
3579
3580 /* make an exact duplicate of old */
3581
3582 SV *
3583 newSVsv(old)
3584 register SV *old;
3585 {
3586     register SV *sv;
3587
3588     if (!old)
3589         return Nullsv;
3590     if (SvTYPE(old) == SVTYPEMASK) {
3591         warn("semi-panic: attempt to dup freed string");
3592         return Nullsv;
3593     }
3594     new_SV(sv);
3595     SvANY(sv) = 0;
3596     SvREFCNT(sv) = 1;
3597     SvFLAGS(sv) = 0;
3598     if (SvTEMP(old)) {
3599         SvTEMP_off(old);
3600         sv_setsv(sv,old);
3601         SvTEMP_on(old);
3602     }
3603     else
3604         sv_setsv(sv,old);
3605     return sv;
3606 }
3607
3608 void
3609 sv_reset(s,stash)
3610 register char *s;
3611 HV *stash;
3612 {
3613     register HE *entry;
3614     register GV *gv;
3615     register SV *sv;
3616     register I32 i;
3617     register PMOP *pm;
3618     register I32 max;
3619     char todo[256];
3620
3621     if (!*s) {          /* reset ?? searches */
3622         for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) {
3623             pm->op_pmflags &= ~PMf_USED;
3624         }
3625         return;
3626     }
3627
3628     /* reset variables */
3629
3630     if (!HvARRAY(stash))
3631         return;
3632
3633     Zero(todo, 256, char);
3634     while (*s) {
3635         i = *s;
3636         if (s[1] == '-') {
3637             s += 2;
3638         }
3639         max = *s++;
3640         for ( ; i <= max; i++) {
3641             todo[i] = 1;
3642         }
3643         for (i = 0; i <= (I32) HvMAX(stash); i++) {
3644             for (entry = HvARRAY(stash)[i];
3645               entry;
3646               entry = HeNEXT(entry)) {
3647                 if (!todo[(U8)*HeKEY(entry)])
3648                     continue;
3649                 gv = (GV*)HeVAL(entry);
3650                 sv = GvSV(gv);
3651                 (void)SvOK_off(sv);
3652                 if (SvTYPE(sv) >= SVt_PV) {
3653                     SvCUR_set(sv, 0);
3654                     if (SvPVX(sv) != Nullch)
3655                         *SvPVX(sv) = '\0';
3656                     SvTAINT(sv);
3657                 }
3658                 if (GvAV(gv)) {
3659                     av_clear(GvAV(gv));
3660                 }
3661                 if (GvHV(gv) && !HvNAME(GvHV(gv))) {
3662                     hv_clear(GvHV(gv));
3663 #ifndef VMS  /* VMS has no environ array */
3664                     if (gv == envgv)
3665                         environ[0] = Nullch;
3666 #endif
3667                 }
3668             }
3669         }
3670     }
3671 }
3672
3673 IO*
3674 sv_2io(sv)
3675 SV *sv;
3676 {
3677     IO* io;
3678     GV* gv;
3679
3680     switch (SvTYPE(sv)) {
3681     case SVt_PVIO:
3682         io = (IO*)sv;
3683         break;
3684     case SVt_PVGV:
3685         gv = (GV*)sv;
3686         io = GvIO(gv);
3687         if (!io)
3688             croak("Bad filehandle: %s", GvNAME(gv));
3689         break;
3690     default:
3691         if (!SvOK(sv))
3692             croak(no_usym, "filehandle");
3693         if (SvROK(sv))
3694             return sv_2io(SvRV(sv));
3695         gv = gv_fetchpv(SvPV(sv,na), FALSE, SVt_PVIO);
3696         if (gv)
3697             io = GvIO(gv);
3698         else
3699             io = 0;
3700         if (!io)
3701             croak("Bad filehandle: %s", SvPV(sv,na));
3702         break;
3703     }
3704     return io;
3705 }
3706
3707 CV *
3708 sv_2cv(sv, st, gvp, lref)
3709 SV *sv;
3710 HV **st;
3711 GV **gvp;
3712 I32 lref;
3713 {
3714     GV *gv;
3715     CV *cv;
3716
3717     if (!sv)
3718         return *gvp = Nullgv, Nullcv;
3719     switch (SvTYPE(sv)) {
3720     case SVt_PVCV:
3721         *st = CvSTASH(sv);
3722         *gvp = Nullgv;
3723         return (CV*)sv;
3724     case SVt_PVHV:
3725     case SVt_PVAV:
3726         *gvp = Nullgv;
3727         return Nullcv;
3728     case SVt_PVGV:
3729         gv = (GV*)sv;
3730         *gvp = gv;
3731         *st = GvESTASH(gv);
3732         goto fix_gv;
3733
3734     default:
3735         if (SvGMAGICAL(sv))
3736             mg_get(sv);
3737         if (SvROK(sv)) {
3738             cv = (CV*)SvRV(sv);
3739             if (SvTYPE(cv) != SVt_PVCV)
3740                 croak("Not a subroutine reference");
3741             *gvp = Nullgv;
3742             *st = CvSTASH(cv);
3743             return cv;
3744         }
3745         if (isGV(sv))
3746             gv = (GV*)sv;
3747         else
3748             gv = gv_fetchpv(SvPV(sv, na), lref, SVt_PVCV);
3749         *gvp = gv;
3750         if (!gv)
3751             return Nullcv;
3752         *st = GvESTASH(gv);
3753     fix_gv:
3754         if (lref && !GvCVu(gv)) {
3755             SV *tmpsv;
3756             ENTER;
3757             tmpsv = NEWSV(704,0);
3758             gv_efullname3(tmpsv, gv, Nullch);
3759             newSUB(start_subparse(FALSE, 0),
3760                    newSVOP(OP_CONST, 0, tmpsv),
3761                    Nullop,
3762                    Nullop);
3763             LEAVE;
3764             if (!GvCVu(gv))
3765                 croak("Unable to create sub named \"%s\"", SvPV(sv,na));
3766         }
3767         return GvCVu(gv);
3768     }
3769 }
3770
3771 #ifndef SvTRUE
3772 I32
3773 SvTRUE(sv)
3774 register SV *sv;
3775 {
3776     if (!sv)
3777         return 0;
3778     if (SvGMAGICAL(sv))
3779         mg_get(sv);
3780     if (SvPOK(sv)) {
3781         register XPV* Xpv;
3782         if ((Xpv = (XPV*)SvANY(sv)) &&
3783                 (*Xpv->xpv_pv > '0' ||
3784                 Xpv->xpv_cur > 1 ||
3785                 (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
3786             return 1;
3787         else
3788             return 0;
3789     }
3790     else {
3791         if (SvIOK(sv))
3792             return SvIVX(sv) != 0;
3793         else {
3794             if (SvNOK(sv))
3795                 return SvNVX(sv) != 0.0;
3796             else
3797                 return sv_2bool(sv);
3798         }
3799     }
3800 }
3801 #endif /* !SvTRUE */
3802
3803 #ifndef SvIV
3804 IV
3805 SvIV(sv)
3806 register SV *sv;
3807 {
3808     if (SvIOK(sv))
3809         return SvIVX(sv);
3810     return sv_2iv(sv);
3811 }
3812 #endif /* !SvIV */
3813
3814 #ifndef SvUV
3815 UV
3816 SvUV(sv)
3817 register SV *sv;
3818 {
3819     if (SvIOK(sv))
3820         return SvUVX(sv);
3821     return sv_2uv(sv);
3822 }
3823 #endif /* !SvUV */
3824
3825 #ifndef SvNV
3826 double
3827 SvNV(sv)
3828 register SV *sv;
3829 {
3830     if (SvNOK(sv))
3831         return SvNVX(sv);
3832     return sv_2nv(sv);
3833 }
3834 #endif /* !SvNV */
3835
3836 #ifdef CRIPPLED_CC
3837 char *
3838 sv_pvn(sv, lp)
3839 SV *sv;
3840 STRLEN *lp;
3841 {
3842     if (SvPOK(sv)) {
3843         *lp = SvCUR(sv);
3844         return SvPVX(sv);
3845     }
3846     return sv_2pv(sv, lp);
3847 }
3848 #endif
3849
3850 char *
3851 sv_pvn_force(sv, lp)
3852 SV *sv;
3853 STRLEN *lp;
3854 {
3855     char *s;
3856
3857     if (SvREADONLY(sv) && curcop != &compiling)
3858         croak(no_modify);
3859
3860     if (SvPOK(sv)) {
3861         *lp = SvCUR(sv);
3862     }
3863     else {
3864         if (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM) {
3865             if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) {
3866                 sv_unglob(sv);
3867                 s = SvPVX(sv);
3868                 *lp = SvCUR(sv);
3869             }
3870             else
3871                 croak("Can't coerce %s to string in %s", sv_reftype(sv,0),
3872                     op_name[op->op_type]);
3873         }
3874         else
3875             s = sv_2pv(sv, lp);
3876         if (s != SvPVX(sv)) {   /* Almost, but not quite, sv_setpvn() */
3877             STRLEN len = *lp;
3878
3879             if (SvROK(sv))
3880                 sv_unref(sv);
3881             (void)SvUPGRADE(sv, SVt_PV);                /* Never FALSE */
3882             SvGROW(sv, len + 1);
3883             Move(s,SvPVX(sv),len,char);
3884             SvCUR_set(sv, len);
3885             *SvEND(sv) = '\0';
3886         }
3887         if (!SvPOK(sv)) {
3888             SvPOK_on(sv);               /* validate pointer */
3889             SvTAINT(sv);
3890             DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2pv(%s)\n",
3891                 (unsigned long)sv,SvPVX(sv)));
3892         }
3893     }
3894     return SvPVX(sv);
3895 }
3896
3897 char *
3898 sv_reftype(sv, ob)
3899 SV* sv;
3900 int ob;
3901 {
3902     if (ob && SvOBJECT(sv))
3903         return HvNAME(SvSTASH(sv));
3904     else {
3905         switch (SvTYPE(sv)) {
3906         case SVt_NULL:
3907         case SVt_IV:
3908         case SVt_NV:
3909         case SVt_RV:
3910         case SVt_PV:
3911         case SVt_PVIV:
3912         case SVt_PVNV:
3913         case SVt_PVMG:
3914         case SVt_PVBM:
3915                                 if (SvROK(sv))
3916                                     return "REF";
3917                                 else
3918                                     return "SCALAR";
3919         case SVt_PVLV:          return "LVALUE";
3920         case SVt_PVAV:          return "ARRAY";
3921         case SVt_PVHV:          return "HASH";
3922         case SVt_PVCV:          return "CODE";
3923         case SVt_PVGV:          return "GLOB";
3924         case SVt_PVFM:          return "FORMLINE";
3925         default:                return "UNKNOWN";
3926         }
3927     }
3928 }
3929
3930 int
3931 sv_isobject(sv)
3932 SV *sv;
3933 {
3934     if (!sv)
3935         return 0;
3936     if (SvGMAGICAL(sv))
3937         mg_get(sv);
3938     if (!SvROK(sv))
3939         return 0;
3940     sv = (SV*)SvRV(sv);
3941     if (!SvOBJECT(sv))
3942         return 0;
3943     return 1;
3944 }
3945
3946 int
3947 sv_isa(sv, name)
3948 SV *sv;
3949 char *name;
3950 {
3951     if (!sv)
3952         return 0;
3953     if (SvGMAGICAL(sv))
3954         mg_get(sv);
3955     if (!SvROK(sv))
3956         return 0;
3957     sv = (SV*)SvRV(sv);
3958     if (!SvOBJECT(sv))
3959         return 0;
3960
3961     return strEQ(HvNAME(SvSTASH(sv)), name);
3962 }
3963
3964 SV*
3965 newSVrv(rv, classname)
3966 SV *rv;
3967 char *classname;
3968 {
3969     SV *sv;
3970
3971     new_SV(sv);
3972     SvANY(sv) = 0;
3973     SvREFCNT(sv) = 0;
3974     SvFLAGS(sv) = 0;
3975     sv_upgrade(rv, SVt_RV);
3976     SvRV(rv) = SvREFCNT_inc(sv);
3977     SvROK_on(rv);
3978
3979     if (classname) {
3980         HV* stash = gv_stashpv(classname, TRUE);
3981         (void)sv_bless(rv, stash);
3982     }
3983     return sv;
3984 }
3985
3986 SV*
3987 sv_setref_pv(rv, classname, pv)
3988 SV *rv;
3989 char *classname;
3990 void* pv;
3991 {
3992     if (!pv)
3993         sv_setsv(rv, &sv_undef);
3994     else
3995         sv_setiv(newSVrv(rv,classname), (IV)pv);
3996     return rv;
3997 }
3998
3999 SV*
4000 sv_setref_iv(rv, classname, iv)
4001 SV *rv;
4002 char *classname;
4003 IV iv;
4004 {
4005     sv_setiv(newSVrv(rv,classname), iv);
4006     return rv;
4007 }
4008
4009 SV*
4010 sv_setref_nv(rv, classname, nv)
4011 SV *rv;
4012 char *classname;
4013 double nv;
4014 {
4015     sv_setnv(newSVrv(rv,classname), nv);
4016     return rv;
4017 }
4018
4019 SV*
4020 sv_setref_pvn(rv, classname, pv, n)
4021 SV *rv;
4022 char *classname;
4023 char* pv;
4024 I32 n;
4025 {
4026     sv_setpvn(newSVrv(rv,classname), pv, n);
4027     return rv;
4028 }
4029
4030 SV*
4031 sv_bless(sv,stash)
4032 SV* sv;
4033 HV* stash;
4034 {
4035     SV *ref;
4036     if (!SvROK(sv))
4037         croak("Can't bless non-reference value");
4038     ref = SvRV(sv);
4039     if (SvFLAGS(ref) & (SVs_OBJECT|SVf_READONLY)) {
4040         if (SvREADONLY(ref))
4041             croak(no_modify);
4042         if (SvOBJECT(ref)) {
4043             if (SvTYPE(ref) != SVt_PVIO)
4044                 --sv_objcount;
4045             SvREFCNT_dec(SvSTASH(ref));
4046         }
4047     }
4048     SvOBJECT_on(ref);
4049     if (SvTYPE(ref) != SVt_PVIO)
4050         ++sv_objcount;
4051     (void)SvUPGRADE(ref, SVt_PVMG);
4052     SvSTASH(ref) = (HV*)SvREFCNT_inc(stash);
4053
4054 #ifdef OVERLOAD
4055     if (Gv_AMG(stash))
4056         SvAMAGIC_on(sv);
4057     else
4058         SvAMAGIC_off(sv);
4059 #endif /* OVERLOAD */
4060
4061     return sv;
4062 }
4063
4064 static void
4065 sv_unglob(sv)
4066 SV* sv;
4067 {
4068     assert(SvTYPE(sv) == SVt_PVGV);
4069     SvFAKE_off(sv);
4070     if (GvGP(sv))
4071         gp_free((GV*)sv);
4072     sv_unmagic(sv, '*');
4073     Safefree(GvNAME(sv));
4074     GvMULTI_off(sv);
4075     SvFLAGS(sv) &= ~SVTYPEMASK;
4076     SvFLAGS(sv) |= SVt_PVMG;
4077 }
4078
4079 void
4080 sv_unref(sv)
4081 SV* sv;
4082 {
4083     SV* rv = SvRV(sv);
4084
4085     SvRV(sv) = 0;
4086     SvROK_off(sv);
4087     if (SvREFCNT(rv) != 1 || SvREADONLY(rv))
4088         SvREFCNT_dec(rv);
4089     else
4090         sv_2mortal(rv);         /* Schedule for freeing later */
4091 }
4092
4093 void
4094 sv_taint(sv)
4095 SV *sv;
4096 {
4097     sv_magic((sv), Nullsv, 't', Nullch, 0);
4098 }
4099
4100 void
4101 sv_untaint(sv)
4102 SV *sv;
4103 {
4104     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
4105         MAGIC *mg = mg_find(sv, 't');
4106         if (mg)
4107             mg->mg_len &= ~1;
4108     }
4109 }
4110
4111 bool
4112 sv_tainted(sv)
4113 SV *sv;
4114 {
4115     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
4116         MAGIC *mg = mg_find(sv, 't');
4117         if (mg && ((mg->mg_len & 1) || (mg->mg_len & 2) && mg->mg_obj == sv))
4118             return TRUE;
4119     }
4120     return FALSE;
4121 }
4122
4123 #ifdef I_STDARG
4124 void
4125 sv_setpvf(SV *sv, const char* pat, ...)
4126 #else
4127 /*VARARGS0*/
4128 void
4129 sv_setpvf(sv, pat, va_alist)
4130     SV *sv;
4131     const char *pat;
4132     va_dcl
4133 #endif
4134 {
4135     va_list args;
4136 #ifdef I_STDARG
4137     va_start(args, pat);
4138 #else
4139     va_start(args);
4140 #endif
4141     sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4142     va_end(args);
4143 }
4144
4145 #ifdef I_STDARG
4146 void
4147 sv_catpvf(SV *sv, const char* pat, ...)
4148 #else
4149 /*VARARGS0*/
4150 void
4151 sv_catpvf(sv, pat, va_alist)
4152     SV *sv;
4153     const char *pat;
4154     va_dcl
4155 #endif
4156 {
4157     va_list args;
4158 #ifdef I_STDARG
4159     va_start(args, pat);
4160 #else
4161     va_start(args);
4162 #endif
4163     sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4164     va_end(args);
4165 }
4166
4167 void
4168 sv_vsetpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
4169     SV *sv;
4170     const char *pat;
4171     STRLEN patlen;
4172     va_list *args;
4173     SV **svargs;
4174     I32 svmax;
4175     bool *used_locale;
4176 {
4177     sv_setpvn(sv, "", 0);
4178     sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale);
4179 }
4180
4181 void
4182 sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
4183     SV *sv;
4184     const char *pat;
4185     STRLEN patlen;
4186     va_list *args;
4187     SV **svargs;
4188     I32 svmax;
4189     bool *used_locale;
4190 {
4191     char *p;
4192     char *q;
4193     char *patend;
4194     STRLEN origlen;
4195     I32 svix = 0;
4196     static char nullstr[] = "(null)";
4197
4198     /* no matter what, this is a string now */
4199     (void)SvPV_force(sv, origlen);
4200
4201     /* special-case "", "%s", and "%_" */
4202     if (patlen == 0)
4203         return;
4204     if (patlen == 2 && pat[0] == '%') {
4205         switch (pat[1]) {
4206         case 's':
4207             if (args) {
4208                 char *s = va_arg(*args, char*);
4209                 sv_catpv(sv, s ? s : nullstr);
4210             }
4211             else if (svix < svmax)
4212                 sv_catsv(sv, *svargs);
4213             return;
4214         case '_':
4215             if (args) {
4216                 sv_catsv(sv, va_arg(*args, SV*));
4217                 return;
4218             }
4219             /* See comment on '_' below */
4220             break;
4221         }
4222     }
4223
4224     patend = (char*)pat + patlen;
4225     for (p = (char*)pat; p < patend; p = q) {
4226         bool alt = FALSE;
4227         bool left = FALSE;
4228         char fill = ' ';
4229         char plus = 0;
4230         char intsize = 0;
4231         STRLEN width = 0;
4232         STRLEN zeros = 0;
4233         bool has_precis = FALSE;
4234         STRLEN precis = 0;
4235
4236         char esignbuf[4];
4237         STRLEN esignlen = 0;
4238
4239         char *eptr = Nullch;
4240         STRLEN elen = 0;
4241         char ebuf[TYPE_DIGITS(int) * 2 + 16]; /* large enough for "%#.#f" */
4242
4243         static char *efloatbuf = Nullch;
4244         static STRLEN efloatsize = 0;
4245
4246         char c;
4247         int i;
4248         unsigned base;
4249         IV iv;
4250         UV uv;
4251         double nv;
4252         STRLEN have;
4253         STRLEN need;
4254         STRLEN gap;
4255
4256         for (q = p; q < patend && *q != '%'; ++q) ;
4257         if (q > p) {
4258             sv_catpvn(sv, p, q - p);
4259             p = q;
4260         }
4261         if (q++ >= patend)
4262             break;
4263
4264         /* FLAGS */
4265
4266         while (*q) {
4267             switch (*q) {
4268             case ' ':
4269             case '+':
4270                 plus = *q++;
4271                 continue;
4272
4273             case '-':
4274                 left = TRUE;
4275                 q++;
4276                 continue;
4277
4278             case '0':
4279                 fill = *q++;
4280                 continue;
4281
4282             case '#':
4283                 alt = TRUE;
4284                 q++;
4285                 continue;
4286
4287             default:
4288                 break;
4289             }
4290             break;
4291         }
4292
4293         /* WIDTH */
4294
4295         switch (*q) {
4296         case '1': case '2': case '3':
4297         case '4': case '5': case '6':
4298         case '7': case '8': case '9':
4299             width = 0;
4300             while (isDIGIT(*q))
4301                 width = width * 10 + (*q++ - '0');
4302             break;
4303
4304         case '*':
4305             if (args)
4306                 i = va_arg(*args, int);
4307             else
4308                 i = (svix < svmax) ? SvIVx(svargs[svix++]) : 0;
4309             left |= (i < 0);
4310             width = (i < 0) ? -i : i;
4311             q++;
4312             break;
4313         }
4314
4315         /* PRECISION */
4316
4317         if (*q == '.') {
4318             q++;
4319             if (*q == '*') {
4320                 if (args)
4321                     i = va_arg(*args, int);
4322                 else
4323                     i = (svix < svmax) ? SvIVx(svargs[svix++]) : 0;
4324                 precis = (i < 0) ? 0 : i;
4325                 q++;
4326             }
4327             else {
4328                 precis = 0;
4329                 while (isDIGIT(*q))
4330                     precis = precis * 10 + (*q++ - '0');
4331             }
4332             has_precis = TRUE;
4333         }
4334
4335         /* SIZE */
4336
4337         switch (*q) {
4338         case 'l':
4339 #if 0  /* when quads have better support within Perl */
4340             if (*(q + 1) == 'l') {
4341                 intsize = 'q';
4342                 q += 2;
4343                 break;
4344             }
4345 #endif
4346             /* FALL THROUGH */
4347         case 'h':
4348         case 'V':
4349             intsize = *q++;
4350             break;
4351         }
4352
4353         /* CONVERSION */
4354
4355         switch (c = *q++) {
4356
4357             /* STRINGS */
4358
4359         case '%':
4360             eptr = q - 1;
4361             elen = 1;
4362             goto string;
4363
4364         case 'c':
4365             if (args)
4366                 c = va_arg(*args, int);
4367             else
4368                 c = (svix < svmax) ? SvIVx(svargs[svix++]) : 0;
4369             eptr = &c;
4370             elen = 1;
4371             goto string;
4372
4373         case 's':
4374             if (args) {
4375                 eptr = va_arg(*args, char*);
4376                 if (eptr)
4377                     elen = strlen(eptr);
4378                 else {
4379                     eptr = nullstr;
4380                     elen = sizeof nullstr - 1;
4381                 }
4382             }
4383             else if (svix < svmax)
4384                 eptr = SvPVx(svargs[svix++], elen);
4385             goto string;
4386
4387         case '_':
4388             /*
4389              * The "%_" hack might have to be changed someday,
4390              * if ISO or ANSI decide to use '_' for something.
4391              * So we keep it hidden from users' code.
4392              */
4393             if (!args)
4394                 goto unknown;
4395             eptr = SvPVx(va_arg(*args, SV*), elen);
4396
4397         string:
4398             if (has_precis && elen > precis)
4399                 elen = precis;
4400             break;
4401
4402             /* INTEGERS */
4403
4404         case 'p':
4405             if (args)
4406                 uv = (UV)va_arg(*args, void*);
4407             else
4408                 uv = (svix < svmax) ? (UV)svargs[svix++] : 0;
4409             base = 16;
4410             goto integer;
4411
4412         case 'D':
4413             intsize = 'l';
4414             /* FALL THROUGH */
4415         case 'd':
4416         case 'i':
4417             if (args) {
4418                 switch (intsize) {
4419                 case 'h':       iv = (short)va_arg(*args, int); break;
4420                 default:        iv = va_arg(*args, int); break;
4421                 case 'l':       iv = va_arg(*args, long); break;
4422                 case 'V':       iv = va_arg(*args, IV); break;
4423                 }
4424             }
4425             else {
4426                 iv = (svix < svmax) ? SvIVx(svargs[svix++]) : 0;
4427                 switch (intsize) {
4428                 case 'h':       iv = (short)iv; break;
4429                 default:        iv = (int)iv; break;
4430                 case 'l':       iv = (long)iv; break;
4431                 case 'V':       break;
4432                 }
4433             }
4434             if (iv >= 0) {
4435                 uv = iv;
4436                 if (plus)
4437                     esignbuf[esignlen++] = plus;
4438             }
4439             else {
4440                 uv = -iv;
4441                 esignbuf[esignlen++] = '-';
4442             }
4443             base = 10;
4444             goto integer;
4445
4446         case 'U':
4447             intsize = 'l';
4448             /* FALL THROUGH */
4449         case 'u':
4450             base = 10;
4451             goto uns_integer;
4452
4453         case 'O':
4454             intsize = 'l';
4455             /* FALL THROUGH */
4456         case 'o':
4457             base = 8;
4458             goto uns_integer;
4459
4460         case 'X':
4461         case 'x':
4462             base = 16;
4463
4464         uns_integer:
4465             if (args) {
4466                 switch (intsize) {
4467                 case 'h':  uv = (unsigned short)va_arg(*args, unsigned); break;
4468                 default:   uv = va_arg(*args, unsigned); break;
4469                 case 'l':  uv = va_arg(*args, unsigned long); break;
4470                 case 'V':  uv = va_arg(*args, UV); break;
4471                 }
4472             }
4473             else {
4474                 uv = (svix < svmax) ? SvUVx(svargs[svix++]) : 0;
4475                 switch (intsize) {
4476                 case 'h':       uv = (unsigned short)uv; break;
4477                 default:        uv = (unsigned)uv; break;
4478                 case 'l':       uv = (unsigned long)uv; break;
4479                 case 'V':       break;
4480                 }
4481             }
4482
4483         integer:
4484             eptr = ebuf + sizeof ebuf;
4485             switch (base) {
4486                 unsigned dig;
4487             case 16:
4488                 p = (c == 'X') ? "0123456789ABCDEF" : "0123456789abcdef";
4489                 do {
4490                     dig = uv & 15;
4491                     *--eptr = p[dig];
4492                 } while (uv >>= 4);
4493                 if (alt) {
4494                     esignbuf[esignlen++] = '0';
4495                     esignbuf[esignlen++] = c;  /* 'x' or 'X' */
4496                 }
4497                 break;
4498             case 8:
4499                 do {
4500                     dig = uv & 7;
4501                     *--eptr = '0' + dig;
4502                 } while (uv >>= 3);
4503                 if (alt && *eptr != '0')
4504                     *--eptr = '0';
4505                 break;
4506             default:            /* it had better be ten or less */
4507                 do {
4508                     dig = uv % base;
4509                     *--eptr = '0' + dig;
4510                 } while (uv /= base);
4511                 break;
4512             }
4513             elen = (ebuf + sizeof ebuf) - eptr;
4514             if (has_precis && precis > elen)
4515                 zeros = precis - elen;
4516             break;
4517
4518             /* FLOATING POINT */
4519
4520         case 'F':
4521             c = 'f';            /* maybe %F isn't supported here */
4522             /* FALL THROUGH */
4523         case 'e': case 'E':
4524         case 'f':
4525         case 'g': case 'G':
4526
4527             /* This is evil, but floating point is even more evil */
4528
4529             if (args)
4530                 nv = va_arg(*args, double);
4531             else
4532                 nv = (svix < svmax) ? SvNVx(svargs[svix++]) : 0.0;
4533
4534             need = 0;
4535             if (c != 'e' && c != 'E') {
4536                 i = PERL_INT_MIN;
4537                 (void)frexp(nv, &i);
4538                 if (i == PERL_INT_MIN)
4539                     die("panic: frexp");
4540                 if (i > 0)
4541                     need = BIT_DIGITS(i);
4542             }
4543             need += has_precis ? precis : 6; /* known default */
4544             if (need < width)
4545                 need = width;
4546
4547             need += 20; /* fudge factor */
4548             if (efloatsize < need) {
4549                 Safefree(efloatbuf);
4550                 efloatsize = need + 20; /* more fudge */
4551                 New(906, efloatbuf, efloatsize, char);
4552             }
4553
4554             eptr = ebuf + sizeof ebuf;
4555             *--eptr = '\0';
4556             *--eptr = c;
4557             if (has_precis) {
4558                 base = precis;
4559                 do { *--eptr = '0' + (base % 10); } while (base /= 10);
4560                 *--eptr = '.';
4561             }
4562             if (width) {
4563                 base = width;
4564                 do { *--eptr = '0' + (base % 10); } while (base /= 10);
4565             }
4566             if (fill == '0')
4567                 *--eptr = fill;
4568             if (plus)
4569                 *--eptr = plus;
4570             if (alt)
4571                 *--eptr = '#';
4572             *--eptr = '%';
4573
4574             (void)sprintf(efloatbuf, eptr, nv);
4575
4576             eptr = efloatbuf;
4577             elen = strlen(efloatbuf);
4578
4579 #ifdef LC_NUMERIC
4580             /*
4581              * User-defined locales may include arbitrary characters.
4582              * And, unfortunately, some system may alloc the "C" locale
4583              * to be overridden by a malicious user.
4584              */
4585             if (used_locale)
4586                 *used_locale = TRUE;
4587 #endif /* LC_NUMERIC */
4588
4589             break;
4590
4591             /* SPECIAL */
4592
4593         case 'n':
4594             i = SvCUR(sv) - origlen;
4595             if (args) {
4596                 switch (intsize) {
4597                 case 'h':       *(va_arg(*args, short*)) = i; break;
4598                 default:        *(va_arg(*args, int*)) = i; break;
4599                 case 'l':       *(va_arg(*args, long*)) = i; break;
4600                 case 'V':       *(va_arg(*args, IV*)) = i; break;
4601                 }
4602             }
4603             else if (svix < svmax)
4604                 sv_setuv(svargs[svix++], (UV)i);
4605             continue;   /* not "break" */
4606
4607             /* UNKNOWN */
4608
4609         default:
4610       unknown:
4611             if (!args && dowarn &&
4612                   (op->op_type == OP_PRTF || op->op_type == OP_SPRINTF)) {
4613                 SV *msg = sv_newmortal();
4614                 sv_setpvf(msg, "Invalid conversion in %s: ",
4615                           (op->op_type == OP_PRTF) ? "printf" : "sprintf");
4616                 if (c)
4617                     sv_catpvf(msg, isPRINT(c) ? "\"%%%c\"" : "\"%%\\%03o\"",
4618                               c & 0xFF);
4619                 else
4620                     sv_catpv(msg, "end of string");
4621                 warn("%_", msg); /* yes, this is reentrant */
4622             }
4623             /* output mangled stuff */
4624             eptr = p;
4625             elen = q - p;
4626             break;
4627         }
4628
4629         have = esignlen + zeros + elen;
4630         need = (have > width ? have : width);
4631         gap = need - have;
4632
4633         SvGROW(sv, SvLEN(sv) + need);
4634         p = SvEND(sv);
4635         if (esignlen && fill == '0') {
4636             for (i = 0; i < esignlen; i++)
4637                 *p++ = esignbuf[i];
4638         }
4639         if (gap && !left) {
4640             memset(p, fill, gap);
4641             p += gap;
4642         }
4643         if (esignlen && fill != '0') {
4644             for (i = 0; i < esignlen; i++)
4645                 *p++ = esignbuf[i];
4646         }
4647         if (zeros) {
4648             for (i = zeros; i; i--)
4649                 *p++ = '0';
4650         }
4651         if (elen) {
4652             memcpy(p, eptr, elen);
4653             p += elen;
4654         }
4655         if (gap && left) {
4656             memset(p, ' ', gap);
4657             p += gap;
4658         }
4659         *p = '\0';
4660         SvCUR(sv) = p - SvPVX(sv);
4661     }
4662 }
4663
4664 #ifdef DEBUGGING
4665 void
4666 sv_dump(sv)
4667 SV* sv;
4668 {
4669     SV *d = sv_newmortal();
4670     char *s;
4671     U32 flags;
4672     U32 type;
4673
4674     if (!sv) {
4675         PerlIO_printf(Perl_debug_log, "SV = 0\n");
4676         return;
4677     }
4678
4679     flags = SvFLAGS(sv);
4680     type = SvTYPE(sv);
4681
4682     sv_setpvf(d, "(0x%lx)\n  REFCNT = %ld\n  FLAGS = (",
4683               (unsigned long)SvANY(sv), (long)SvREFCNT(sv));
4684     if (flags & SVs_PADBUSY)    sv_catpv(d, "PADBUSY,");
4685     if (flags & SVs_PADTMP)     sv_catpv(d, "PADTMP,");
4686     if (flags & SVs_PADMY)      sv_catpv(d, "PADMY,");
4687     if (flags & SVs_TEMP)       sv_catpv(d, "TEMP,");
4688     if (flags & SVs_OBJECT)     sv_catpv(d, "OBJECT,");
4689     if (flags & SVs_GMG)        sv_catpv(d, "GMG,");
4690     if (flags & SVs_SMG)        sv_catpv(d, "SMG,");
4691     if (flags & SVs_RMG)        sv_catpv(d, "RMG,");
4692
4693     if (flags & SVf_IOK)        sv_catpv(d, "IOK,");
4694     if (flags & SVf_NOK)        sv_catpv(d, "NOK,");
4695     if (flags & SVf_POK)        sv_catpv(d, "POK,");
4696     if (flags & SVf_ROK)        sv_catpv(d, "ROK,");
4697     if (flags & SVf_OOK)        sv_catpv(d, "OOK,");
4698     if (flags & SVf_FAKE)       sv_catpv(d, "FAKE,");
4699     if (flags & SVf_READONLY)   sv_catpv(d, "READONLY,");
4700
4701 #ifdef OVERLOAD
4702     if (flags & SVf_AMAGIC)     sv_catpv(d, "OVERLOAD,");
4703 #endif /* OVERLOAD */
4704     if (flags & SVp_IOK)        sv_catpv(d, "pIOK,");
4705     if (flags & SVp_NOK)        sv_catpv(d, "pNOK,");
4706     if (flags & SVp_POK)        sv_catpv(d, "pPOK,");
4707     if (flags & SVp_SCREAM)     sv_catpv(d, "SCREAM,");
4708
4709     switch (type) {
4710     case SVt_PVCV:
4711     case SVt_PVFM:
4712         if (CvANON(sv))         sv_catpv(d, "ANON,");
4713         if (CvUNIQUE(sv))       sv_catpv(d, "UNIQUE,");
4714         if (CvCLONE(sv))        sv_catpv(d, "CLONE,");
4715         if (CvCLONED(sv))       sv_catpv(d, "CLONED,");
4716         if (CvNODEBUG(sv))      sv_catpv(d, "NODEBUG,");
4717         break;
4718     case SVt_PVHV:
4719         if (HvSHAREKEYS(sv))    sv_catpv(d, "SHAREKEYS,");
4720         if (HvLAZYDEL(sv))      sv_catpv(d, "LAZYDEL,");
4721         break;
4722     case SVt_PVGV:
4723         if (GvINTRO(sv))        sv_catpv(d, "INTRO,");
4724         if (GvMULTI(sv))        sv_catpv(d, "MULTI,");
4725         if (GvASSUMECV(sv))     sv_catpv(d, "ASSUMECV,");
4726         if (GvIMPORTED(sv)) {
4727             sv_catpv(d, "IMPORT");
4728             if (GvIMPORTED(sv) == GVf_IMPORTED)
4729                 sv_catpv(d, "ALL,");
4730             else {
4731                 sv_catpv(d, "(");
4732                 if (GvIMPORTED_SV(sv))  sv_catpv(d, " SV");
4733                 if (GvIMPORTED_AV(sv))  sv_catpv(d, " AV");
4734                 if (GvIMPORTED_HV(sv))  sv_catpv(d, " HV");
4735                 if (GvIMPORTED_CV(sv))  sv_catpv(d, " CV");
4736                 sv_catpv(d, " ),");
4737             }
4738         }
4739     }
4740
4741     if (*(SvEND(d) - 1) == ',')
4742         SvPVX(d)[--SvCUR(d)] = '\0';
4743     sv_catpv(d, ")");
4744     s = SvPVX(d);
4745
4746     PerlIO_printf(Perl_debug_log, "SV = ");
4747     switch (type) {
4748     case SVt_NULL:
4749         PerlIO_printf(Perl_debug_log, "NULL%s\n", s);
4750         return;
4751     case SVt_IV:
4752         PerlIO_printf(Perl_debug_log, "IV%s\n", s);
4753         break;
4754     case SVt_NV:
4755         PerlIO_printf(Perl_debug_log, "NV%s\n", s);
4756         break;
4757     case SVt_RV:
4758         PerlIO_printf(Perl_debug_log, "RV%s\n", s);
4759         break;
4760     case SVt_PV:
4761         PerlIO_printf(Perl_debug_log, "PV%s\n", s);
4762         break;
4763     case SVt_PVIV:
4764         PerlIO_printf(Perl_debug_log, "PVIV%s\n", s);
4765         break;
4766     case SVt_PVNV:
4767         PerlIO_printf(Perl_debug_log, "PVNV%s\n", s);
4768         break;
4769     case SVt_PVBM:
4770         PerlIO_printf(Perl_debug_log, "PVBM%s\n", s);
4771         break;
4772     case SVt_PVMG:
4773         PerlIO_printf(Perl_debug_log, "PVMG%s\n", s);
4774         break;
4775     case SVt_PVLV:
4776         PerlIO_printf(Perl_debug_log, "PVLV%s\n", s);
4777         break;
4778     case SVt_PVAV:
4779         PerlIO_printf(Perl_debug_log, "PVAV%s\n", s);
4780         break;
4781     case SVt_PVHV:
4782         PerlIO_printf(Perl_debug_log, "PVHV%s\n", s);
4783         break;
4784     case SVt_PVCV:
4785         PerlIO_printf(Perl_debug_log, "PVCV%s\n", s);
4786         break;
4787     case SVt_PVGV:
4788         PerlIO_printf(Perl_debug_log, "PVGV%s\n", s);
4789         break;
4790     case SVt_PVFM:
4791         PerlIO_printf(Perl_debug_log, "PVFM%s\n", s);
4792         break;
4793     case SVt_PVIO:
4794         PerlIO_printf(Perl_debug_log, "PVIO%s\n", s);
4795         break;
4796     default:
4797         PerlIO_printf(Perl_debug_log, "UNKNOWN%s\n", s);
4798         return;
4799     }
4800     if (type >= SVt_PVIV || type == SVt_IV)
4801         PerlIO_printf(Perl_debug_log, "  IV = %ld\n", (long)SvIVX(sv));
4802     if (type >= SVt_PVNV || type == SVt_NV) {
4803         SET_NUMERIC_STANDARD();
4804         PerlIO_printf(Perl_debug_log, "  NV = %.*g\n", DBL_DIG, SvNVX(sv));
4805     }
4806     if (SvROK(sv)) {
4807         PerlIO_printf(Perl_debug_log, "  RV = 0x%lx\n", (long)SvRV(sv));
4808         sv_dump(SvRV(sv));
4809         return;
4810     }
4811     if (type < SVt_PV)
4812         return;
4813     if (type <= SVt_PVLV) {
4814         if (SvPVX(sv))
4815             PerlIO_printf(Perl_debug_log, "  PV = 0x%lx \"%s\"\n  CUR = %ld\n  LEN = %ld\n",
4816                 (long)SvPVX(sv), SvPVX(sv), (long)SvCUR(sv), (long)SvLEN(sv));
4817         else
4818             PerlIO_printf(Perl_debug_log, "  PV = 0\n");
4819     }
4820     if (type >= SVt_PVMG) {
4821         if (SvMAGIC(sv)) {
4822             PerlIO_printf(Perl_debug_log, "  MAGIC = 0x%lx\n", (long)SvMAGIC(sv));
4823         }
4824         if (SvSTASH(sv))
4825             PerlIO_printf(Perl_debug_log, "  STASH = \"%s\"\n", HvNAME(SvSTASH(sv)));
4826     }
4827     switch (type) {
4828     case SVt_PVLV:
4829         PerlIO_printf(Perl_debug_log, "  TYPE = %c\n", LvTYPE(sv));
4830         PerlIO_printf(Perl_debug_log, "  TARGOFF = %ld\n", (long)LvTARGOFF(sv));
4831         PerlIO_printf(Perl_debug_log, "  TARGLEN = %ld\n", (long)LvTARGLEN(sv));
4832         PerlIO_printf(Perl_debug_log, "  TARG = 0x%lx\n", (long)LvTARG(sv));
4833         sv_dump(LvTARG(sv));
4834         break;
4835     case SVt_PVAV:
4836         PerlIO_printf(Perl_debug_log, "  ARRAY = 0x%lx\n", (long)AvARRAY(sv));
4837         PerlIO_printf(Perl_debug_log, "  ALLOC = 0x%lx\n", (long)AvALLOC(sv));
4838         PerlIO_printf(Perl_debug_log, "  FILL = %ld\n", (long)AvFILL(sv));
4839         PerlIO_printf(Perl_debug_log, "  MAX = %ld\n", (long)AvMAX(sv));
4840         PerlIO_printf(Perl_debug_log, "  ARYLEN = 0x%lx\n", (long)AvARYLEN(sv));
4841         flags = AvFLAGS(sv);
4842         sv_setpv(d, "");
4843         if (flags & AVf_REAL)   sv_catpv(d, ",REAL");
4844         if (flags & AVf_REIFY)  sv_catpv(d, ",REIFY");
4845         if (flags & AVf_REUSED) sv_catpv(d, ",REUSED");
4846         PerlIO_printf(Perl_debug_log, "  FLAGS = (%s)\n",
4847                       SvCUR(d) ? SvPVX(d) + 1 : "");
4848         break;
4849     case SVt_PVHV:
4850         PerlIO_printf(Perl_debug_log, "  ARRAY = 0x%lx\n",(long)HvARRAY(sv));
4851         PerlIO_printf(Perl_debug_log, "  KEYS = %ld\n", (long)HvKEYS(sv));
4852         PerlIO_printf(Perl_debug_log, "  FILL = %ld\n", (long)HvFILL(sv));
4853         PerlIO_printf(Perl_debug_log, "  MAX = %ld\n", (long)HvMAX(sv));
4854         PerlIO_printf(Perl_debug_log, "  RITER = %ld\n", (long)HvRITER(sv));
4855         PerlIO_printf(Perl_debug_log, "  EITER = 0x%lx\n",(long) HvEITER(sv));
4856         if (HvPMROOT(sv))
4857             PerlIO_printf(Perl_debug_log, "  PMROOT = 0x%lx\n",(long)HvPMROOT(sv));
4858         if (HvNAME(sv))
4859             PerlIO_printf(Perl_debug_log, "  NAME = \"%s\"\n", HvNAME(sv));
4860         break;
4861     case SVt_PVCV:
4862         if (SvPOK(sv))
4863             PerlIO_printf(Perl_debug_log, "  PROTOTYPE = \"%s\"\n", SvPV(sv,na));
4864         /* FALL THROUGH */
4865     case SVt_PVFM:
4866         PerlIO_printf(Perl_debug_log, "  STASH = 0x%lx\n", (long)CvSTASH(sv));
4867         PerlIO_printf(Perl_debug_log, "  START = 0x%lx\n", (long)CvSTART(sv));
4868         PerlIO_printf(Perl_debug_log, "  ROOT = 0x%lx\n", (long)CvROOT(sv));
4869         PerlIO_printf(Perl_debug_log, "  XSUB = 0x%lx\n", (long)CvXSUB(sv));
4870         PerlIO_printf(Perl_debug_log, "  XSUBANY = %ld\n", (long)CvXSUBANY(sv).any_i32);
4871         PerlIO_printf(Perl_debug_log, "  GV = 0x%lx", (long)CvGV(sv));
4872         if (CvGV(sv) && GvNAME(CvGV(sv))) {
4873             PerlIO_printf(Perl_debug_log, "  \"%s\"\n", GvNAME(CvGV(sv)));
4874         } else {
4875             PerlIO_printf(Perl_debug_log, "\n");
4876         }
4877         PerlIO_printf(Perl_debug_log, "  FILEGV = 0x%lx\n", (long)CvFILEGV(sv));
4878         PerlIO_printf(Perl_debug_log, "  DEPTH = %ld\n", (long)CvDEPTH(sv));
4879         PerlIO_printf(Perl_debug_log, "  PADLIST = 0x%lx\n", (long)CvPADLIST(sv));
4880         PerlIO_printf(Perl_debug_log, "  OUTSIDE = 0x%lx\n", (long)CvOUTSIDE(sv));
4881         if (type == SVt_PVFM)
4882             PerlIO_printf(Perl_debug_log, "  LINES = %ld\n", (long)FmLINES(sv));
4883         break;
4884     case SVt_PVGV:
4885         PerlIO_printf(Perl_debug_log, "  NAME = \"%s\"\n", GvNAME(sv));
4886         PerlIO_printf(Perl_debug_log, "  NAMELEN = %ld\n", (long)GvNAMELEN(sv));
4887         PerlIO_printf(Perl_debug_log, "  STASH = \"%s\"\n", HvNAME(GvSTASH(sv)));
4888         PerlIO_printf(Perl_debug_log, "  GP = 0x%lx\n", (long)GvGP(sv));
4889         PerlIO_printf(Perl_debug_log, "    SV = 0x%lx\n", (long)GvSV(sv));
4890         PerlIO_printf(Perl_debug_log, "    REFCNT = %ld\n", (long)GvREFCNT(sv));
4891         PerlIO_printf(Perl_debug_log, "    IO = 0x%lx\n", (long)GvIOp(sv));
4892         PerlIO_printf(Perl_debug_log, "    FORM = 0x%lx\n", (long)GvFORM(sv));
4893         PerlIO_printf(Perl_debug_log, "    AV = 0x%lx\n", (long)GvAV(sv));
4894         PerlIO_printf(Perl_debug_log, "    HV = 0x%lx\n", (long)GvHV(sv));
4895         PerlIO_printf(Perl_debug_log, "    CV = 0x%lx\n", (long)GvCV(sv));
4896         PerlIO_printf(Perl_debug_log, "    CVGEN = 0x%lx\n", (long)GvCVGEN(sv));
4897         PerlIO_printf(Perl_debug_log, "    LASTEXPR = %ld\n", (long)GvLASTEXPR(sv));
4898         PerlIO_printf(Perl_debug_log, "    LINE = %ld\n", (long)GvLINE(sv));
4899         PerlIO_printf(Perl_debug_log, "    FILEGV = 0x%lx\n", (long)GvFILEGV(sv));
4900         PerlIO_printf(Perl_debug_log, "    EGV = 0x%lx\n", (long)GvEGV(sv));
4901         break;
4902     case SVt_PVIO:
4903         PerlIO_printf(Perl_debug_log, "  IFP = 0x%lx\n", (long)IoIFP(sv));
4904         PerlIO_printf(Perl_debug_log, "  OFP = 0x%lx\n", (long)IoOFP(sv));
4905         PerlIO_printf(Perl_debug_log, "  DIRP = 0x%lx\n", (long)IoDIRP(sv));
4906         PerlIO_printf(Perl_debug_log, "  LINES = %ld\n", (long)IoLINES(sv));
4907         PerlIO_printf(Perl_debug_log, "  PAGE = %ld\n", (long)IoPAGE(sv));
4908         PerlIO_printf(Perl_debug_log, "  PAGE_LEN = %ld\n", (long)IoPAGE_LEN(sv));
4909         PerlIO_printf(Perl_debug_log, "  LINES_LEFT = %ld\n", (long)IoLINES_LEFT(sv));
4910         PerlIO_printf(Perl_debug_log, "  TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
4911         PerlIO_printf(Perl_debug_log, "  TOP_GV = 0x%lx\n", (long)IoTOP_GV(sv));
4912         PerlIO_printf(Perl_debug_log, "  FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
4913         PerlIO_printf(Perl_debug_log, "  FMT_GV = 0x%lx\n", (long)IoFMT_GV(sv));
4914         PerlIO_printf(Perl_debug_log, "  BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
4915         PerlIO_printf(Perl_debug_log, "  BOTTOM_GV = 0x%lx\n", (long)IoBOTTOM_GV(sv));
4916         PerlIO_printf(Perl_debug_log, "  SUBPROCESS = %ld\n", (long)IoSUBPROCESS(sv));
4917         PerlIO_printf(Perl_debug_log, "  TYPE = %c\n", IoTYPE(sv));
4918         PerlIO_printf(Perl_debug_log, "  FLAGS = 0x%lx\n", (long)IoFLAGS(sv));
4919         break;
4920     }
4921 }
4922 #else
4923 void
4924 sv_dump(sv)
4925 SV* sv;
4926 {
4927 }
4928 #endif