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