Change 19916 by [EMAIL PROTECTED] on 2003/07/01 16:51:31
Subject: [PATCH] B:: fixes + 'When were CVOPs gone ?'
From: Enache Adrian <[EMAIL PROTECTED]>
Date: Tue, 1 Jul 2003 19:51:25 +0300
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/ext/B/B.pm#52 edit
... //depot/perl/ext/B/B.xs#83 edit
... //depot/perl/ext/B/B/Debug.pm#21 edit
... //depot/perl/ext/B/defsubs_h.PL#16 edit
... //depot/perl/ext/B/typemap#8 edit
... //depot/perl/t/op/magic.t#61 edit
Differences ...
==== //depot/perl/ext/B/B.pm#52 (text) ====
Index: perl/ext/B/B.pm
--- perl/ext/B/B.pm#51~19886~ Sun Jun 29 12:18:43 2003
+++ perl/ext/B/B.pm Tue Jul 1 09:51:31 2003
@@ -21,7 +21,9 @@
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 @@
@B::SVOP::ISA = 'B::OP';
@B::PADOP::ISA = 'B::OP';
@B::PVOP::ISA = 'B::OP';
[EMAIL PROTECTED]::CVOP::ISA = 'B::OP';
@B::LOOP::ISA = 'B::LISTOP';
@B::PMOP::ISA = 'B::LISTOP';
@B::COP::ISA = 'B::OP';
@@ -880,7 +881,7 @@
=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 @@
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 @@
=item precomp
-=item pmoffet
+=item pmoffset
Only when perl was compiled with ithreads.
==== //depot/perl/ext/B/B.xs#83 (text) ====
Index: perl/ext/B/B.xs
--- perl/ext/B/B.xs#82~18856~ Sat Mar 8 12:16:36 2003
+++ perl/ext/B/B.xs Tue Jul 1 09:51:31 2003
@@ -49,9 +49,8 @@
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 @@
"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 @@
#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::AV
B_end_av()
+B::GV
+B_inc_gv()
+
#ifdef USE_ITHREADS
B::AV
@@ -504,8 +524,26 @@
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 @@
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 @@
#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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
OUTPUT:
RETVAL
+void*
+GvGP(gv)
+ B::GV gv
+
B::HV
GvSTASH(gv)
B::GV gv
@@ -1386,6 +1467,10 @@
MODULE = B PACKAGE = B::CV PREFIX = Cv
+U32
+CvCONST(cv)
+ B::CV cv
+
B::HV
CvSTASH(cv)
B::CV cv
@@ -1434,8 +1519,8 @@
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
==== //depot/perl/ext/B/B/Debug.pm#21 (text) ====
Index: perl/ext/B/B/Debug.pm
--- perl/ext/B/B/Debug.pm#20~18856~ Sat Mar 8 12:16:36 2003
+++ perl/ext/B/B/Debug.pm Tue Jul 1 09:51:31 2003
@@ -104,12 +104,6 @@
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()}) {
==== //depot/perl/ext/B/defsubs_h.PL#16 (text) ====
Index: perl/ext/B/defsubs_h.PL
--- perl/ext/B/defsubs_h.PL#15~18727~ Sun Feb 16 05:55:10 2003
+++ perl/ext/B/defsubs_h.PL Tue Jul 1 09:51:31 2003
@@ -6,6 +6,12 @@
$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 @@
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);
==== //depot/perl/ext/B/typemap#8 (text) ====
Index: perl/ext/B/typemap
--- perl/ext/B/typemap#7~18984~ Fri Mar 14 11:38:57 2003
+++ perl/ext/B/typemap Tue Jul 1 09:51:31 2003
@@ -9,7 +9,6 @@
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
==== //depot/perl/t/op/magic.t#61 (xtext) ====
Index: perl/t/op/magic.t
--- perl/t/op/magic.t#60~19887~ Mon Jun 30 00:20:58 2003
+++ perl/t/op/magic.t Tue Jul 1 09:51:31 2003
@@ -302,7 +302,7 @@
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;
}
}
End of Patch.
