From: Adrian M. Enache Date: Tue, 1 Jul 2003 19:51:25 +0000 (+0300) Subject: B:: fixes + 'When were CVOPs gone ?' X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=651aa52ea1faa8061eb86ace84ffe785cc94a922;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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, C, C, C, C, C, -C, C, C, C, C, C. +C, C, C, C, C. 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 --- 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 --- 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 --- 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 --- 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 --- 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; } }