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