B.xs revision 7c478bd95313f5f23a4c958a745db2134aa03244
/* B.xs
*
* Copyright (c) 1996 Malcolm Beattie
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef PERL_OBJECT
#define PL_op_name (get_op_names())
#define PL_opargs (get_opargs())
#define PL_op_desc (get_op_descs())
#endif
#ifdef PerlIO
typedef PerlIO * InputStream;
#else
typedef FILE * InputStream;
#endif
static char *svclassnames[] = {
"B::NULL",
"B::IV",
"B::NV",
"B::RV",
"B::PV",
"B::PVIV",
"B::PVNV",
"B::PVMG",
"B::BM",
"B::PVLV",
"B::AV",
"B::HV",
"B::CV",
"B::GV",
"B::FM",
"B::IO",
};
typedef enum {
OPc_NULL, /* 0 */
OPc_BASEOP, /* 1 */
OPc_UNOP, /* 2 */
OPc_BINOP, /* 3 */
OPc_LOGOP, /* 4 */
OPc_LISTOP, /* 5 */
OPc_PMOP, /* 6 */
OPc_SVOP, /* 7 */
OPc_PADOP, /* 8 */
OPc_PVOP, /* 9 */
OPc_CVOP, /* 10 */
OPc_LOOP, /* 11 */
OPc_COP /* 12 */
} opclass;
static char *opclassnames[] = {
"B::NULL",
"B::OP",
"B::UNOP",
"B::BINOP",
"B::LOGOP",
"B::LISTOP",
"B::PMOP",
"B::SVOP",
"B::PADOP",
"B::PVOP",
"B::CVOP",
"B::LOOP",
"B::COP"
};
static int walkoptree_debug = 0; /* Flag for walkoptree debug hook */
static opclass
{
if (!o)
return OPc_NULL;
if (o->op_type == 0)
if (o->op_type == OP_SASSIGN)
#ifdef USE_ITHREADS
return OPc_PADOP;
#endif
case OA_BASEOP:
return OPc_BASEOP;
case OA_UNOP:
return OPc_UNOP;
case OA_BINOP:
return OPc_BINOP;
case OA_LOGOP:
return OPc_LOGOP;
case OA_LISTOP:
return OPc_LISTOP;
case OA_PMOP:
return OPc_PMOP;
case OA_SVOP:
return OPc_SVOP;
case OA_PADOP:
return OPc_PADOP;
case OA_PVOP_OR_SVOP:
/*
* Character translations (tr///) are usually a PVOP, keeping a
* pointer to a table of shorts used to look up translations.
* Under utf8, however, a simple table isn't practical; instead,
* the OP is an SVOP, and the SV is a reference to a swash
* (i.e., an RV pointing to an HV).
*/
case OA_LOOP:
return OPc_LOOP;
case OA_COP:
return OPc_COP;
case OA_BASEOP_OR_UNOP:
/*
* UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
* whether parens were seen. perly.y uses OPf_SPECIAL to
* signal whether a BASEOP had empty parens or none.
* Some other UNOPs are created later, though, so the best
* test is OPf_KIDS, which is set in newUNOP.
*/
case OA_FILESTATOP:
/*
* The file stat OPs are created via UNI(OP_foo) in toke.c but use
* the OPf_REF flag to distinguish between OP types instead of the
* usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
* return OPc_UNOP so that walkoptree can find our children. If
* OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
* (no argument to the operator) it's an OP; with OPf_REF set it's
* an SVOP (and op_sv is the GV for the filehandle argument).
*/
#ifdef USE_ITHREADS
#else
#endif
case OA_LOOPEXOP:
/*
* next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
* label was omitted (in which case it's a BASEOP) or else a term was
* seen. In this last case, all except goto are definitely PVOP but
* goto is either a PVOP (with an ordinary constant label), an UNOP
* with OPf_STACKED (with a non-constant non-sub) or an UNOP for
* OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
* get set.
*/
if (o->op_flags & OPf_STACKED)
return OPc_UNOP;
else if (o->op_flags & OPf_SPECIAL)
return OPc_BASEOP;
else
return OPc_PVOP;
}
warn("can't determine class of operator %s, assuming BASEOP\n",
PL_op_name[o->op_type]);
return OPc_BASEOP;
}
static char *
{
}
static SV *
{
char *type = 0;
type = "B::SPECIAL";
break;
}
}
if (!type) {
}
return arg;
}
static SV *
{
return arg;
}
static SV *
{
char *s;
else
{
/* XXX Optimise? */
{
/* At least try a little for readability */
if (*s == '"')
else if (*s == '\\')
else if (*s >= ' ' && *s < 127) /* XXX not portable */
else if (*s == '\n')
else if (*s == '\r')
else if (*s == '\t')
else if (*s == '\a')
else if (*s == '\b')
else if (*s == '\f')
else if (*s == '\v')
else
{
/* no trigraph support */
/* Don't want promotion of a signed -1 char in sprintf args */
unsigned char c = (unsigned char) *s;
}
/* XXX Add line breaks if string is long */
}
}
return sstr;
}
static SV *
{
if (*s == '\'')
else if (*s == '\\')
else if (*s >= ' ' && *s < 127) /* XXX not portable */
else if (*s == '\n')
else if (*s == '\r')
else if (*s == '\t')
else if (*s == '\a')
else if (*s == '\b')
else if (*s == '\f')
else if (*s == '\v')
else
{
/* no trigraph support */
/* Don't want promotion of a signed -1 char in sprintf args */
unsigned char c = (unsigned char) *s;
}
return sstr;
}
void
{
dSP;
OP *o;
croak("opsv is not a reference");
if (walkoptree_debug) {
}
/* Use the same opsv. Rely on methods not to mess it up. */
}
}
}
BOOT:
{
specialsv_list[0] = Nullsv;
#include "defsubs.h"
}
#define B_main_cv() PL_main_cv
#define B_begin_av() PL_beginav_save
#define B_main_root() PL_main_root
#define B_main_start() PL_main_start
#define B_amagic_generation() PL_amagic_generation
#define B_sv_undef() &PL_sv_undef
B::AV
B::AV
B::AV
B_end_av()
B::CV
B::OP
B::OP
long
B::AV
B::SV
B::SV
B_sv_yes()
B::SV
B_sv_no()
void
char * method
CODE:
int
walkoptree_debug(...)
CODE:
walkoptree_debug = 1;
B::SV
CODE:
croak("argument is not a reference");
void
char * name
CODE:
{
int i;
ST(0) = sv_newmortal();
name += 3;
for (i = 0; i < PL_maxo; i++)
{
{
result = i;
break;
}
}
}
void
int opnum
CODE:
ST(0) = sv_newmortal();
}
void
CODE:
char *s;
cast_I32(i)
IV i
void
minus_c()
CODE:
PL_minus_c = TRUE;
void
CODE:
PL_minus_c |= 0x10;
SV *
CODE:
SV *
CODE:
void
#ifdef USE_THREADS
int i;
for (i = 0; i < len; i++)
#endif
#define OP_sibling(o) o->op_sibling
#define OP_private(o) o->op_private
B::OP
OP_next(o)
B::OP o
B::OP
OP_sibling(o)
B::OP o
char *
OP_name(o)
B::OP o
CODE:
void
OP_ppaddr(o)
B::OP o
int i;
CODE:
char *
OP_desc(o)
B::OP o
OP_targ(o)
B::OP o
OP_type(o)
B::OP o
OP_seq(o)
B::OP o
OP_flags(o)
B::OP o
OP_private(o)
B::OP o
#define UNOP_first(o) o->op_first
B::OP
UNOP_first(o)
B::UNOP o
#define BINOP_last(o) o->op_last
B::OP
BINOP_last(o)
B::BINOP o
#define LOGOP_other(o) o->op_other
B::OP
LOGOP_other(o)
B::LOGOP o
B::LISTOP o
int i = NO_INIT
CODE:
i = 0;
i++;
RETVAL = i;
#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) o->op_pmregexp
#define PMOP_pmflags(o) o->op_pmflags
#define PMOP_pmpermflags(o) o->op_pmpermflags
void
B::PMOP o
CODE:
ST(0) = sv_newmortal();
root = o->op_pmreplroot;
/* OP_PUSHRE stores an SV* instead of an OP* in op_pmreplroot */
}
else {
}
B::OP
B::PMOP o
B::PMOP
PMOP_pmnext(o)
B::PMOP o
PMOP_pmflags(o)
B::PMOP o
B::PMOP o
void
PMOP_precomp(o)
B::PMOP o
CODE:
ST(0) = sv_newmortal();
rx = o->op_pmregexp;
if (rx)
B::SV
SVOP_sv(o)
B::SVOP o
B::GV
SVOP_gv(o)
B::SVOP o
#define PADOP_padix(o) o->op_padix
PADOP_padix(o)
B::PADOP o
B::SV
PADOP_sv(o)
B::PADOP o
B::GV
PADOP_gv(o)
B::PADOP o
void
PVOP_pv(o)
B::PVOP o
CODE:
/*
* OP_TRANS uses op_pv to point to a table of 256 shorts
* whereas other PVOPs point to a null terminated string.
*/
256 * sizeof(short) : 0));
#define LOOP_redoop(o) o->op_redoop
#define LOOP_nextop(o) o->op_nextop
#define LOOP_lastop(o) o->op_lastop
B::OP
LOOP_redoop(o)
B::LOOP o
B::OP
LOOP_nextop(o)
B::LOOP o
B::OP
LOOP_lastop(o)
B::LOOP o
#define COP_stashpv(o) CopSTASHPV(o)
#define COP_cop_seq(o) o->cop_seq
#define COP_arybase(o) o->cop_arybase
#define COP_warnings(o) o->cop_warnings
char *
COP_label(o)
B::COP o
char *
COP_stashpv(o)
B::COP o
B::HV
COP_stash(o)
B::COP o
char *
COP_file(o)
B::COP o
COP_cop_seq(o)
B::COP o
COP_arybase(o)
B::COP o
COP_line(o)
B::COP o
B::SV
COP_warnings(o)
B::COP o
int
void
CODE:
if (sizeof(IV) == 8) {
/*
* The following way of spelling 32 is to stop compilers on
* 32-bit architectures from moaning about the shift count
* being >= the width of the type. Such architectures don't
* reach this code anyway (unless sizeof(IV) > 8 but then
* everything else breaks too so I'm not fussed at the moment).
*/
#ifdef UV_IS_QUAD
#else
#endif
} else {
}
B::SV
char*
void
CODE:
ST(0) = sv_newmortal();
void
B::HV
B::MAGIC
char
B::SV
void
CODE:
ST(0) = sv_newmortal();
} else {
}
}
char
B::SV
void
CODE:
/* Boyer-Moore table is just after string and its safety-margin \0 */
void
CODE:
bool
CODE:
B::HV
B::SV
B::IO
B::CV
B::AV
B::HV
B::GV
B::CV
char *
B::GV
long
long
long
long
char *
B::GV
char *
B::GV
char *
B::GV
short
char
void
I32 i;
}
B::HV
B::OP
B::OP
B::GV
char *
long
B::AV
B::CV
void
CODE:
void
CODE:
char *
B::PMOP
void
char *key;
(void)hv_iterinit(hv);
}
}