This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Macroify the block_hooks structure.
authorBen Morrow <ben@morrow.me.uk>
Mon, 7 Dec 2009 11:52:23 +0000 (11:52 +0000)
committerRafael Garcia-Suarez <rgs@consttype.org>
Mon, 12 Jul 2010 08:40:47 +0000 (10:40 +0200)
Add a flags member, so it can be extended later if necessary. Add a
bhk_eval member, called from doeval to catch requires and string evals.

ext/XS-APItest/APItest.xs
op.h
perl.h
pp_ctl.c

index 012102d..54880b7 100644 (file)
@@ -271,17 +271,12 @@ blockhook_pre_end(pTHX_ OP **o)
 
     /* if we hit the end of a scope we missed the start of, we need to
      * unconditionally clear @CSC */
-    if (GvAV(MY_CXT.cscgv) == MY_CXT.cscav && MY_CXT.cscav)
+    if (GvAV(MY_CXT.cscgv) == MY_CXT.cscav && MY_CXT.cscav) {
         av_clear(MY_CXT.cscav);
+    }
 
 }
 
-STATIC struct block_hooks my_block_hooks = {
-    blockhook_start,
-    blockhook_pre_end,
-    NULL
-};
-
 #include "const-c.inc"
 
 MODULE = XS::APItest:Hash              PACKAGE = XS::APItest::Hash
@@ -634,6 +629,7 @@ PROTOTYPES: DISABLE
 
 BOOT:
 {
+    BHK *bhk;
     MY_CXT_INIT;
 
     MY_CXT.i  = 99;
@@ -642,9 +638,13 @@ BOOT:
         GV_ADD, SVt_PVAV);
     MY_CXT.cscav = GvAV(MY_CXT.cscgv);
 
+    Newxz(bhk, 1, BHK);
+    BhkENTRY_set(bhk, start, blockhook_start);
+    BhkENTRY_set(bhk, pre_end, blockhook_pre_end);
+
     if (!PL_blockhooks)
         PL_blockhooks = newAV();
-    av_push(PL_blockhooks, newSViv(PTR2IV(&my_block_hooks))); 
+    av_push(PL_blockhooks, newSViv(PTR2IV(bhk))); 
 }                              
 
 void
diff --git a/op.h b/op.h
index 7de236f..ac34f1d 100644 (file)
--- a/op.h
+++ b/op.h
@@ -646,27 +646,45 @@ struct loop {
 #endif
 
 struct block_hooks {
+    U32            bhk_flags;
     void    (*bhk_start)       (pTHX_ int full);
     void    (*bhk_pre_end)     (pTHX_ OP **seq);
     void    (*bhk_post_end)    (pTHX_ OP **seq);
+    void    (*bhk_eval)                (pTHX_ OP *const saveop);
 };
 
+#define BhkFLAGS(hk)           ((hk)->bhk_flags)
+
+#define BHKf_start         0x01
+#define BHKf_pre_end       0x02
+#define BHKf_post_end      0x04
+#define BHKf_eval          0x08
+
+#define BhkENTRY(hk, which) \
+    ((BhkFLAGS(hk) & BHKf_ ## which) ? ((hk)->bhk_ ## which) : NULL)
+
+#define BhkENTRY_set(hk, which, ptr) \
+    STMT_START { \
+       (hk)->bhk_ ## which = ptr; \
+       (hk)->bhk_flags |= BHKf_ ## which; \
+    } STMT_END
+
 #define CALL_BLOCK_HOOKS(which, arg) \
     STMT_START { \
        if (PL_blockhooks) { \
            I32 i; \
            for (i = av_len(PL_blockhooks); i >= 0; i--) { \
                SV *sv = AvARRAY(PL_blockhooks)[i]; \
-               struct block_hooks *hk; \
+               BHK *hk; \
                \
                assert(SvIOK(sv)); \
                if (SvUOK(sv)) \
-                   hk = INT2PTR(struct block_hooks *, SvUVX(sv)); \
+                   hk = INT2PTR(BHK *, SvUVX(sv)); \
                else \
-                   hk = INT2PTR(struct block_hooks *, SvIVX(sv)); \
+                   hk = INT2PTR(BHK *, SvIVX(sv)); \
                \
-               if (hk->bhk_ ## which) \
-                   CALL_FPTR(hk->bhk_ ## which)(aTHX_ arg); \
+               if (BhkENTRY(hk, which)) \
+                   CALL_FPTR(BhkENTRY(hk, which))(aTHX_ arg); \
            } \
        } \
     } STMT_END
diff --git a/perl.h b/perl.h
index 3d60a33..0d4a891 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -2385,6 +2385,8 @@ typedef struct padop PADOP;
 typedef struct pvop PVOP;
 typedef struct loop LOOP;
 
+typedef struct block_hooks BHK;
+
 typedef struct interpreter PerlInterpreter;
 
 /* Amdahl's <ksync.h> has struct sv */
index 912e934..1bac360 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3131,6 +3131,8 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     else
        CLEAR_ERRSV();
 
+    CALL_BLOCK_HOOKS(eval, saveop);
+
     /* note that yyparse() may raise an exception, e.g. C<BEGIN{die}>,
      * so honour CATCH_GET and trap it here if necessary */