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
}
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_
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
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
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
projects / p5sagit/p5-mst-13.2.git / blobdiff