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 && !(SvFLAGS(sv) & SVs_PADTMP))
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 && !(SvFLAGS(sv) & SVs_PADTMP))
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 && !(SvFLAGS(sv) & SVs_PADTMP))
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                 case SVt_PVIO:
1643                     if (intro)
1644                         SAVESPTR(GvIOp(dstr));
1645                     else
1646                         dref = (SV*)GvIOp(dstr);
1647                     GvIOp(dstr) = (IO*)sref;
1648                     break;
1649                 default:
1650                     if (intro)
1651                         SAVESPTR(GvSV(dstr));
1652                     else
1653                         dref = (SV*)GvSV(dstr);
1654                     GvSV(dstr) = sref;
1655                     break;
1656                 }
1657                 if (curcop->cop_stash != GvSTASH(dstr))
1658                     GvFLAGS(dstr) |= GVf_IMPORTED;      /* crude */
1659                 if (dref)
1660                     SvREFCNT_dec(dref);
1661                 if (intro)
1662                     SAVEFREESV(sref);
1663                 SvTAINT(dstr);
1664                 return;
1665             }
1666             if (SvPVX(dstr)) {
1667                 Safefree(SvPVX(dstr));
1668                 SvLEN(dstr)=SvCUR(dstr)=0;
1669             }
1670         }
1671         (void)SvOK_off(dstr);
1672         SvRV(dstr) = SvREFCNT_inc(SvRV(sstr));
1673         SvROK_on(dstr);
1674         if (sflags & SVp_NOK) {
1675             SvNOK_on(dstr);
1676             SvNVX(dstr) = SvNVX(sstr);
1677         }
1678         if (sflags & SVp_IOK) {
1679             (void)SvIOK_on(dstr);
1680             SvIVX(dstr) = SvIVX(sstr);
1681         }
1682 #ifdef OVERLOAD
1683         if (SvAMAGIC(sstr)) {
1684             SvAMAGIC_on(dstr);
1685         }
1686 #endif /* OVERLOAD */
1687     }
1688     else if (sflags & SVp_POK) {
1689
1690         /*
1691          * Check to see if we can just swipe the string.  If so, it's a
1692          * possible small lose on short strings, but a big win on long ones.
1693          * It might even be a win on short strings if SvPVX(dstr)
1694          * has to be allocated and SvPVX(sstr) has to be freed.
1695          */
1696
1697         if (SvTEMP(sstr)) {             /* slated for free anyway? */
1698             if (SvPVX(dstr)) {          /* we know that dtype >= SVt_PV */
1699                 (void)SvOOK_off(dstr);
1700                 Safefree(SvPVX(dstr));
1701             }
1702             SvPV_set(dstr, SvPVX(sstr));
1703             SvLEN_set(dstr, SvLEN(sstr));
1704             SvCUR_set(dstr, SvCUR(sstr));
1705             (void)SvPOK_only(dstr);
1706             SvTEMP_off(dstr);
1707             SvPV_set(sstr, Nullch);
1708             SvLEN_set(sstr, 0);
1709             SvPOK_off(sstr);                    /* wipe out any weird flags */
1710             SvPVX(sstr) = 0;                    /* so sstr frees uneventfully */
1711         }
1712         else {                                  /* have to copy actual string */
1713             STRLEN len = SvCUR(sstr);
1714
1715             SvGROW(dstr, len + 1);              /* inlined from sv_setpvn */
1716             Move(SvPVX(sstr),SvPVX(dstr),len,char);
1717             SvCUR_set(dstr, len);
1718             *SvEND(dstr) = '\0';
1719             (void)SvPOK_only(dstr);
1720         }
1721         /*SUPPRESS 560*/
1722         if (sflags & SVp_NOK) {
1723             SvNOK_on(dstr);
1724             SvNVX(dstr) = SvNVX(sstr);
1725         }
1726         if (sflags & SVp_IOK) {
1727             (void)SvIOK_on(dstr);
1728             SvIVX(dstr) = SvIVX(sstr);
1729         }
1730     }
1731     else if (sflags & SVp_NOK) {
1732         SvNVX(dstr) = SvNVX(sstr);
1733         (void)SvNOK_only(dstr);
1734         if (SvIOK(sstr)) {
1735             (void)SvIOK_on(dstr);
1736             SvIVX(dstr) = SvIVX(sstr);
1737         }
1738     }
1739     else if (sflags & SVp_IOK) {
1740         (void)SvIOK_only(dstr);
1741         SvIVX(dstr) = SvIVX(sstr);
1742     }
1743     else {
1744         (void)SvOK_off(dstr);
1745     }
1746     SvTAINT(dstr);
1747 }
1748
1749 void
1750 sv_setpvn(sv,ptr,len)
1751 register SV *sv;
1752 register char *ptr;
1753 register STRLEN len;
1754 {
1755     assert(len >= 0);
1756     if (SvTHINKFIRST(sv)) {
1757         if (SvREADONLY(sv) && curcop != &compiling)
1758             croak(no_modify);
1759         if (SvROK(sv))
1760             sv_unref(sv);
1761     }
1762     if (!ptr) {
1763         (void)SvOK_off(sv);
1764         return;
1765     }
1766     if (SvTYPE(sv) >= SVt_PV) {
1767         if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
1768             sv_unglob(sv);
1769     }
1770     else if (!sv_upgrade(sv, SVt_PV))
1771         return;
1772     SvGROW(sv, len + 1);
1773     Move(ptr,SvPVX(sv),len,char);
1774     SvCUR_set(sv, len);
1775     *SvEND(sv) = '\0';
1776     (void)SvPOK_only(sv);               /* validate pointer */
1777     SvTAINT(sv);
1778 }
1779
1780 void
1781 sv_setpv(sv,ptr)
1782 register SV *sv;
1783 register char *ptr;
1784 {
1785     register STRLEN len;
1786
1787     if (SvTHINKFIRST(sv)) {
1788         if (SvREADONLY(sv) && curcop != &compiling)
1789             croak(no_modify);
1790         if (SvROK(sv))
1791             sv_unref(sv);
1792     }
1793     if (!ptr) {
1794         (void)SvOK_off(sv);
1795         return;
1796     }
1797     len = strlen(ptr);
1798     if (SvTYPE(sv) >= SVt_PV) {
1799         if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
1800             sv_unglob(sv);
1801     }
1802     else if (!sv_upgrade(sv, SVt_PV))
1803         return;
1804     SvGROW(sv, len + 1);
1805     Move(ptr,SvPVX(sv),len+1,char);
1806     SvCUR_set(sv, len);
1807     (void)SvPOK_only(sv);               /* validate pointer */
1808     SvTAINT(sv);
1809 }
1810
1811 void
1812 sv_usepvn(sv,ptr,len)
1813 register SV *sv;
1814 register char *ptr;
1815 register STRLEN len;
1816 {
1817     if (SvTHINKFIRST(sv)) {
1818         if (SvREADONLY(sv) && curcop != &compiling)
1819             croak(no_modify);
1820         if (SvROK(sv))
1821             sv_unref(sv);
1822     }
1823     if (!SvUPGRADE(sv, SVt_PV))
1824         return;
1825     if (!ptr) {
1826         (void)SvOK_off(sv);
1827         return;
1828     }
1829     if (SvPVX(sv))
1830         Safefree(SvPVX(sv));
1831     Renew(ptr, len+1, char);
1832     SvPVX(sv) = ptr;
1833     SvCUR_set(sv, len);
1834     SvLEN_set(sv, len+1);
1835     *SvEND(sv) = '\0';
1836     (void)SvPOK_only(sv);               /* validate pointer */
1837     SvTAINT(sv);
1838 }
1839
1840 void
1841 sv_chop(sv,ptr) /* like set but assuming ptr is in sv */
1842 register SV *sv;
1843 register char *ptr;
1844 {
1845     register STRLEN delta;
1846
1847     if (!ptr || !SvPOKp(sv))
1848         return;
1849     if (SvTHINKFIRST(sv)) {
1850         if (SvREADONLY(sv) && curcop != &compiling)
1851             croak(no_modify);
1852         if (SvROK(sv))
1853             sv_unref(sv);
1854     }
1855     if (SvTYPE(sv) < SVt_PVIV)
1856         sv_upgrade(sv,SVt_PVIV);
1857
1858     if (!SvOOK(sv)) {
1859         SvIVX(sv) = 0;
1860         SvFLAGS(sv) |= SVf_OOK;
1861     }
1862     SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVp_IOK|SVp_NOK);
1863     delta = ptr - SvPVX(sv);
1864     SvLEN(sv) -= delta;
1865     SvCUR(sv) -= delta;
1866     SvPVX(sv) += delta;
1867     SvIVX(sv) += delta;
1868 }
1869
1870 void
1871 sv_catpvn(sv,ptr,len)
1872 register SV *sv;
1873 register char *ptr;
1874 register STRLEN len;
1875 {
1876     STRLEN tlen;
1877     char *junk;
1878
1879     junk = SvPV_force(sv, tlen);
1880     SvGROW(sv, tlen + len + 1);
1881     if (ptr == junk)
1882         ptr = SvPVX(sv);
1883     Move(ptr,SvPVX(sv)+tlen,len,char);
1884     SvCUR(sv) += len;
1885     *SvEND(sv) = '\0';
1886     (void)SvPOK_only(sv);               /* validate pointer */
1887     SvTAINT(sv);
1888 }
1889
1890 void
1891 sv_catsv(dstr,sstr)
1892 SV *dstr;
1893 register SV *sstr;
1894 {
1895     char *s;
1896     STRLEN len;
1897     if (!sstr)
1898         return;
1899     if (s = SvPV(sstr, len))
1900         sv_catpvn(dstr,s,len);
1901 }
1902
1903 void
1904 sv_catpv(sv,ptr)
1905 register SV *sv;
1906 register char *ptr;
1907 {
1908     register STRLEN len;
1909     STRLEN tlen;
1910     char *junk;
1911
1912     if (!ptr)
1913         return;
1914     junk = SvPV_force(sv, tlen);
1915     len = strlen(ptr);
1916     SvGROW(sv, tlen + len + 1);
1917     if (ptr == junk)
1918         ptr = SvPVX(sv);
1919     Move(ptr,SvPVX(sv)+tlen,len+1,char);
1920     SvCUR(sv) += len;
1921     (void)SvPOK_only(sv);               /* validate pointer */
1922     SvTAINT(sv);
1923 }
1924
1925 SV *
1926 #ifdef LEAKTEST
1927 newSV(x,len)
1928 I32 x;
1929 #else
1930 newSV(len)
1931 #endif
1932 STRLEN len;
1933 {
1934     register SV *sv;
1935
1936     new_SV();
1937     SvANY(sv) = 0;
1938     SvREFCNT(sv) = 1;
1939     SvFLAGS(sv) = 0;
1940     if (len) {
1941         sv_upgrade(sv, SVt_PV);
1942         SvGROW(sv, len + 1);
1943     }
1944     return sv;
1945 }
1946
1947 void
1948 sv_magic(sv, obj, how, name, namlen)
1949 register SV *sv;
1950 SV *obj;
1951 int how;
1952 char *name;
1953 I32 namlen;
1954 {
1955     MAGIC* mg;
1956
1957     if (SvREADONLY(sv) && curcop != &compiling && !strchr("gB", how))
1958         croak(no_modify);
1959     if (SvMAGICAL(sv) || (how == 't' && SvTYPE(sv) >= SVt_PVMG)) {
1960         if (SvMAGIC(sv) && (mg = mg_find(sv, how))) {
1961             if (how == 't')
1962                 mg->mg_len |= 1;
1963             return;
1964         }
1965     }
1966     else {
1967         if (!SvUPGRADE(sv, SVt_PVMG))
1968             return;
1969     }
1970     Newz(702,mg, 1, MAGIC);
1971     mg->mg_moremagic = SvMAGIC(sv);
1972
1973     SvMAGIC(sv) = mg;
1974     if (!obj || obj == sv || how == '#')
1975         mg->mg_obj = obj;
1976     else {
1977         mg->mg_obj = SvREFCNT_inc(obj);
1978         mg->mg_flags |= MGf_REFCOUNTED;
1979     }
1980     mg->mg_type = how;
1981     mg->mg_len = namlen;
1982     if (name && namlen >= 0)
1983         mg->mg_ptr = savepvn(name, namlen);
1984     switch (how) {
1985     case 0:
1986         mg->mg_virtual = &vtbl_sv;
1987         break;
1988 #ifdef OVERLOAD
1989     case 'A':
1990         mg->mg_virtual = &vtbl_amagic;
1991         break;
1992     case 'a':
1993         mg->mg_virtual = &vtbl_amagicelem;
1994         break;
1995     case 'c':
1996         mg->mg_virtual = 0;
1997         break;
1998 #endif /* OVERLOAD */
1999     case 'B':
2000         mg->mg_virtual = &vtbl_bm;
2001         break;
2002     case 'E':
2003         mg->mg_virtual = &vtbl_env;
2004         break;
2005     case 'e':
2006         mg->mg_virtual = &vtbl_envelem;
2007         break;
2008     case 'g':
2009         mg->mg_virtual = &vtbl_mglob;
2010         break;
2011     case 'I':
2012         mg->mg_virtual = &vtbl_isa;
2013         break;
2014     case 'i':
2015         mg->mg_virtual = &vtbl_isaelem;
2016         break;
2017     case 'L':
2018         SvRMAGICAL_on(sv);
2019         mg->mg_virtual = 0;
2020         break;
2021     case 'l':
2022         mg->mg_virtual = &vtbl_dbline;
2023         break;
2024     case 'P':
2025         mg->mg_virtual = &vtbl_pack;
2026         break;
2027     case 'p':
2028     case 'q':
2029         mg->mg_virtual = &vtbl_packelem;
2030         break;
2031     case 'S':
2032         mg->mg_virtual = &vtbl_sig;
2033         break;
2034     case 's':
2035         mg->mg_virtual = &vtbl_sigelem;
2036         break;
2037     case 't':
2038         mg->mg_virtual = &vtbl_taint;
2039         mg->mg_len = 1;
2040         break;
2041     case 'U':
2042         mg->mg_virtual = &vtbl_uvar;
2043         break;
2044     case 'v':
2045         mg->mg_virtual = &vtbl_vec;
2046         break;
2047     case 'x':
2048         mg->mg_virtual = &vtbl_substr;
2049         break;
2050     case '*':
2051         mg->mg_virtual = &vtbl_glob;
2052         break;
2053     case '#':
2054         mg->mg_virtual = &vtbl_arylen;
2055         break;
2056     case '.':
2057         mg->mg_virtual = &vtbl_pos;
2058         break;
2059     case '~':   /* Reserved for use by extensions not perl internals.   */
2060         /* Useful for attaching extension internal data to perl vars.   */
2061         /* Note that multiple extensions may clash if magical scalars   */
2062         /* etc holding private data from one are passed to another.     */
2063         SvRMAGICAL_on(sv);
2064         break;
2065     default:
2066         croak("Don't know how to handle magic of type '%c'", how);
2067     }
2068     mg_magical(sv);
2069     if (SvGMAGICAL(sv))
2070         SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
2071 }
2072
2073 int
2074 sv_unmagic(sv, type)
2075 SV* sv;
2076 int type;
2077 {
2078     MAGIC* mg;
2079     MAGIC** mgp;
2080     if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv))
2081         return 0;
2082     mgp = &SvMAGIC(sv);
2083     for (mg = *mgp; mg; mg = *mgp) {
2084         if (mg->mg_type == type) {
2085             MGVTBL* vtbl = mg->mg_virtual;
2086             *mgp = mg->mg_moremagic;
2087             if (vtbl && vtbl->svt_free)
2088                 (*vtbl->svt_free)(sv, mg);
2089             if (mg->mg_ptr && mg->mg_type != 'g')
2090                 Safefree(mg->mg_ptr);
2091             if (mg->mg_flags & MGf_REFCOUNTED)
2092                 SvREFCNT_dec(mg->mg_obj);
2093             Safefree(mg);
2094         }
2095         else
2096             mgp = &mg->mg_moremagic;
2097     }
2098     if (!SvMAGIC(sv)) {
2099         SvMAGICAL_off(sv);
2100         SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
2101     }
2102
2103     return 0;
2104 }
2105
2106 void
2107 sv_insert(bigstr,offset,len,little,littlelen)
2108 SV *bigstr;
2109 STRLEN offset;
2110 STRLEN len;
2111 char *little;
2112 STRLEN littlelen;
2113 {
2114     register char *big;
2115     register char *mid;
2116     register char *midend;
2117     register char *bigend;
2118     register I32 i;
2119
2120     if (!bigstr)
2121         croak("Can't modify non-existent substring");
2122     SvPV_force(bigstr, na);
2123
2124     i = littlelen - len;
2125     if (i > 0) {                        /* string might grow */
2126         big = SvGROW(bigstr, SvCUR(bigstr) + i + 1);
2127         mid = big + offset + len;
2128         midend = bigend = big + SvCUR(bigstr);
2129         bigend += i;
2130         *bigend = '\0';
2131         while (midend > mid)            /* shove everything down */
2132             *--bigend = *--midend;
2133         Move(little,big+offset,littlelen,char);
2134         SvCUR(bigstr) += i;
2135         SvSETMAGIC(bigstr);
2136         return;
2137     }
2138     else if (i == 0) {
2139         Move(little,SvPVX(bigstr)+offset,len,char);
2140         SvSETMAGIC(bigstr);
2141         return;
2142     }
2143
2144     big = SvPVX(bigstr);
2145     mid = big + offset;
2146     midend = mid + len;
2147     bigend = big + SvCUR(bigstr);
2148
2149     if (midend > bigend)
2150         croak("panic: sv_insert");
2151
2152     if (mid - big > bigend - midend) {  /* faster to shorten from end */
2153         if (littlelen) {
2154             Move(little, mid, littlelen,char);
2155             mid += littlelen;
2156         }
2157         i = bigend - midend;
2158         if (i > 0) {
2159             Move(midend, mid, i,char);
2160             mid += i;
2161         }
2162         *mid = '\0';
2163         SvCUR_set(bigstr, mid - big);
2164     }
2165     /*SUPPRESS 560*/
2166     else if (i = mid - big) {   /* faster from front */
2167         midend -= littlelen;
2168         mid = midend;
2169         sv_chop(bigstr,midend-i);
2170         big += i;
2171         while (i--)
2172             *--midend = *--big;
2173         if (littlelen)
2174             Move(little, mid, littlelen,char);
2175     }
2176     else if (littlelen) {
2177         midend -= littlelen;
2178         sv_chop(bigstr,midend);
2179         Move(little,midend,littlelen,char);
2180     }
2181     else {
2182         sv_chop(bigstr,midend);
2183     }
2184     SvSETMAGIC(bigstr);
2185 }
2186
2187 /* make sv point to what nstr did */
2188
2189 void
2190 sv_replace(sv,nsv)
2191 register SV *sv;
2192 register SV *nsv;
2193 {
2194     U32 refcnt = SvREFCNT(sv);
2195     if (SvTHINKFIRST(sv)) {
2196         if (SvREADONLY(sv) && curcop != &compiling)
2197             croak(no_modify);
2198         if (SvROK(sv))
2199             sv_unref(sv);
2200     }
2201     if (SvREFCNT(nsv) != 1)
2202         warn("Reference miscount in sv_replace()");
2203     if (SvMAGICAL(sv)) {
2204         if (SvMAGICAL(nsv))
2205             mg_free(nsv);
2206         else
2207             sv_upgrade(nsv, SVt_PVMG);
2208         SvMAGIC(nsv) = SvMAGIC(sv);
2209         SvFLAGS(nsv) |= SvMAGICAL(sv);
2210         SvMAGICAL_off(sv);
2211         SvMAGIC(sv) = 0;
2212     }
2213     SvREFCNT(sv) = 0;
2214     sv_clear(sv);
2215     StructCopy(nsv,sv,SV);
2216     SvREFCNT(sv) = refcnt;
2217     del_SV(nsv);
2218 }
2219
2220 void
2221 sv_clear(sv)
2222 register SV *sv;
2223 {
2224     assert(sv);
2225     assert(SvREFCNT(sv) == 0);
2226
2227     if (SvOBJECT(sv)) {
2228         dSP;
2229         GV* destructor;
2230
2231         if (defstash) {         /* Still have a symbol table? */
2232             destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
2233
2234             ENTER;
2235             SAVEFREESV(SvSTASH(sv));
2236             if (destructor && GvCV(destructor)) {
2237                 SV ref;
2238
2239                 Zero(&ref, 1, SV);
2240                 sv_upgrade(&ref, SVt_RV);
2241                 SAVEI32(SvREFCNT(sv));
2242                 SvRV(&ref) = SvREFCNT_inc(sv);
2243                 SvROK_on(&ref);
2244
2245                 EXTEND(SP, 2);
2246                 PUSHMARK(SP);
2247                 PUSHs(&ref);
2248                 PUTBACK;
2249                 perl_call_sv((SV*)destructor, G_DISCARD|G_EVAL|G_KEEPERR);
2250                 del_XRV(SvANY(&ref));
2251             }
2252             LEAVE;
2253         }
2254         else
2255             SvREFCNT_dec(SvSTASH(sv));
2256         if (SvOBJECT(sv)) {
2257             SvOBJECT_off(sv);   /* Curse the object. */
2258             if (SvTYPE(sv) != SVt_PVIO)
2259                 --sv_objcount;  /* XXX Might want something more general */
2260         }
2261     }
2262     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
2263         mg_free(sv);
2264     switch (SvTYPE(sv)) {
2265     case SVt_PVIO:
2266         io_close((IO*)sv);
2267         Safefree(IoTOP_NAME(sv));
2268         Safefree(IoFMT_NAME(sv));
2269         Safefree(IoBOTTOM_NAME(sv));
2270         /* FALL THROUGH */
2271     case SVt_PVBM:
2272         goto freescalar;
2273     case SVt_PVCV:
2274     case SVt_PVFM:
2275         cv_undef((CV*)sv);
2276         goto freescalar;
2277     case SVt_PVHV:
2278         hv_undef((HV*)sv);
2279         break;
2280     case SVt_PVAV:
2281         av_undef((AV*)sv);
2282         break;
2283     case SVt_PVGV:
2284         gp_free(sv);
2285         Safefree(GvNAME(sv));
2286         /* FALL THROUGH */
2287     case SVt_PVLV:
2288     case SVt_PVMG:
2289     case SVt_PVNV:
2290     case SVt_PVIV:
2291       freescalar:
2292         (void)SvOOK_off(sv);
2293         /* FALL THROUGH */
2294     case SVt_PV:
2295     case SVt_RV:
2296         if (SvROK(sv))
2297             SvREFCNT_dec(SvRV(sv));
2298         else if (SvPVX(sv))
2299             Safefree(SvPVX(sv));
2300         break;
2301 /*
2302     case SVt_NV:
2303     case SVt_IV:
2304     case SVt_NULL:
2305         break;
2306 */
2307     }
2308
2309     switch (SvTYPE(sv)) {
2310     case SVt_NULL:
2311         break;
2312     case SVt_IV:
2313         del_XIV(SvANY(sv));
2314         break;
2315     case SVt_NV:
2316         del_XNV(SvANY(sv));
2317         break;
2318     case SVt_RV:
2319         del_XRV(SvANY(sv));
2320         break;
2321     case SVt_PV:
2322         del_XPV(SvANY(sv));
2323         break;
2324     case SVt_PVIV:
2325         del_XPVIV(SvANY(sv));
2326         break;
2327     case SVt_PVNV:
2328         del_XPVNV(SvANY(sv));
2329         break;
2330     case SVt_PVMG:
2331         del_XPVMG(SvANY(sv));
2332         break;
2333     case SVt_PVLV:
2334         del_XPVLV(SvANY(sv));
2335         break;
2336     case SVt_PVAV:
2337         del_XPVAV(SvANY(sv));
2338         break;
2339     case SVt_PVHV:
2340         del_XPVHV(SvANY(sv));
2341         break;
2342     case SVt_PVCV:
2343         del_XPVCV(SvANY(sv));
2344         break;
2345     case SVt_PVGV:
2346         del_XPVGV(SvANY(sv));
2347         break;
2348     case SVt_PVBM:
2349         del_XPVBM(SvANY(sv));
2350         break;
2351     case SVt_PVFM:
2352         del_XPVFM(SvANY(sv));
2353         break;
2354     case SVt_PVIO:
2355         del_XPVIO(SvANY(sv));
2356         break;
2357     }
2358     SvFLAGS(sv) &= SVf_BREAK;
2359     SvFLAGS(sv) |= SVTYPEMASK;
2360 }
2361
2362 SV *
2363 sv_newref(sv)
2364 SV* sv;
2365 {
2366     if (sv)
2367         SvREFCNT(sv)++;
2368     return sv;
2369 }
2370
2371 void
2372 sv_free(sv)
2373 SV *sv;
2374 {
2375     if (!sv)
2376         return;
2377     if (SvREADONLY(sv)) {
2378         if (sv == &sv_undef || sv == &sv_yes || sv == &sv_no)
2379             return;
2380     }
2381     if (SvREFCNT(sv) == 0) {
2382         if (SvFLAGS(sv) & SVf_BREAK)
2383             return;
2384         warn("Attempt to free unreferenced scalar");
2385         return;
2386     }
2387     if (--SvREFCNT(sv) > 0)
2388         return;
2389 #ifdef DEBUGGING
2390     if (SvTEMP(sv)) {
2391         warn("Attempt to free temp prematurely");
2392         return;
2393     }
2394 #endif
2395     sv_clear(sv);
2396     del_SV(sv);
2397 }
2398
2399 STRLEN
2400 sv_len(sv)
2401 register SV *sv;
2402 {
2403     char *junk;
2404     STRLEN len;
2405
2406     if (!sv)
2407         return 0;
2408
2409     if (SvGMAGICAL(sv))
2410         len = mg_len(sv);
2411     else
2412         junk = SvPV(sv, len);
2413     return len;
2414 }
2415
2416 I32
2417 sv_eq(str1,str2)
2418 register SV *str1;
2419 register SV *str2;
2420 {
2421     char *pv1;
2422     STRLEN cur1;
2423     char *pv2;
2424     STRLEN cur2;
2425
2426     if (!str1) {
2427         pv1 = "";
2428         cur1 = 0;
2429     }
2430     else
2431         pv1 = SvPV(str1, cur1);
2432
2433     if (!str2)
2434         return !cur1;
2435     else
2436         pv2 = SvPV(str2, cur2);
2437
2438     if (cur1 != cur2)
2439         return 0;
2440
2441     return !bcmp(pv1, pv2, cur1);
2442 }
2443
2444 I32
2445 sv_cmp(str1,str2)
2446 register SV *str1;
2447 register SV *str2;
2448 {
2449     I32 retval;
2450     char *pv1;
2451     STRLEN cur1;
2452     char *pv2;
2453     STRLEN cur2;
2454
2455     if (!str1) {
2456         pv1 = "";
2457         cur1 = 0;
2458     }
2459     else
2460         pv1 = SvPV(str1, cur1);
2461
2462     if (!str2) {
2463         pv2 = "";
2464         cur2 = 0;
2465     }
2466     else
2467         pv2 = SvPV(str2, cur2);
2468
2469     if (!cur1)
2470         return cur2 ? -1 : 0;
2471     if (!cur2)
2472         return 1;
2473
2474     if (cur1 < cur2) {
2475         /*SUPPRESS 560*/
2476         if (retval = memcmp((void*)pv1, (void*)pv2, cur1))
2477             return retval < 0 ? -1 : 1;
2478         else
2479             return -1;
2480     }
2481     /*SUPPRESS 560*/
2482     else if (retval = memcmp((void*)pv1, (void*)pv2, cur2))
2483         return retval < 0 ? -1 : 1;
2484     else if (cur1 == cur2)
2485         return 0;
2486     else
2487         return 1;
2488 }
2489
2490 char *
2491 sv_gets(sv,fp,append)
2492 register SV *sv;
2493 register FILE *fp;
2494 I32 append;
2495 {
2496     char *rsptr;
2497     STRLEN rslen;
2498     register STDCHAR rslast;
2499     register STDCHAR *bp;
2500     register I32 cnt;
2501     I32 i;
2502
2503 #ifdef FAST_SV_GETS
2504     /*
2505      * We're going to steal some values from the stdio struct
2506      * and put EVERYTHING in the innermost loop into registers.
2507      */
2508     register STDCHAR *ptr;
2509     STRLEN bpx;
2510     I32 shortbuffered;
2511 #endif
2512
2513     if (SvTHINKFIRST(sv)) {
2514         if (SvREADONLY(sv) && curcop != &compiling)
2515             croak(no_modify);
2516         if (SvROK(sv))
2517             sv_unref(sv);
2518     }
2519     if (!SvUPGRADE(sv, SVt_PV))
2520         return 0;
2521
2522     if (RsSNARF(rs)) {
2523         rsptr = NULL;
2524         rslen = 0;
2525     }
2526     else if (RsPARA(rs)) {
2527         rsptr = "\n\n";
2528         rslen = 2;
2529     }
2530     else
2531         rsptr = SvPV(rs, rslen);
2532     rslast = rslen ? rsptr[rslen - 1] : '\0';
2533
2534     if (RsPARA(rs)) {           /* have to do this both before and after */
2535         do {                    /* to make sure file boundaries work right */
2536             if (feof(fp))
2537                 return 0;
2538             i = getc(fp);
2539             if (i != '\n') {
2540                 if (i == -1)
2541                     return 0;
2542                 ungetc(i,fp);
2543                 break;
2544             }
2545         } while (i != EOF);
2546     }
2547
2548 #ifdef FAST_SV_GETS
2549
2550     /* Here is some breathtakingly efficient cheating */
2551
2552     cnt = FILE_cnt(fp);                 /* get count into register */
2553     (void)SvPOK_only(sv);               /* validate pointer */
2554     if (SvLEN(sv) - append <= cnt + 1) { /* make sure we have the room */
2555         if (cnt > 80 && SvLEN(sv) > append) {
2556             shortbuffered = cnt - SvLEN(sv) + append + 1;
2557             cnt -= shortbuffered;
2558         }
2559         else {
2560             shortbuffered = 0;
2561             SvGROW(sv, append+cnt+2);/* (remembering cnt can be -1) */
2562         }
2563     }
2564     else
2565         shortbuffered = 0;
2566     bp = (STDCHAR*)SvPVX(sv) + append;  /* move these two too to registers */
2567     ptr = FILE_ptr(fp);
2568     for (;;) {
2569       screamer:
2570         if (cnt > 0) {
2571             if (rslen) {
2572                 while (--cnt >= 0) {                 /* this     |  eat */
2573                     if ((*bp++ = *ptr++) == rslast)  /* really   |  dust */
2574                         goto thats_all_folks;        /* screams  |  sed :-) */
2575                 }
2576             }
2577             else {
2578                 memcpy((char*)bp, (char*)ptr, cnt);  /* this     |  eat */
2579                 bp += cnt;                           /* screams  |  dust */
2580                 ptr += cnt;                          /* louder   |  sed :-) */
2581             }
2582         }
2583
2584         if (shortbuffered) {            /* oh well, must extend */
2585             cnt = shortbuffered;
2586             shortbuffered = 0;
2587             bpx = bp - (STDCHAR*)SvPVX(sv); /* box up before relocation */
2588             SvCUR_set(sv, bpx);
2589             SvGROW(sv, SvLEN(sv) + append + cnt + 2);
2590             bp = (STDCHAR*)SvPVX(sv) + bpx; /* unbox after relocation */
2591             continue;
2592         }
2593
2594         FILE_cnt(fp) = cnt;             /* deregisterize cnt and ptr */
2595         FILE_ptr(fp) = ptr;
2596         i = _filbuf(fp);                /* get more characters */
2597         cnt = FILE_cnt(fp);
2598         ptr = FILE_ptr(fp);             /* reregisterize cnt and ptr */
2599
2600         if (i == EOF)                   /* all done for ever? */
2601             goto thats_really_all_folks;
2602
2603         bpx = bp - (STDCHAR*)SvPVX(sv); /* box up before relocation */
2604         SvCUR_set(sv, bpx);
2605         SvGROW(sv, bpx + cnt + 2);
2606         bp = (STDCHAR*)SvPVX(sv) + bpx; /* unbox after relocation */
2607
2608         *bp++ = i;                      /* store character from _filbuf */
2609
2610         if (rslen && (STDCHAR)i == rslast)  /* all done for now? */
2611             goto thats_all_folks;
2612     }
2613
2614 thats_all_folks:
2615     if ((rslen > 1 && (bp - (STDCHAR*)SvPVX(sv) < rslen)) ||
2616           bcmp((char*)bp - rslen, rsptr, rslen))
2617         goto screamer;                  /* go back to the fray */
2618 thats_really_all_folks:
2619     if (shortbuffered)
2620         cnt += shortbuffered;
2621     FILE_cnt(fp) = cnt;                 /* put these back or we're in trouble */
2622     FILE_ptr(fp) = ptr;
2623     *bp = '\0';
2624     SvCUR_set(sv, bp - (STDCHAR*)SvPVX(sv));  /* set length */
2625
2626 #else /* SV_FAST_GETS */
2627
2628     /*The big, slow, and stupid way */
2629
2630     {
2631         STDCHAR buf[8192];
2632
2633 screamer:
2634         if (rslen) {
2635             register STDCHAR *bpe = buf + sizeof(buf);
2636             bp = buf;
2637             while ((i = getc(fp)) != EOF && (*bp++ = i) != rslast && bp < bpe)
2638                 ; /* keep reading */
2639             cnt = bp - buf;
2640         }
2641         else {
2642             cnt = fread((char*)buf, 1, sizeof(buf), fp);
2643             i = cnt ? (U8)buf[cnt - 1] : EOF;
2644         }
2645
2646         if (append)
2647             sv_catpvn(sv, buf, cnt);
2648         else
2649             sv_setpvn(sv, buf, cnt);
2650
2651         if (i != EOF &&                 /* joy */
2652             (!rslen ||
2653              SvCUR(sv) < rslen ||
2654              bcmp(SvPVX(sv) + SvCUR(sv) - rslen, rsptr, rslen)))
2655         {
2656             append = -1;
2657             goto screamer;
2658         }
2659     }
2660
2661 #endif /* SV_FAST_GETS */
2662
2663     if (RsPARA(rs)) {           /* have to do this both before and after */
2664         while (i != EOF) {      /* to make sure file boundaries work right */
2665             i = getc(fp);
2666             if (i != '\n') {
2667                 ungetc(i,fp);
2668                 break;
2669             }
2670         }
2671     }
2672
2673     return (SvCUR(sv) - append) ? SvPVX(sv) : Nullch;
2674 }
2675
2676 void
2677 sv_inc(sv)
2678 register SV *sv;
2679 {
2680     register char *d;
2681     int flags;
2682
2683     if (!sv)
2684         return;
2685     if (SvTHINKFIRST(sv)) {
2686         if (SvREADONLY(sv) && curcop != &compiling)
2687             croak(no_modify);
2688         if (SvROK(sv)) {
2689 #ifdef OVERLOAD
2690           if (SvAMAGIC(sv) && AMG_CALLun(sv,inc)) return;
2691 #endif /* OVERLOAD */
2692           sv_unref(sv);
2693         }
2694     }
2695     if (SvGMAGICAL(sv))
2696         mg_get(sv);
2697     flags = SvFLAGS(sv);
2698     if (flags & SVp_IOK) {
2699         ++SvIVX(sv);
2700         (void)SvIOK_only(sv);
2701         return;
2702     }
2703     if (flags & SVp_NOK) {
2704         SvNVX(sv) += 1.0;
2705         (void)SvNOK_only(sv);
2706         return;
2707     }
2708     if (!(flags & SVp_POK) || !*SvPVX(sv)) {
2709         if ((flags & SVTYPEMASK) < SVt_PVNV)
2710             sv_upgrade(sv, SVt_NV);
2711         SvNVX(sv) = 1.0;
2712         (void)SvNOK_only(sv);
2713         return;
2714     }
2715     d = SvPVX(sv);
2716     while (isALPHA(*d)) d++;
2717     while (isDIGIT(*d)) d++;
2718     if (*d) {
2719         sv_setnv(sv,atof(SvPVX(sv)) + 1.0);  /* punt */
2720         return;
2721     }
2722     d--;
2723     while (d >= SvPVX(sv)) {
2724         if (isDIGIT(*d)) {
2725             if (++*d <= '9')
2726                 return;
2727             *(d--) = '0';
2728         }
2729         else {
2730             ++*d;
2731             if (isALPHA(*d))
2732                 return;
2733             *(d--) -= 'z' - 'a' + 1;
2734         }
2735     }
2736     /* oh,oh, the number grew */
2737     SvGROW(sv, SvCUR(sv) + 2);
2738     SvCUR(sv)++;
2739     for (d = SvPVX(sv) + SvCUR(sv); d > SvPVX(sv); d--)
2740         *d = d[-1];
2741     if (isDIGIT(d[1]))
2742         *d = '1';
2743     else
2744         *d = d[1];
2745 }
2746
2747 void
2748 sv_dec(sv)
2749 register SV *sv;
2750 {
2751     int flags;
2752
2753     if (!sv)
2754         return;
2755     if (SvTHINKFIRST(sv)) {
2756         if (SvREADONLY(sv) && curcop != &compiling)
2757             croak(no_modify);
2758         if (SvROK(sv)) {
2759 #ifdef OVERLOAD
2760           if (SvAMAGIC(sv) && AMG_CALLun(sv,dec)) return;
2761 #endif /* OVERLOAD */
2762           sv_unref(sv);
2763         }
2764     }
2765     if (SvGMAGICAL(sv))
2766         mg_get(sv);
2767     flags = SvFLAGS(sv);
2768     if (flags & SVp_IOK) {
2769         --SvIVX(sv);
2770         (void)SvIOK_only(sv);
2771         return;
2772     }
2773     if (flags & SVp_NOK) {
2774         SvNVX(sv) -= 1.0;
2775         (void)SvNOK_only(sv);
2776         return;
2777     }
2778     if (!(flags & SVp_POK)) {
2779         if ((flags & SVTYPEMASK) < SVt_PVNV)
2780             sv_upgrade(sv, SVt_NV);
2781         SvNVX(sv) = -1.0;
2782         (void)SvNOK_only(sv);
2783         return;
2784     }
2785     sv_setnv(sv,atof(SvPVX(sv)) - 1.0);
2786 }
2787
2788 /* Make a string that will exist for the duration of the expression
2789  * evaluation.  Actually, it may have to last longer than that, but
2790  * hopefully we won't free it until it has been assigned to a
2791  * permanent location. */
2792
2793 static void
2794 sv_mortalgrow()
2795 {
2796     tmps_max += 128;
2797     Renew(tmps_stack, tmps_max, SV*);
2798 }
2799
2800 SV *
2801 sv_mortalcopy(oldstr)
2802 SV *oldstr;
2803 {
2804     register SV *sv;
2805
2806     new_SV();
2807     SvANY(sv) = 0;
2808     SvREFCNT(sv) = 1;
2809     SvFLAGS(sv) = 0;
2810     sv_setsv(sv,oldstr);
2811     if (++tmps_ix >= tmps_max)
2812         sv_mortalgrow();
2813     tmps_stack[tmps_ix] = sv;
2814     SvTEMP_on(sv);
2815     return sv;
2816 }
2817
2818 SV *
2819 sv_newmortal()
2820 {
2821     register SV *sv;
2822
2823     new_SV();
2824     SvANY(sv) = 0;
2825     SvREFCNT(sv) = 1;
2826     SvFLAGS(sv) = SVs_TEMP;
2827     if (++tmps_ix >= tmps_max)
2828         sv_mortalgrow();
2829     tmps_stack[tmps_ix] = sv;
2830     return sv;
2831 }
2832
2833 /* same thing without the copying */
2834
2835 SV *
2836 sv_2mortal(sv)
2837 register SV *sv;
2838 {
2839     if (!sv)
2840         return sv;
2841     if (SvREADONLY(sv) && curcop != &compiling)
2842         croak(no_modify);
2843     if (++tmps_ix >= tmps_max)
2844         sv_mortalgrow();
2845     tmps_stack[tmps_ix] = sv;
2846     SvTEMP_on(sv);
2847     return sv;
2848 }
2849
2850 SV *
2851 newSVpv(s,len)
2852 char *s;
2853 STRLEN len;
2854 {
2855     register SV *sv;
2856
2857     new_SV();
2858     SvANY(sv) = 0;
2859     SvREFCNT(sv) = 1;
2860     SvFLAGS(sv) = 0;
2861     if (!len)
2862         len = strlen(s);
2863     sv_setpvn(sv,s,len);
2864     return sv;
2865 }
2866
2867 SV *
2868 newSVnv(n)
2869 double n;
2870 {
2871     register SV *sv;
2872
2873     new_SV();
2874     SvANY(sv) = 0;
2875     SvREFCNT(sv) = 1;
2876     SvFLAGS(sv) = 0;
2877     sv_setnv(sv,n);
2878     return sv;
2879 }
2880
2881 SV *
2882 newSViv(i)
2883 IV i;
2884 {
2885     register SV *sv;
2886
2887     new_SV();
2888     SvANY(sv) = 0;
2889     SvREFCNT(sv) = 1;
2890     SvFLAGS(sv) = 0;
2891     sv_setiv(sv,i);
2892     return sv;
2893 }
2894
2895 SV *
2896 newRV(ref)
2897 SV *ref;
2898 {
2899     register SV *sv;
2900
2901     new_SV();
2902     SvANY(sv) = 0;
2903     SvREFCNT(sv) = 1;
2904     SvFLAGS(sv) = 0;
2905     sv_upgrade(sv, SVt_RV);
2906     SvTEMP_off(ref);
2907     SvRV(sv) = SvREFCNT_inc(ref);
2908     SvROK_on(sv);
2909     return sv;
2910 }
2911
2912 /* make an exact duplicate of old */
2913
2914 SV *
2915 newSVsv(old)
2916 register SV *old;
2917 {
2918     register SV *sv;
2919
2920     if (!old)
2921         return Nullsv;
2922     if (SvTYPE(old) == SVTYPEMASK) {
2923         warn("semi-panic: attempt to dup freed string");
2924         return Nullsv;
2925     }
2926     new_SV();
2927     SvANY(sv) = 0;
2928     SvREFCNT(sv) = 1;
2929     SvFLAGS(sv) = 0;
2930     if (SvTEMP(old)) {
2931         SvTEMP_off(old);
2932         sv_setsv(sv,old);
2933         SvTEMP_on(old);
2934     }
2935     else
2936         sv_setsv(sv,old);
2937     return sv;
2938 }
2939
2940 void
2941 sv_reset(s,stash)
2942 register char *s;
2943 HV *stash;
2944 {
2945     register HE *entry;
2946     register GV *gv;
2947     register SV *sv;
2948     register I32 i;
2949     register PMOP *pm;
2950     register I32 max;
2951     char todo[256];
2952
2953     if (!*s) {          /* reset ?? searches */
2954         for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) {
2955             pm->op_pmflags &= ~PMf_USED;
2956         }
2957         return;
2958     }
2959
2960     /* reset variables */
2961
2962     if (!HvARRAY(stash))
2963         return;
2964
2965     Zero(todo, 256, char);
2966     while (*s) {
2967         i = *s;
2968         if (s[1] == '-') {
2969             s += 2;
2970         }
2971         max = *s++;
2972         for ( ; i <= max; i++) {
2973             todo[i] = 1;
2974         }
2975         for (i = 0; i <= (I32) HvMAX(stash); i++) {
2976             for (entry = HvARRAY(stash)[i];
2977               entry;
2978               entry = entry->hent_next) {
2979                 if (!todo[(U8)*entry->hent_key])
2980                     continue;
2981                 gv = (GV*)entry->hent_val;
2982                 sv = GvSV(gv);
2983                 (void)SvOK_off(sv);
2984                 if (SvTYPE(sv) >= SVt_PV) {
2985                     SvCUR_set(sv, 0);
2986                     SvTAINT(sv);
2987                     if (SvPVX(sv) != Nullch)
2988                         *SvPVX(sv) = '\0';
2989                 }
2990                 if (GvAV(gv)) {
2991                     av_clear(GvAV(gv));
2992                 }
2993                 if (GvHV(gv)) {
2994                     if (HvNAME(GvHV(gv)))
2995                         continue;
2996                     hv_clear(GvHV(gv));
2997 #ifndef VMS  /* VMS has no environ array */
2998                     if (gv == envgv)
2999                         environ[0] = Nullch;
3000 #endif
3001                 }
3002             }
3003         }
3004     }
3005 }
3006
3007 CV *
3008 sv_2cv(sv, st, gvp, lref)
3009 SV *sv;
3010 HV **st;
3011 GV **gvp;
3012 I32 lref;
3013 {
3014     GV *gv;
3015     CV *cv;
3016
3017     if (!sv)
3018         return *gvp = Nullgv, Nullcv;
3019     switch (SvTYPE(sv)) {
3020     case SVt_PVCV:
3021         *st = CvSTASH(sv);
3022         *gvp = Nullgv;
3023         return (CV*)sv;
3024     case SVt_PVHV:
3025     case SVt_PVAV:
3026         *gvp = Nullgv;
3027         return Nullcv;
3028     case SVt_PVGV:
3029         gv = (GV*)sv;
3030         *gvp = gv;
3031         *st = GvESTASH(gv);
3032         goto fix_gv;
3033
3034     default:
3035         if (SvGMAGICAL(sv))
3036             mg_get(sv);
3037         if (SvROK(sv)) {
3038             cv = (CV*)SvRV(sv);
3039             if (SvTYPE(cv) != SVt_PVCV)
3040                 croak("Not a subroutine reference");
3041             *gvp = Nullgv;
3042             *st = CvSTASH(cv);
3043             return cv;
3044         }
3045         if (isGV(sv))
3046             gv = (GV*)sv;
3047         else
3048             gv = gv_fetchpv(SvPV(sv, na), lref, SVt_PVCV);
3049         *gvp = gv;
3050         if (!gv)
3051             return Nullcv;
3052         *st = GvESTASH(gv);
3053     fix_gv:
3054         if (lref && !GvCV(gv)) {
3055             SV *tmpsv;
3056             ENTER;
3057             tmpsv = NEWSV(704,0);
3058             gv_efullname(tmpsv, gv);
3059             newSUB(start_subparse(),
3060                    newSVOP(OP_CONST, 0, tmpsv),
3061                    Nullop,
3062                    Nullop);
3063             LEAVE;
3064             if (!GvCV(gv))
3065                 croak("Unable to create sub named \"%s\"", SvPV(sv,na));
3066         }
3067         return GvCV(gv);
3068     }
3069 }
3070
3071 #ifndef SvTRUE
3072 I32
3073 SvTRUE(sv)
3074 register SV *sv;
3075 {
3076     if (!sv)
3077         return 0;
3078     if (SvGMAGICAL(sv))
3079         mg_get(sv);
3080     if (SvPOK(sv)) {
3081         register XPV* Xpv;
3082         if ((Xpv = (XPV*)SvANY(sv)) &&
3083                 (*Xpv->xpv_pv > '0' ||
3084                 Xpv->xpv_cur > 1 ||
3085                 (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
3086             return 1;
3087         else
3088             return 0;
3089     }
3090     else {
3091         if (SvIOK(sv))
3092             return SvIVX(sv) != 0;
3093         else {
3094             if (SvNOK(sv))
3095                 return SvNVX(sv) != 0.0;
3096             else
3097                 return sv_2bool(sv);
3098         }
3099     }
3100 }
3101 #endif /* SvTRUE */
3102
3103 #ifndef SvIV
3104 IV SvIV(Sv)
3105 register SV *Sv;
3106 {
3107     if (SvIOK(Sv))
3108         return SvIVX(Sv);
3109     return sv_2iv(Sv);
3110 }
3111 #endif /* SvIV */
3112
3113
3114 #ifndef SvNV
3115 double SvNV(Sv)
3116 register SV *Sv;
3117 {
3118     if (SvNOK(Sv))
3119         return SvNVX(Sv);
3120     if (SvIOK(Sv))
3121         return (double)SvIVX(Sv);
3122     return sv_2nv(Sv);
3123 }
3124 #endif /* SvNV */
3125
3126 #ifdef CRIPPLED_CC
3127 char *
3128 sv_pvn(sv, lp)
3129 SV *sv;
3130 STRLEN *lp;
3131 {
3132     if (SvPOK(sv)) {
3133         *lp = SvCUR(sv);
3134         return SvPVX(sv);
3135     }
3136     return sv_2pv(sv, lp);
3137 }
3138 #endif
3139
3140 char *
3141 sv_pvn_force(sv, lp)
3142 SV *sv;
3143 STRLEN *lp;
3144 {
3145     char *s;
3146
3147     if (SvREADONLY(sv) && curcop != &compiling)
3148         croak(no_modify);
3149
3150     if (SvPOK(sv)) {
3151         *lp = SvCUR(sv);
3152     }
3153     else {
3154         if (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM) {
3155             if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) {
3156                 sv_unglob(sv);
3157                 s = SvPVX(sv);
3158                 *lp = SvCUR(sv);
3159             }
3160             else
3161                 croak("Can't coerce %s to string in %s", sv_reftype(sv,0),
3162                     op_name[op->op_type]);
3163         }
3164         else
3165             s = sv_2pv(sv, lp);
3166         if (s != SvPVX(sv)) {   /* Almost, but not quite, sv_setpvn() */
3167             STRLEN len = *lp;
3168
3169             if (SvROK(sv))
3170                 sv_unref(sv);
3171             (void)SvUPGRADE(sv, SVt_PV);                /* Never FALSE */
3172             SvGROW(sv, len + 1);
3173             Move(s,SvPVX(sv),len,char);
3174             SvCUR_set(sv, len);
3175             *SvEND(sv) = '\0';
3176         }
3177         if (!SvPOK(sv)) {
3178             SvPOK_on(sv);               /* validate pointer */
3179             SvTAINT(sv);
3180             DEBUG_c(fprintf(stderr,"0x%lx 2pv(%s)\n",
3181                 (unsigned long)sv,SvPVX(sv)));
3182         }
3183     }
3184     return SvPVX(sv);
3185 }
3186
3187 char *
3188 sv_reftype(sv, ob)
3189 SV* sv;
3190 int ob;
3191 {
3192     if (ob && SvOBJECT(sv))
3193         return HvNAME(SvSTASH(sv));
3194     else {
3195         switch (SvTYPE(sv)) {
3196         case SVt_NULL:
3197         case SVt_IV:
3198         case SVt_NV:
3199         case SVt_RV:
3200         case SVt_PV:
3201         case SVt_PVIV:
3202         case SVt_PVNV:
3203         case SVt_PVMG:
3204         case SVt_PVBM:
3205                                 if (SvROK(sv))
3206                                     return "REF";
3207                                 else
3208                                     return "SCALAR";
3209         case SVt_PVLV:          return "LVALUE";
3210         case SVt_PVAV:          return "ARRAY";
3211         case SVt_PVHV:          return "HASH";
3212         case SVt_PVCV:          return "CODE";
3213         case SVt_PVGV:          return "GLOB";
3214         case SVt_PVFM:          return "FORMLINE";
3215         default:                return "UNKNOWN";
3216         }
3217     }
3218 }
3219
3220 int
3221 sv_isobject(sv)
3222 SV *sv;
3223 {
3224     if (!SvROK(sv))
3225         return 0;
3226     sv = (SV*)SvRV(sv);
3227     if (!SvOBJECT(sv))
3228         return 0;
3229     return 1;
3230 }
3231
3232 int
3233 sv_isa(sv, name)
3234 SV *sv;
3235 char *name;
3236 {
3237     if (!SvROK(sv))
3238         return 0;
3239     sv = (SV*)SvRV(sv);
3240     if (!SvOBJECT(sv))
3241         return 0;
3242
3243     return strEQ(HvNAME(SvSTASH(sv)), name);
3244 }
3245
3246 SV*
3247 newSVrv(rv, classname)
3248 SV *rv;
3249 char *classname;
3250 {
3251     SV *sv;
3252
3253     new_SV();
3254     SvANY(sv) = 0;
3255     SvREFCNT(sv) = 0;
3256     SvFLAGS(sv) = 0;
3257     sv_upgrade(rv, SVt_RV);
3258     SvRV(rv) = SvREFCNT_inc(sv);
3259     SvROK_on(rv);
3260
3261     if (classname) {
3262         HV* stash = gv_stashpv(classname, TRUE);
3263         (void)sv_bless(rv, stash);
3264     }
3265     return sv;
3266 }
3267
3268 SV*
3269 sv_setref_pv(rv, classname, pv)
3270 SV *rv;
3271 char *classname;
3272 void* pv;
3273 {
3274     if (!pv)
3275         sv_setsv(rv, &sv_undef);
3276     else
3277         sv_setiv(newSVrv(rv,classname), (IV)pv);
3278     return rv;
3279 }
3280
3281 SV*
3282 sv_setref_iv(rv, classname, iv)
3283 SV *rv;
3284 char *classname;
3285 IV iv;
3286 {
3287     sv_setiv(newSVrv(rv,classname), iv);
3288     return rv;
3289 }
3290
3291 SV*
3292 sv_setref_nv(rv, classname, nv)
3293 SV *rv;
3294 char *classname;
3295 double nv;
3296 {
3297     sv_setnv(newSVrv(rv,classname), nv);
3298     return rv;
3299 }
3300
3301 SV*
3302 sv_setref_pvn(rv, classname, pv, n)
3303 SV *rv;
3304 char *classname;
3305 char* pv;
3306 I32 n;
3307 {
3308     sv_setpvn(newSVrv(rv,classname), pv, n);
3309     return rv;
3310 }
3311
3312 SV*
3313 sv_bless(sv,stash)
3314 SV* sv;
3315 HV* stash;
3316 {
3317     SV *ref;
3318     if (!SvROK(sv))
3319         croak("Can't bless non-reference value");
3320     ref = SvRV(sv);
3321     if (SvFLAGS(ref) & (SVs_OBJECT|SVf_READONLY)) {
3322         if (SvREADONLY(ref))
3323             croak(no_modify);
3324         if (SvOBJECT(ref) && SvTYPE(ref) != SVt_PVIO)
3325             --sv_objcount;
3326     }
3327     SvOBJECT_on(ref);
3328     ++sv_objcount;
3329     (void)SvUPGRADE(ref, SVt_PVMG);
3330     SvSTASH(ref) = (HV*)SvREFCNT_inc(stash);
3331
3332 #ifdef OVERLOAD
3333     SvAMAGIC_off(sv);
3334     if (Gv_AMG(stash)) {
3335       SvAMAGIC_on(sv);
3336     }
3337 #endif /* OVERLOAD */
3338
3339     return sv;
3340 }
3341
3342 static void
3343 sv_unglob(sv)
3344 SV* sv;
3345 {
3346     assert(SvTYPE(sv) == SVt_PVGV);
3347     SvFAKE_off(sv);
3348     if (GvGP(sv))
3349         gp_free(sv);
3350     sv_unmagic(sv, '*');
3351     Safefree(GvNAME(sv));
3352     SvMULTI_off(sv);
3353     SvFLAGS(sv) &= ~SVTYPEMASK;
3354     SvFLAGS(sv) |= SVt_PVMG;
3355 }
3356
3357 void
3358 sv_unref(sv)
3359 SV* sv;
3360 {
3361     SV* rv = SvRV(sv);
3362
3363     SvRV(sv) = 0;
3364     SvROK_off(sv);
3365     if (SvREFCNT(rv) != 1 || SvREADONLY(rv))
3366         SvREFCNT_dec(rv);
3367     else
3368         sv_2mortal(rv);         /* Schedule for freeing later */
3369 }
3370
3371 #ifdef DEBUGGING
3372 void
3373 sv_dump(sv)
3374 SV* sv;
3375 {
3376     char tmpbuf[1024];
3377     char *d = tmpbuf;
3378     U32 flags;
3379     U32 type;
3380
3381     if (!sv) {
3382         fprintf(stderr, "SV = 0\n");
3383         return;
3384     }
3385
3386     flags = SvFLAGS(sv);
3387     type = SvTYPE(sv);
3388
3389     sprintf(d, "(0x%lx)\n  REFCNT = %ld\n  FLAGS = (",
3390         (unsigned long)SvANY(sv), (long)SvREFCNT(sv));
3391     d += strlen(d);
3392     if (flags & SVs_PADBUSY)    strcat(d, "PADBUSY,");
3393     if (flags & SVs_PADTMP)     strcat(d, "PADTMP,");
3394     if (flags & SVs_PADMY)      strcat(d, "PADMY,");
3395     if (flags & SVs_TEMP)       strcat(d, "TEMP,");
3396     if (flags & SVs_OBJECT)     strcat(d, "OBJECT,");
3397     if (flags & SVs_GMG)        strcat(d, "GMG,");
3398     if (flags & SVs_SMG)        strcat(d, "SMG,");
3399     if (flags & SVs_RMG)        strcat(d, "RMG,");
3400     d += strlen(d);
3401
3402     if (flags & SVf_IOK)        strcat(d, "IOK,");
3403     if (flags & SVf_NOK)        strcat(d, "NOK,");
3404     if (flags & SVf_POK)        strcat(d, "POK,");
3405     if (flags & SVf_ROK)        strcat(d, "ROK,");
3406     if (flags & SVf_OOK)        strcat(d, "OOK,");
3407     if (flags & SVf_FAKE)       strcat(d, "FAKE,");
3408     if (flags & SVf_READONLY)   strcat(d, "READONLY,");
3409     d += strlen(d);
3410
3411     if (flags & SVp_IOK)        strcat(d, "pIOK,");
3412     if (flags & SVp_NOK)        strcat(d, "pNOK,");
3413     if (flags & SVp_POK)        strcat(d, "pPOK,");
3414     if (flags & SVp_SCREAM)     strcat(d, "SCREAM,");
3415     d += strlen(d);
3416     if (d[-1] == ',')
3417         d--;
3418     *d++ = ')';
3419     *d = '\0';
3420
3421     fprintf(stderr, "SV = ");
3422     switch (type) {
3423     case SVt_NULL:
3424         fprintf(stderr,"NULL%s\n", tmpbuf);
3425         return;
3426     case SVt_IV:
3427         fprintf(stderr,"IV%s\n", tmpbuf);
3428         break;
3429     case SVt_NV:
3430         fprintf(stderr,"NV%s\n", tmpbuf);
3431         break;
3432     case SVt_RV:
3433         fprintf(stderr,"RV%s\n", tmpbuf);
3434         break;
3435     case SVt_PV:
3436         fprintf(stderr,"PV%s\n", tmpbuf);
3437         break;
3438     case SVt_PVIV:
3439         fprintf(stderr,"PVIV%s\n", tmpbuf);
3440         break;
3441     case SVt_PVNV:
3442         fprintf(stderr,"PVNV%s\n", tmpbuf);
3443         break;
3444     case SVt_PVBM:
3445         fprintf(stderr,"PVBM%s\n", tmpbuf);
3446         break;
3447     case SVt_PVMG:
3448         fprintf(stderr,"PVMG%s\n", tmpbuf);
3449         break;
3450     case SVt_PVLV:
3451         fprintf(stderr,"PVLV%s\n", tmpbuf);
3452         break;
3453     case SVt_PVAV:
3454         fprintf(stderr,"PVAV%s\n", tmpbuf);
3455         break;
3456     case SVt_PVHV:
3457         fprintf(stderr,"PVHV%s\n", tmpbuf);
3458         break;
3459     case SVt_PVCV:
3460         fprintf(stderr,"PVCV%s\n", tmpbuf);
3461         break;
3462     case SVt_PVGV:
3463         fprintf(stderr,"PVGV%s\n", tmpbuf);
3464         break;
3465     case SVt_PVFM:
3466         fprintf(stderr,"PVFM%s\n", tmpbuf);
3467         break;
3468     case SVt_PVIO:
3469         fprintf(stderr,"PVIO%s\n", tmpbuf);
3470         break;
3471     default:
3472         fprintf(stderr,"UNKNOWN%s\n", tmpbuf);
3473         return;
3474     }
3475     if (type >= SVt_PVIV || type == SVt_IV)
3476         fprintf(stderr, "  IV = %ld\n", (long)SvIVX(sv));
3477     if (type >= SVt_PVNV || type == SVt_NV)
3478         fprintf(stderr, "  NV = %.*g\n", DBL_DIG, SvNVX(sv));
3479     if (SvROK(sv)) {
3480         fprintf(stderr, "  RV = 0x%lx\n", (long)SvRV(sv));
3481         sv_dump(SvRV(sv));
3482         return;
3483     }
3484     if (type < SVt_PV)
3485         return;
3486     if (type <= SVt_PVLV) {
3487         if (SvPVX(sv))
3488             fprintf(stderr, "  PV = 0x%lx \"%s\"\n  CUR = %ld\n  LEN = %ld\n",
3489                 (long)SvPVX(sv), SvPVX(sv), (long)SvCUR(sv), (long)SvLEN(sv));
3490         else
3491             fprintf(stderr, "  PV = 0\n");
3492     }
3493     if (type >= SVt_PVMG) {
3494         if (SvMAGIC(sv)) {
3495             fprintf(stderr, "  MAGIC = 0x%lx\n", (long)SvMAGIC(sv));
3496         }
3497         if (SvSTASH(sv))
3498             fprintf(stderr, "  STASH = %s\n", HvNAME(SvSTASH(sv)));
3499     }
3500     switch (type) {
3501     case SVt_PVLV:
3502         fprintf(stderr, "  TYPE = %c\n", LvTYPE(sv));
3503         fprintf(stderr, "  TARGOFF = %ld\n", (long)LvTARGOFF(sv));
3504         fprintf(stderr, "  TARGLEN = %ld\n", (long)LvTARGLEN(sv));
3505         fprintf(stderr, "  TARG = 0x%lx\n", (long)LvTARG(sv));
3506         sv_dump(LvTARG(sv));
3507         break;
3508     case SVt_PVAV:
3509         fprintf(stderr, "  ARRAY = 0x%lx\n", (long)AvARRAY(sv));
3510         fprintf(stderr, "  ALLOC = 0x%lx\n", (long)AvALLOC(sv));
3511         fprintf(stderr, "  FILL = %ld\n", (long)AvFILL(sv));
3512         fprintf(stderr, "  MAX = %ld\n", (long)AvMAX(sv));
3513         fprintf(stderr, "  ARYLEN = 0x%lx\n", (long)AvARYLEN(sv));
3514         flags = AvFLAGS(sv);
3515         d = tmpbuf;
3516         if (flags & AVf_REAL)   strcat(d, "REAL,");
3517         if (flags & AVf_REIFY)  strcat(d, "REIFY,");
3518         if (flags & AVf_REUSED) strcat(d, "REUSED,");
3519         if (*d)
3520             d[strlen(d)-1] = '\0';
3521         fprintf(stderr, "  FLAGS = (%s)\n", d);
3522         break;
3523     case SVt_PVHV:
3524         fprintf(stderr, "  ARRAY = 0x%lx\n",(long)HvARRAY(sv));
3525         fprintf(stderr, "  KEYS = %ld\n", (long)HvKEYS(sv));
3526         fprintf(stderr, "  FILL = %ld\n", (long)HvFILL(sv));
3527         fprintf(stderr, "  MAX = %ld\n", (long)HvMAX(sv));
3528         fprintf(stderr, "  RITER = %ld\n", (long)HvRITER(sv));
3529         fprintf(stderr, "  EITER = 0x%lx\n",(long) HvEITER(sv));
3530         if (HvPMROOT(sv))
3531             fprintf(stderr, "  PMROOT = 0x%lx\n",(long)HvPMROOT(sv));
3532         if (HvNAME(sv))
3533             fprintf(stderr, "  NAME = \"%s\"\n", HvNAME(sv));
3534         break;
3535     case SVt_PVFM:
3536     case SVt_PVCV:
3537         fprintf(stderr, "  STASH = 0x%lx\n", (long)CvSTASH(sv));
3538         fprintf(stderr, "  START = 0x%lx\n", (long)CvSTART(sv));
3539         fprintf(stderr, "  ROOT = 0x%lx\n", (long)CvROOT(sv));
3540         fprintf(stderr, "  XSUB = 0x%lx\n", (long)CvXSUB(sv));
3541         fprintf(stderr, "  XSUBANY = %ld\n", (long)CvXSUBANY(sv).any_i32);
3542         fprintf(stderr, "  FILEGV = 0x%lx\n", (long)CvFILEGV(sv));
3543         fprintf(stderr, "  DEPTH = %ld\n", (long)CvDEPTH(sv));
3544         fprintf(stderr, "  PADLIST = 0x%lx\n", (long)CvPADLIST(sv));
3545         fprintf(stderr, "  OUTSIDE = 0x%lx\n", (long)CvOUTSIDE(sv));
3546         if (type == SVt_PVFM)
3547             fprintf(stderr, "  LINES = %ld\n", (long)FmLINES(sv));
3548         break;
3549     case SVt_PVGV:
3550         fprintf(stderr, "  NAME = %s\n", GvNAME(sv));
3551         fprintf(stderr, "  NAMELEN = %ld\n", (long)GvNAMELEN(sv));
3552         fprintf(stderr, "  STASH = 0x%lx\n", (long)GvSTASH(sv));
3553         fprintf(stderr, "  GP = 0x%lx\n", (long)GvGP(sv));
3554         fprintf(stderr, "    SV = 0x%lx\n", (long)GvSV(sv));
3555         fprintf(stderr, "    REFCNT = %ld\n", (long)GvREFCNT(sv));
3556         fprintf(stderr, "    IO = 0x%lx\n", (long)GvIOp(sv));
3557         fprintf(stderr, "    FORM = 0x%lx\n", (long)GvFORM(sv));
3558         fprintf(stderr, "    AV = 0x%lx\n", (long)GvAV(sv));
3559         fprintf(stderr, "    HV = 0x%lx\n", (long)GvHV(sv));
3560         fprintf(stderr, "    CV = 0x%lx\n", (long)GvCV(sv));
3561         fprintf(stderr, "    CVGEN = 0x%lx\n", (long)GvCVGEN(sv));
3562         fprintf(stderr, "    LASTEXPR = %ld\n", (long)GvLASTEXPR(sv));
3563         fprintf(stderr, "    LINE = %ld\n", (long)GvLINE(sv));
3564         fprintf(stderr, "    FLAGS = 0x%x\n", (int)GvFLAGS(sv));
3565         fprintf(stderr, "    STASH = 0x%lx\n", (long)GvSTASH(sv));
3566         fprintf(stderr, "    EGV = 0x%lx\n", (long)GvEGV(sv));
3567         break;
3568     case SVt_PVIO:
3569         fprintf(stderr, "  IFP = 0x%lx\n", (long)IoIFP(sv));
3570         fprintf(stderr, "  OFP = 0x%lx\n", (long)IoOFP(sv));
3571         fprintf(stderr, "  DIRP = 0x%lx\n", (long)IoDIRP(sv));
3572         fprintf(stderr, "  LINES = %ld\n", (long)IoLINES(sv));
3573         fprintf(stderr, "  PAGE = %ld\n", (long)IoPAGE(sv));
3574         fprintf(stderr, "  PAGE_LEN = %ld\n", (long)IoPAGE_LEN(sv));
3575         fprintf(stderr, "  LINES_LEFT = %ld\n", (long)IoLINES_LEFT(sv));
3576         fprintf(stderr, "  TOP_NAME = %s\n", IoTOP_NAME(sv));
3577         fprintf(stderr, "  TOP_GV = 0x%lx\n", (long)IoTOP_GV(sv));
3578         fprintf(stderr, "  FMT_NAME = %s\n", IoFMT_NAME(sv));
3579         fprintf(stderr, "  FMT_GV = 0x%lx\n", (long)IoFMT_GV(sv));
3580         fprintf(stderr, "  BOTTOM_NAME = %s\n", IoBOTTOM_NAME(sv));
3581         fprintf(stderr, "  BOTTOM_GV = 0x%lx\n", (long)IoBOTTOM_GV(sv));
3582         fprintf(stderr, "  SUBPROCESS = %ld\n", (long)IoSUBPROCESS(sv));
3583         fprintf(stderr, "  TYPE = %c\n", IoTYPE(sv));
3584         fprintf(stderr, "  FLAGS = 0x%lx\n", (long)IoFLAGS(sv));
3585         break;
3586     }
3587 }
3588 #else
3589 void
3590 sv_dump(sv)
3591 SV* sv;
3592 {
3593 }
3594 #endif
3595
3596 IO*
3597 sv_2io(sv)
3598 SV *sv;
3599 {
3600     IO* io;
3601     GV* gv;
3602
3603     switch (SvTYPE(sv)) {
3604     case SVt_PVIO:
3605         io = (IO*)sv;
3606         break;
3607     case SVt_PVGV:
3608         gv = (GV*)sv;
3609         io = GvIO(gv);
3610         if (!io)
3611             croak("Bad filehandle: %s", GvNAME(gv));
3612         break;
3613     default:
3614         if (!SvOK(sv))
3615             croak(no_usym, "filehandle");
3616         if (SvROK(sv))
3617             return sv_2io(SvRV(sv));
3618         gv = gv_fetchpv(SvPV(sv,na), FALSE, SVt_PVIO);
3619         if (gv)
3620             io = GvIO(gv);
3621         else
3622             io = 0;
3623         if (!io)
3624             croak("Bad filehandle: %s", SvPV(sv,na));
3625         break;
3626     }
3627     return io;
3628 }
3629