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