B:: fixes + 'When were CVOPs gone ?'

Message-ID: <20030701165125.GA1521@ratsnest.hole>

p4raw-id: //depot/perl@19916

diff --git a/ext/B/B.pm b/ext/B/B.pm
index 3dfb2c9..b1a68b9 100644 (file)
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -21,7 +21,9 @@ require Exporter;
                amagic_generation perlstring
                walkoptree_slow walkoptree walkoptree_exec walksymtable
                parents comppadlist sv_undef compile_stats timing_info
-               begin_av init_av check_av end_av regex_padav);
+               begin_av init_av check_av end_av regex_padav dowarn
+               defstash curstash warnhook diehook inc_gv
+               );
 
 sub OPf_KIDS ();
 use strict;
@@ -51,7 +53,6 @@ use strict;
 @B::SVOP::ISA = 'B::OP';
 @B::PADOP::ISA = 'B::OP';
 @B::PVOP::ISA = 'B::OP';
-@B::CVOP::ISA = 'B::OP';
 @B::LOOP::ISA = 'B::LISTOP';
 @B::PMOP::ISA = 'B::LISTOP';
 @B::COP::ISA = 'B::OP';
@@ -880,7 +881,7 @@ For constant subroutines, returns the constant SV returned by the subroutine.
 =head2 OP-RELATED CLASSES
 
 C<B::OP>, C<B::UNOP>, C<B::BINOP>, C<B::LOGOP>, C<B::LISTOP>, C<B::PMOP>,
-C<B::SVOP>, C<B::PADOP>, C<B::PVOP>, C<B::CVOP>, C<B::LOOP>, C<B::COP>.
+C<B::SVOP>, C<B::PADOP>, C<B::PVOP>, C<B::LOOP>, C<B::COP>.
 
 These classes correspond in the obvious way to the underlying C
 structures of similar names. The inheritance hierarchy mimics the
@@ -888,9 +889,9 @@ underlying C "inheritance":
 
                                  B::OP
                                    |
-                   +---------------+--------+--------+------+
-                   |               |        |        |      |
-                B::UNOP          B::SVOP B::PADOP B::CVOP B::COP
+                   +---------------+--------+--------+
+                   |               |        |        |
+                B::UNOP          B::SVOP B::PADOP  B::COP
                  ,'  `-.
                 /       `--.
            B::BINOP     B::LOGOP
@@ -990,7 +991,7 @@ This returns the op description from the global C PL_op_desc array
 
 =item precomp
 
-=item pmoffet
+=item pmoffset
 
 Only when perl was compiled with ithreads.
 

diff --git a/ext/B/B.xs b/ext/B/B.xs
index 595b928..868f15b 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -49,9 +49,8 @@ typedef enum {
     OPc_SVOP,  /* 7 */
     OPc_PADOP, /* 8 */
     OPc_PVOP,  /* 9 */
-    OPc_CVOP,  /* 10 */
-    OPc_LOOP,  /* 11 */
-    OPc_COP    /* 12 */
+    OPc_LOOP,  /* 10 */
+    OPc_COP    /* 11 */
 } opclass;
 
 static char *opclassnames[] = {
@@ -65,11 +64,25 @@ static char *opclassnames[] = {
     "B::SVOP",
     "B::PADOP",
     "B::PVOP",
-    "B::CVOP",
     "B::LOOP",
     "B::COP"   
 };
 
+static size_t opsizes[] = {
+    0, 
+    sizeof(OP),
+    sizeof(UNOP),
+    sizeof(BINOP),
+    sizeof(LOGOP),
+    sizeof(LISTOP),
+    sizeof(PMOP),
+    sizeof(SVOP),
+    sizeof(PADOP),
+    sizeof(PVOP),
+    sizeof(LOOP),
+    sizeof(COP)        
+};
+
 #define MY_CXT_KEY "B::_guts" XS_VERSION
 
 typedef struct {
@@ -447,12 +460,16 @@ BOOT:
 
 #define B_main_cv()    PL_main_cv
 #define B_init_av()    PL_initav
+#define B_inc_gv()     PL_incgv
 #define B_check_av()   PL_checkav_save
 #define B_begin_av()   PL_beginav_save
 #define B_end_av()     PL_endav
 #define B_main_root()  PL_main_root
 #define B_main_start() PL_main_start
 #define B_amagic_generation()  PL_amagic_generation
+#define B_defstash()   PL_defstash
+#define B_curstash()   PL_curstash
+#define B_dowarn()     PL_dowarn
 #define B_comppadlist()        (PL_main_cv ? CvPADLIST(PL_main_cv) : CvPADLIST(PL_compcv))
 #define B_sv_undef()   &PL_sv_undef
 #define B_sv_yes()     &PL_sv_yes
@@ -473,6 +490,9 @@ B_begin_av()
 B::AV
 B_end_av()
 
+B::GV
+B_inc_gv()
+
 #ifdef USE_ITHREADS
 
 B::AV
@@ -504,8 +524,26 @@ B_sv_yes()
 B::SV
 B_sv_no()
 
-MODULE = B     PACKAGE = B
+B::HV
+B_curstash()
+
+B::HV
+B_defstash()
 
+U8
+B_dowarn()
+
+void
+B_warnhook()
+    CODE:
+       ST(0) = make_sv_object(aTHX_ sv_newmortal(), PL_warnhook);
+
+void
+B_diehook()
+    CODE:
+       ST(0) = make_sv_object(aTHX_ sv_newmortal(), PL_diehook);
+
+MODULE = B     PACKAGE = B
 
 void
 walkoptree(opsv, method)
@@ -639,6 +677,14 @@ threadsv_names()
 
 MODULE = B     PACKAGE = B::OP         PREFIX = OP_
 
+size_t
+OP_size(o)
+       B::OP           o
+    CODE:
+       RETVAL = opsizes[cc_opclass(aTHX_ o)];
+    OUTPUT:
+       RETVAL
+
 B::OP
 OP_next(o)
        B::OP           o
@@ -739,6 +785,9 @@ LISTOP_children(o)
 #define PMOP_pmregexp(o)       PM_GETRE(o)
 #ifdef USE_ITHREADS
 #define PMOP_pmoffset(o)       o->op_pmoffset
+#define PMOP_pmstashpv(o)      o->op_pmstashpv
+#else
+#define PMOP_pmstash(o)                o->op_pmstash
 #endif
 #define PMOP_pmflags(o)                o->op_pmflags
 #define PMOP_pmpermflags(o)    o->op_pmpermflags
@@ -781,6 +830,16 @@ IV
 PMOP_pmoffset(o)
        B::PMOP         o
 
+char*
+PMOP_pmstashpv(o)
+       B::PMOP         o
+
+#else
+
+B::HV
+PMOP_pmstash(o)
+       B::PMOP         o
+
 #endif
 
 U32
@@ -929,6 +988,12 @@ B::SV
 COP_io(o)
        B::COP  o
 
+MODULE = B     PACKAGE = B::SV
+
+U32
+SvTYPE(sv)
+       B::SV   sv
+
 MODULE = B     PACKAGE = B::SV         PREFIX = Sv
 
 U32
@@ -939,6 +1004,18 @@ U32
 SvFLAGS(sv)
        B::SV   sv
 
+U32
+SvPOK(sv)
+       B::SV   sv
+
+U32
+SvROK(sv)
+       B::SV   sv
+
+U32
+SvMAGICAL(sv)
+       B::SV   sv
+
 MODULE = B     PACKAGE = B::IV         PREFIX = Sv
 
 IV
@@ -1038,6 +1115,15 @@ SvPV(sv)
             sv_setpvn(ST(0), NULL, 0);
         }
 
+void
+SvPVBM(sv)
+       B::PV   sv
+    CODE:
+        ST(0) = sv_newmortal();
+       sv_setpvn(ST(0), SvPVX(sv),
+           SvCUR(sv) + (SvTYPE(sv) == SVt_PVBM ? 257 : 0));
+
+
 STRLEN
 SvLEN(sv)
        B::PV   sv
@@ -1100,15 +1186,6 @@ MgFLAGS(mg)
 B::SV
 MgOBJ(mg)
        B::MAGIC        mg
-    CODE:
-        if( mg->mg_type != 'r' ) {
-            RETVAL = MgOBJ(mg);
-        }
-        else {
-            croak( "OBJ is not meaningful on r-magic" );
-        }
-    OUTPUT:
-        RETVAL
 
 IV
 MgREGEX(mg)
@@ -1150,9 +1227,9 @@ MgPTR(mg)
        if (mg->mg_ptr){
                if (mg->mg_len >= 0){
                        sv_setpvn(ST(0), mg->mg_ptr, mg->mg_len);
-               } else {
-                       if (mg->mg_len == HEf_SVKEY)    
-                               sv_setsv(ST(0),newRV((SV*)mg->mg_ptr));
+               } else if (mg->mg_len == HEf_SVKEY) {
+                       ST(0) = make_sv_object(aTHX_
+                                   sv_newmortal(), (SV*)mg->mg_ptr);
                }
        }
 
@@ -1214,6 +1291,10 @@ is_empty(gv)
     OUTPUT:
         RETVAL
 
+void*
+GvGP(gv)
+       B::GV   gv
+
 B::HV
 GvSTASH(gv)
        B::GV   gv
@@ -1386,6 +1467,10 @@ AvFLAGS(av)
 
 MODULE = B     PACKAGE = B::CV         PREFIX = Cv
 
+U32
+CvCONST(cv)
+       B::CV   cv
+
 B::HV
 CvSTASH(cv)
        B::CV   cv
@@ -1434,8 +1519,8 @@ CvXSUBANY(cv)
        B::CV   cv
     CODE:
        ST(0) = CvCONST(cv) ?
-                    make_sv_object(aTHX_ sv_newmortal(),CvXSUBANY(cv).any_ptr) :
-                    sv_2mortal(newSViv(CvXSUBANY(cv).any_iv));
+           make_sv_object(aTHX_ sv_newmortal(),CvXSUBANY(cv).any_ptr) :
+           sv_2mortal(newSViv(CvXSUBANY(cv).any_iv));
 
 MODULE = B    PACKAGE = B::CV
 

diff --git a/ext/B/B/Debug.pm b/ext/B/B/Debug.pm
index 1368bc8..684e6b2 100644 (file)
--- a/ext/B/B/Debug.pm
+++ b/ext/B/B/Debug.pm
@@ -104,12 +104,6 @@ sub B::PADOP::debug {
     printf "\top_padix\t\t%ld\n", $op->padix;
 }
 
-sub B::CVOP::debug {
-    my ($op) = @_;
-    $op->B::OP::debug();
-    printf "\top_cv\t\t0x%x\n", ${$op->cv};
-}
-
 sub B::NULL::debug {
     my ($sv) = @_;
     if ($$sv == ${sv_undef()}) {

diff --git a/ext/B/defsubs_h.PL b/ext/B/defsubs_h.PL
index 9748736..8a10bf4 100644 (file)
--- a/ext/B/defsubs_h.PL
+++ b/ext/B/defsubs_h.PL
@@ -6,6 +6,12 @@ my ($out) = __FILE__ =~ /(^.*)\.PL/i;
 $out =~ s/_h$/.h/;
 open(OUT,">$out") || die "Cannot open $file:$!";
 print "Extracting $out...\n";
+print OUT <<"END";
+/*
+ !!! Don't modify this file - it's autogenerated from $0 !!!
+ */
+END
+
 foreach my $const (qw(
                      AVf_REAL 
                      HEf_SVKEY
@@ -14,7 +20,7 @@ foreach my $const (qw(
                      GVf_IMPORTED_SV GVf_IMPORTED_CV
                      CVf_METHOD CVf_LOCKED CVf_LVALUE CVf_CONST CVf_ASSERTION
                       SVpad_OUR SVf_FAKE SVf_IOK SVf_IVisUV SVf_NOK SVf_POK 
-                     SVf_ROK SVp_IOK SVp_POK SVp_NOK
+                     SVf_ROK SVp_IOK SVp_POK SVp_NOK SVt_PVGV SVt_PVHV
                      ))
  {
   doconst($const);

diff --git a/ext/B/typemap b/ext/B/typemap
index ccbcd90..77a92ea 100644 (file)
--- a/ext/B/typemap
+++ b/ext/B/typemap
@@ -9,7 +9,6 @@ B::PMOP         T_OP_OBJ
 B::SVOP                T_OP_OBJ
 B::PADOP       T_OP_OBJ
 B::PVOP                T_OP_OBJ
-B::CVOP                T_OP_OBJ
 B::LOOP                T_OP_OBJ
 B::COP         T_OP_OBJ
 

diff --git a/t/op/magic.t b/t/op/magic.t
index 611a01b..b386e40 100755 (executable)
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -302,7 +302,7 @@ else {
             ok(!$ps ||   # we allow that something goes wrong with the ps command
                $ps eq "x", 'altering $0 is effective (testing with `ps`)');
        } else {
-           skip("\$0 check only on Linux and FreeBSD") for 0,1;
+           skip("\$0 check only on Linux and FreeBSD") for 0, 1;
        }
 }