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