sv.c

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