sv.c

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