sv.c

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