Tokeniser debugging

[perl5.git] / scope.c

diff --git a/scope.c b/scope.c
index 91e0374..82cd748 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -1,6 +1,6 @@
 /*    scope.c
  *
- *    Copyright (c) 1991-1999, Larry Wall
+ *    Copyright (c) 1991-2000, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -16,6 +16,7 @@
 #define PERL_IN_SCOPE_C
 #include "perl.h"
 
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
 void *
 Perl_default_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt,
                     protect_body_t body, ...)
@@ -36,8 +37,6 @@ Perl_vdefault_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt,
     int ex;
     void *ret;
 
-    DEBUG_l(Perl_deb(aTHX_ "Setting up local jumplevel %p, was %p\n",
-               pcur_env, PL_top_env));
     JMPENV_PUSH(ex);
     if (ex)
        ret = NULL;
@@ -47,6 +46,7 @@ Perl_vdefault_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt,
     JMPENV_POP;
     return ret;
 }
+#endif
 
 SV**
 Perl_stack_grow(pTHX_ SV **sp, SV **p, int n)
@@ -79,7 +79,6 @@ PERL_SI *
 Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems)
 {
     PERL_SI *si;
-    PERL_CONTEXT *cxt;
     New(56, si, 1, PERL_SI);
     si->si_stack = newAV();
     AvREAL_off(si->si_stack);
@@ -250,7 +249,7 @@ Perl_save_svref(pTHX_ SV **sptr)
     return save_scalar_at(sptr);
 }
 
-/* Like save_svref(), but doesn't deal with magic.  Can be used to
+/* 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
 Perl_save_generic_svref(pTHX_ SV **sptr)
@@ -262,6 +261,19 @@ Perl_save_generic_svref(pTHX_ SV **sptr)
     SSPUSHINT(SAVEt_GENERIC_SVREF);
 }
 
+/* Like save_pptr(), but also Safefree()s the new value if it is different
+ * from the old one.  Can be used to restore a global char* to its prior
+ * contents, freeing new value. */
+void
+Perl_save_generic_pvref(pTHX_ char **str)
+{
+    dTHR;
+    SSCHECK(3);
+    SSPUSHPTR(str);
+    SSPUSHPTR(*str);
+    SSPUSHINT(SAVEt_GENERIC_PVREF);
+}
+
 void
 Perl_save_gp(pTHX_ GV *gv, I32 empty)
 {
@@ -290,6 +302,7 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty)
        GvGP(gv) = gp_ref(gp);
        GvSV(gv) = NEWSV(72,0);
        GvLINE(gv) = CopLINE(PL_curcop);
+       GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : "";
        GvEGV(gv) = gv;
     }
     else {
@@ -316,7 +329,7 @@ Perl_save_ary(pTHX_ GV *gv)
     av = GvAVn(gv);
     if (SvMAGIC(oav)) {
        SvMAGIC(av) = SvMAGIC(oav);
-       SvFLAGS(av) |= SvMAGICAL(oav);
+       SvFLAGS((SV*)av) |= SvMAGICAL(oav);
        SvMAGICAL_off(oav);
        SvMAGIC(oav) = 0;
        PL_localizing = 1;
@@ -341,7 +354,7 @@ Perl_save_hash(pTHX_ GV *gv)
     hv = GvHVn(gv);
     if (SvMAGIC(ohv)) {
        SvMAGIC(hv) = SvMAGIC(ohv);
-       SvFLAGS(hv) |= SvMAGICAL(ohv);
+       SvFLAGS((SV*)hv) |= SvMAGICAL(ohv);
        SvMAGICAL_off(ohv);
        SvMAGIC(ohv) = 0;
        PL_localizing = 1;
@@ -457,6 +470,17 @@ Perl_save_sptr(pTHX_ SV **sptr)
     SSPUSHINT(SAVEt_SPTR);
 }
 
+void
+Perl_save_padsv(pTHX_ PADOFFSET off)
+{
+    dTHR;
+    SSCHECK(4);
+    SSPUSHPTR(PL_curpad[off]);
+    SSPUSHPTR(PL_curpad);
+    SSPUSHLONG((long)off);
+    SSPUSHINT(SAVEt_PADSV);
+}
+
 SV **
 Perl_save_threadsv(pTHX_ PADOFFSET i)
 {
@@ -647,6 +671,7 @@ Perl_leave_scope(pTHX_ I32 base)
     register AV *av;
     register HV *hv;
     register void* ptr;
+    register char* str;
     I32 i;
 
     if (base < -1)
@@ -667,14 +692,20 @@ Perl_leave_scope(pTHX_ I32 base)
            ptr = &GvSV(gv);
            SvREFCNT_dec(gv);
            goto restore_sv;
+        case SAVEt_GENERIC_PVREF:              /* generic pv */
+           str = (char*)SSPOPPTR;
+           ptr = SSPOPPTR;
+           if (*(char**)ptr != str) {
+               Safefree(*(char**)ptr);
+               *(char**)ptr = str;
+           }
+           break;
         case SAVEt_GENERIC_SVREF:              /* generic sv */
            value = (SV*)SSPOPPTR;
            ptr = SSPOPPTR;
-           if (ptr) {
-               sv = *(SV**)ptr;
-               *(SV**)ptr = value;
-               SvREFCNT_dec(sv);
-           }
+           sv = *(SV**)ptr;
+           *(SV**)ptr = value;
+           SvREFCNT_dec(sv);
            SvREFCNT_dec(value);
            break;
         case SAVEt_SVREF:                      /* scalar reference */
@@ -715,7 +746,7 @@ Perl_leave_scope(pTHX_ I32 base)
            if (GvAV(gv)) {
                AV *goner = GvAV(gv);
                SvMAGIC(av) = SvMAGIC(goner);
-               SvFLAGS(av) |= SvMAGICAL(goner);
+               SvFLAGS((SV*)av) |= SvMAGICAL(goner);
                SvMAGICAL_off(goner);
                SvMAGIC(goner) = 0;
                SvREFCNT_dec(goner);
@@ -941,6 +972,14 @@ Perl_leave_scope(pTHX_ I32 base)
            else
                PL_curpad = Null(SV**);
            break;
+       case SAVEt_PADSV:
+           {
+               PADOFFSET off = (PADOFFSET)SSPOPLONG;
+               ptr = SSPOPPTR;
+               if (ptr)
+                   ((SV**)ptr)[off] = (SV*)SSPOPPTR;
+           }
+           break;
        default:
            Perl_croak(aTHX_ "panic: leave_scope inconsistency");
        }
@@ -994,8 +1033,9 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
        PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_OP_TYPE = %s (%s)\n",
                PL_op_name[cx->blk_eval.old_op_type],
                PL_op_desc[cx->blk_eval.old_op_type]);
-       PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n",
-               cx->blk_eval.old_name);
+       if (cx->blk_eval.old_namesv)
+           PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n",
+                         SvPVX(cx->blk_eval.old_namesv));
        PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%"UVxf"\n",
                PTR2UV(cx->blk_eval.old_eval_root));
        break;