the workaround is needed in all 7.2.* compilers,

[perl5.git] / scope.c

diff --git a/scope.c b/scope.c
index 51aeed2..3680a88 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)
@@ -283,13 +283,13 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty)
 
        if (GvCVu(gv))
            PL_sub_generation++;        /* taking a method out of circulation */
-       else if (GvIOp(gv) && (IoFLAGS(GvIOp(gv)) & IOf_ARGV)) {
+       if (GvIOp(gv) && (IoFLAGS(GvIOp(gv)) & IOf_ARGV)) {
            gp->gp_io = newIO();
            IoFLAGS(gp->gp_io) |= IOf_ARGV|IOf_START;
        }
        GvGP(gv) = gp_ref(gp);
        GvSV(gv) = NEWSV(72,0);
-       GvLINE(gv) = PL_curcop->cop_line;
+       GvLINE(gv) = CopLINE(PL_curcop);
        GvEGV(gv) = gv;
     }
     else {
@@ -316,7 +316,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 +341,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;
@@ -405,6 +405,16 @@ Perl_save_I16(pTHX_ I16 *intp)
 }
 
 void
+Perl_save_I8(pTHX_ I8 *bytep)
+{
+    dTHR;
+    SSCHECK(3);
+    SSPUSHINT(*bytep);
+    SSPUSHPTR(bytep);
+    SSPUSHINT(SAVEt_I8);
+}
+
+void
 Perl_save_iv(pTHX_ IV *ivp)
 {
     dTHR;
@@ -428,6 +438,16 @@ Perl_save_pptr(pTHX_ char **pptr)
 }
 
 void
+Perl_save_vptr(pTHX_ void *ptr)
+{
+    dTHR;
+    SSCHECK(3);
+    SSPUSHPTR(*(char**)ptr);
+    SSPUSHPTR(ptr);
+    SSPUSHINT(SAVEt_VPTR);
+}
+
+void
 Perl_save_sptr(pTHX_ SV **sptr)
 {
     dTHR;
@@ -443,8 +463,8 @@ Perl_save_threadsv(pTHX_ PADOFFSET i)
 #ifdef USE_THREADS
     dTHR;
     SV **svp = &THREADSV(i);   /* XXX Change to save by offset */
-    DEBUG_S(PerlIO_printf(Perl_debug_log, "save_threadsv %u: %p %p:%s\n",
-                         i, svp, *svp, SvPEEK(*svp)));
+    DEBUG_S(PerlIO_printf(Perl_debug_log, "save_threadsv %"UVuf": %p %p:%s\n",
+                         (UV)i, svp, *svp, SvPEEK(*svp)));
     save_svref(svp);
     return svp;
 #else
@@ -695,7 +715,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);
@@ -741,6 +761,10 @@ Perl_leave_scope(pTHX_ I32 base)
            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;
@@ -749,6 +773,7 @@ Perl_leave_scope(pTHX_ I32 base)
            ptr = SSPOPPTR;
            *(SV**)ptr = (SV*)SSPOPPTR;
            break;
+       case SAVEt_VPTR:                        /* random* reference */
        case SAVEt_PPTR:                        /* char* reference */
            ptr = SSPOPPTR;
            *(char**)ptr = (char*)SSPOPPTR;
@@ -909,6 +934,13 @@ Perl_leave_scope(pTHX_ I32 base)
            }
            *(I32*)&PL_hints = (I32)SSPOPINT;
            break;
+       case SAVEt_COMPPAD:
+           PL_comppad = (AV*)SSPOPPTR;
+           if (PL_comppad)
+               PL_curpad = AvARRAY(PL_comppad);
+           else
+               PL_curpad = Null(SV**);
+           break;
        default:
            Perl_croak(aTHX_ "panic: leave_scope inconsistency");
        }
@@ -936,17 +968,25 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
     case CXt_NULL:
     case CXt_BLOCK:
        break;
-    case CXt_SUB:
+    case CXt_FORMAT:
        PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%"UVxf"\n",
                PTR2UV(cx->blk_sub.cv));
        PerlIO_printf(Perl_debug_log, "BLK_SUB.GV = 0x%"UVxf"\n",
                PTR2UV(cx->blk_sub.gv));
        PerlIO_printf(Perl_debug_log, "BLK_SUB.DFOUTGV = 0x%"UVxf"\n",
                PTR2UV(cx->blk_sub.dfoutgv));
+       PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n",
+               (int)cx->blk_sub.hasargs);
+       break;
+    case CXt_SUB:
+       PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%"UVxf"\n",
+               PTR2UV(cx->blk_sub.cv));
        PerlIO_printf(Perl_debug_log, "BLK_SUB.OLDDEPTH = %ld\n",
                (long)cx->blk_sub.olddepth);
        PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n",
                (int)cx->blk_sub.hasargs);
+       PerlIO_printf(Perl_debug_log, "BLK_SUB.LVAL = %d\n",
+               (int)cx->blk_sub.lval);
        break;
     case CXt_EVAL:
        PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_IN_EVAL = %ld\n",
@@ -954,8 +994,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;
@@ -976,8 +1017,8 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
        PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%"UVxf"\n",
                PTR2UV(cx->blk_loop.iterary));
        PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%"UVxf"\n",
-               PTR2UV(cx->blk_loop.itervar));
-       if (cx->blk_loop.itervar)
+               PTR2UV(CxITERVAR(cx)));
+       if (CxITERVAR(cx))
            PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERSAVE = 0x%"UVxf"\n",
                PTR2UV(cx->blk_loop.itersave));
        PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERLVAL = 0x%"UVxf"\n",