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);
+ }
}
typedef OP *B__OP;
#define B_main_cv() PL_main_cv
#define B_init_av() PL_initav
+#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_sv_undef() &PL_sv_undef
#define B_sv_yes() &PL_sv_yes
#define B_sv_no() &PL_sv_no
+#ifdef USE_ITHREADS
+#define B_regex_padav() PL_regex_padav
+#endif
B::AV
B_init_av()
B::AV
+B_check_av()
+
+B::AV
B_begin_av()
B::AV
B_end_av()
+#ifdef USE_ITHREADS
+
+B::AV
+B_regex_padav()
+
+#endif
+
B::CV
B_main_cv()
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
- 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
#define OP_next(o) o->op_next
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;
#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
+#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_
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
+ sv_setiv(ST(0), INT2PTR(PADOFFSET,root) );
+#else
sv_setiv(newSVrv(ST(0), root ?
svclassnames[SvTYPE((SV*)root)] : "B::SV"),
PTR2IV(root));
+#endif
}
else {
sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), PTR2IV(root));
PMOP_pmnext(o)
B::PMOP o
-U16
+#ifdef USE_ITHREADS
+
+IV
+PMOP_pmoffset(o)
+ B::PMOP o
+
+#endif
+
+U32
PMOP_pmflags(o)
B::PMOP o
-U16
+U32
PMOP_pmpermflags(o)
B::PMOP o
+U8
+PMOP_pmdynflags(o)
+ B::PMOP o
+
void
PMOP_precomp(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_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_warnings(o)
B::COP o
+B::SV
+COP_io(o)
+ B::COP o
+
MODULE = B PACKAGE = B::SV PREFIX = Sv
U32
B::PV sv
CODE:
ST(0) = sv_newmortal();
- if( SvPOK(sv) ) {
+ if( SvPOK(sv) ) {
sv_setpvn(ST(0), SvPVX(sv), SvCUR(sv));
SvFLAGS(ST(0)) |= SvUTF8(sv);
}
#define MgFLAGS(mg) mg->mg_flags
#define MgOBJ(mg) mg->mg_obj
#define MgLENGTH(mg) mg->mg_len
+#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)
OUTPUT:
RETVAL
+IV
+MgREGEX(mg)
+ B::MAGIC mg
+ CODE:
+ if( mg->mg_type == 'r' ) {
+ RETVAL = MgREGEX(mg);
+ }
+ else {
+ croak( "REGEX is only meaningful on r-magic" );
+ }
+ OUTPUT:
+ RETVAL
+
SV*
precomp(mg)
B::MAGIC mg
CvOUTSIDE(cv)
B::CV cv
+U32
+CvOUTSIDE_SEQ(cv)
+ B::CV cv
+
void
CvXSUB(cv)
B::CV cv