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