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