sv.c

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