typedef struct {
int x_walkoptree_debug; /* Flag for walkoptree debug hook */
- SV * x_specialsv_list[6];
+ SV * x_specialsv_list[7];
} my_cxt_t;
START_MY_CXT
SV *sstr = newSVpvn("", 0);
STRLEN len;
char *s;
+ char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
if (!SvOK(sv))
sv_setpvn(sstr, "0", 1);
sv_catpv(sstr, "\\\"");
else if (*s == '\\')
sv_catpv(sstr, "\\\\");
+ /* trigraphs - bleagh */
+ else if (*s == '?' && len>=3 && s[1] == '?')
+ {
+ sprintf(escbuff, "\\%03o", '?');
+ sv_catpv(sstr, escbuff);
+ }
else if (*s >= ' ' && *s < 127) /* XXX not portable */
sv_catpvn(sstr, s, 1);
else if (*s == '\n')
sv_catpv(sstr, "\\v");
else
{
- /* no trigraph support */
- char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
/* Don't want promotion of a signed -1 char in sprintf args */
unsigned char c = (unsigned char) *s;
sprintf(escbuff, "\\%03o", c);
specialsv_list[3] = &PL_sv_no;
specialsv_list[4] = pWARN_ALL;
specialsv_list[5] = pWARN_NONE;
+ specialsv_list[6] = pWARN_STD;
#include "defsubs.h"
}
#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_end_av()
+#ifdef USE_ITHREADS
+
+B::AV
+B_regex_padav()
+
+#endif
+
B::CV
B_main_cv()
#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
+#ifdef USE_ITHREADS
+
+IV
+PMOP_pmoffset(o)
+ B::PMOP o
+
+#endif
+
U16
PMOP_pmflags(o)
B::PMOP o
PMOP_pmpermflags(o)
B::PMOP o
+U8
+PMOP_pmdynflags(o)
+ B::PMOP o
+
void
PMOP_precomp(o)
B::PMOP o
SvPVX(sv)
B::PV sv
+B::SV
+SvRV(sv)
+ B::PV sv
+ CODE:
+ if( SvROK(sv) ) {
+ RETVAL = SvRV(sv);
+ }
+ else {
+ croak( "argument is not SvROK" );
+ }
+ OUTPUT:
+ RETVAL
+
void
SvPV(sv)
B::PV sv
CODE:
- ST(0) = sv_newmortal();
- sv_setpvn(ST(0), SvPVX(sv), SvCUR(sv));
- SvFLAGS(ST(0)) |= SvUTF8(sv);
+ ST(0) = sv_newmortal();
+ if( SvPOK(sv) ) {
+ sv_setpvn(ST(0), SvPVX(sv), SvCUR(sv));
+ SvFLAGS(ST(0)) |= SvUTF8(sv);
+ }
+ else {
+ /* XXX for backward compatibility, but should fail */
+ /* croak( "argument is not SvPOK" ); */
+ sv_setpvn(ST(0), NULL, 0);
+ }
STRLEN
SvLEN(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::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)
+ 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
+ CODE:
+ if (mg->mg_type == 'r') {
+ REGEXP* rx = (REGEXP*)mg->mg_obj;
+ if( rx )
+ RETVAL = newSVpvn( rx->precomp, rx->prelen );
+ }
+ else {
+ croak( "precomp is only meaningful on r-magic" );
+ }
+ OUTPUT:
+ RETVAL
I32
MgLENGTH(mg)
IoSUBPROCESS(io)
B::IO io
+bool
+IsSTD(io,name)
+ B::IO io
+ char* name
+ PREINIT:
+ PerlIO* handle = 0;
+ CODE:
+ if( strEQ( name, "stdin" ) ) {
+ handle = PerlIO_stdin();
+ }
+ else if( strEQ( name, "stdout" ) ) {
+ handle = PerlIO_stdout();
+ }
+ else if( strEQ( name, "stderr" ) ) {
+ handle = PerlIO_stderr();
+ }
+ else {
+ croak( "Invalid value '%s'", name );
+ }
+ RETVAL = handle == IoIFP(io);
+ OUTPUT:
+ RETVAL
+
MODULE = B PACKAGE = B::IO
char
CvXSUBANY(cv)
B::CV cv
CODE:
- ST(0) = sv_2mortal(newSViv(CvXSUBANY(cv).any_iv));
+ ST(0) = CvCONST(cv) ?
+ make_sv_object(aTHX_ sv_newmortal(),CvXSUBANY(cv).any_ptr) :
+ sv_2mortal(newSViv(CvXSUBANY(cv).any_iv));
MODULE = B PACKAGE = B::CV