"B::PVNV",
"B::PVMG",
"B::BM",
+#if PERL_VERSION >= 9
+ "B::GV",
+#endif
"B::PVLV",
"B::AV",
"B::HV",
"B::CV",
+#if PERL_VERSION <= 8
"B::GV",
+#endif
"B::FM",
"B::IO",
};
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[] = {
"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 {
return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
#ifdef USE_ITHREADS
- if (o->op_type == OP_GV || o->op_type == OP_GVSV || o->op_type == OP_AELEMFAST)
+ if (o->op_type == OP_GV || o->op_type == OP_GVSV ||
+ o->op_type == OP_AELEMFAST || o->op_type == OP_RCATLINE)
return OPc_PADOP;
#endif
}
static SV *
-cstring(pTHX_ SV *sv)
+cstring(pTHX_ SV *sv, bool perlstyle)
{
SV *sstr = newSVpvn("", 0);
STRLEN len;
if (!SvOK(sv))
sv_setpvn(sstr, "0", 1);
+ else if (perlstyle && SvUTF8(sv))
+ {
+ SV *tmpsv = sv_newmortal(); /* Temporary SV to feed sv_uni_display */
+ len = SvCUR(sv);
+ s = sv_uni_display(tmpsv, sv, 8*len, UNI_DISPLAY_QQ);
+ sv_setpv(sstr,"\"");
+ while (*s)
+ {
+ if (*s == '"')
+ sv_catpv(sstr, "\\\"");
+ else if (*s == '$')
+ sv_catpv(sstr, "\\$");
+ else if (*s == '@')
+ sv_catpv(sstr, "\\@");
+ else if (*s == '\\')
+ {
+ if (strchr("nrftax\\",*(s+1)))
+ sv_catpvn(sstr, s++, 2);
+ else
+ sv_catpv(sstr, "\\\\");
+ }
+ else /* should always be printable */
+ sv_catpvn(sstr, s, 1);
+ ++s;
+ }
+ sv_catpv(sstr, "\"");
+ return sstr;
+ }
else
{
/* XXX Optimise? */
else if (*s == '\\')
sv_catpv(sstr, "\\\\");
/* trigraphs - bleagh */
- else if (*s == '?' && len>=3 && s[1] == '?')
+ else if (!perlstyle && *s == '?' && len>=3 && s[1] == '?')
{
sprintf(escbuff, "\\%03o", '?');
sv_catpv(sstr, escbuff);
}
- else if (*s >= ' ' && *s < 127) /* XXX not portable */
+ else if (perlstyle && *s == '$')
+ sv_catpv(sstr, "\\$");
+ else if (perlstyle && *s == '@')
+ sv_catpv(sstr, "\\@");
+#ifdef EBCDIC
+ else if (isPRINT(*s))
+#else
+ else if (*s >= ' ' && *s < 127)
+#endif /* EBCDIC */
sv_catpvn(sstr, s, 1);
else if (*s == '\n')
sv_catpv(sstr, "\\n");
sv_catpv(sstr, "\\b");
else if (*s == '\f')
sv_catpv(sstr, "\\f");
- else if (*s == '\v')
+ else if (!perlstyle && *s == '\v')
sv_catpv(sstr, "\\v");
else
{
sv_catpv(sstr, "\\'");
else if (*s == '\\')
sv_catpv(sstr, "\\\\");
- else if (*s >= ' ' && *s < 127) /* XXX not portable */
+#ifdef EBCDIC
+ else if (isPRINT(*s))
+#else
+ else if (*s >= ' ' && *s < 127)
+#endif /* EBCDIC */
sv_catpvn(sstr, s, 1);
else if (*s == '\n')
sv_catpv(sstr, "\\n");
walkoptree(pTHX_ SV *opsv, char *method)
{
dSP;
- OP *o;
+ OP *o, *kid;
dMY_CXT;
if (!SvROK(opsv))
PUTBACK;
perl_call_method(method, G_DISCARD);
if (o && (o->op_flags & OPf_KIDS)) {
- OP *kid;
for (kid = ((UNOP*)o)->op_first; kid; kid = kid->op_sibling) {
/* Use the same opsv. Rely on methods not to mess it up. */
sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), PTR2IV(kid));
walkoptree(aTHX_ opsv, method);
}
}
+ if (o && (cc_opclass(aTHX_ o) == OPc_PMOP)
+ && (kid = cPMOPo->op_pmreplroot))
+ {
+ sv_setiv(newSVrv(opsv, opclassnames[OPc_PMOP]), PTR2IV(kid));
+ walkoptree(aTHX_ opsv, method);
+ }
+}
+
+SV **
+oplist(pTHX_ OP *o, SV **SP)
+{
+ for(; o; o = o->op_next) {
+ SV *opsv;
+#if PERL_VERSION >= 9
+ if (o->op_opt == 0)
+ break;
+ o->op_opt = 0;
+#else
+ if (o->op_seq == 0)
+ break;
+ o->op_seq = 0;
+#endif
+ opsv = sv_newmortal();
+ sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ (OP*)o)), PTR2IV(o));
+ XPUSHs(opsv);
+ switch (o->op_type) {
+ case OP_SUBST:
+ SP = oplist(aTHX_ cPMOPo->op_pmreplstart, SP);
+ continue;
+ case OP_SORT:
+ if (o->op_flags & OPf_STACKED && o->op_flags & OPf_SPECIAL) {
+ OP *kid = cLISTOPo->op_first->op_sibling; /* pass pushmark */
+ kid = kUNOP->op_first; /* pass rv2gv */
+ kid = kUNOP->op_first; /* pass leave */
+ SP = oplist(aTHX_ kid->op_next, SP);
+ }
+ continue;
+ }
+ switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
+ case OA_LOGOP:
+ SP = oplist(aTHX_ cLOGOPo->op_other, SP);
+ break;
+ case OA_LOOP:
+ SP = oplist(aTHX_ cLOOPo->op_lastop, SP);
+ SP = oplist(aTHX_ cLOOPo->op_nextop, SP);
+ SP = oplist(aTHX_ cLOOPo->op_redoop, SP);
+ break;
+ }
+ }
+ return SP;
}
typedef OP *B__OP;
typedef SV *B__PVLV;
typedef SV *B__BM;
typedef SV *B__RV;
+typedef SV *B__FM;
typedef AV *B__AV;
typedef HV *B__HV;
typedef CV *B__CV;
specialsv_list[4] = pWARN_ALL;
specialsv_list[5] = pWARN_NONE;
specialsv_list[6] = pWARN_STD;
+#if PERL_VERSION <= 8
+# define CVf_ASSERTION 0
+#endif
#include "defsubs.h"
}
#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
#define B_sv_no() &PL_sv_no
+#define B_formfeed() PL_formfeed
#ifdef USE_ITHREADS
#define B_regex_padav() PL_regex_padav
#endif
B_init_av()
B::AV
+B_check_av()
+
+B::AV
B_begin_av()
B::AV
B_end_av()
+B::GV
+B_inc_gv()
+
#ifdef USE_ITHREADS
B::AV
B::SV
B_sv_no()
-MODULE = B PACKAGE = B
+B::HV
+B_curstash()
+
+B::HV
+B_defstash()
+U8
+B_dowarn()
+
+B::SV
+B_formfeed()
+
+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)
cstring(sv)
SV * sv
CODE:
- RETVAL = cstring(aTHX_ sv);
+ RETVAL = cstring(aTHX_ sv, 0);
+ OUTPUT:
+ RETVAL
+
+SV *
+perlstring(sv)
+ SV * sv
+ CODE:
+ RETVAL = cstring(aTHX_ sv, 1);
OUTPUT:
RETVAL
void
threadsv_names()
PPCODE:
-#ifdef USE_5005THREADS
+#if PERL_VERSION <= 8
+# ifdef USE_5005THREADS
int i;
STRLEN len = strlen(PL_threadsv_names);
EXTEND(sp, len);
for (i = 0; i < len; i++)
PUSHs(sv_2mortal(newSVpvn(&PL_threadsv_names[i], 1)));
+# endif
#endif
-
#define OP_next(o) o->op_next
#define OP_sibling(o) o->op_sibling
#define OP_desc(o) PL_op_desc[o->op_type]
#define OP_targ(o) o->op_targ
#define OP_type(o) o->op_type
-#define OP_seq(o) o->op_seq
+#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
#define OP_flags(o) o->op_flags
#define OP_private(o) o->op_private
+#define OP_spare(o) o->op_spare
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
CODE:
sv_setpvn(sv, "PL_ppaddr[OP_", 13);
sv_catpv(sv, PL_op_name[o->op_type]);
- for (i=13; i<SvCUR(sv); ++i)
+ for (i=13; (STRLEN)i < SvCUR(sv); ++i)
SvPVX(sv)[i] = toUPPER(SvPVX(sv)[i]);
sv_catpv(sv, "]");
ST(0) = sv;
OP_type(o)
B::OP o
+#if PERL_VERSION >= 9
+
+U8
+OP_opt(o)
+ B::OP o
+
+U8
+OP_static(o)
+ B::OP o
+
+#else
+
U16
OP_seq(o)
B::OP o
+#endif
+
U8
OP_flags(o)
B::OP o
OP_private(o)
B::OP o
+#if PERL_VERSION >= 9
+
+U8
+OP_spare(o)
+ B::OP o
+
+#endif
+
+void
+OP_oplist(o)
+ B::OP o
+ PPCODE:
+ SP = oplist(aTHX_ o, SP);
+
#define UNOP_first(o) o->op_first
MODULE = B PACKAGE = B::UNOP PREFIX = UNOP_
#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
PMOP_pmoffset(o)
B::PMOP o
+char*
+PMOP_pmstashpv(o)
+ B::PMOP o
+
+#else
+
+B::HV
+PMOP_pmstash(o)
+ B::PMOP o
+
#endif
-U16
+U32
PMOP_pmflags(o)
B::PMOP o
-U16
+U32
PMOP_pmpermflags(o)
B::PMOP o
B::SVOP o
#define PADOP_padix(o) o->op_padix
-#define PADOP_sv(o) (o->op_padix ? PL_curpad[o->op_padix] : Nullsv)
+#define PADOP_sv(o) (o->op_padix ? PAD_SVl(o->op_padix) : Nullsv)
#define PADOP_gv(o) ((o->op_padix \
- && SvTYPE(PL_curpad[o->op_padix]) == SVt_PVGV) \
- ? (GV*)PL_curpad[o->op_padix] : Nullgv)
+ && SvTYPE(PAD_SVl(o->op_padix)) == SVt_PVGV) \
+ ? (GV*)PAD_SVl(o->op_padix) : Nullgv)
MODULE = B PACKAGE = B::PADOP PREFIX = PADOP_
#define COP_stashpv(o) CopSTASHPV(o)
#define COP_stash(o) CopSTASH(o)
#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_line(o) CopLINE(o)
#define COP_warnings(o) o->cop_warnings
+#define COP_io(o) o->cop_io
MODULE = B PACKAGE = B::COP PREFIX = COP_
COP_file(o)
B::COP o
+B::GV
+COP_filegv(o)
+ B::COP o
+
+
U32
COP_cop_seq(o)
B::COP o
COP_arybase(o)
B::COP o
-U16
+U32
COP_line(o)
B::COP o
COP_warnings(o)
B::COP o
+B::SV
+COP_io(o)
+ B::COP o
+
+MODULE = B PACKAGE = B::SV
+
+U32
+SvTYPE(sv)
+ B::SV sv
+
+#define object_2svref(sv) sv
+#define SVREF SV *
+
+SVREF
+object_2svref(sv)
+ B::SV sv
+
MODULE = B PACKAGE = B::SV PREFIX = Sv
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
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
#define MgFLAGS(mg) mg->mg_flags
#define MgOBJ(mg) mg->mg_obj
#define MgLENGTH(mg) mg->mg_len
-#define MgREGEX(mg) ((IV)(mg->mg_obj))
+#define MgREGEX(mg) PTR2IV(mg->mg_obj)
MODULE = B PACKAGE = B::MAGIC PREFIX = Mg
B::MAGIC
MgMOREMAGIC(mg)
B::MAGIC mg
+ CODE:
+ if( MgMOREMAGIC(mg) ) {
+ RETVAL = MgMOREMAGIC(mg);
+ }
+ else {
+ XSRETURN_UNDEF;
+ }
+ OUTPUT:
+ RETVAL
U16
MgPRIVATE(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)
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);
}
}
OUTPUT:
RETVAL
+void*
+GvGP(gv)
+ B::GV gv
+
B::HV
GvSTASH(gv)
B::GV gv
GvIO(gv)
B::GV gv
-B::CV
+B::FM
GvFORM(gv)
B::GV gv
+ CODE:
+ RETVAL = (SV*)GvFORM(gv);
+ OUTPUT:
+ RETVAL
B::AV
GvAV(gv)
GvCVGEN(gv)
B::GV gv
-U16
+U32
GvLINE(gv)
B::GV gv
XPUSHs(make_sv_object(aTHX_ sv_newmortal(), svp[i]));
}
+void
+AvARRAYelt(av, idx)
+ B::AV av
+ int idx
+ PPCODE:
+ if (idx >= 0 && AvFILL(av) >= 0 && idx <= AvFILL(av))
+ XPUSHs(make_sv_object(aTHX_ sv_newmortal(), (AvARRAY(av)[idx])));
+ else
+ XPUSHs(make_sv_object(aTHX_ sv_newmortal(), NULL));
+
+
MODULE = B PACKAGE = B::AV
U8
AvFLAGS(av)
B::AV av
+MODULE = B PACKAGE = B::FM PREFIX = Fm
+
+IV
+FmLINES(form)
+ B::FM form
+
MODULE = B PACKAGE = B::CV PREFIX = Cv
+U32
+CvCONST(cv)
+ B::CV cv
+
B::HV
CvSTASH(cv)
B::CV cv
CvOUTSIDE(cv)
B::CV cv
+U32
+CvOUTSIDE_SEQ(cv)
+ B::CV cv
+
void
CvXSUB(cv)
B::CV 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
projects / p5sagit/p5-mst-13.2.git / blobdiff