This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Wrap PL_blockhooks in an API function.
authorBen Morrow <ben@morrow.me.uk>
Mon, 7 Dec 2009 12:55:57 +0000 (12:55 +0000)
committerRafael Garcia-Suarez <rgs@consttype.org>
Mon, 12 Jul 2010 08:40:47 +0000 (10:40 +0200)
This should help prevent people from thinking they can get cute with the
contents.

embed.fnc
embed.h
ext/XS-APItest/APItest.xs
global.sym
op.c
proto.h

index d3f14b1..054616a 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -214,6 +214,7 @@ pR  |OP*    |block_end      |I32 floor|NULLOK OP* seq
 ApR    |I32    |block_gimme
 : Used in perly.y
 pR     |int    |block_start    |int full
+Aop    |void   |blockhook_register |NN BHK *hk
 : Used in perl.c
 p      |void   |boot_core_UNIVERSAL
 : Used in perl.c
diff --git a/embed.h b/embed.h
index df31c37..5e79e58 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -84,6 +84,8 @@
 #define block_gimme            Perl_block_gimme
 #ifdef PERL_CORE
 #define block_start            Perl_block_start
+#endif
+#ifdef PERL_CORE
 #define boot_core_UNIVERSAL    Perl_boot_core_UNIVERSAL
 #define boot_core_PerlIO       Perl_boot_core_PerlIO
 #endif
 #define block_gimme()          Perl_block_gimme(aTHX)
 #ifdef PERL_CORE
 #define block_start(a)         Perl_block_start(aTHX_ a)
+#endif
+#ifdef PERL_CORE
 #define boot_core_UNIVERSAL()  Perl_boot_core_UNIVERSAL(aTHX)
 #define boot_core_PerlIO()     Perl_boot_core_PerlIO(aTHX)
 #endif
index 54880b7..35533fc 100644 (file)
@@ -641,10 +641,7 @@ BOOT:
     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(bhk))); 
+    Perl_blockhook_register(aTHX_ bhk);
 }                              
 
 void
index f7fb28d..db01b92 100644 (file)
@@ -56,6 +56,7 @@ Perl_av_unshift
 Perl_av_arylen_p
 Perl_av_iter_p
 Perl_block_gimme
+Perl_blockhook_register
 Perl_call_list
 Perl_cast_ulong
 Perl_cast_i32
diff --git a/op.c b/op.c
index dc18a2d..9caf8cd 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2343,6 +2343,14 @@ Perl_block_end(pTHX_ I32 floor, OP *seq)
     return retval;
 }
 
+void
+Perl_blockhook_register(pTHX_ BHK *hk)
+{
+    PERL_ARGS_ASSERT_BLOCKHOOK_REGISTER;
+
+    Perl_av_create_and_push(aTHX_ &PL_blockhooks, newSViv(PTR2IV(hk)));
+}
+
 STATIC OP *
 S_newDEFSVOP(pTHX)
 {
diff --git a/proto.h b/proto.h
index c1c0f05..535dc78 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -289,6 +289,11 @@ PERL_CALLCONV I32  Perl_block_gimme(pTHX)
 PERL_CALLCONV int      Perl_block_start(pTHX_ int full)
                        __attribute__warn_unused_result__;
 
+PERL_CALLCONV void     Perl_blockhook_register(pTHX_ BHK *hk)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_BLOCKHOOK_REGISTER    \
+       assert(hk)
+
 PERL_CALLCONV void     Perl_boot_core_UNIVERSAL(pTHX);
 PERL_CALLCONV void     Perl_boot_core_PerlIO(pTHX);
 PERL_CALLCONV void     Perl_call_list(pTHX_ I32 oldscope, AV *paramList)