static const char* const svclassnames[] = {
"B::NULL",
+#if PERL_VERSION >= 9
+ "B::BIND",
+#endif
"B::IV",
"B::NV",
"B::RV",
"B::PVIV",
"B::PVNV",
"B::PVMG",
+#if PERL_VERSION <= 8
"B::BM",
+#endif
#if PERL_VERSION >= 9
"B::GV",
#endif
if (o->op_type == OP_SASSIGN)
return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
+ if (o->op_type == OP_AELEMFAST) {
+ if (o->op_flags & OPf_SPECIAL)
+ return OPc_BASEOP;
+ else
+#ifdef USE_ITHREADS
+ return OPc_PADOP;
+#else
+ return OPc_SVOP;
+#endif
+ }
+
#ifdef USE_ITHREADS
if (o->op_type == OP_GV || o->op_type == OP_GVSV ||
- o->op_type == OP_AELEMFAST || o->op_type == OP_RCATLINE)
+ o->op_type == OP_RCATLINE)
return OPc_PADOP;
#endif
}
static SV *
+make_temp_object(pTHX_ SV *arg, SV *temp)
+{
+ SV *target;
+ const char *const type = svclassnames[SvTYPE(temp)];
+ const IV iv = PTR2IV(temp);
+
+ target = newSVrv(arg, type);
+ sv_setiv(target, iv);
+
+ /* Need to keep our "temp" around as long as the target exists.
+ Simplest way seems to be to hang it from magic, and let that clear
+ it up. No vtable, so won't actually get in the way of anything. */
+ sv_magicext(target, temp, PERL_MAGIC_sv, NULL, NULL, 0);
+ /* magic object has had its reference count increased, so we must drop
+ our reference. */
+ SvREFCNT_dec(temp);
+ return arg;
+}
+
+static SV *
+make_warnings_object(pTHX_ SV *arg, STRLEN *warnings)
+{
+ const char *type = 0;
+ dMY_CXT;
+ IV iv = sizeof(specialsv_list)/sizeof(SV*);
+
+ /* Counting down is deliberate. Before the split between make_sv_object
+ and make_warnings_obj there appeared to be a bug - Nullsv and pWARN_STD
+ were both 0, so you could never get a B::SPECIAL for pWARN_STD */
+
+ while (iv--) {
+ if ((SV*)warnings == specialsv_list[iv]) {
+ type = "B::SPECIAL";
+ break;
+ }
+ }
+ if (type) {
+ sv_setiv(newSVrv(arg, type), iv);
+ return arg;
+ } else {
+ /* B assumes that warnings are a regular SV. Seems easier to keep it
+ happy by making them into a regular SV. */
+ return make_temp_object(aTHX_ arg,
+ newSVpvn((char *)(warnings + 1), *warnings));
+ }
+}
+
+static SV *
+make_cop_io_object(pTHX_ SV *arg, COP *cop)
+{
+ if (CopHINTS_get(cop) & HINT_LEXICAL_IO) {
+ /* I feel you should be able to simply SvREFCNT_inc the return value
+ from this, but if you do (and restore the line
+ my $ioix = $cop->io->ix;
+ in B::COP::bsave in Bytecode.pm, then you get errors about
+ "attempt to free temp prematurely ... during global destruction.
+ The SV's flags are consistent with the error, but quite how the
+ temp escaped from the save stack is not clear. */
+ SV *value = Perl_refcounted_he_fetch(aTHX_ cop->cop_hints_hash,
+ 0, "open", 4, 0, 0);
+ return make_temp_object(aTHX_ arg, newSVsv(value));
+ } else {
+ return make_sv_object(aTHX_ arg, NULL);
+ }
+}
+
+static SV *
make_mg_object(pTHX_ SV *arg, MAGIC *mg)
{
sv_setiv(newSVrv(arg, "B::MAGIC"), PTR2IV(mg));
typedef IO *B__IO;
typedef MAGIC *B__MAGIC;
+typedef HE *B__HE;
+typedef struct refcounted_he *B__RHE;
MODULE = B PACKAGE = B PREFIX = B_
BOOT:
{
- HV *stash = gv_stashpvn("B", 1, TRUE);
+ HV *stash = gv_stashpvn("B", 1, GV_ADD);
AV *export_ok = perl_get_av("B::EXPORT_OK",TRUE);
MY_CXT_INIT;
specialsv_list[0] = Nullsv;
specialsv_list[1] = &PL_sv_undef;
specialsv_list[2] = &PL_sv_yes;
specialsv_list[3] = &PL_sv_no;
- specialsv_list[4] = pWARN_ALL;
- specialsv_list[5] = pWARN_NONE;
- specialsv_list[6] = pWARN_STD;
+ specialsv_list[4] = (SV *) pWARN_ALL;
+ specialsv_list[5] = (SV *) pWARN_NONE;
+ specialsv_list[6] = (SV *) pWARN_STD;
#if PERL_VERSION <= 8
# define CVf_ASSERTION 0
#endif
#define B_init_av() PL_initav
#define B_inc_gv() PL_incgv
#define B_check_av() PL_checkav_save
+#define B_unitcheck_av() PL_unitcheckav_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_sub_generation() PL_sub_generation
#define B_defstash() PL_defstash
#define B_curstash() PL_curstash
#define B_dowarn() PL_dowarn
B_check_av()
B::AV
+B_unitcheck_av()
+
+B::AV
B_begin_av()
B::AV
long
B_amagic_generation()
+long
+B_sub_generation()
+
B::AV
B_comppadlist()
#define COP_file(o) CopFILE(o)
#define COP_filegv(o) CopFILEGV(o)
#define COP_cop_seq(o) o->cop_seq
-#define COP_arybase(o) o->cop_arybase
+#define COP_arybase(o) CopARYBASE_get(o)
#define COP_line(o) CopLINE(o)
-#define COP_warnings(o) o->cop_warnings
-#define COP_io(o) o->cop_io
+#define COP_hints(o) CopHINTS_get(o)
MODULE = B PACKAGE = B::COP PREFIX = COP_
COP_line(o)
B::COP o
-B::SV
+void
COP_warnings(o)
B::COP o
+ PPCODE:
+ ST(0) = make_warnings_object(aTHX_ sv_newmortal(), o->cop_warnings);
+ XSRETURN(1);
-B::SV
+void
COP_io(o)
B::COP o
+ PPCODE:
+ ST(0) = make_cop_io_object(aTHX_ sv_newmortal(), o);
+ XSRETURN(1);
+
+U32
+COP_hints(o)
+ B::COP o
+
+B::RHE
+COP_hints_hash(o)
+ B::COP o
+ CODE:
+ RETVAL = o->cop_hints_hash;
+ OUTPUT:
+ RETVAL
MODULE = B PACKAGE = B::SV
SvNVX(sv)
B::NV sv
+U32
+COP_SEQ_RANGE_LOW(sv)
+ B::NV sv
+
+U32
+COP_SEQ_RANGE_HIGH(sv)
+ B::NV sv
+
+U32
+PARENT_PAD_INDEX(sv)
+ B::NV sv
+
+U32
+PARENT_FAKELEX_FLAGS(sv)
+ B::NV sv
+
MODULE = B PACKAGE = B::RV PREFIX = Sv
B::SV
sv_setpvn(ST(0), NULL, 0);
}
+# This used to read 257. I think that that was buggy - should have been 258.
+# (The "\0", the flags byte, and 256 for the table. Not that anything
+# anywhere calls this method. NWC.
void
SvPVBM(sv)
B::PV sv
CODE:
ST(0) = sv_newmortal();
sv_setpvn(ST(0), SvPVX_const(sv),
- SvCUR(sv) + (SvTYPE(sv) == SVt_PVBM ? 257 : 0));
+ SvCUR(sv) + (SvVALID(sv) ? 256 + PERL_FBM_TABLE_OFFSET : 0));
STRLEN
MgREGEX(mg)
B::MAGIC mg
CODE:
- if( mg->mg_type == 'r' ) {
+ if(mg->mg_type == PERL_MAGIC_qr) {
RETVAL = MgREGEX(mg);
}
else {
precomp(mg)
B::MAGIC mg
CODE:
- if (mg->mg_type == 'r') {
+ if (mg->mg_type == PERL_MAGIC_qr) {
REGEXP* rx = (REGEXP*)mg->mg_obj;
+ RETVAL = Nullsv;
if( rx )
RETVAL = newSVpvn( rx->precomp, rx->prelen );
}
BmUSEFUL(sv)
B::BM sv
-U16
+U32
BmPREVIOUS(sv)
B::BM sv
CODE:
str = SvPV(sv, len);
/* Boyer-Moore table is just after string and its safety-margin \0 */
- ST(0) = sv_2mortal(newSVpvn(str + len + 1, 256));
+ ST(0) = sv_2mortal(newSVpvn(str + len + PERL_FBM_TABLE_OFFSET, 256));
MODULE = B PACKAGE = B::GV PREFIX = Gv
AvMAX(av)
B::AV av
+#if PERL_VERSION < 9
+
+
+#define AvOFF(av) ((XPVAV*)SvANY(av))->xof_off
+
+IV
+AvOFF(av)
+ B::AV av
+
+#endif
+
void
AvARRAY(av)
B::AV av
else
XPUSHs(make_sv_object(aTHX_ sv_newmortal(), NULL));
+#if PERL_VERSION < 9
+
+MODULE = B PACKAGE = B::AV
+
+U8
+AvFLAGS(av)
+ B::AV av
+
+#endif
+
MODULE = B PACKAGE = B::FM PREFIX = Fm
IV
B::OP
CvSTART(cv)
B::CV cv
+ CODE:
+ RETVAL = CvISXSUB(cv) ? NULL : CvSTART(cv);
+ OUTPUT:
+ RETVAL
B::OP
CvROOT(cv)
B::CV cv
+ CODE:
+ RETVAL = CvISXSUB(cv) ? NULL : CvROOT(cv);
+ OUTPUT:
+ RETVAL
B::GV
CvGV(cv)
CvXSUB(cv)
B::CV cv
CODE:
- ST(0) = sv_2mortal(newSViv(PTR2IV(CvXSUB(cv))));
+ ST(0) = sv_2mortal(newSViv(CvISXSUB(cv) ? PTR2IV(CvXSUB(cv)) : 0));
void
CODE:
ST(0) = CvCONST(cv) ?
make_sv_object(aTHX_ sv_newmortal(),(SV *)CvXSUBANY(cv).any_ptr) :
- sv_2mortal(newSViv(CvXSUBANY(cv).any_iv));
+ sv_2mortal(newSViv(CvISXSUB(cv) ? CvXSUBANY(cv).any_iv : 0));
MODULE = B PACKAGE = B::CV
HvNAME(hv)
B::HV hv
+#if PERL_VERSION < 9
+
+B::PMOP
+HvPMROOT(hv)
+ B::HV hv
+
+#endif
+
void
HvARRAY(hv)
B::HV hv
PUSHs(make_sv_object(aTHX_ sv_newmortal(), sv));
}
}
+
+MODULE = B PACKAGE = B::HE PREFIX = He
+
+B::SV
+HeVAL(he)
+ B::HE he
+
+U32
+HeHASH(he)
+ B::HE he
+
+B::SV
+HeSVKEY_force(he)
+ B::HE he
+
+MODULE = B PACKAGE = B::RHE PREFIX = RHE_
+
+SV*
+RHE_HASH(h)
+ B::RHE h
+ CODE:
+ RETVAL = newRV( (SV*)Perl_refcounted_he_chain_2hv(aTHX_ h) );
+ OUTPUT:
+ RETVAL