Modify the return value of Gv_AMupdate to indicate a compilation error
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Wed, 8 Jul 2009 22:03:47 +0000 (00:03 +0200)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Wed, 8 Jul 2009 22:03:47 +0000 (00:03 +0200)
This way we'll restore most of the performance on object desctruction
lost by the previous commit

embed.fnc
gv.c
proto.h

index 8689af0..0001d1f 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -99,7 +99,7 @@ END_EXTERN_C
 START_EXTERN_C
 #  include "pp_proto.h"
 Ap     |SV*    |amagic_call    |NN SV* left|NN SV* right|int method|int dir
 START_EXTERN_C
 #  include "pp_proto.h"
 Ap     |SV*    |amagic_call    |NN SV* left|NN SV* right|int method|int dir
-Ap     |bool   |Gv_AMupdate    |NN HV* stash|bool destructing
+Ap     |int    |Gv_AMupdate    |NN HV* stash|bool destructing
 ApR    |CV*    |gv_handler     |NULLOK HV* stash|I32 id
 : Used in perly.y
 p      |OP*    |append_elem    |I32 optype|NULLOK OP* first|NULLOK OP* last
 ApR    |CV*    |gv_handler     |NULLOK HV* stash|I32 id
 : Used in perly.y
 p      |OP*    |append_elem    |I32 optype|NULLOK OP* first|NULLOK OP* last
diff --git a/gv.c b/gv.c
index ca8e7a7..f24a7f1 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1664,8 +1664,13 @@ Perl_magic_freeovrld(pTHX_ SV *sv, MAGIC *mg)
 }
 
 /* Updates and caches the CV's */
 }
 
 /* Updates and caches the CV's */
+/* Returns:
+ * 1 on success and there is some overload
+ * 0 if there is no overload
+ * -1 if some error occurred and it couldn't croak
+ */
 
 
-bool
+int
 Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
 {
   dVAR;
 Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
 {
   dVAR;
@@ -1681,7 +1686,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
       const AMT * const amtp = (AMT*)mg->mg_ptr;
       if (amtp->was_ok_am == PL_amagic_generation
          && amtp->was_ok_sub == newgen) {
       const AMT * const amtp = (AMT*)mg->mg_ptr;
       if (amtp->was_ok_am == PL_amagic_generation
          && amtp->was_ok_sub == newgen) {
-         return (bool)AMT_OVERLOADED(amtp);
+         return AMT_OVERLOADED(amtp) ? 1 : 0;
       }
       sv_unmagic(MUTABLE_SV(stash), PERL_MAGIC_overload_table);
   }
       }
       sv_unmagic(MUTABLE_SV(stash), PERL_MAGIC_overload_table);
   }
@@ -1758,7 +1763,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
                {
                    /* Can be an import stub (created by "can"). */
                    if (destructing) {
                {
                    /* Can be an import stub (created by "can"). */
                    if (destructing) {
-                       return FALSE;
+                       return -1;
                    }
                    else {
                        const char * const name = (gvsv && SvPOK(gvsv)) ?  SvPVX_const(gvsv) : "???";
                    }
                    else {
                        const char * const name = (gvsv && SvPOK(gvsv)) ?  SvPVX_const(gvsv) : "???";
@@ -1797,7 +1802,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
   AMT_AMAGIC_off(&amt);
   sv_magic(MUTABLE_SV(stash), 0, PERL_MAGIC_overload_table,
                                                (char*)&amt, sizeof(AMTS));
   AMT_AMAGIC_off(&amt);
   sv_magic(MUTABLE_SV(stash), 0, PERL_MAGIC_overload_table,
                                                (char*)&amt, sizeof(AMTS));
-  return FALSE;
+  return 0;
 }
 
 
 }
 
 
@@ -1821,7 +1826,7 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id)
       do_update:
        /* If we're looking up a destructor to invoke, we must avoid
         * that Gv_AMupdate croaks, because we might be dying already */
       do_update:
        /* If we're looking up a destructor to invoke, we must avoid
         * that Gv_AMupdate croaks, because we might be dying already */
-       if (!Gv_AMupdate(stash, id == DESTROY_amg)) {
+       if (Gv_AMupdate(stash, id == DESTROY_amg) == -1) {
            /* and if it didn't found a destructor, we fall back
             * to a simpler method that will only look for the
             * destructor instead of the whole magic */
            /* and if it didn't found a destructor, we fall back
             * to a simpler method that will only look for the
             * destructor instead of the whole magic */
diff --git a/proto.h b/proto.h
index f853470..b2e9e90 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -131,7 +131,7 @@ PERL_CALLCONV SV*   Perl_amagic_call(pTHX_ SV* left, SV* right, int method, int di
 #define PERL_ARGS_ASSERT_AMAGIC_CALL   \
        assert(left); assert(right)
 
 #define PERL_ARGS_ASSERT_AMAGIC_CALL   \
        assert(left); assert(right)
 
-PERL_CALLCONV bool     Perl_Gv_AMupdate(pTHX_ HV* stash, bool destructing)
+PERL_CALLCONV int      Perl_Gv_AMupdate(pTHX_ HV* stash, bool destructing)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_GV_AMUPDATE   \
        assert(stash)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_GV_AMUPDATE   \
        assert(stash)