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