This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
support for C<exists &func> (from Spider Boardman)
[perl5.git] / scope.c
diff --git a/scope.c b/scope.c
index 44c3d92..7052282 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -17,26 +17,27 @@
 #include "perl.h"
 
 void *
-Perl_default_protect(pTHX_ int *excpt, protect_body_t body, ...)
+Perl_default_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt,
+                    protect_body_t body, ...)
 {
     void *ret;
     va_list args;
     va_start(args, body);
-    ret = vdefault_protect(excpt, body, &args);
+    ret = vdefault_protect(pcur_env, excpt, body, &args);
     va_end(args);
     return ret;
 }
 
 void *
-Perl_vdefault_protect(pTHX_ int *excpt, protect_body_t body, va_list *args)
+Perl_vdefault_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt,
+                     protect_body_t body, va_list *args)
 {
     dTHR;
-    dJMPENV;
     int ex;
     void *ret;
 
     DEBUG_l(Perl_deb(aTHX_ "Setting up local jumplevel %p, was %p\n",
-               &cur_env, PL_top_env));
+               pcur_env, PL_top_env));
     JMPENV_PUSH(ex);
     if (ex)
        ret = NULL;
@@ -278,12 +279,17 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty)
     if (empty) {
        register GP *gp;
 
+       Newz(602, gp, 1, GP);
+
        if (GvCVu(gv))
            PL_sub_generation++;        /* taking a method out of circulation */
-       Newz(602, gp, 1, GP);
+       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 {
@@ -399,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;
@@ -422,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;
@@ -437,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(PerlIO_stderr(), "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
@@ -541,7 +567,7 @@ Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg)
 }
 
 void
-Perl_save_destructor(pTHX_ DESTRUCTORFUNC_t f, void* p)
+Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
 {
     dTHR;
     SSCHECK(3);
@@ -551,6 +577,16 @@ Perl_save_destructor(pTHX_ DESTRUCTORFUNC_t f, void* p)
 }
 
 void
+Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p)
+{
+    dTHR;
+    SSCHECK(3);
+    SSPUSHDXPTR(f);
+    SSPUSHPTR(p);
+    SSPUSHINT(SAVEt_DESTRUCTOR_X);
+}
+
+void
 Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr)
 {
     dTHR;
@@ -646,7 +682,7 @@ Perl_leave_scope(pTHX_ I32 base)
            ptr = SSPOPPTR;
        restore_sv:
            sv = *(SV**)ptr;
-           DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+           DEBUG_S(PerlIO_printf(Perl_debug_log,
                                  "restore svref: %p %p:%s -> %p:%s\n",
                                  ptr, sv, SvPEEK(sv), value, SvPEEK(value)));
            if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) &&
@@ -725,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;
@@ -733,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;
@@ -831,7 +872,11 @@ Perl_leave_scope(pTHX_ I32 base)
            break;
        case SAVEt_DESTRUCTOR:
            ptr = SSPOPPTR;
-           CALLDESTRUCTOR(aTHXo_ ptr);
+           (*SSPOPDPTR)(ptr);
+           break;
+       case SAVEt_DESTRUCTOR_X:
+           ptr = SSPOPPTR;
+           (*SSPOPDXPTR)(aTHXo_ ptr);
            break;
        case SAVEt_REGCONTEXT:
        case SAVEt_ALLOC:
@@ -903,28 +948,38 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
     PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), PL_block_type[CxTYPE(cx)]);
     if (CxTYPE(cx) != CXt_SUBST) {
        PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
-       PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop);
+       PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%"UVxf"\n",
+                     PTR2UV(cx->blk_oldcop));
        PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
        PerlIO_printf(Perl_debug_log, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp);
        PerlIO_printf(Perl_debug_log, "BLK_OLDRETSP = %ld\n", (long)cx->blk_oldretsp);
-       PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%lx\n", (long)cx->blk_oldpm);
+       PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%"UVxf"\n",
+                     PTR2UV(cx->blk_oldpm));
        PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR");
     }
     switch (CxTYPE(cx)) {
     case CXt_NULL:
     case CXt_BLOCK:
        break;
+    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%lx\n",
-               (long)cx->blk_sub.cv);
-       PerlIO_printf(Perl_debug_log, "BLK_SUB.GV = 0x%lx\n",
-               (long)cx->blk_sub.gv);
-       PerlIO_printf(Perl_debug_log, "BLK_SUB.DFOUTGV = 0x%lx\n",
-               (long)cx->blk_sub.dfoutgv);
+       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",
@@ -934,8 +989,8 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
                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);
-       PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%lx\n",
-               (long)cx->blk_eval.old_eval_root);
+       PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%"UVxf"\n",
+               PTR2UV(cx->blk_eval.old_eval_root));
        break;
 
     case CXt_LOOP:
@@ -943,23 +998,23 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
                cx->blk_loop.label);
        PerlIO_printf(Perl_debug_log, "BLK_LOOP.RESETSP = %ld\n",
                (long)cx->blk_loop.resetsp);
-       PerlIO_printf(Perl_debug_log, "BLK_LOOP.REDO_OP = 0x%lx\n",
-               (long)cx->blk_loop.redo_op);
-       PerlIO_printf(Perl_debug_log, "BLK_LOOP.NEXT_OP = 0x%lx\n",
-               (long)cx->blk_loop.next_op);
-       PerlIO_printf(Perl_debug_log, "BLK_LOOP.LAST_OP = 0x%lx\n",
-               (long)cx->blk_loop.last_op);
+       PerlIO_printf(Perl_debug_log, "BLK_LOOP.REDO_OP = 0x%"UVxf"\n",
+               PTR2UV(cx->blk_loop.redo_op));
+       PerlIO_printf(Perl_debug_log, "BLK_LOOP.NEXT_OP = 0x%"UVxf"\n",
+               PTR2UV(cx->blk_loop.next_op));
+       PerlIO_printf(Perl_debug_log, "BLK_LOOP.LAST_OP = 0x%"UVxf"\n",
+               PTR2UV(cx->blk_loop.last_op));
        PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERIX = %ld\n",
                (long)cx->blk_loop.iterix);
-       PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%lx\n",
-               (long)cx->blk_loop.iterary);
-       PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%lx\n",
-               (long)cx->blk_loop.itervar);
-       if (cx->blk_loop.itervar)
-           PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERSAVE = 0x%lx\n",
-               (long)cx->blk_loop.itersave);
-       PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERLVAL = 0x%lx\n",
-               (long)cx->blk_loop.iterlval);
+       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(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",
+               PTR2UV(cx->blk_loop.iterlval));
        break;
 
     case CXt_SUBST:
@@ -973,18 +1028,18 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
                (long)cx->sb_once);
        PerlIO_printf(Perl_debug_log, "SB_ORIG = %s\n",
                cx->sb_orig);
-       PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%lx\n",
-               (long)cx->sb_dstr);
-       PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%lx\n",
-               (long)cx->sb_targ);
-       PerlIO_printf(Perl_debug_log, "SB_S = 0x%lx\n",
-               (long)cx->sb_s);
-       PerlIO_printf(Perl_debug_log, "SB_M = 0x%lx\n",
-               (long)cx->sb_m);
-       PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%lx\n",
-               (long)cx->sb_strend);
-       PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%lx\n",
-               (long)cx->sb_rxres);
+       PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%"UVxf"\n",
+               PTR2UV(cx->sb_dstr));
+       PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%"UVxf"\n",
+               PTR2UV(cx->sb_targ));
+       PerlIO_printf(Perl_debug_log, "SB_S = 0x%"UVxf"\n",
+               PTR2UV(cx->sb_s));
+       PerlIO_printf(Perl_debug_log, "SB_M = 0x%"UVxf"\n",
+               PTR2UV(cx->sb_m));
+       PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%"UVxf"\n",
+               PTR2UV(cx->sb_strend));
+       PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%"UVxf"\n",
+               PTR2UV(cx->sb_rxres));
        break;
     }
 #endif /* DEBUGGING */
Unnamed repository; edit this file 'description' to name the repository.