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