static const char* const svclassnames[] = {
"B::NULL",
+#if PERL_VERSION >= 9
+ "B::BIND",
+#endif
"B::IV",
"B::NV",
+#if PERL_VERSION <= 10
"B::RV",
+#endif
"B::PV",
"B::PVIV",
"B::PVNV",
"B::PVMG",
+#if PERL_VERSION <= 8
"B::BM",
+#endif
+#if PERL_VERSION >= 11
+ "B::REGEXP",
+#endif
#if PERL_VERSION >= 9
"B::GV",
#endif
return arg;
}
+#if PERL_VERSION >= 9
static SV *
make_temp_object(pTHX_ SV *arg, SV *temp)
{
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);
+ SV *const value = newSV(0);
+
+ Perl_emulate_cop_io(aTHX_ cop, value);
+
+ if(SvOK(value)) {
return make_temp_object(aTHX_ arg, newSVsv(value));
} else {
+ SvREFCNT_dec(value);
return make_sv_object(aTHX_ arg, NULL);
}
}
+#endif
static SV *
make_mg_object(pTHX_ SV *arg, MAGIC *mg)
return sstr;
}
+#if PERL_VERSION >= 9
+# define PMOP_pmreplstart(o) o->op_pmstashstartu.op_pmreplstart
+# define PMOP_pmreplroot(o) o->op_pmreplrootu.op_pmreplroot
+#else
+# define PMOP_pmreplstart(o) o->op_pmreplstart
+# define PMOP_pmreplroot(o) o->op_pmreplroot
+# define PMOP_pmpermflags(o) o->op_pmpermflags
+# define PMOP_pmdynflags(o) o->op_pmdynflags
+#endif
+
static void
walkoptree(pTHX_ SV *opsv, const char *method)
{
}
}
if (o && (cc_opclass(aTHX_ o) == OPc_PMOP) && o->op_type != OP_PUSHRE
- && (kid = cPMOPo->op_pmreplroot))
+ && (kid = PMOP_pmreplroot(cPMOPo)))
{
sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), PTR2IV(kid));
walkoptree(aTHX_ opsv, method);
XPUSHs(opsv);
switch (o->op_type) {
case OP_SUBST:
- SP = oplist(aTHX_ cPMOPo->op_pmreplstart, SP);
+ SP = oplist(aTHX_ PMOP_pmreplstart(cPMOPo), SP);
continue;
case OP_SORT:
if (o->op_flags & OPf_STACKED && o->op_flags & OPf_SPECIAL) {
typedef SV *B__PV;
typedef SV *B__NV;
typedef SV *B__PVMG;
+#if PERL_VERSION >= 11
+typedef SV *B__REGEXP;
+#endif
typedef SV *B__PVLV;
typedef SV *B__BM;
typedef SV *B__RV;
typedef IO *B__IO;
typedef MAGIC *B__MAGIC;
+typedef HE *B__HE;
+#if PERL_VERSION >= 9
+typedef struct refcounted_he *B__RHE;
+#endif
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[5] = (SV *) pWARN_NONE;
specialsv_list[6] = (SV *) pWARN_STD;
#if PERL_VERSION <= 8
-# define CVf_ASSERTION 0
+# define OPpPAD_STATE 0
#endif
#include "defsubs.h"
}
#define B_init_av() PL_initav
#define B_inc_gv() PL_incgv
#define B_check_av() PL_checkav_save
+#if PERL_VERSION > 8
+# define B_unitcheck_av() PL_unitcheckav_save
+#else
+# define B_unitcheck_av() NULL
+#endif
#define B_begin_av() PL_beginav_save
#define B_end_av() PL_endav
#define B_main_root() PL_main_root
B::AV
B_check_av()
+#if PERL_VERSION >= 9
+
+B::AV
+B_unitcheck_av()
+
+#endif
+
B::AV
B_begin_av()
#define OP_type(o) o->op_type
#if PERL_VERSION >= 9
# define OP_opt(o) o->op_opt
-# define OP_static(o) o->op_static
#else
# define OP_seq(o) o->op_seq
#endif
#if PERL_VERSION >= 9
-U8
+U16
OP_opt(o)
B::OP o
-U8
-OP_static(o)
- B::OP o
-
#else
U16
#if PERL_VERSION >= 9
-U8
+U16
OP_spare(o)
B::OP o
OUTPUT:
RETVAL
-#define PMOP_pmreplroot(o) o->op_pmreplroot
-#define PMOP_pmreplstart(o) o->op_pmreplstart
#define PMOP_pmnext(o) o->op_pmnext
#define PMOP_pmregexp(o) PM_GETRE(o)
#ifdef USE_ITHREADS
#define PMOP_pmoffset(o) o->op_pmoffset
-#define PMOP_pmstashpv(o) o->op_pmstashpv
+#define PMOP_pmstashpv(o) PmopSTASHPV(o);
#else
-#define PMOP_pmstash(o) o->op_pmstash
+#define PMOP_pmstash(o) PmopSTASH(o);
#endif
#define PMOP_pmflags(o) o->op_pmflags
-#define PMOP_pmpermflags(o) o->op_pmpermflags
-#define PMOP_pmdynflags(o) o->op_pmdynflags
MODULE = B PACKAGE = B::PMOP PREFIX = PMOP_
+#if PERL_VERSION <= 8
+
void
PMOP_pmreplroot(o)
B::PMOP o
root = o->op_pmreplroot;
/* OP_PUSHRE stores an SV* instead of an OP* in op_pmreplroot */
if (o->op_type == OP_PUSHRE) {
-#ifdef USE_ITHREADS
+# ifdef USE_ITHREADS
sv_setiv(ST(0), INT2PTR(PADOFFSET,root) );
-#else
+# else
sv_setiv(newSVrv(ST(0), root ?
svclassnames[SvTYPE((SV*)root)] : "B::SV"),
PTR2IV(root));
-#endif
+# endif
}
else {
sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), PTR2IV(root));
}
+#else
+
+void
+PMOP_pmreplroot(o)
+ B::PMOP o
+ CODE:
+ ST(0) = sv_newmortal();
+ if (o->op_type == OP_PUSHRE) {
+# ifdef USE_ITHREADS
+ sv_setiv(ST(0), o->op_pmreplrootu.op_pmtargetoff);
+# else
+ GV *const target = o->op_pmreplrootu.op_pmtargetgv;
+ sv_setiv(newSVrv(ST(0), target ?
+ svclassnames[SvTYPE((SV*)target)] : "B::SV"),
+ PTR2IV(target));
+# endif
+ }
+ else {
+ OP *const root = o->op_pmreplrootu.op_pmreplroot;
+ sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)),
+ PTR2IV(root));
+ }
+
+#endif
+
B::OP
PMOP_pmreplstart(o)
B::PMOP o
+#if PERL_VERSION < 9
+
B::PMOP
PMOP_pmnext(o)
B::PMOP o
+#endif
+
#ifdef USE_ITHREADS
IV
PMOP_pmflags(o)
B::PMOP o
+#if PERL_VERSION < 9
+
U32
PMOP_pmpermflags(o)
B::PMOP o
PMOP_pmdynflags(o)
B::PMOP o
+#endif
+
void
PMOP_precomp(o)
B::PMOP o
ST(0) = sv_newmortal();
rx = PM_GETRE(o);
if (rx)
- sv_setpvn(ST(0), rx->precomp, rx->prelen);
+ sv_setpvn(ST(0), RX_PRECOMP(rx), RX_PRELEN(rx));
+
+#if PERL_VERSION >= 9
+
+void
+PMOP_reflags(o)
+ B::PMOP o
+ REGEXP * rx = NO_INIT
+ CODE:
+ ST(0) = sv_newmortal();
+ rx = PM_GETRE(o);
+ if (rx)
+ sv_setuv(ST(0), RX_EXTFLAGS(rx));
+
+#endif
#define SVOP_sv(o) cSVOPo->op_sv
#define SVOP_gv(o) ((GV*)cSVOPo->op_sv)
#define PADOP_sv(o) (o->op_padix ? PAD_SVl(o->op_padix) : Nullsv)
#define PADOP_gv(o) ((o->op_padix \
&& SvTYPE(PAD_SVl(o->op_padix)) == SVt_PVGV) \
- ? (GV*)PAD_SVl(o->op_padix) : Nullgv)
+ ? (GV*)PAD_SVl(o->op_padix) : (GV *)NULL)
MODULE = B PACKAGE = B::PADOP PREFIX = PADOP_
LOOP_lastop(o)
B::LOOP o
-#define COP_label(o) o->cop_label
+#define COP_label(o) CopLABEL(o)
#define COP_stashpv(o) CopSTASHPV(o)
#define COP_stash(o) CopSTASH(o)
#define COP_file(o) CopFILE(o)
#define COP_arybase(o) CopARYBASE_get(o)
#define COP_line(o) CopLINE(o)
#define COP_hints(o) CopHINTS_get(o)
+#if PERL_VERSION < 9
+# define COP_warnings(o) o->cop_warnings
+# define COP_io(o) o->cop_io
+#endif
MODULE = B PACKAGE = B::COP PREFIX = COP_
+#if PERL_VERSION >= 11
+
+const char *
+COP_label(o)
+ B::COP o
+
+#else
+
char *
COP_label(o)
B::COP o
+#endif
+
char *
COP_stashpv(o)
B::COP o
COP_line(o)
B::COP o
+#if PERL_VERSION >= 9
+
void
COP_warnings(o)
B::COP o
ST(0) = make_cop_io_object(aTHX_ sv_newmortal(), o);
XSRETURN(1);
+B::RHE
+COP_hints_hash(o)
+ B::COP o
+ CODE:
+ RETVAL = o->cop_hints_hash;
+ OUTPUT:
+ RETVAL
+
+#else
+
+B::SV
+COP_warnings(o)
+ B::COP o
+
+B::SV
+COP_io(o)
+ B::COP o
+
+#endif
+
U32
COP_hints(o)
B::COP o
ST(0) = sv_2mortal(newSVpvn((char *)&w, 4));
}
+
+#if PERL_VERSION >= 11
+
+B::SV
+RV(sv)
+ B::IV sv
+ CODE:
+ if( SvROK(sv) ) {
+ RETVAL = SvRV(sv);
+ }
+ else {
+ croak( "argument is not SvROK" );
+ }
+ OUTPUT:
+ RETVAL
+
+#endif
+
MODULE = B PACKAGE = B::NV PREFIX = Sv
NV
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
+
+#if PERL_VERSION < 11
+
MODULE = B PACKAGE = B::RV PREFIX = Sv
B::SV
SvRV(sv)
B::RV sv
+#endif
+
MODULE = B PACKAGE = B::PV PREFIX = Sv
char*
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
SvSTASH(sv)
B::PVMG sv
+MODULE = B PACKAGE = B::REGEXP
+
+#if PERL_VERSION >= 11
+
+IV
+REGEX(sv)
+ B::REGEXP sv
+ CODE:
+ /* FIXME - can we code this method more efficiently? */
+ RETVAL = PTR2IV(sv);
+ OUTPUT:
+ RETVAL
+
+SV*
+precomp(sv)
+ B::REGEXP sv
+ CODE:
+ RETVAL = newSVpvn( RX_PRECOMP(sv), RX_PRELEN(sv) );
+ OUTPUT:
+ RETVAL
+
+#endif
+
#define MgMOREMAGIC(mg) mg->mg_moremagic
#define MgPRIVATE(mg) mg->mg_private
#define MgTYPE(mg) mg->mg_type
REGEXP* rx = (REGEXP*)mg->mg_obj;
RETVAL = Nullsv;
if( rx )
- RETVAL = newSVpvn( rx->precomp, rx->prelen );
+ RETVAL = newSVpvn( RX_PRECOMP(rx), RX_PRELEN(rx) );
}
else {
croak( "precomp is only meaningful on r-magic" );
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
OUTPUT:
RETVAL
+bool
+isGV_with_GP(gv)
+ B::GV gv
+ CODE:
+#if PERL_VERSION >= 9
+ RETVAL = isGV_with_GP(gv) ? TRUE : FALSE;
+#else
+ RETVAL = TRUE; /* In 5.8 and earlier they all are. */
+#endif
+ OUTPUT:
+ RETVAL
+
void*
GvGP(gv)
B::GV gv
IoBOTTOM_GV(io)
B::IO io
+#if PERL_VERSION <= 8
+
short
IoSUBPROCESS(io)
B::IO io
+#endif
+
bool
IsSTD(io,name)
B::IO io
(void)hv_iterinit(hv);
EXTEND(sp, HvKEYS(hv) * 2);
while ((sv = hv_iternextsv(hv, &key, &len))) {
- PUSHs(newSVpvn(key, len));
+ mPUSHp(key, len);
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_
+
+#if PERL_VERSION >= 9
+
+SV*
+RHE_HASH(h)
+ B::RHE h
+ CODE:
+ RETVAL = newRV( (SV*)Perl_refcounted_he_chain_2hv(aTHX_ h) );
+ OUTPUT:
+ RETVAL
+
+#endif
projects / p5sagit/p5-mst-13.2.git / blobdiff