Upgrade to Digest-SHA-5.34.
[p5sagit/p5-mst-13.2.git] / scope.c
diff --git a/scope.c b/scope.c
index 14f7884..5939877 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -1,7 +1,7 @@
 /*    scope.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -150,7 +150,7 @@ Perl_free_tmps(pTHX)
     const I32 myfloor = PL_tmps_floor;
     while (PL_tmps_ix > myfloor) {      /* clean up after last statement */
        SV* const sv = PL_tmps_stack[PL_tmps_ix];
-       PL_tmps_stack[PL_tmps_ix--] = Nullsv;
+       PL_tmps_stack[PL_tmps_ix--] = NULL;
        if (sv && sv != &PL_sv_undef) {
            SvTEMP_off(sv);
            SvREFCNT_dec(sv);           /* note, can modify tmps_ix!!! */
@@ -163,13 +163,13 @@ S_save_scalar_at(pTHX_ SV **sptr)
 {
     dVAR;
     SV * const osv = *sptr;
-    register SV * const sv = *sptr = NEWSV(0,0);
+    register SV * const sv = *sptr = newSV(0);
 
     if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
        if (SvGMAGICAL(osv)) {
            const bool oldtainted = PL_tainted;
            SvFLAGS(osv) |= (SvFLAGS(osv) &
-              (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+              (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
            PL_tainted = oldtainted;
        }
        mg_localize(osv, sv);
@@ -192,18 +192,6 @@ Perl_save_scalar(pTHX_ GV *gv)
     return save_scalar_at(sptr);
 }
 
-SV*
-Perl_save_svref(pTHX_ SV **sptr)
-{
-    dVAR;
-    SvGETMAGIC(*sptr);
-    SSCHECK(3);
-    SSPUSHPTR(sptr);
-    SSPUSHPTR(SvREFCNT_inc(*sptr));
-    SSPUSHINT(SAVEt_SVREF);
-    return save_scalar_at(sptr);
-}
-
 /* Like save_sptr(), but also SvREFCNT_dec()s the new value.  Can be used to
  * restore a global SV to its prior contents, freeing new value. */
 void
@@ -281,7 +269,7 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty)
            IoFLAGS(gp->gp_io) |= IOf_ARGV|IOf_START;
        }
        GvGP(gv) = gp_ref(gp);
-       GvSV(gv) = NEWSV(72,0);
+       GvSV(gv) = newSV(0);
        GvLINE(gv) = CopLINE(PL_curcop);
        /* XXX Ideally this cast would be replaced with a change to const char*
           in the struct.  */
@@ -356,16 +344,6 @@ Perl_save_int(pTHX_ int *intp)
 }
 
 void
-Perl_save_long(pTHX_ long int *longp)
-{
-    dVAR;
-    SSCHECK(3);
-    SSPUSHLONG(*longp);
-    SSPUSHPTR(longp);
-    SSPUSHINT(SAVEt_LONG);
-}
-
-void
 Perl_save_bool(pTHX_ bool *boolp)
 {
     dVAR;
@@ -385,36 +363,6 @@ Perl_save_I32(pTHX_ I32 *intp)
     SSPUSHINT(SAVEt_I32);
 }
 
-void
-Perl_save_I16(pTHX_ I16 *intp)
-{
-    dVAR;
-    SSCHECK(3);
-    SSPUSHINT(*intp);
-    SSPUSHPTR(intp);
-    SSPUSHINT(SAVEt_I16);
-}
-
-void
-Perl_save_I8(pTHX_ I8 *bytep)
-{
-    dVAR;
-    SSCHECK(3);
-    SSPUSHINT(*bytep);
-    SSPUSHPTR(bytep);
-    SSPUSHINT(SAVEt_I8);
-}
-
-void
-Perl_save_iv(pTHX_ IV *ivp)
-{
-    dVAR;
-    SSCHECK(3);
-    SSPUSHIV(*ivp);
-    SSPUSHPTR(ivp);
-    SSPUSHINT(SAVEt_IV);
-}
-
 /* Cannot use save_sptr() to store a char* since the SV** cast will
  * force word-alignment and we'll miss the pointer.
  */
@@ -460,24 +408,6 @@ Perl_save_padsv(pTHX_ PADOFFSET off)
     SSPUSHINT(SAVEt_PADSV);
 }
 
-SV **
-Perl_save_threadsv(pTHX_ PADOFFSET i)
-{
-    dVAR;
-    Perl_croak(aTHX_ "panic: save_threadsv called in non-threaded perl");
-    PERL_UNUSED_ARG(i);
-    NORETURN_FUNCTION_END;
-}
-
-void
-Perl_save_nogv(pTHX_ GV *gv)
-{
-    dVAR;
-    SSCHECK(2);
-    SSPUSHPTR(gv);
-    SSPUSHINT(SAVEt_NSTAB);
-}
-
 void
 Perl_save_hptr(pTHX_ HV **hptr)
 {
@@ -557,32 +487,6 @@ Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen)
 }
 
 void
-Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg)
-{
-    dVAR;
-    register I32 i;
-
-    for (i = 1; i <= maxsarg; i++) {
-       register SV * const sv = NEWSV(0,0);
-       sv_setsv(sv,sarg[i]);
-       SSCHECK(3);
-       SSPUSHPTR(sarg[i]);             /* remember the pointer */
-       SSPUSHPTR(sv);                  /* remember the value */
-       SSPUSHINT(SAVEt_ITEM);
-    }
-}
-
-void
-Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
-{
-    dVAR;
-    SSCHECK(3);
-    SSPUSHDPTR(f);
-    SSPUSHPTR(p);
-    SSPUSHINT(SAVEt_DESTRUCTOR);
-}
-
-void
 Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p)
 {
     dVAR;
@@ -637,6 +541,18 @@ Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr)
        sv_2mortal(sv);
 }
 
+SV*
+Perl_save_svref(pTHX_ SV **sptr)
+{
+    dVAR;
+    SvGETMAGIC(*sptr);
+    SSCHECK(3);
+    SSPUSHPTR(sptr);
+    SSPUSHPTR(SvREFCNT_inc(*sptr));
+    SSPUSHINT(SAVEt_SVREF);
+    return save_scalar_at(sptr);
+}
+
 void
 Perl_save_op(pTHX)
 {
@@ -694,7 +610,20 @@ Perl_leave_scope(pTHX_ I32 base)
            gv = (GV*)SSPOPPTR;
            ptr = &GvSV(gv);
            av = (AV*)gv; /* what to refcnt_dec */
-           goto restore_sv;
+       restore_sv:
+           sv = *(SV**)ptr;
+           DEBUG_S(PerlIO_printf(Perl_debug_log,
+                                 "restore svref: %p %p:%s -> %p:%s\n",
+                                 ptr, sv, SvPEEK(sv), value, SvPEEK(value)));
+           *(SV**)ptr = value;
+           SvREFCNT_dec(sv);
+           PL_localizing = 2;
+           SvSETMAGIC(value);
+           PL_localizing = 0;
+           SvREFCNT_dec(value);
+           if (av) /* actually an av, hv or gv */
+               SvREFCNT_dec(av);
+           break;
        case SAVEt_GENERIC_PVREF:               /* generic pv */
            str = (char*)SSPOPPTR;
            ptr = SSPOPPTR;
@@ -723,24 +652,6 @@ Perl_leave_scope(pTHX_ I32 base)
            SvREFCNT_dec(sv);
            SvREFCNT_dec(value);
            break;
-       case SAVEt_SVREF:                       /* scalar reference */
-           value = (SV*)SSPOPPTR;
-           ptr = SSPOPPTR;
-           av = NULL; /* what to refcnt_dec */
-       restore_sv:
-           sv = *(SV**)ptr;
-           DEBUG_S(PerlIO_printf(Perl_debug_log,
-                                 "restore svref: %p %p:%s -> %p:%s\n",
-                                 ptr, sv, SvPEEK(sv), value, SvPEEK(value)));
-           *(SV**)ptr = value;
-           SvREFCNT_dec(sv);
-           PL_localizing = 2;
-           SvSETMAGIC(value);
-           PL_localizing = 0;
-           SvREFCNT_dec(value);
-           if (av) /* actually an av, hv or gv */
-               SvREFCNT_dec(av);
-           break;
        case SAVEt_AV:                          /* array reference */
            av = (AV*)SSPOPPTR;
            gv = (GV*)SSPOPPTR;
@@ -784,10 +695,6 @@ Perl_leave_scope(pTHX_ I32 base)
            ptr = SSPOPPTR;
            *(int*)ptr = (int)SSPOPINT;
            break;
-       case SAVEt_LONG:                        /* long reference */
-           ptr = SSPOPPTR;
-           *(long*)ptr = (long)SSPOPLONG;
-           break;
        case SAVEt_BOOL:                        /* bool reference */
            ptr = SSPOPPTR;
            *(bool*)ptr = (bool)SSPOPBOOL;
@@ -796,18 +703,6 @@ Perl_leave_scope(pTHX_ I32 base)
            ptr = SSPOPPTR;
            *(I32*)ptr = (I32)SSPOPINT;
            break;
-       case SAVEt_I16:                         /* I16 reference */
-           ptr = SSPOPPTR;
-           *(I16*)ptr = (I16)SSPOPINT;
-           break;
-       case SAVEt_I8:                          /* I8 reference */
-           ptr = SSPOPPTR;
-           *(I8*)ptr = (I8)SSPOPINT;
-           break;
-       case SAVEt_IV:                          /* IV reference */
-           ptr = SSPOPPTR;
-           *(IV*)ptr = (IV)SSPOPIV;
-           break;
        case SAVEt_SPTR:                        /* SV* reference */
            ptr = SSPOPPTR;
            *(SV**)ptr = (SV*)SSPOPPTR;
@@ -825,10 +720,6 @@ Perl_leave_scope(pTHX_ I32 base)
            ptr = SSPOPPTR;
            *(AV**)ptr = (AV*)SSPOPPTR;
            break;
-       case SAVEt_NSTAB:
-           gv = (GV*)SSPOPPTR;
-           (void)sv_clear((SV*)gv);
-           break;
        case SAVEt_GP:                          /* scalar reference */
            ptr = SSPOPPTR;
            gv = (GV*)SSPOPPTR;
@@ -909,7 +800,7 @@ Perl_leave_scope(pTHX_ I32 base)
                switch (SvTYPE(sv)) {   /* Console ourselves with a new value */
                case SVt_PVAV:  *(SV**)ptr = (SV*)newAV();      break;
                case SVt_PVHV:  *(SV**)ptr = (SV*)newHV();      break;
-               default:        *(SV**)ptr = NEWSV(0,0);        break;
+               default:        *(SV**)ptr = newSV(0);          break;
                }
                SvREFCNT_dec(sv);       /* Cast current value to the winds. */
                /* preserve pad nature, but also mark as not live
@@ -925,10 +816,6 @@ Perl_leave_scope(pTHX_ I32 base)
            SvREFCNT_dec(hv);
            Safefree(ptr);
            break;
-       case SAVEt_DESTRUCTOR:
-           ptr = SSPOPPTR;
-           (*SSPOPDPTR)(ptr);
-           break;
        case SAVEt_DESTRUCTOR_X:
            ptr = SSPOPPTR;
            (*SSPOPDXPTR)(aTHX_ ptr);
@@ -1028,6 +915,36 @@ Perl_leave_scope(pTHX_ I32 base)
                SvFLAGS(sv) |= val;
            }
            break;
+           /* These are only saved in mathoms.c */
+       case SAVEt_SVREF:                       /* scalar reference */
+           value = (SV*)SSPOPPTR;
+           ptr = SSPOPPTR;
+           av = NULL; /* what to refcnt_dec */
+           goto restore_sv;
+       case SAVEt_LONG:                        /* long reference */
+           ptr = SSPOPPTR;
+           *(long*)ptr = (long)SSPOPLONG;
+           break;
+       case SAVEt_I16:                         /* I16 reference */
+           ptr = SSPOPPTR;
+           *(I16*)ptr = (I16)SSPOPINT;
+           break;
+       case SAVEt_I8:                          /* I8 reference */
+           ptr = SSPOPPTR;
+           *(I8*)ptr = (I8)SSPOPINT;
+           break;
+       case SAVEt_IV:                          /* IV reference */
+           ptr = SSPOPPTR;
+           *(IV*)ptr = (IV)SSPOPIV;
+           break;
+       case SAVEt_NSTAB:
+           gv = (GV*)SSPOPPTR;
+           (void)sv_clear((SV*)gv);
+           break;
+       case SAVEt_DESTRUCTOR:
+           ptr = SSPOPPTR;
+           (*SSPOPDPTR)(ptr);
+           break;
        default:
            Perl_croak(aTHX_ "panic: leave_scope inconsistency");
        }