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 bool
  54 sv_upgrade(sv, mt)
  55 register SV* sv;
  56 U32 mt;
  57 {
  58     char*       pv;
  59     U32         cur;
  60     U32         len;
  61     I32         iv;
  62     double      nv;
  63     MAGIC*      magic;
  64     HV*         stash;
  65
  66     if (SvTYPE(sv) == mt)
  67         return TRUE;
  68
  69     switch (SvTYPE(sv)) {
  70     case SVt_NULL:
  71         pv      = 0;
  72         cur     = 0;
  73         len     = 0;
  74         iv      = 0;
  75         nv      = 0.0;
  76         magic   = 0;
  77         stash   = 0;
  78         break;
  79     case SVt_REF:
  80         sv_free((SV*)SvANY(sv));
  81         pv      = 0;
  82         cur     = 0;
  83         len     = 0;
  84         iv      = SvANYI32(sv);
  85         nv      = (double)SvANYI32(sv);
  86         SvNOK_only(sv);
  87         magic   = 0;
  88         stash   = 0;
  89         if (mt == SVt_PV)
  90             mt = SVt_PVIV;
  91         break;
  92     case SVt_IV:
  93         pv      = 0;
  94         cur     = 0;
  95         len     = 0;
  96         iv      = SvIV(sv);
  97         nv      = (double)SvIV(sv);
  98         del_XIV(SvANY(sv));
  99         magic   = 0;
 100         stash   = 0;
 101         if (mt == SVt_PV)
 102             mt = SVt_PVIV;
 103         break;
 104     case SVt_NV:
 105         pv      = 0;
 106         cur     = 0;
 107         len     = 0;
 108         if (SvIOK(sv))
 109             iv  = SvIV(sv);
 110         else
 111             iv  = (I32)SvNV(sv);
 112         nv      = SvNV(sv);
 113         magic   = 0;
 114         stash   = 0;
 115         del_XNV(SvANY(sv));
 116         SvANY(sv) = 0;
 117         if (mt == SVt_PV || mt == SVt_PVIV)
 118             mt = SVt_PVNV;
 119         break;
 120     case SVt_PV:
 121         nv = 0.0;
 122         pv      = SvPV(sv);
 123         cur     = SvCUR(sv);
 124         len     = SvLEN(sv);
 125         iv      = 0;
 126         nv      = 0.0;
 127         magic   = 0;
 128         stash   = 0;
 129         del_XPV(SvANY(sv));
 130         break;
 131     case SVt_PVIV:
 132         nv = 0.0;
 133         pv      = SvPV(sv);
 134         cur     = SvCUR(sv);
 135         len     = SvLEN(sv);
 136         iv      = SvIV(sv);
 137         nv      = 0.0;
 138         magic   = 0;
 139         stash   = 0;
 140         del_XPVIV(SvANY(sv));
 141         break;
 142     case SVt_PVNV:
 143         nv = SvNV(sv);
 144         pv      = SvPV(sv);
 145         cur     = SvCUR(sv);
 146         len     = SvLEN(sv);
 147         iv      = SvIV(sv);
 148         nv      = SvNV(sv);
 149         magic   = 0;
 150         stash   = 0;
 151         del_XPVNV(SvANY(sv));
 152         break;
 153     case SVt_PVMG:
 154         pv      = SvPV(sv);
 155         cur     = SvCUR(sv);
 156         len     = SvLEN(sv);
 157         iv      = SvIV(sv);
 158         nv      = SvNV(sv);
 159         magic   = SvMAGIC(sv);
 160         stash   = SvSTASH(sv);
 161         del_XPVMG(SvANY(sv));
 162         break;
 163     default:
 164         fatal("Can't upgrade that kind of scalar");
 165     }
 166
 167     switch (mt) {
 168     case SVt_NULL:
 169         fatal("Can't upgrade to undef");
 170     case SVt_REF:
 171         SvIOK_on(sv);
 172         break;
 173     case SVt_IV:
 174         SvANY(sv) = new_XIV();
 175         SvIV(sv)        = iv;
 176         break;
 177     case SVt_NV:
 178         SvANY(sv) = new_XNV();
 179         SvIV(sv)        = iv;
 180         SvNV(sv)        = nv;
 181         break;
 182     case SVt_PV:
 183         SvANY(sv) = new_XPV();
 184         SvPV(sv)        = pv;
 185         SvCUR(sv)       = cur;
 186         SvLEN(sv)       = len;
 187         break;
 188     case SVt_PVIV:
 189         SvANY(sv) = new_XPVIV();
 190         SvPV(sv)        = pv;
 191         SvCUR(sv)       = cur;
 192         SvLEN(sv)       = len;
 193         SvIV(sv)        = iv;
 194         if (SvNIOK(sv))
 195             SvIOK_on(sv);
 196         SvNOK_off(sv);
 197         break;
 198     case SVt_PVNV:
 199         SvANY(sv) = new_XPVNV();
 200         SvPV(sv)        = pv;
 201         SvCUR(sv)       = cur;
 202         SvLEN(sv)       = len;
 203         SvIV(sv)        = iv;
 204         SvNV(sv)        = nv;
 205         break;
 206     case SVt_PVMG:
 207         SvANY(sv) = new_XPVMG();
 208         SvPV(sv)        = pv;
 209         SvCUR(sv)       = cur;
 210         SvLEN(sv)       = len;
 211         SvIV(sv)        = iv;
 212         SvNV(sv)        = nv;
 213         SvMAGIC(sv)     = magic;
 214         SvSTASH(sv)     = stash;
 215         break;
 216     case SVt_PVLV:
 217         SvANY(sv) = new_XPVLV();
 218         SvPV(sv)        = pv;
 219         SvCUR(sv)       = cur;
 220         SvLEN(sv)       = len;
 221         SvIV(sv)        = iv;
 222         SvNV(sv)        = nv;
 223         SvMAGIC(sv)     = magic;
 224         SvSTASH(sv)     = stash;
 225         LvTARGOFF(sv)   = 0;
 226         LvTARGLEN(sv)   = 0;
 227         LvTARG(sv)      = 0;
 228         LvTYPE(sv)      = 0;
 229         break;
 230     case SVt_PVAV:
 231         SvANY(sv) = new_XPVAV();
 232         SvPV(sv)        = pv;
 233         SvCUR(sv)       = cur;
 234         SvLEN(sv)       = len;
 235         SvIV(sv)        = iv;
 236         SvNV(sv)        = nv;
 237         SvMAGIC(sv)     = magic;
 238         SvSTASH(sv)     = stash;
 239         AvMAGIC(sv)     = 0;
 240         AvARRAY(sv)     = 0;
 241         AvALLOC(sv)     = 0;
 242         AvMAX(sv)       = 0;
 243         AvFILL(sv)      = 0;
 244         AvARYLEN(sv)    = 0;
 245         AvFLAGS(sv)     = 0;
 246         break;
 247     case SVt_PVHV:
 248         SvANY(sv) = new_XPVHV();
 249         SvPV(sv)        = pv;
 250         SvCUR(sv)       = cur;
 251         SvLEN(sv)       = len;
 252         SvIV(sv)        = iv;
 253         SvNV(sv)        = nv;
 254         SvMAGIC(sv)     = magic;
 255         SvSTASH(sv)     = stash;
 256         HvMAGIC(sv)     = 0;
 257         HvARRAY(sv)     = 0;
 258         HvMAX(sv)       = 0;
 259         HvDOSPLIT(sv)   = 0;
 260         HvFILL(sv)      = 0;
 261         HvRITER(sv)     = 0;
 262         HvEITER(sv)     = 0;
 263         HvPMROOT(sv)    = 0;
 264         HvNAME(sv)      = 0;
 265         HvDBM(sv)       = 0;
 266         HvCOEFFSIZE(sv) = 0;
 267         break;
 268     case SVt_PVCV:
 269         SvANY(sv) = new_XPVCV();
 270         SvPV(sv)        = pv;
 271         SvCUR(sv)       = cur;
 272         SvLEN(sv)       = len;
 273         SvIV(sv)        = iv;
 274         SvNV(sv)        = nv;
 275         SvMAGIC(sv)     = magic;
 276         SvSTASH(sv)     = stash;
 277         CvSTASH(sv)     = 0;
 278         CvSTART(sv)     = 0;
 279         CvROOT(sv)      = 0;
 280         CvUSERSUB(sv)   = 0;
 281         CvUSERINDEX(sv) = 0;
 282         CvFILEGV(sv)    = 0;
 283         CvDEPTH(sv)     = 0;
 284         CvPADLIST(sv)   = 0;
 285         CvDELETED(sv)   = 0;
 286         break;
 287     case SVt_PVGV:
 288         SvANY(sv) = new_XPVGV();
 289         SvPV(sv)        = pv;
 290         SvCUR(sv)       = cur;
 291         SvLEN(sv)       = len;
 292         SvIV(sv)        = iv;
 293         SvNV(sv)        = nv;
 294         SvMAGIC(sv)     = magic;
 295         SvSTASH(sv)     = stash;
 296         GvNAME(sv)      = 0;
 297         GvNAMELEN(sv)   = 0;
 298         GvSTASH(sv)     = 0;
 299         break;
 300     case SVt_PVBM:
 301         SvANY(sv) = new_XPVBM();
 302         SvPV(sv)        = pv;
 303         SvCUR(sv)       = cur;
 304         SvLEN(sv)       = len;
 305         SvIV(sv)        = iv;
 306         SvNV(sv)        = nv;
 307         SvMAGIC(sv)     = magic;
 308         SvSTASH(sv)     = stash;
 309         BmRARE(sv)      = 0;
 310         BmUSEFUL(sv)    = 0;
 311         BmPREVIOUS(sv)  = 0;
 312         break;
 313     case SVt_PVFM:
 314         SvANY(sv) = new_XPVFM();
 315         SvPV(sv)        = pv;
 316         SvCUR(sv)       = cur;
 317         SvLEN(sv)       = len;
 318         SvIV(sv)        = iv;
 319         SvNV(sv)        = nv;
 320         SvMAGIC(sv)     = magic;
 321         SvSTASH(sv)     = stash;
 322         FmLINES(sv)     = 0;
 323         break;
 324     }
 325     SvTYPE(sv) = mt;
 326     return TRUE;
 327 }
 328
 329 char *
 330 sv_peek(sv)
 331 register SV *sv;
 332 {
 333     char *t = tokenbuf;
 334     *t = '\0';
 335
 336   retry:
 337     if (!sv) {
 338         strcpy(t, "VOID");
 339         return tokenbuf;
 340     }
 341     else if (sv == (SV*)0x55555555 || SvTYPE(sv) == 'U') {
 342         strcpy(t, "WILD");
 343         return tokenbuf;
 344     }
 345     else if (SvREFCNT(sv) == 0 && !SvREADONLY(sv)) {
 346         strcpy(t, "UNREF");
 347         return tokenbuf;
 348     }
 349     else {
 350         switch (SvTYPE(sv)) {
 351         default:
 352             strcpy(t,"FREED");
 353             return tokenbuf;
 354             break;
 355
 356         case SVt_NULL:
 357             return "UNDEF";
 358         case SVt_REF:
 359             strcpy(t, "\\");
 360             t += strlen(t);
 361             sv = (SV*)SvANY(sv);
 362             goto retry;
 363         case SVt_IV:
 364             strcpy(t,"IV");
 365             break;
 366         case SVt_NV:
 367             strcpy(t,"NV");
 368             break;
 369         case SVt_PV:
 370             strcpy(t,"PV");
 371             break;
 372         case SVt_PVIV:
 373             strcpy(t,"PVIV");
 374             break;
 375         case SVt_PVNV:
 376             strcpy(t,"PVNV");
 377             break;
 378         case SVt_PVMG:
 379             strcpy(t,"PVMG");
 380             break;
 381         case SVt_PVLV:
 382             strcpy(t,"PVLV");
 383             break;
 384         case SVt_PVAV:
 385             strcpy(t,"AV");
 386             break;
 387         case SVt_PVHV:
 388             strcpy(t,"HV");
 389             break;
 390         case SVt_PVCV:
 391             strcpy(t,"CV");
 392             break;
 393         case SVt_PVGV:
 394             strcpy(t,"GV");
 395             break;
 396         case SVt_PVBM:
 397             strcpy(t,"BM");
 398             break;
 399         case SVt_PVFM:
 400             strcpy(t,"FM");
 401             break;
 402         }
 403     }
 404     t += strlen(t);
 405
 406     if (SvPOK(sv)) {
 407         if (!SvPV(sv))
 408             return "(null)";
 409         if (SvOOK(sv))
 410             sprintf(t,"(%d+\"%0.127s\")",SvIV(sv),SvPV(sv));
 411         else
 412             sprintf(t,"(\"%0.127s\")",SvPV(sv));
 413     }
 414     else if (SvNOK(sv))
 415         sprintf(t,"(%g)",SvNV(sv));
 416     else if (SvIOK(sv))
 417         sprintf(t,"(%ld)",(long)SvIV(sv));
 418     else
 419         strcpy(t,"()");
 420     return tokenbuf;
 421 }
 422
 423 int
 424 sv_backoff(sv)
 425 register SV *sv;
 426 {
 427     assert(SvOOK(sv));
 428     if (SvIV(sv)) {
 429         char *s = SvPV(sv);
 430         SvLEN(sv) += SvIV(sv);
 431         SvPV(sv) -= SvIV(sv);
 432         SvIV_set(sv, 0);
 433         Move(s, SvPV(sv), SvCUR(sv)+1, char);
 434     }
 435     SvFLAGS(sv) &= ~SVf_OOK;
 436 }
 437
 438 char *
 439 sv_grow(sv,newlen)
 440 register SV *sv;
 441 #ifndef DOSISH
 442 register I32 newlen;
 443 #else
 444 unsigned long newlen;
 445 #endif
 446 {
 447     register char *s;
 448
 449 #ifdef MSDOS
 450     if (newlen >= 0x10000) {
 451         fprintf(stderr, "Allocation too large: %lx\n", newlen);
 452         my_exit(1);
 453     }
 454 #endif /* MSDOS */
 455     if (SvREADONLY(sv))
 456         fatal(no_modify);
 457     if (SvTYPE(sv) < SVt_PV) {
 458         sv_upgrade(sv, SVt_PV);
 459         s = SvPV(sv);
 460     }
 461     else if (SvOOK(sv)) {       /* pv is offset? */
 462         sv_backoff(sv);
 463         s = SvPV(sv);
 464         if (newlen > SvLEN(sv))
 465             newlen += 10 * (newlen - SvCUR(sv)); /* avoid copy each time */
 466     }
 467     else
 468         s = SvPV(sv);
 469     if (newlen > SvLEN(sv)) {           /* need more room? */
 470         if (SvLEN(sv))
 471             Renew(s,newlen,char);
 472         else
 473             New(703,s,newlen,char);
 474         SvPV_set(sv, s);
 475         SvLEN_set(sv, newlen);
 476     }
 477     return s;
 478 }
 479
 480 void
 481 sv_setiv(sv,i)
 482 register SV *sv;
 483 I32 i;
 484 {
 485     if (SvREADONLY(sv))
 486         fatal(no_modify);
 487     if (SvTYPE(sv) < SVt_IV)
 488         sv_upgrade(sv, SVt_IV);
 489     else if (SvTYPE(sv) == SVt_PV)
 490         sv_upgrade(sv, SVt_PVIV);
 491     SvIV(sv) = i;
 492     SvIOK_only(sv);                     /* validate number */
 493     SvTDOWN(sv);
 494 }
 495
 496 void
 497 sv_setnv(sv,num)
 498 register SV *sv;
 499 double num;
 500 {
 501     if (SvREADONLY(sv))
 502         fatal(no_modify);
 503     if (SvTYPE(sv) < SVt_NV)
 504         sv_upgrade(sv, SVt_NV);
 505     else if (SvTYPE(sv) < SVt_PVNV)
 506         sv_upgrade(sv, SVt_PVNV);
 507     else if (SvPOK(sv)) {
 508         SvOOK_off(sv);
 509     }
 510     SvNV(sv) = num;
 511     SvNOK_only(sv);                     /* validate number */
 512     SvTDOWN(sv);
 513 }
 514
 515 I32
 516 sv_2iv(sv)
 517 register SV *sv;
 518 {
 519     if (!sv)
 520         return 0;
 521     if (SvREADONLY(sv)) {
 522         if (SvNOK(sv))
 523             return (I32)SvNV(sv);
 524         if (SvPOK(sv) && SvLEN(sv))
 525             return atof(SvPV(sv));
 526         if (dowarn)
 527             warn("Use of uninitialized variable");
 528         return 0;
 529     }
 530     if (SvTYPE(sv) < SVt_IV) {
 531         if (SvTYPE(sv) == SVt_REF)
 532             return (I32)SvANYI32(sv);
 533         sv_upgrade(sv, SVt_IV);
 534         DEBUG_c((stderr,"0x%lx num(%g)\n",sv,SvIV(sv)));
 535         return SvIV(sv);
 536     }
 537     else if (SvTYPE(sv) == SVt_PV)
 538         sv_upgrade(sv, SVt_PVIV);
 539     if (SvNOK(sv))
 540         SvIV(sv) = (I32)SvNV(sv);
 541     else if (SvPOK(sv) && SvLEN(sv))
 542         SvIV(sv) = atol(SvPV(sv));
 543     else  {
 544         if (dowarn)
 545             warn("Use of uninitialized variable");
 546         SvUPGRADE(sv, SVt_IV);
 547         SvIV(sv) = 0;
 548     }
 549     SvIOK_on(sv);
 550     DEBUG_c((stderr,"0x%lx 2iv(%d)\n",sv,SvIV(sv)));
 551     return SvIV(sv);
 552 }
 553
 554 double
 555 sv_2nv(sv)
 556 register SV *sv;
 557 {
 558     if (!sv)
 559         return 0.0;
 560     if (SvREADONLY(sv)) {
 561         if (SvPOK(sv) && SvLEN(sv))
 562             return atof(SvPV(sv));
 563         if (dowarn)
 564             warn("Use of uninitialized variable");
 565         return 0.0;
 566     }
 567     if (SvTYPE(sv) < SVt_NV) {
 568         if (SvTYPE(sv) == SVt_REF)
 569             return (double)SvANYI32(sv);
 570         sv_upgrade(sv, SVt_NV);
 571         DEBUG_c((stderr,"0x%lx num(%g)\n",sv,SvNV(sv)));
 572         return SvNV(sv);
 573     }
 574     else if (SvTYPE(sv) < SVt_PVNV)
 575         sv_upgrade(sv, SVt_PVNV);
 576     if (SvPOK(sv) && SvLEN(sv))
 577         SvNV(sv) = atof(SvPV(sv));
 578     else if (SvIOK(sv))
 579         SvNV(sv) = (double)SvIV(sv);
 580     else  {
 581         if (dowarn)
 582             warn("Use of uninitialized variable");
 583         SvNV(sv) = 0.0;
 584     }
 585     SvNOK_on(sv);
 586     DEBUG_c((stderr,"0x%lx 2nv(%g)\n",sv,SvNV(sv)));
 587     return SvNV(sv);
 588 }
 589
 590 char *
 591 sv_2pv(sv)
 592 register SV *sv;
 593 {
 594     register char *s;
 595     int olderrno;
 596
 597     if (!sv)
 598         return "";
 599     if (SvTYPE(sv) == SVt_REF) {
 600         sv = (SV*)SvANY(sv);
 601         if (!sv)
 602             return "<Empty reference>";
 603         switch (SvTYPE(sv)) {
 604         case SVt_NULL:  s = "an undefined value";               break;
 605         case SVt_REF:   s = "a reference";                      break;
 606         case SVt_IV:    s = "an integer value";                 break;
 607         case SVt_NV:    s = "a numeric value";                  break;
 608         case SVt_PV:    s = "a string value";                   break;
 609         case SVt_PVIV:  s = "a string+integer value";           break;
 610         case SVt_PVNV:  s = "a scalar value";                   break;
 611         case SVt_PVMG:  s = "a magic value";                    break;
 612         case SVt_PVLV:  s = "an lvalue";                        break;
 613         case SVt_PVAV:  s = "an array value";                   break;
 614         case SVt_PVHV:  s = "an associative array value";       break;
 615         case SVt_PVCV:  s = "a code value";                     break;
 616         case SVt_PVGV:  s = "a glob value";                     break;
 617         case SVt_PVBM:  s = "a search string";                  break;
 618         case SVt_PVFM:  s = "a formatline";                     break;
 619         default:        s = "something weird";                  break;
 620         }
 621         sprintf(tokenbuf,"<Reference to %s at 0x%lx>", s, (unsigned long)sv);
 622         return tokenbuf;
 623     }
 624     if (SvREADONLY(sv)) {
 625         if (SvIOK(sv)) {
 626             (void)sprintf(tokenbuf,"%ld",SvIV(sv));
 627             return tokenbuf;
 628         }
 629         if (SvNOK(sv)) {
 630             (void)sprintf(tokenbuf,"%.20g",SvNV(sv));
 631             return tokenbuf;
 632         }
 633         if (dowarn)
 634             warn("Use of uninitialized variable");
 635         return "";
 636     }
 637     if (!SvUPGRADE(sv, SVt_PV))
 638         return 0;
 639     if (SvNOK(sv)) {
 640         if (SvTYPE(sv) < SVt_PVNV)
 641             sv_upgrade(sv, SVt_PVNV);
 642         SvGROW(sv, 28);
 643         s = SvPV(sv);
 644         olderrno = errno;       /* some Xenix systems wipe out errno here */
 645 #if defined(scs) && defined(ns32000)
 646         gcvt(SvNV(sv),20,s);
 647 #else
 648 #ifdef apollo
 649         if (SvNV(sv) == 0.0)
 650             (void)strcpy(s,"0");
 651         else
 652 #endif /*apollo*/
 653         (void)sprintf(s,"%.20g",SvNV(sv));
 654 #endif /*scs*/
 655         errno = olderrno;
 656         while (*s) s++;
 657 #ifdef hcx
 658         if (s[-1] == '.')
 659             s--;
 660 #endif
 661     }
 662     else if (SvIOK(sv)) {
 663         if (SvTYPE(sv) < SVt_PVIV)
 664             sv_upgrade(sv, SVt_PVIV);
 665         SvGROW(sv, 11);
 666         s = SvPV(sv);
 667         olderrno = errno;       /* some Xenix systems wipe out errno here */
 668         (void)sprintf(s,"%ld",SvIV(sv));
 669         errno = olderrno;
 670         while (*s) s++;
 671     }
 672     else {
 673         if (dowarn)
 674             warn("Use of uninitialized variable");
 675         sv_grow(sv, 1);
 676         s = SvPV(sv);
 677     }
 678     *s = '\0';
 679     SvCUR_set(sv, s - SvPV(sv));
 680     SvPOK_on(sv);
 681     DEBUG_c((stderr,"0x%lx 2pv(%s)\n",sv,SvPV(sv)));
 682     return SvPV(sv);
 683 }
 684
 685 /* Note: sv_setsv() should not be called with a source string that needs
 686  * be reused, since it may destroy the source string if it is marked
 687  * as temporary.
 688  */
 689
 690 void
 691 sv_setsv(dstr,sstr)
 692 SV *dstr;
 693 register SV *sstr;
 694 {
 695     if (sstr == dstr)
 696         return;
 697     if (SvREADONLY(dstr))
 698         fatal(no_modify);
 699     if (!sstr)
 700         sstr = &sv_undef;
 701
 702     if (SvTYPE(dstr) < SvTYPE(sstr))
 703         sv_upgrade(dstr, SvTYPE(sstr));
 704     else if (SvTYPE(dstr) == SVt_PV && SvTYPE(sstr) <= SVt_NV) {
 705         if (SvTYPE(sstr) <= SVt_IV)
 706             sv_upgrade(dstr, SVt_PVIV);         /* handle discontinuities */
 707         else
 708             sv_upgrade(dstr, SVt_PVNV);
 709     }
 710     else if (SvTYPE(dstr) == SVt_PVIV && SvTYPE(sstr) == SVt_NV)
 711         sv_upgrade(dstr, SVt_PVNV);
 712
 713     switch (SvTYPE(sstr)) {
 714     case SVt_NULL:
 715         if (SvTYPE(dstr) == SVt_REF) {
 716             sv_free((SV*)SvANY(dstr));
 717             SvANY(dstr) = 0;
 718             SvTYPE(dstr) = SVt_NULL;
 719         }
 720         else
 721             SvOK_off(dstr);
 722         return;
 723     case SVt_REF:
 724         SvTUP(sstr);
 725         if (SvTYPE(dstr) == SVt_REF) {
 726             SvANY(dstr) = (void*)sv_ref((SV*)SvANY(sstr));
 727         }
 728         else {
 729             if (SvMAGICAL(dstr))
 730                 fatal("Can't assign a reference to a magical variable");
 731             sv_clear(dstr);
 732             SvTYPE(dstr) = SVt_REF;
 733             SvANY(dstr) = (void*)sv_ref((SV*)SvANY(sstr));
 734             SvOK_off(dstr);
 735         }
 736         SvTDOWN(sstr);
 737         return;
 738     case SVt_PVGV:
 739         SvTUP(sstr);
 740         if (SvTYPE(dstr) == SVt_PVGV) {
 741             SvOK_off(dstr);
 742             if (!GvAV(sstr))
 743                 gv_AVadd(sstr);
 744             if (!GvHV(sstr))
 745                 gv_HVadd(sstr);
 746             if (!GvIO(sstr))
 747                 GvIO(sstr) = newIO();
 748             if (GvGP(dstr))
 749                 gp_free(dstr);
 750             GvGP(dstr) = gp_ref(GvGP(sstr));
 751             SvTDOWN(sstr);
 752             return;
 753         }
 754         /* FALL THROUGH */
 755
 756     default:
 757         if (SvMAGICAL(sstr))
 758             mg_get(sstr);
 759         /* XXX */
 760         break;
 761     }
 762
 763     SvPRIVATE(dstr)     = SvPRIVATE(sstr);
 764     SvSTORAGE(dstr)     = SvSTORAGE(sstr);
 765
 766     if (SvPOK(sstr)) {
 767
 768         SvTUP(sstr);
 769
 770         /*
 771          * Check to see if we can just swipe the string.  If so, it's a
 772          * possible small lose on short strings, but a big win on long ones.
 773          * It might even be a win on short strings if SvPV(dstr)
 774          * has to be allocated and SvPV(sstr) has to be freed.
 775          */
 776
 777         if (SvTEMP(sstr)) {             /* slated for free anyway? */
 778             if (SvPOK(dstr)) {
 779                 SvOOK_off(dstr);
 780                 Safefree(SvPV(dstr));
 781             }
 782             SvPV_set(dstr, SvPV(sstr));
 783             SvLEN_set(dstr, SvLEN(sstr));
 784             SvCUR_set(dstr, SvCUR(sstr));
 785             SvTYPE(dstr) = SvTYPE(sstr);
 786             SvPOK_only(dstr);
 787             SvTEMP_off(dstr);
 788             SvPV_set(sstr, Nullch);
 789             SvLEN_set(sstr, 0);
 790             SvPOK_off(sstr);                    /* wipe out any weird flags */
 791             SvTYPE(sstr) = 0;                   /* so sstr frees uneventfully */
 792         }
 793         else {                                  /* have to copy actual string */
 794             if (SvPV(dstr)) { /* XXX ck type */
 795                 SvOOK_off(dstr);
 796             }
 797             sv_setpvn(dstr,SvPV(sstr),SvCUR(sstr));
 798         }
 799         /*SUPPRESS 560*/
 800         if (SvNOK(sstr)) {
 801             SvNOK_on(dstr);
 802             SvNV(dstr) = SvNV(sstr);
 803         }
 804         if (SvIOK(sstr)) {
 805             SvIOK_on(dstr);
 806             SvIV(dstr) = SvIV(sstr);
 807         }
 808     }
 809     else if (SvNOK(sstr)) {
 810         SvTUP(sstr);
 811         SvNV(dstr) = SvNV(sstr);
 812         SvNOK_only(dstr);
 813         if (SvIOK(sstr)) {
 814             SvIOK_on(dstr);
 815             SvIV(dstr) = SvIV(sstr);
 816         }
 817     }
 818     else if (SvIOK(sstr)) {
 819         SvTUP(sstr);
 820         SvIOK_only(dstr);
 821         SvIV(dstr) = SvIV(sstr);
 822     }
 823     else {
 824         SvTUP(sstr);
 825         SvOK_off(dstr);
 826     }
 827     SvTDOWN(dstr);
 828 }
 829
 830 void
 831 sv_setpvn(sv,ptr,len)
 832 register SV *sv;
 833 register char *ptr;
 834 register STRLEN len;
 835 {
 836     if (!SvUPGRADE(sv, SVt_PV))
 837         return;
 838     SvGROW(sv, len + 1);
 839     if (ptr)
 840         Move(ptr,SvPV(sv),len,char);
 841     SvCUR_set(sv, len);
 842     *SvEND(sv) = '\0';
 843     SvPOK_only(sv);             /* validate pointer */
 844     SvTDOWN(sv);
 845 }
 846
 847 void
 848 sv_setpv(sv,ptr)
 849 register SV *sv;
 850 register char *ptr;
 851 {
 852     register STRLEN len;
 853
 854     if (SvREADONLY(sv))
 855         fatal(no_modify);
 856     if (!ptr)
 857         ptr = "";
 858     len = strlen(ptr);
 859     if (!SvUPGRADE(sv, SVt_PV))
 860         return;
 861     SvGROW(sv, len + 1);
 862     Move(ptr,SvPV(sv),len+1,char);
 863     SvCUR_set(sv, len);
 864     SvPOK_only(sv);             /* validate pointer */
 865     SvTDOWN(sv);
 866 }
 867
 868 void
 869 sv_chop(sv,ptr) /* like set but assuming ptr is in sv */
 870 register SV *sv;
 871 register char *ptr;
 872 {
 873     register STRLEN delta;
 874
 875     if (!ptr || !SvPOK(sv))
 876         return;
 877     if (SvREADONLY(sv))
 878         fatal(no_modify);
 879     if (SvTYPE(sv) < SVt_PVIV)
 880         sv_upgrade(sv,SVt_PVIV);
 881
 882     if (!SvOOK(sv)) {
 883         SvIV(sv) = 0;
 884         SvFLAGS(sv) |= SVf_OOK;
 885     }
 886     SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK);
 887     delta = ptr - SvPV(sv);
 888     SvLEN(sv) -= delta;
 889     SvCUR(sv) -= delta;
 890     SvPV(sv) += delta;
 891     SvIV(sv) += delta;
 892 }
 893
 894 void
 895 sv_catpvn(sv,ptr,len)
 896 register SV *sv;
 897 register char *ptr;
 898 register STRLEN len;
 899 {
 900     if (SvREADONLY(sv))
 901         fatal(no_modify);
 902     if (!(SvPOK(sv)))
 903         (void)sv_2pv(sv);
 904     SvGROW(sv, SvCUR(sv) + len + 1);
 905     Move(ptr,SvPV(sv)+SvCUR(sv),len,char);
 906     SvCUR(sv) += len;
 907     *SvEND(sv) = '\0';
 908     SvPOK_only(sv);             /* validate pointer */
 909     SvTDOWN(sv);
 910 }
 911
 912 void
 913 sv_catsv(dstr,sstr)
 914 SV *dstr;
 915 register SV *sstr;
 916 {
 917     char *s;
 918     if (!sstr)
 919         return;
 920     if (s = SvPVn(sstr)) {
 921         if (SvPOK(sstr))
 922             sv_catpvn(dstr,s,SvCUR(sstr));
 923         else
 924             sv_catpv(dstr,s);
 925     }
 926 }
 927
 928 void
 929 sv_catpv(sv,ptr)
 930 register SV *sv;
 931 register char *ptr;
 932 {
 933     register STRLEN len;
 934
 935     if (SvREADONLY(sv))
 936         fatal(no_modify);
 937     if (!ptr)
 938         return;
 939     if (!(SvPOK(sv)))
 940         (void)sv_2pv(sv);
 941     len = strlen(ptr);
 942     SvGROW(sv, SvCUR(sv) + len + 1);
 943     Move(ptr,SvPV(sv)+SvCUR(sv),len+1,char);
 944     SvCUR(sv) += len;
 945     SvPOK_only(sv);             /* validate pointer */
 946     SvTDOWN(sv);
 947 }
 948
 949 char *
 950 sv_append_till(sv,from,fromend,delim,keeplist)
 951 register SV *sv;
 952 register char *from;
 953 register char *fromend;
 954 register I32 delim;
 955 char *keeplist;
 956 {
 957     register char *to;
 958     register STRLEN len;
 959
 960     if (SvREADONLY(sv))
 961         fatal(no_modify);
 962     if (!from)
 963         return Nullch;
 964     len = fromend - from;
 965     if (!SvUPGRADE(sv, SVt_PV))
 966         return 0;
 967     SvGROW(sv, SvCUR(sv) + len + 1);
 968     SvPOK_only(sv);             /* validate pointer */
 969     to = SvPV(sv)+SvCUR(sv);
 970     for (; from < fromend; from++,to++) {
 971         if (*from == '\\' && from+1 < fromend && delim != '\\') {
 972             if (!keeplist)
 973                 *to++ = *from++;
 974             else if (from[1] && index(keeplist,from[1]))
 975                 *to++ = *from++;
 976             else
 977                 from++;
 978         }
 979         else if (*from == delim)
 980             break;
 981         *to = *from;
 982     }
 983     *to = '\0';
 984     SvCUR_set(sv, to - SvPV(sv));
 985     return from;
 986 }
 987
 988 SV *
 989 #ifdef LEAKTEST
 990 newSV(x,len)
 991 I32 x;
 992 #else
 993 newSV(len)
 994 #endif
 995 STRLEN len;
 996 {
 997     register SV *sv;
 998
 999     sv = (SV*)new_SV();
1000     Zero(sv, 1, SV);
1001     SvREFCNT(sv)++;
1002     if (len) {
1003         sv_upgrade(sv, SVt_PV);
1004         SvGROW(sv, len + 1);
1005     }
1006     return sv;
1007 }
1008
1009 void
1010 sv_magic(sv, obj, how, name, namlen)
1011 register SV *sv;
1012 SV *obj;
1013 char how;
1014 char *name;
1015 STRLEN namlen;
1016 {
1017     MAGIC* mg;
1018
1019     if (SvREADONLY(sv))
1020         fatal(no_modify);
1021     if (!SvUPGRADE(sv, SVt_PVMG))
1022         return;
1023     Newz(702,mg, 1, MAGIC);
1024     mg->mg_moremagic = SvMAGIC(sv);
1025     SvMAGICAL_on(sv);
1026     SvMAGIC(sv) = mg;
1027     mg->mg_obj = obj;
1028     mg->mg_type = how;
1029     if (name) {
1030         mg->mg_ptr = nsavestr(name, namlen);
1031         mg->mg_len = namlen;
1032     }
1033     switch (how) {
1034     case 0:
1035         mg->mg_virtual = &vtbl_sv;
1036         break;
1037     case 'B':
1038         mg->mg_virtual = &vtbl_bm;
1039         break;
1040     case 'D':
1041         mg->mg_virtual = &vtbl_dbm;
1042         break;
1043     case 'd':
1044         mg->mg_virtual = &vtbl_dbmelem;
1045         break;
1046     case 'E':
1047         mg->mg_virtual = &vtbl_env;
1048         break;
1049     case 'e':
1050         mg->mg_virtual = &vtbl_envelem;
1051         break;
1052     case 'L':
1053         mg->mg_virtual = &vtbl_dbline;
1054         break;
1055     case 'S':
1056         mg->mg_virtual = &vtbl_sig;
1057         break;
1058     case 's':
1059         mg->mg_virtual = &vtbl_sigelem;
1060         break;
1061     case 'U':
1062         mg->mg_virtual = &vtbl_uvar;
1063         break;
1064     case 'v':
1065         mg->mg_virtual = &vtbl_vec;
1066         break;
1067     case 'x':
1068         mg->mg_virtual = &vtbl_substr;
1069         break;
1070     case '*':
1071         mg->mg_virtual = &vtbl_glob;
1072         break;
1073     case '#':
1074         mg->mg_virtual = &vtbl_arylen;
1075         break;
1076     default:
1077         fatal("Don't know how to handle magic of type '%c'", how);
1078     }
1079 }
1080
1081 void
1082 sv_insert(bigstr,offset,len,little,littlelen)
1083 SV *bigstr;
1084 STRLEN offset;
1085 STRLEN len;
1086 char *little;
1087 STRLEN littlelen;
1088 {
1089     register char *big;
1090     register char *mid;
1091     register char *midend;
1092     register char *bigend;
1093     register I32 i;
1094
1095     if (SvREADONLY(bigstr))
1096         fatal(no_modify);
1097     SvPOK_only(bigstr);
1098
1099     i = littlelen - len;
1100     if (i > 0) {                        /* string might grow */
1101         if (!SvUPGRADE(bigstr, SVt_PV))
1102             return;
1103         SvGROW(bigstr, SvCUR(bigstr) + i + 1);
1104         big = SvPV(bigstr);
1105         mid = big + offset + len;
1106         midend = bigend = big + SvCUR(bigstr);
1107         bigend += i;
1108         *bigend = '\0';
1109         while (midend > mid)            /* shove everything down */
1110             *--bigend = *--midend;
1111         Move(little,big+offset,littlelen,char);
1112         SvCUR(bigstr) += i;
1113         SvSETMAGIC(bigstr);
1114         return;
1115     }
1116     else if (i == 0) {
1117         Move(little,SvPV(bigstr)+offset,len,char);
1118         SvSETMAGIC(bigstr);
1119         return;
1120     }
1121
1122     big = SvPV(bigstr);
1123     mid = big + offset;
1124     midend = mid + len;
1125     bigend = big + SvCUR(bigstr);
1126
1127     if (midend > bigend)
1128         fatal("panic: sv_insert");
1129
1130     if (mid - big > bigend - midend) {  /* faster to shorten from end */
1131         if (littlelen) {
1132             Move(little, mid, littlelen,char);
1133             mid += littlelen;
1134         }
1135         i = bigend - midend;
1136         if (i > 0) {
1137             Move(midend, mid, i,char);
1138             mid += i;
1139         }
1140         *mid = '\0';
1141         SvCUR_set(bigstr, mid - big);
1142     }
1143     /*SUPPRESS 560*/
1144     else if (i = mid - big) {   /* faster from front */
1145         midend -= littlelen;
1146         mid = midend;
1147         sv_chop(bigstr,midend-i);
1148         big += i;
1149         while (i--)
1150             *--midend = *--big;
1151         if (littlelen)
1152             Move(little, mid, littlelen,char);
1153     }
1154     else if (littlelen) {
1155         midend -= littlelen;
1156         sv_chop(bigstr,midend);
1157         Move(little,midend,littlelen,char);
1158     }
1159     else {
1160         sv_chop(bigstr,midend);
1161     }
1162     SvSETMAGIC(bigstr);
1163 }
1164
1165 /* make sv point to what nstr did */
1166
1167 void
1168 sv_replace(sv,nsv)
1169 register SV *sv;
1170 register SV *nsv;
1171 {
1172     U32 refcnt = SvREFCNT(sv);
1173     if (SvREADONLY(sv))
1174         fatal(no_modify);
1175     if (SvREFCNT(nsv) != 1)
1176         warn("Reference miscount in sv_replace()");
1177     SvREFCNT(sv) = 0;
1178     sv_clear(sv);
1179     StructCopy(nsv,sv,SV);
1180     SvREFCNT(sv) = refcnt;
1181     Safefree(nsv);
1182 }
1183
1184 void
1185 sv_clear(sv)
1186 register SV *sv;
1187 {
1188     assert(sv);
1189     assert(SvREFCNT(sv) == 0);
1190
1191     switch (SvTYPE(sv)) {
1192     case SVt_PVFM:
1193         goto freemagic;
1194     case SVt_PVBM:
1195         goto freemagic;
1196     case SVt_PVGV:
1197         gp_free(sv);
1198         goto freemagic;
1199     case SVt_PVCV:
1200         op_free(CvSTART(sv));
1201         goto freemagic;
1202     case SVt_PVHV:
1203         hv_clear(sv, FALSE);
1204         goto freemagic;
1205     case SVt_PVAV:
1206         av_clear(sv);
1207         goto freemagic;
1208     case SVt_PVLV:
1209         goto freemagic;
1210     case SVt_PVMG:
1211       freemagic:
1212         if (SvMAGICAL(sv))
1213             mg_freeall(sv);
1214     case SVt_PVNV:
1215     case SVt_PVIV:
1216         SvOOK_off(sv);
1217         /* FALL THROUGH */
1218     case SVt_PV:
1219         if (SvPV(sv))
1220             Safefree(SvPV(sv));
1221         break;
1222     case SVt_NV:
1223         break;
1224     case SVt_IV:
1225         break;
1226     case SVt_REF:
1227         sv_free((SV*)SvANY(sv));
1228         break;
1229     case SVt_NULL:
1230         break;
1231     }
1232
1233     switch (SvTYPE(sv)) {
1234     case SVt_NULL:
1235         break;
1236     case SVt_REF:
1237         break;
1238     case SVt_IV:
1239         del_XIV(SvANY(sv));
1240         break;
1241     case SVt_NV:
1242         del_XNV(SvANY(sv));
1243         break;
1244     case SVt_PV:
1245         del_XPV(SvANY(sv));
1246         break;
1247     case SVt_PVIV:
1248         del_XPVIV(SvANY(sv));
1249         break;
1250     case SVt_PVNV:
1251         del_XPVNV(SvANY(sv));
1252         break;
1253     case SVt_PVMG:
1254         del_XPVMG(SvANY(sv));
1255         break;
1256     case SVt_PVLV:
1257         del_XPVLV(SvANY(sv));
1258         break;
1259     case SVt_PVAV:
1260         del_XPVAV(SvANY(sv));
1261         break;
1262     case SVt_PVHV:
1263         del_XPVHV(SvANY(sv));
1264         break;
1265     case SVt_PVCV:
1266         del_XPVCV(SvANY(sv));
1267         break;
1268     case SVt_PVGV:
1269         del_XPVGV(SvANY(sv));
1270         break;
1271     case SVt_PVBM:
1272         del_XPVBM(SvANY(sv));
1273         break;
1274     case SVt_PVFM:
1275         del_XPVFM(SvANY(sv));
1276         break;
1277     }
1278     DEB(SvTYPE(sv) = 0xff;)
1279 }
1280
1281 SV *
1282 sv_ref(sv)
1283 SV* sv;
1284 {
1285     SvREFCNT(sv)++;
1286     return sv;
1287 }
1288
1289 void
1290 sv_free(sv)
1291 SV *sv;
1292 {
1293     if (!sv)
1294         return;
1295     if (SvREADONLY(sv)) {
1296         if (sv == &sv_undef || sv == &sv_yes || sv == &sv_no)
1297             return;
1298     }
1299     if (SvREFCNT(sv) == 0) {
1300         warn("Attempt to free unreferenced scalar");
1301         return;
1302     }
1303     if (--SvREFCNT(sv) > 0)
1304         return;
1305     if (SvSTORAGE(sv) == 'O') {
1306         dSP;
1307         BINOP myop;             /* fake syntax tree node */
1308         GV* destructor;
1309
1310         SvSTORAGE(sv) = 0;              /* Curse the object. */
1311
1312         ENTER;
1313         SAVESPTR(curcop);
1314         SAVESPTR(op);
1315         curcop = &compiling;
1316         curstash = SvSTASH(sv);
1317         destructor = gv_fetchpv("DESTROY", FALSE);
1318
1319         if (GvCV(destructor)) {
1320             SV* ref = sv_mortalcopy(&sv_undef);
1321             SvREFCNT(ref) = 1;
1322             sv_upgrade(ref, SVt_REF);
1323             SvANY(ref) = (void*)sv_ref(sv);
1324
1325             op = (OP*)&myop;
1326             Zero(op, 1, OP);
1327             myop.op_last = (OP*)&myop;
1328             myop.op_flags = OPf_STACKED;
1329             myop.op_next = Nullop;
1330
1331             EXTEND(SP, 2);
1332             PUSHs((SV*)destructor);
1333             pp_pushmark();
1334             PUSHs(ref);
1335             PUTBACK;
1336             op = pp_entersubr();
1337             run();
1338             stack_sp--;
1339             LEAVE;      /* Will eventually free sv as ordinary item. */
1340             return;
1341         }
1342         LEAVE;
1343     }
1344     sv_clear(sv);
1345     DEB(SvTYPE(sv) = 0xff;)
1346     del_SV(sv);
1347 }
1348
1349 STRLEN
1350 sv_len(sv)
1351 register SV *sv;
1352 {
1353     I32 paren;
1354     I32 i;
1355     char *s;
1356
1357     if (!sv)
1358         return 0;
1359
1360     if (SvMAGICAL(sv))
1361         return mg_len(sv, SvMAGIC(sv));
1362
1363     if (!(SvPOK(sv))) {
1364         (void)sv_2pv(sv);
1365         if (!SvOK(sv))
1366             return 0;
1367     }
1368     if (SvPV(sv))
1369         return SvCUR(sv);
1370     else
1371         return 0;
1372 }
1373
1374 I32
1375 sv_eq(str1,str2)
1376 register SV *str1;
1377 register SV *str2;
1378 {
1379     char *pv1;
1380     U32 cur1;
1381     char *pv2;
1382     U32 cur2;
1383
1384     if (!str1) {
1385         pv1 = "";
1386         cur1 = 0;
1387     }
1388     else {
1389         if (SvMAGICAL(str1))
1390             mg_get(str1);
1391         if (!SvPOK(str1)) {
1392             (void)sv_2pv(str1);
1393             if (!SvPOK(str1))
1394                 str1 = &sv_no;
1395         }
1396         pv1 = SvPV(str1);
1397         cur1 = SvCUR(str1);
1398     }
1399
1400     if (!str2)
1401         return !cur1;
1402     else {
1403         if (SvMAGICAL(str2))
1404             mg_get(str2);
1405         if (!SvPOK(str2)) {
1406             (void)sv_2pv(str2);
1407             if (!SvPOK(str2))
1408                 return !cur1;
1409         }
1410         pv2 = SvPV(str2);
1411         cur2 = SvCUR(str2);
1412     }
1413
1414     if (cur1 != cur2)
1415         return 0;
1416
1417     return !bcmp(pv1, pv2, cur1);
1418 }
1419
1420 I32
1421 sv_cmp(str1,str2)
1422 register SV *str1;
1423 register SV *str2;
1424 {
1425     I32 retval;
1426     char *pv1;
1427     U32 cur1;
1428     char *pv2;
1429     U32 cur2;
1430
1431     if (!str1) {
1432         pv1 = "";
1433         cur1 = 0;
1434     }
1435     else {
1436         if (SvMAGICAL(str1))
1437             mg_get(str1);
1438         if (!SvPOK(str1)) {
1439             (void)sv_2pv(str1);
1440             if (!SvPOK(str1))
1441                 str1 = &sv_no;
1442         }
1443         pv1 = SvPV(str1);
1444         cur1 = SvCUR(str1);
1445     }
1446
1447     if (!str2) {
1448         pv2 = "";
1449         cur2 = 0;
1450     }
1451     else {
1452         if (SvMAGICAL(str2))
1453             mg_get(str2);
1454         if (!SvPOK(str2)) {
1455             (void)sv_2pv(str2);
1456             if (!SvPOK(str2))
1457                 str2 = &sv_no;
1458         }
1459         pv2 = SvPV(str2);
1460         cur2 = SvCUR(str2);
1461     }
1462
1463     if (!cur1)
1464         return cur2 ? -1 : 0;
1465     if (!cur2)
1466         return 1;
1467
1468     if (cur1 < cur2) {
1469         /*SUPPRESS 560*/
1470         if (retval = memcmp(pv1, pv2, cur1))
1471             return retval < 0 ? -1 : 1;
1472         else
1473             return -1;
1474     }
1475     /*SUPPRESS 560*/
1476     else if (retval = memcmp(pv1, pv2, cur2))
1477         return retval < 0 ? -1 : 1;
1478     else if (cur1 == cur2)
1479         return 0;
1480     else
1481         return 1;
1482 }
1483
1484 char *
1485 sv_gets(sv,fp,append)
1486 register SV *sv;
1487 register FILE *fp;
1488 I32 append;
1489 {
1490     register char *bp;          /* we're going to steal some values */
1491     register I32 cnt;           /*  from the stdio struct and put EVERYTHING */
1492     register STDCHAR *ptr;      /*   in the innermost loop into registers */
1493     register I32 newline = rschar;/* (assuming >= 6 registers) */
1494     I32 i;
1495     STRLEN bpx;
1496     I32 shortbuffered;
1497
1498     if (SvREADONLY(sv))
1499         fatal(no_modify);
1500     if (!SvUPGRADE(sv, SVt_PV))
1501         return;
1502     if (rspara) {               /* have to do this both before and after */
1503         do {                    /* to make sure file boundaries work right */
1504             i = getc(fp);
1505             if (i != '\n') {
1506                 ungetc(i,fp);
1507                 break;
1508             }
1509         } while (i != EOF);
1510     }
1511 #ifdef STDSTDIO         /* Here is some breathtakingly efficient cheating */
1512     cnt = fp->_cnt;                     /* get count into register */
1513     SvPOK_only(sv);                     /* validate pointer */
1514     if (SvLEN(sv) - append <= cnt + 1) { /* make sure we have the room */
1515         if (cnt > 80 && SvLEN(sv) > append) {
1516             shortbuffered = cnt - SvLEN(sv) + append + 1;
1517             cnt -= shortbuffered;
1518         }
1519         else {
1520             shortbuffered = 0;
1521             SvGROW(sv, append+cnt+2);/* (remembering cnt can be -1) */
1522         }
1523     }
1524     else
1525         shortbuffered = 0;
1526     bp = SvPV(sv) + append;             /* move these two too to registers */
1527     ptr = fp->_ptr;
1528     for (;;) {
1529       screamer:
1530         while (--cnt >= 0) {                    /* this */      /* eat */
1531             if ((*bp++ = *ptr++) == newline)    /* really */    /* dust */
1532                 goto thats_all_folks;           /* screams */   /* sed :-) */
1533         }
1534
1535         if (shortbuffered) {                    /* oh well, must extend */
1536             cnt = shortbuffered;
1537             shortbuffered = 0;
1538             bpx = bp - SvPV(sv);        /* prepare for possible relocation */
1539             SvCUR_set(sv, bpx);
1540             SvGROW(sv, SvLEN(sv) + append + cnt + 2);
1541             bp = SvPV(sv) + bpx;        /* reconstitute our pointer */
1542             continue;
1543         }
1544
1545         fp->_cnt = cnt;                 /* deregisterize cnt and ptr */
1546         fp->_ptr = ptr;
1547         i = _filbuf(fp);                /* get more characters */
1548         cnt = fp->_cnt;
1549         ptr = fp->_ptr;                 /* reregisterize cnt and ptr */
1550
1551         bpx = bp - SvPV(sv);    /* prepare for possible relocation */
1552         SvCUR_set(sv, bpx);
1553         SvGROW(sv, bpx + cnt + 2);
1554         bp = SvPV(sv) + bpx;    /* reconstitute our pointer */
1555
1556         if (i == newline) {             /* all done for now? */
1557             *bp++ = i;
1558             goto thats_all_folks;
1559         }
1560         else if (i == EOF)              /* all done for ever? */
1561             goto thats_really_all_folks;
1562         *bp++ = i;                      /* now go back to screaming loop */
1563     }
1564
1565 thats_all_folks:
1566     if (rslen > 1 && (bp - SvPV(sv) < rslen || bcmp(bp - rslen, rs, rslen)))
1567         goto screamer;  /* go back to the fray */
1568 thats_really_all_folks:
1569     if (shortbuffered)
1570         cnt += shortbuffered;
1571     fp->_cnt = cnt;                     /* put these back or we're in trouble */
1572     fp->_ptr = ptr;
1573     *bp = '\0';
1574     SvCUR_set(sv, bp - SvPV(sv));       /* set length */
1575
1576 #else /* !STDSTDIO */   /* The big, slow, and stupid way */
1577
1578     {
1579         char buf[8192];
1580         register char * bpe = buf + sizeof(buf) - 3;
1581
1582 screamer:
1583         bp = buf;
1584         while ((i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe) ;
1585
1586         if (append)
1587             sv_catpvn(sv, buf, bp - buf);
1588         else
1589             sv_setpvn(sv, buf, bp - buf);
1590         if (i != EOF                    /* joy */
1591             &&
1592             (i != newline
1593              ||
1594              (rslen > 1
1595               &&
1596               (SvCUR(sv) < rslen
1597                ||
1598                bcmp(SvPV(sv) + SvCUR(sv) - rslen, rs, rslen)
1599               )
1600              )
1601             )
1602            )
1603         {
1604             append = -1;
1605             goto screamer;
1606         }
1607     }
1608
1609 #endif /* STDSTDIO */
1610
1611     if (rspara) {
1612         while (i != EOF) {
1613             i = getc(fp);
1614             if (i != '\n') {
1615                 ungetc(i,fp);
1616                 break;
1617             }
1618         }
1619     }
1620     return SvCUR(sv) - append ? SvPV(sv) : Nullch;
1621 }
1622
1623 void
1624 sv_inc(sv)
1625 register SV *sv;
1626 {
1627     register char *d;
1628
1629     if (!sv)
1630         return;
1631     if (SvREADONLY(sv))
1632         fatal(no_modify);
1633     if (SvMAGICAL(sv))
1634         mg_get(sv);
1635     if (SvIOK(sv)) {
1636         ++SvIV(sv);
1637         SvIOK_only(sv);
1638         return;
1639     }
1640     if (SvNOK(sv)) {
1641         SvNV(sv) += 1.0;
1642         SvNOK_only(sv);
1643         return;
1644     }
1645     if (!SvPOK(sv) || !*SvPV(sv)) {
1646         if (!SvUPGRADE(sv, SVt_NV))
1647             return;
1648         SvNV(sv) = 1.0;
1649         SvNOK_only(sv);
1650         return;
1651     }
1652     d = SvPV(sv);
1653     while (isALPHA(*d)) d++;
1654     while (isDIGIT(*d)) d++;
1655     if (*d) {
1656         sv_setnv(sv,atof(SvPV(sv)) + 1.0);  /* punt */
1657         return;
1658     }
1659     d--;
1660     while (d >= SvPV(sv)) {
1661         if (isDIGIT(*d)) {
1662             if (++*d <= '9')
1663                 return;
1664             *(d--) = '0';
1665         }
1666         else {
1667             ++*d;
1668             if (isALPHA(*d))
1669                 return;
1670             *(d--) -= 'z' - 'a' + 1;
1671         }
1672     }
1673     /* oh,oh, the number grew */
1674     SvGROW(sv, SvCUR(sv) + 2);
1675     SvCUR(sv)++;
1676     for (d = SvPV(sv) + SvCUR(sv); d > SvPV(sv); d--)
1677         *d = d[-1];
1678     if (isDIGIT(d[1]))
1679         *d = '1';
1680     else
1681         *d = d[1];
1682 }
1683
1684 void
1685 sv_dec(sv)
1686 register SV *sv;
1687 {
1688     if (!sv)
1689         return;
1690     if (SvREADONLY(sv))
1691         fatal(no_modify);
1692     if (SvMAGICAL(sv))
1693         mg_get(sv);
1694     if (SvIOK(sv)) {
1695         --SvIV(sv);
1696         SvIOK_only(sv);
1697         return;
1698     }
1699     if (SvNOK(sv)) {
1700         SvNV(sv) -= 1.0;
1701         SvNOK_only(sv);
1702         return;
1703     }
1704     if (!SvPOK(sv)) {
1705         if (!SvUPGRADE(sv, SVt_NV))
1706             return;
1707         SvNV(sv) = -1.0;
1708         SvNOK_only(sv);
1709         return;
1710     }
1711     sv_setnv(sv,atof(SvPV(sv)) - 1.0);
1712 }
1713
1714 /* Make a string that will exist for the duration of the expression
1715  * evaluation.  Actually, it may have to last longer than that, but
1716  * hopefully we won't free it until it has been assigned to a
1717  * permanent location. */
1718
1719 SV *
1720 sv_mortalcopy(oldstr)
1721 SV *oldstr;
1722 {
1723     register SV *sv = NEWSV(78,0);
1724
1725     sv_setsv(sv,oldstr);
1726     if (++tmps_ix > tmps_max) {
1727         tmps_max = tmps_ix;
1728         if (!(tmps_max & 127)) {
1729             if (tmps_max)
1730                 Renew(tmps_stack, tmps_max + 128, SV*);
1731             else
1732                 New(702,tmps_stack, 128, SV*);
1733         }
1734     }
1735     tmps_stack[tmps_ix] = sv;
1736     if (SvPOK(sv))
1737         SvTEMP_on(sv);
1738     return sv;
1739 }
1740
1741 /* same thing without the copying */
1742
1743 SV *
1744 sv_2mortal(sv)
1745 register SV *sv;
1746 {
1747     if (!sv)
1748         return sv;
1749     if (SvREADONLY(sv))
1750         fatal(no_modify);
1751     if (++tmps_ix > tmps_max) {
1752         tmps_max = tmps_ix;
1753         if (!(tmps_max & 127)) {
1754             if (tmps_max)
1755                 Renew(tmps_stack, tmps_max + 128, SV*);
1756             else
1757                 New(704,tmps_stack, 128, SV*);
1758         }
1759     }
1760     tmps_stack[tmps_ix] = sv;
1761     if (SvPOK(sv))
1762         SvTEMP_on(sv);
1763     return sv;
1764 }
1765
1766 SV *
1767 newSVpv(s,len)
1768 char *s;
1769 STRLEN len;
1770 {
1771     register SV *sv = NEWSV(79,0);
1772
1773     if (!len)
1774         len = strlen(s);
1775     sv_setpvn(sv,s,len);
1776     return sv;
1777 }
1778
1779 SV *
1780 newSVnv(n)
1781 double n;
1782 {
1783     register SV *sv = NEWSV(80,0);
1784
1785     sv_setnv(sv,n);
1786     return sv;
1787 }
1788
1789 SV *
1790 newSViv(i)
1791 I32 i;
1792 {
1793     register SV *sv = NEWSV(80,0);
1794
1795     sv_setiv(sv,i);
1796     return sv;
1797 }
1798
1799 /* make an exact duplicate of old */
1800
1801 SV *
1802 newSVsv(old)
1803 register SV *old;
1804 {
1805     register SV *new;
1806
1807     if (!old)
1808         return Nullsv;
1809     if (SvTYPE(old) == 0xff) {
1810         warn("semi-panic: attempt to dup freed string");
1811         return Nullsv;
1812     }
1813     new = NEWSV(80,0);
1814     if (SvTEMP(old)) {
1815         SvTEMP_off(old);
1816         sv_setsv(new,old);
1817         SvTEMP_on(old);
1818     }
1819     else
1820         sv_setsv(new,old);
1821     return new;
1822 }
1823
1824 void
1825 sv_reset(s,stash)
1826 register char *s;
1827 HV *stash;
1828 {
1829     register HE *entry;
1830     register GV *gv;
1831     register SV *sv;
1832     register I32 i;
1833     register PMOP *pm;
1834     register I32 max;
1835
1836     if (!*s) {          /* reset ?? searches */
1837         for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) {
1838             pm->op_pmflags &= ~PMf_USED;
1839         }
1840         return;
1841     }
1842
1843     /* reset variables */
1844
1845     if (!HvARRAY(stash))
1846         return;
1847     while (*s) {
1848         i = *s;
1849         if (s[1] == '-') {
1850             s += 2;
1851         }
1852         max = *s++;
1853         for ( ; i <= max; i++) {
1854             for (entry = HvARRAY(stash)[i];
1855               entry;
1856               entry = entry->hent_next) {
1857                 gv = (GV*)entry->hent_val;
1858                 sv = GvSV(gv);
1859                 SvOK_off(sv);
1860                 if (SvTYPE(sv) >= SVt_PV) {
1861                     SvCUR_set(sv, 0);
1862                     SvTDOWN(sv);
1863                     if (SvPV(sv) != Nullch)
1864                         *SvPV(sv) = '\0';
1865                 }
1866                 if (GvAV(gv)) {
1867                     av_clear(GvAV(gv));
1868                 }
1869                 if (GvHV(gv)) {
1870                     hv_clear(GvHV(gv), FALSE);
1871                     if (gv == envgv)
1872                         environ[0] = Nullch;
1873                 }
1874             }
1875         }
1876     }
1877 }
1878
1879 #ifdef OLD
1880 AV *
1881 sv_2av(sv, st, gvp, lref)
1882 SV *sv;
1883 HV **st;
1884 GV **gvp;
1885 I32 lref;
1886 {
1887     GV *gv;
1888
1889     switch (SvTYPE(sv)) {
1890     case SVt_PVAV:
1891         *st = sv->sv_u.sv_stash;
1892         *gvp = Nullgv;
1893         return sv->sv_u.sv_av;
1894     case SVt_PVHV:
1895     case SVt_PVCV:
1896         *gvp = Nullgv;
1897         return Nullav;
1898     default:
1899         if (isGV(sv))
1900             gv = (GV*)sv;
1901         else
1902             gv = gv_fetchpv(SvPVn(sv), lref);
1903         *gvp = gv;
1904         if (!gv)
1905             return Nullav;
1906         *st = GvESTASH(gv);
1907         if (lref)
1908             return GvAVn(gv);
1909         else
1910             return GvAV(gv);
1911     }
1912 }
1913
1914 HV *
1915 sv_2hv(sv, st, gvp, lref)
1916 SV *sv;
1917 HV **st;
1918 GV **gvp;
1919 I32 lref;
1920 {
1921     GV *gv;
1922
1923     switch (SvTYPE(sv)) {
1924     case SVt_PVHV:
1925         *st = sv->sv_u.sv_stash;
1926         *gvp = Nullgv;
1927         return sv->sv_u.sv_hv;
1928     case SVt_PVAV:
1929     case SVt_PVCV:
1930         *gvp = Nullgv;
1931         return Nullhv;
1932     default:
1933         if (isGV(sv))
1934             gv = (GV*)sv;
1935         else
1936             gv = gv_fetchpv(SvPVn(sv), lref);
1937         *gvp = gv;
1938         if (!gv)
1939             return Nullhv;
1940         *st = GvESTASH(gv);
1941         if (lref)
1942             return GvHVn(gv);
1943         else
1944             return GvHV(gv);
1945     }
1946 }
1947 #endif;
1948
1949 CV *
1950 sv_2cv(sv, st, gvp, lref)
1951 SV *sv;
1952 HV **st;
1953 GV **gvp;
1954 I32 lref;
1955 {
1956     GV *gv;
1957     CV *cv;
1958
1959     if (!sv)
1960         return Nullcv;
1961     switch (SvTYPE(sv)) {
1962     case SVt_REF:
1963         cv = (CV*)SvANY(sv);
1964         if (SvTYPE(cv) != SVt_PVCV)
1965             fatal("Not a subroutine reference");
1966         *gvp = Nullgv;
1967         *st = CvSTASH(cv);
1968         return cv;
1969     case SVt_PVCV:
1970         *st = CvSTASH(sv);
1971         *gvp = Nullgv;
1972         return (CV*)sv;
1973     case SVt_PVHV:
1974     case SVt_PVAV:
1975         *gvp = Nullgv;
1976         return Nullcv;
1977     default:
1978         if (isGV(sv))
1979             gv = (GV*)sv;
1980         else
1981             gv = gv_fetchpv(SvPVn(sv), lref);
1982         *gvp = gv;
1983         if (!gv)
1984             return Nullcv;
1985         *st = GvESTASH(gv);
1986         return GvCV(gv);
1987     }
1988 }
1989
1990 #ifndef SvTRUE
1991 I32
1992 SvTRUE(sv)
1993 register SV *sv;
1994 {
1995     if (SvMAGICAL(sv))
1996         mg_get(sv);
1997     if (SvPOK(sv)) {
1998         register XPV* Xpv;
1999         if ((Xpv = (XPV*)SvANY(sv)) &&
2000                 (*Xpv->xpv_pv > '0' ||
2001                 Xpv->xpv_cur > 1 ||
2002                 (Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
2003             return 1;
2004         else
2005             return 0;
2006     }
2007     else {
2008         if (SvIOK(sv))
2009             return SvIV(sv) != 0;
2010         else {
2011             if (SvNOK(sv))
2012                 return SvNV(sv) != 0.0;
2013             else
2014                 return 0;
2015         }
2016     }
2017 }
2018 #endif /* SvTRUE */
2019
2020 #ifndef SvNVn
2021 double SvNVn(Sv)
2022 register SV *Sv;
2023 {
2024     SvTUP(Sv);
2025     if (SvMAGICAL(sv))
2026         mg_get(sv);
2027     if (SvNOK(Sv))
2028         return SvNV(Sv);
2029     if (SvIOK(Sv))
2030         return (double)SvIV(Sv);
2031     return sv_2nv(Sv);
2032 }
2033 #endif /* SvNVn */
2034
2035 #ifndef SvPVn
2036 char *
2037 SvPVn(sv)
2038 SV *sv;
2039 {
2040     SvTUP(sv);
2041     if (SvMAGICAL(sv))
2042         mg_get(sv);
2043     return SvPOK(sv) ? SvPV(sv) : sv_2pv(sv);
2044 }
2045 #endif
2046