diff options
Diffstat (limited to 'ext')
| -rw-r--r-- | ext/B/B.xs | 1207 | ||||
| -rw-r--r-- | ext/B/Makefile.PL | 54 | ||||
| -rw-r--r-- | ext/B/NOTES | 168 | ||||
| -rw-r--r-- | ext/B/README | 325 | ||||
| -rw-r--r-- | ext/B/TESTS | 78 | ||||
| -rw-r--r-- | ext/B/Todo | 37 | ||||
| -rw-r--r-- | ext/B/byteperl.c | 103 | ||||
| -rw-r--r-- | ext/B/ramblings/cc.notes | 32 | ||||
| -rw-r--r-- | ext/B/ramblings/curcop.runtime | 39 | ||||
| -rw-r--r-- | ext/B/ramblings/flip-flop | 51 | ||||
| -rw-r--r-- | ext/B/ramblings/magic | 93 | ||||
| -rw-r--r-- | ext/B/ramblings/reg.alloc | 32 | ||||
| -rw-r--r-- | ext/B/ramblings/runtime.porting | 350 | ||||
| -rw-r--r-- | ext/B/typemap | 69 |
14 files changed, 2638 insertions, 0 deletions
diff --git a/ext/B/B.xs b/ext/B/B.xs new file mode 100644 index 0000000000..0bb7acba02 --- /dev/null +++ b/ext/B/B.xs @@ -0,0 +1,1207 @@ +/* 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. + * + */ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include "INTERN.h" +#include "bytecode.h" +#include "byterun.h" + +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_CONDOP, /* 5 */ + OPc_LISTOP, /* 6 */ + OPc_PMOP, /* 7 */ + OPc_SVOP, /* 8 */ + OPc_GVOP, /* 9 */ + OPc_PVOP, /* 10 */ + OPc_CVOP, /* 11 */ + OPc_LOOP, /* 12 */ + OPc_COP /* 13 */ +} opclass; + +static char *opclassnames[] = { + "B::NULL", + "B::OP", + "B::UNOP", + "B::BINOP", + "B::LOGOP", + "B::CONDOP", + "B::LISTOP", + "B::PMOP", + "B::SVOP", + "B::GVOP", + "B::PVOP", + "B::CVOP", + "B::LOOP", + "B::COP" +}; + +static int walkoptree_debug = 0; /* Flag for walkoptree debug hook */ + +static opclass +cc_opclass(OP *o) +{ + if (!o) + return OPc_NULL; + + if (o->op_type == 0) + return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP; + + if (o->op_type == OP_SASSIGN) + return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP); + + switch (opargs[o->op_type] & OA_CLASS_MASK) { + 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_CONDOP: + return OPc_CONDOP; + + case OA_LISTOP: + return OPc_LISTOP; + + case OA_PMOP: + return OPc_PMOP; + + case OA_SVOP: + return OPc_SVOP; + + case OA_GVOP: + return OPc_GVOP; + + case OA_PVOP: + return OPc_PVOP; + + 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 bare parens were seen. perly.y uses OPf_SPECIAL to + * signal whether an OP or an UNOP was chosen. + * Frederic.Chauveau@pasteur.fr says we need to check for OPf_KIDS too. + */ + return ((o->op_flags & OPf_SPECIAL) ? OPc_BASEOP : + (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP); + + 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 + * a GVOP (and op_gv is the GV for the filehandle argument). + */ + return ((o->op_flags & OPf_KIDS) ? OPc_UNOP : + (o->op_flags & OPf_REF) ? OPc_GVOP : OPc_BASEOP); + + 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", + op_name[o->op_type]); + return OPc_BASEOP; +} + +static char * +cc_opclassname(OP *o) +{ + return opclassnames[cc_opclass(o)]; +} + +static SV * +make_sv_object(SV *arg, SV *sv) +{ + char *type = 0; + IV iv; + + for (iv = 0; iv < sizeof(specialsv_list)/sizeof(SV*); iv++) { + if (sv == specialsv_list[iv]) { + type = "B::SPECIAL"; + break; + } + } + if (!type) { + type = svclassnames[SvTYPE(sv)]; + iv = (IV)sv; + } + sv_setiv(newSVrv(arg, type), iv); + return arg; +} + +static SV * +make_mg_object(SV *arg, MAGIC *mg) +{ + sv_setiv(newSVrv(arg, "B::MAGIC"), (IV)mg); + return arg; +} + +static SV * +cstring(SV *sv) +{ + SV *sstr = newSVpv("", 0); + STRLEN len; + char *s; + + if (!SvOK(sv)) + sv_setpvn(sstr, "0", 1); + else + { + /* XXX Optimise? */ + s = SvPV(sv, len); + sv_catpv(sstr, "\""); + for (; len; len--, s++) + { + /* At least try a little for readability */ + if (*s == '"') + sv_catpv(sstr, "\\\""); + else if (*s == '\\') + sv_catpv(sstr, "\\\\"); + else if (*s >= ' ' && *s < 127) /* XXX not portable */ + sv_catpvn(sstr, s, 1); + else if (*s == '\n') + sv_catpv(sstr, "\\n"); + else if (*s == '\r') + sv_catpv(sstr, "\\r"); + else if (*s == '\t') + sv_catpv(sstr, "\\t"); + else if (*s == '\a') + sv_catpv(sstr, "\\a"); + else if (*s == '\b') + sv_catpv(sstr, "\\b"); + else if (*s == '\f') + sv_catpv(sstr, "\\f"); + else if (*s == '\v') + 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); + sv_catpv(sstr, escbuff); + } + /* XXX Add line breaks if string is long */ + } + sv_catpv(sstr, "\""); + } + return sstr; +} + +static SV * +cchar(SV *sv) +{ + SV *sstr = newSVpv("'", 0); + char *s = SvPV(sv, na); + + if (*s == '\'') + sv_catpv(sstr, "\\'"); + else if (*s == '\\') + sv_catpv(sstr, "\\\\"); + else if (*s >= ' ' && *s < 127) /* XXX not portable */ + sv_catpvn(sstr, s, 1); + else if (*s == '\n') + sv_catpv(sstr, "\\n"); + else if (*s == '\r') + sv_catpv(sstr, "\\r"); + else if (*s == '\t') + sv_catpv(sstr, "\\t"); + else if (*s == '\a') + sv_catpv(sstr, "\\a"); + else if (*s == '\b') + sv_catpv(sstr, "\\b"); + else if (*s == '\f') + sv_catpv(sstr, "\\f"); + else if (*s == '\v') + 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); + sv_catpv(sstr, escbuff); + } + sv_catpv(sstr, "'"); + return sstr; +} + +void * +bset_obj_store(void *obj, I32 ix) +{ + if (ix > obj_list_fill) { + if (obj_list_fill == -1) + New(666, obj_list, ix + 1, void*); + else + Renew(obj_list, ix + 1, void*); + obj_list_fill = ix; + } + obj_list[ix] = obj; + return obj; +} + +#ifdef INDIRECT_BGET_MACROS +void freadpv(U32 len, void *data) +{ + New(666, pv.xpv_pv, len, char); + fread(pv.xpv_pv, 1, len, (FILE*)data); + pv.xpv_len = len; + pv.xpv_cur = len - 1; +} + +void byteload_fh(FILE *fp) +{ + struct bytestream bs; + bs.data = fp; + bs.fgetc = (int(*) _((void*)))fgetc; + bs.fread = (int(*) _((char*,size_t,size_t,void*)))fread; + bs.freadpv = freadpv; + byterun(bs); +} + +static int fgetc_fromstring(void *data) +{ + char **strp = (char **)data; + return *(*strp)++; +} + +static int fread_fromstring(char *argp, size_t elemsize, size_t nelem, + void *data) +{ + char **strp = (char **)data; + size_t len = elemsize * nelem; + + memcpy(argp, *strp, len); + *strp += len; + return (int)len; +} + +static void freadpv_fromstring(U32 len, void *data) +{ + char **strp = (char **)data; + + New(666, pv.xpv_pv, len, char); + memcpy(pv.xpv_pv, *strp, len); + pv.xpv_len = len; + pv.xpv_cur = len - 1; + *strp += len; +} + +void byteload_string(char *str) +{ + struct bytestream bs; + bs.data = &str; + bs.fgetc = fgetc_fromstring; + bs.fread = fread_fromstring; + bs.freadpv = freadpv_fromstring; + byterun(bs); +} +#else +void byteload_fh(FILE *fp) +{ + byterun(fp); +} + +void byteload_string(char *str) +{ + croak("Must compile with -DINDIRECT_BGET_MACROS for byteload_string"); +} +#endif /* INDIRECT_BGET_MACROS */ + +void +walkoptree(SV *opsv, char *method) +{ + dSP; + OP *o; + + if (!SvROK(opsv)) + croak("opsv is not a reference"); + opsv = sv_mortalcopy(opsv); + o = (OP*)SvIV((SV*)SvRV(opsv)); + if (walkoptree_debug) { + PUSHMARK(sp); + XPUSHs(opsv); + PUTBACK; + perl_call_method("walkoptree_debug", G_DISCARD); + } + PUSHMARK(sp); + XPUSHs(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(kid)), (IV)kid); + walkoptree(opsv, method); + } + } +} + +typedef OP *B__OP; +typedef UNOP *B__UNOP; +typedef BINOP *B__BINOP; +typedef LOGOP *B__LOGOP; +typedef CONDOP *B__CONDOP; +typedef LISTOP *B__LISTOP; +typedef PMOP *B__PMOP; +typedef SVOP *B__SVOP; +typedef GVOP *B__GVOP; +typedef PVOP *B__PVOP; +typedef LOOP *B__LOOP; +typedef COP *B__COP; + +typedef SV *B__SV; +typedef SV *B__IV; +typedef SV *B__PV; +typedef SV *B__NV; +typedef SV *B__PVMG; +typedef SV *B__PVLV; +typedef SV *B__BM; +typedef SV *B__RV; +typedef AV *B__AV; +typedef HV *B__HV; +typedef CV *B__CV; +typedef GV *B__GV; +typedef IO *B__IO; + +typedef MAGIC *B__MAGIC; + +MODULE = B PACKAGE = B PREFIX = B_ + +PROTOTYPES: DISABLE + +BOOT: + INIT_SPECIALSV_LIST; + +#define B_main_cv() main_cv +#define B_main_root() main_root +#define B_main_start() main_start +#define B_comppadlist() (main_cv ? CvPADLIST(main_cv) : CvPADLIST(compcv)) +#define B_sv_undef() &sv_undef +#define B_sv_yes() &sv_yes +#define B_sv_no() &sv_no + +B::CV +B_main_cv() + +B::OP +B_main_root() + +B::OP +B_main_start() + +B::AV +B_comppadlist() + +B::SV +B_sv_undef() + +B::SV +B_sv_yes() + +B::SV +B_sv_no() + +MODULE = B PACKAGE = B + + +void +walkoptree(opsv, method) + SV * opsv + char * method + +int +walkoptree_debug(...) + CODE: + RETVAL = walkoptree_debug; + if (items > 0 && SvTRUE(ST(1))) + walkoptree_debug = 1; + OUTPUT: + RETVAL + +int +byteload_fh(fp) + FILE * fp + CODE: + byteload_fh(fp); + RETVAL = 1; + OUTPUT: + RETVAL + +void +byteload_string(str) + char * str + +#define address(sv) (IV)sv + +IV +address(sv) + SV * sv + +B::SV +svref_2object(sv) + SV * sv + CODE: + if (!SvROK(sv)) + croak("argument is not a reference"); + RETVAL = (SV*)SvRV(sv); + OUTPUT: + RETVAL + +void +ppname(opnum) + int opnum + CODE: + ST(0) = sv_newmortal(); + if (opnum >= 0 && opnum < maxo) { + sv_setpvn(ST(0), "pp_", 3); + sv_catpv(ST(0), op_name[opnum]); + } + +void +hash(sv) + SV * sv + CODE: + char *s; + STRLEN len; + U32 hash = 0; + char hexhash[11]; /* must fit "0xffffffff" plus trailing \0 */ + s = SvPV(sv, len); + while (len--) + hash = hash * 33 + *s++; + sprintf(hexhash, "0x%x", hash); + ST(0) = sv_2mortal(newSVpv(hexhash, 0)); + +#define cast_I32(foo) (I32)foo +IV +cast_I32(i) + IV i + +void +minus_c() + CODE: + minus_c = TRUE; + +SV * +cstring(sv) + SV * sv + +SV * +cchar(sv) + SV * sv + +void +threadsv_names() + PPCODE: +#ifdef USE_THREADS + int i; + STRLEN len = strlen(threadsv_names); + + EXTEND(sp, len); + for (i = 0; i < len; i++) + PUSHs(sv_2mortal(newSVpv(&threadsv_names[i], 1))); +#endif + + +#define OP_next(o) o->op_next +#define OP_sibling(o) o->op_sibling +#define OP_desc(o) 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 +#define OP_flags(o) o->op_flags +#define OP_private(o) o->op_private + +MODULE = B PACKAGE = B::OP PREFIX = OP_ + +B::OP +OP_next(o) + B::OP o + +B::OP +OP_sibling(o) + B::OP o + +char * +OP_ppaddr(o) + B::OP o + CODE: + ST(0) = sv_newmortal(); + sv_setpvn(ST(0), "pp_", 3); + sv_catpv(ST(0), op_name[o->op_type]); + +char * +OP_desc(o) + B::OP o + +U16 +OP_targ(o) + B::OP o + +U16 +OP_type(o) + B::OP o + +U16 +OP_seq(o) + B::OP o + +U8 +OP_flags(o) + B::OP o + +U8 +OP_private(o) + B::OP o + +#define UNOP_first(o) o->op_first + +MODULE = B PACKAGE = B::UNOP PREFIX = UNOP_ + +B::OP +UNOP_first(o) + B::UNOP o + +#define BINOP_last(o) o->op_last + +MODULE = B PACKAGE = B::BINOP PREFIX = BINOP_ + +B::OP +BINOP_last(o) + B::BINOP o + +#define LOGOP_other(o) o->op_other + +MODULE = B PACKAGE = B::LOGOP PREFIX = LOGOP_ + +B::OP +LOGOP_other(o) + B::LOGOP o + +#define CONDOP_true(o) o->op_true +#define CONDOP_false(o) o->op_false + +MODULE = B PACKAGE = B::CONDOP PREFIX = CONDOP_ + +B::OP +CONDOP_true(o) + B::CONDOP o + +B::OP +CONDOP_false(o) + B::CONDOP o + +#define LISTOP_children(o) o->op_children + +MODULE = B PACKAGE = B::LISTOP PREFIX = LISTOP_ + +U32 +LISTOP_children(o) + B::LISTOP o + +#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 + +MODULE = B PACKAGE = B::PMOP PREFIX = PMOP_ + +void +PMOP_pmreplroot(o) + B::PMOP o + OP * root = NO_INIT + CODE: + ST(0) = sv_newmortal(); + root = o->op_pmreplroot; + /* OP_PUSHRE stores an SV* instead of an OP* in op_pmreplroot */ + if (o->op_type == OP_PUSHRE) { + sv_setiv(newSVrv(ST(0), root ? + svclassnames[SvTYPE((SV*)root)] : "B::SV"), + (IV)root); + } + else { + sv_setiv(newSVrv(ST(0), cc_opclassname(root)), (IV)root); + } + +B::OP +PMOP_pmreplstart(o) + B::PMOP o + +B::PMOP +PMOP_pmnext(o) + B::PMOP o + +U16 +PMOP_pmflags(o) + B::PMOP o + +U16 +PMOP_pmpermflags(o) + B::PMOP o + +void +PMOP_precomp(o) + B::PMOP o + REGEXP * rx = NO_INIT + CODE: + ST(0) = sv_newmortal(); + rx = o->op_pmregexp; + if (rx) + sv_setpvn(ST(0), rx->precomp, rx->prelen); + +#define SVOP_sv(o) o->op_sv + +MODULE = B PACKAGE = B::SVOP PREFIX = SVOP_ + + +B::SV +SVOP_sv(o) + B::SVOP o + +#define GVOP_gv(o) o->op_gv + +MODULE = B PACKAGE = B::GVOP PREFIX = GVOP_ + + +B::GV +GVOP_gv(o) + B::GVOP o + +MODULE = B PACKAGE = B::PVOP PREFIX = PVOP_ + +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. + */ + ST(0) = sv_2mortal(newSVpv(o->op_pv, (o->op_type == OP_TRANS) ? + 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 + +MODULE = B PACKAGE = B::LOOP PREFIX = LOOP_ + + +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_label(o) o->cop_label +#define COP_stash(o) o->cop_stash +#define COP_filegv(o) o->cop_filegv +#define COP_cop_seq(o) o->cop_seq +#define COP_arybase(o) o->cop_arybase +#define COP_line(o) o->cop_line + +MODULE = B PACKAGE = B::COP PREFIX = COP_ + +char * +COP_label(o) + B::COP o + +B::HV +COP_stash(o) + B::COP o + +B::GV +COP_filegv(o) + B::COP o + +U32 +COP_cop_seq(o) + B::COP o + +I32 +COP_arybase(o) + B::COP o + +U16 +COP_line(o) + B::COP o + +MODULE = B PACKAGE = B::SV PREFIX = Sv + +U32 +SvREFCNT(sv) + B::SV sv + +U32 +SvFLAGS(sv) + B::SV sv + +MODULE = B PACKAGE = B::IV PREFIX = Sv + +IV +SvIV(sv) + B::IV sv + +IV +SvIVX(sv) + B::IV sv + +MODULE = B PACKAGE = B::IV + +#define needs64bits(sv) ((I32)SvIVX(sv) != SvIVX(sv)) + +int +needs64bits(sv) + B::IV sv + +void +packiv(sv) + B::IV sv + CODE: + if (sizeof(IV) == 8) { + U32 wp[2]; + IV iv = SvIVX(sv); + /* + * 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). + */ + wp[0] = htonl(((U32)iv) >> (sizeof(IV)*4)); + wp[1] = htonl(iv & 0xffffffff); + ST(0) = sv_2mortal(newSVpv((char *)wp, 8)); + } else { + U32 w = htonl((U32)SvIVX(sv)); + ST(0) = sv_2mortal(newSVpv((char *)&w, 4)); + } + +MODULE = B PACKAGE = B::NV PREFIX = Sv + +double +SvNV(sv) + B::NV sv + +double +SvNVX(sv) + B::NV sv + +MODULE = B PACKAGE = B::RV PREFIX = Sv + +B::SV +SvRV(sv) + B::RV sv + +MODULE = B PACKAGE = B::PV PREFIX = Sv + +void +SvPV(sv) + B::PV sv + CODE: + ST(0) = sv_newmortal(); + sv_setpvn(ST(0), SvPVX(sv), SvCUR(sv)); + +MODULE = B PACKAGE = B::PVMG PREFIX = Sv + +void +SvMAGIC(sv) + B::PVMG sv + MAGIC * mg = NO_INIT + PPCODE: + for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) + XPUSHs(make_mg_object(sv_newmortal(), mg)); + +MODULE = B PACKAGE = B::PVMG + +B::HV +SvSTASH(sv) + B::PVMG sv + +#define MgMOREMAGIC(mg) mg->mg_moremagic +#define MgPRIVATE(mg) mg->mg_private +#define MgTYPE(mg) mg->mg_type +#define MgFLAGS(mg) mg->mg_flags +#define MgOBJ(mg) mg->mg_obj + +MODULE = B PACKAGE = B::MAGIC PREFIX = Mg + +B::MAGIC +MgMOREMAGIC(mg) + B::MAGIC mg + +U16 +MgPRIVATE(mg) + B::MAGIC mg + +char +MgTYPE(mg) + B::MAGIC mg + +U8 +MgFLAGS(mg) + B::MAGIC mg + +B::SV +MgOBJ(mg) + B::MAGIC mg + +void +MgPTR(mg) + B::MAGIC mg + CODE: + ST(0) = sv_newmortal(); + if (mg->mg_ptr) + sv_setpvn(ST(0), mg->mg_ptr, mg->mg_len); + +MODULE = B PACKAGE = B::PVLV PREFIX = Lv + +U32 +LvTARGOFF(sv) + B::PVLV sv + +U32 +LvTARGLEN(sv) + B::PVLV sv + +char +LvTYPE(sv) + B::PVLV sv + +B::SV +LvTARG(sv) + B::PVLV sv + +MODULE = B PACKAGE = B::BM PREFIX = Bm + +I32 +BmUSEFUL(sv) + B::BM sv + +U16 +BmPREVIOUS(sv) + B::BM sv + +U8 +BmRARE(sv) + B::BM sv + +void +BmTABLE(sv) + B::BM sv + STRLEN len = NO_INIT + char * str = NO_INIT + CODE: + str = SvPV(sv, len); + /* Boyer-Moore table is just after string and its safety-margin \0 */ + ST(0) = sv_2mortal(newSVpv(str + len + 1, 256)); + +MODULE = B PACKAGE = B::GV PREFIX = Gv + +void +GvNAME(gv) + B::GV gv + CODE: + ST(0) = sv_2mortal(newSVpv(GvNAME(gv), GvNAMELEN(gv))); + +B::HV +GvSTASH(gv) + B::GV gv + +B::SV +GvSV(gv) + B::GV gv + +B::IO +GvIO(gv) + B::GV gv + +B::CV +GvFORM(gv) + B::GV gv + +B::AV +GvAV(gv) + B::GV gv + +B::HV +GvHV(gv) + B::GV gv + +B::GV +GvEGV(gv) + B::GV gv + +B::CV +GvCV(gv) + B::GV gv + +U32 +GvCVGEN(gv) + B::GV gv + +U16 +GvLINE(gv) + B::GV gv + +B::GV +GvFILEGV(gv) + B::GV gv + +MODULE = B PACKAGE = B::GV + +U32 +GvREFCNT(gv) + B::GV gv + +U8 +GvFLAGS(gv) + B::GV gv + +MODULE = B PACKAGE = B::IO PREFIX = Io + +long +IoLINES(io) + B::IO io + +long +IoPAGE(io) + B::IO io + +long +IoPAGE_LEN(io) + B::IO io + +long +IoLINES_LEFT(io) + B::IO io + +char * +IoTOP_NAME(io) + B::IO io + +B::GV +IoTOP_GV(io) + B::IO io + +char * +IoFMT_NAME(io) + B::IO io + +B::GV +IoFMT_GV(io) + B::IO io + +char * +IoBOTTOM_NAME(io) + B::IO io + +B::GV +IoBOTTOM_GV(io) + B::IO io + +short +IoSUBPROCESS(io) + B::IO io + +MODULE = B PACKAGE = B::IO + +char +IoTYPE(io) + B::IO io + +U8 +IoFLAGS(io) + B::IO io + +MODULE = B PACKAGE = B::AV PREFIX = Av + +SSize_t +AvFILL(av) + B::AV av + +SSize_t +AvMAX(av) + B::AV av + +#define AvOFF(av) ((XPVAV*)SvANY(av))->xof_off + +IV +AvOFF(av) + B::AV av + +void +AvARRAY(av) + B::AV av + PPCODE: + if (AvFILL(av) >= 0) { + SV **svp = AvARRAY(av); + I32 i; + for (i = 0; i <= AvFILL(av); i++) + XPUSHs(make_sv_object(sv_newmortal(), svp[i])); + } + +MODULE = B PACKAGE = B::AV + +U8 +AvFLAGS(av) + B::AV av + +MODULE = B PACKAGE = B::CV PREFIX = Cv + +B::HV +CvSTASH(cv) + B::CV cv + +B::OP +CvSTART(cv) + B::CV cv + +B::OP +CvROOT(cv) + B::CV cv + +B::GV +CvGV(cv) + B::CV cv + +B::GV +CvFILEGV(cv) + B::CV cv + +long +CvDEPTH(cv) + B::CV cv + +B::AV +CvPADLIST(cv) + B::CV cv + +B::CV +CvOUTSIDE(cv) + B::CV cv + +void +CvXSUB(cv) + B::CV cv + CODE: + ST(0) = sv_2mortal(newSViv((IV)CvXSUB(cv))); + + +void +CvXSUBANY(cv) + B::CV cv + CODE: + ST(0) = sv_2mortal(newSViv(CvXSUBANY(cv).any_iv)); + +MODULE = B PACKAGE = B::HV PREFIX = Hv + +STRLEN +HvFILL(hv) + B::HV hv + +STRLEN +HvMAX(hv) + B::HV hv + +I32 +HvKEYS(hv) + B::HV hv + +I32 +HvRITER(hv) + B::HV hv + +char * +HvNAME(hv) + B::HV hv + +B::PMOP +HvPMROOT(hv) + B::HV hv + +void +HvARRAY(hv) + B::HV hv + PPCODE: + if (HvKEYS(hv) > 0) { + SV *sv; + char *key; + I32 len; + (void)hv_iterinit(hv); + EXTEND(sp, HvKEYS(hv) * 2); + while (sv = hv_iternextsv(hv, &key, &len)) { + PUSHs(newSVpv(key, len)); + PUSHs(make_sv_object(sv_newmortal(), sv)); + } + } diff --git a/ext/B/Makefile.PL b/ext/B/Makefile.PL new file mode 100644 index 0000000000..bcc8baa242 --- /dev/null +++ b/ext/B/Makefile.PL @@ -0,0 +1,54 @@ +use ExtUtils::MakeMaker; +use Config; + +my $e = $Config{'exe_ext'}; +my $o = $Config{'obj_ext'}; +my $exeout_flag = '-o '; +if ($^O eq 'MSWin32') { + if ($Config{'cc'} =~ /^cl/i) { + $exeout_flag = '-Fe'; + } + elsif ($Config{'cc'} =~ /^bcc/i) { + $exeout_flag = '-e'; + } +} + +WriteMakefile( + NAME => "B", + VERSION => "a5", + OBJECT => "B$o byterun$o", + depend => { + "B$o" => "B.c bytecode.h byterun.h", + }, + clean => { + FILES => "perl byteperl$e btest$e btest.c *$o B.c *~" + } +); + +sub MY::post_constants { + "\nLIBS = $Config{libs}\n" +} + +sub MY::top_targets { + my $self = shift; + my $targets = $self->MM::top_targets(); + $targets =~ s/^(all ::.*)$/$1 byteperl$e/m; + return <<"EOT" . $targets; +# +# byterun.h, byterun.c and Asmdata.pm are auto-generated. If any of the +# files are missing or if you change bytecode.pl (which is what generates +# them all) then you can "make regen_headers" to regenerate them. +# +regen_headers: + \$(PERL) bytecode.pl + \$(MV) Asmdata.pm B +# +# byteperl is *not* a standard perl+XSUB executable. It's a special +# program for running standalone bytecode executables. It isn't an XSUB +# at the moment because a standlone Perl program needs to set up curpad +# which is overwritten on exit from an XSUB. +# +byteperl$e : byteperl$o B$o byterun$o + \$(CC) ${exeout_flag}byteperl$e byteperl$o B$o byterun$o \$(LDFLAGS) \$(PERL_ARCHLIB)/CORE/$Config{libperl} \$(LIBS) +EOT +} diff --git a/ext/B/NOTES b/ext/B/NOTES new file mode 100644 index 0000000000..ee10ba03e9 --- /dev/null +++ b/ext/B/NOTES @@ -0,0 +1,168 @@ +C backend invocation + If there are any non-option arguments, they are taken to be + names of objects to be saved (probably doesn't work properly yet). + Without extra arguments, it saves the main program. + -ofilename Output to filename instead of STDOUT + -v Verbose (currently gives a few compilation statistics) + -- Force end of options + -uPackname Force apparently unused subs from package Packname to + be compiled. This allows programs to use eval "foo()" + even when sub foo is never seen to be used at compile + time. The down side is that any subs which really are + never used also have code generated. This option is + necessary, for example, if you have a signal handler + foo which you initialise with $SIG{BAR} = "foo". + A better fix, though, is just to change it to + $SIG{BAR} = \&foo. You can have multiple -u options. + -D Debug options (concat or separate flags like perl -D) + o OPs, prints each OP as it's processed + c COPs, prints COPs as processed (incl. file & line num) + A prints AV information on saving + C prints CV information on saving + M prints MAGIC information on saving + -f Force optimisations on or off one at a time. + cog Copy-on-grow: PVs declared and initialised statically + no-cog No copy-on-grow + -On Optimisation level (n = 0, 1, 2, ...). -O means -O1. + Currently, -O1 and higher set -fcog. + +Examples + perl -MO=C foo.pl > foo.c + perl cc_harness -o foo foo.c + + perl -MO=C,-v,-DcA bar.pl > /dev/null + +CC backend invocation + If there are any non-option arguments, they are taken to be names of + subs to be saved. Without extra arguments, it saves the main program. + -ofilename Output to filename instead of STDOUT + -- Force end of options + -uPackname Force apparently unused subs from package Packname to + be compiled. This allows programs to use eval "foo()" + even when sub foo is never seen to be used at compile + time. The down side is that any subs which really are + never used also have code generated. This option is + necessary, for example, if you have a signal handler + foo which you initialise with $SIG{BAR} = "foo". + A better fix, though, is just to change it to + $SIG{BAR} = \&foo. You can have multiple -u options. + -mModulename Instead of generating source for a runnable executable, + generate source for an XSUB module. The + boot_Modulename function (which DynaLoader can look + for) does the appropriate initialisation and runs the + main part of the Perl source that is being compiled. + -pn Generate code for perl patchlevel n (e.g. 3 or 4). + The default is to generate C code which will link + with the currently executing version of perl. + running the perl compiler. + -D Debug options (concat or separate flags like perl -D) + r Writes debugging output to STDERR just as it's about + to write to the program's runtime (otherwise writes + debugging info as comments in its C output). + O Outputs each OP as it's compiled + s Outputs the contents of the shadow stack at each OP + p Outputs the contents of the shadow pad of lexicals as + it's loaded for each sub or the main program. + q Outputs the name of each fake PP function in the queue + as it's about to processes. + l Output the filename and line number of each original + line of Perl code as it's processed (pp_nextstate). + t Outputs timing information of compilation stages + -f Force optimisations on or off one at a time. + [ + cog Copy-on-grow: PVs declared and initialised statically + no-cog No copy-on-grow + These two not in CC yet. + ] + freetmps-each-bblock Delays FREETMPS from the end of each + statement to the end of the each basic + block. + freetmps-each-loop Delays FREETMPS from the end of each + statement to the end of the group of + basic blocks forming a loop. At most + one of the freetmps-each-* options can + be used. + omit-taint Omits generating code for handling + perl's tainting mechanism. + -On Optimisation level (n = 0, 1, 2, ...). -O means -O1. + Currently, -O1 sets -ffreetmps-each-bblock and -O2 + sets -ffreetmps-each-loop. + +Example + perl -MO=CC,-O2,-ofoo.c foo.pl + perl cc_harness -o foo foo.c + + perl -MO=CC,-mFoo,-oFoo.c Foo.pm + perl cc_harness -shared -c -o Foo.so Foo.c + + +Bytecode backend invocation + + If there are any non-option arguments, they are taken to be + names of objects to be saved (probably doesn't work properly yet). + Without extra arguments, it saves the main program. + -ofilename Output to filename instead of STDOUT. + -- Force end of options. + -f Force optimisations on or off one at a time. + Each can be preceded by no- to turn the option off. + compress-nullops + Only fills in the necessary fields of ops which have + been optimised away by perl's internal compiler. + omit-sequence-numbers + Leaves out code to fill in the op_seq field of all ops + which is only used by perl's internal compiler. + bypass-nullops + If op->op_next ever points to a NULLOP, replaces the + op_next field with the first non-NULLOP in the path + of execution. + strip-syntax-tree + Leaves out code to fill in the pointers which link the + internal syntax tree together. They're not needed at + run-time but leaving them out will make it impossible + to recompile or disassemble the resulting program. + It will also stop "goto label" statements from working. + -On Optimisation level (n = 0, 1, 2, ...). -O means -O1. + -O1 sets -fcompress-nullops -fomit-sequence numbers. + -O6 adds -fstrip-syntax-tree. + -D Debug options (concat or separate flags like perl -D) + o OPs, prints each OP as it's processed. + b print debugging information about bytecompiler progress + a tells the assembler to include source assembler lines + in its output as bytecode comments. + C prints each CV taken from the final symbol tree walk. + -S Output assembler source rather than piping it + through the assembler and outputting bytecode. + -m Compile as a module rather than a standalone program. + Currently this just means that the bytecodes for + initialising main_start, main_root and curpad are + omitted. + +Example + perl -MO=Bytecode,-O6,-o,foo.plc foo.pl + + perl -MO=Bytecode,-S foo.pl > foo.S + assemble foo.S > foo.plc + byteperl foo.plc + + perl -MO=Bytecode,-m,-oFoo.pmc Foo.pm + +Backends for debugging + perl -MO=Terse,exec foo.pl + perl -MO=Debug bar.pl + +O module + Used with "perl -MO=Backend,foo,bar prog.pl" to invoke the backend + B::Backend with options foo and bar. O invokes the sub + B::Backend::compile() with arguments foo and bar at BEGIN time. + That compile() sub must do any inital argument processing replied. + If unsuccessful, it should return a string which O arranges to be + printed as an error message followed by a clean error exit. In the + normal case where any option processing in compile() is successful, + it should return a sub ref (usually a closure) to perform the + actual compilation. When O regains control, it ensures that the + "-c" option is forced (so that the program being compiled doesn't + end up running) and registers an END block to call back the sub ref + returned from the backend's compile(). Perl then continues by + parsing prog.pl (just as it would with "perl -c prog.pl") and after + doing so, assuming there are no parse-time errors, the END block + of O gets called and the actual backend compilation happens. Phew. diff --git a/ext/B/README b/ext/B/README new file mode 100644 index 0000000000..4e4ed25fdc --- /dev/null +++ b/ext/B/README @@ -0,0 +1,325 @@ + Perl Compiler Kit, Version alpha4 + + Copyright (c) 1996, 1997, Malcolm Beattie + + This program is free software; you can redistribute it and/or modify + it under the terms of either: + + a) the GNU General Public License as published by the Free + Software Foundation; either version 1, or (at your option) any + later version, or + + b) the "Artistic License" which comes with this kit. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either + the GNU General Public License or the Artistic License for more details. + + You should have received a copy of the Artistic License with this kit, + in the file named "Artistic". If not, you can get one from the Perl + distribution. You should also have received a copy of the GNU General + Public License, in the file named "Copying". If not, you can get one + from the Perl distribution or else write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +CHANGES + +New since alpha3 + Anonymous subs work properly with C and CC. + Heuristics for forcing compilation of apparently unused subs/methods. + Subs which use the AutoLoader module are forcibly loaded at compile-time. + Slightly faster compilation. + Handles slightly more complex code within a BEGIN { }. + Minor bug fixes. + +New since alpha2 + CC backend now supports ".." and s//e. + Xref backend generates cross-reference reports + Cleanups to fix benign but irritating "-w" warnings + Minor cxstack fix +New since alpha1 + Working CC backend + Shared globs and pre-initialised hash support + Some XSUB support + Assorted bug fixes + +INSTALLATION + +(1) You need perl5.002 or later. + +(2) If you want to compile and run programs with the C or CC backends +which undefine (or redefine) subroutines, then you need to apply a +one-line patch to perl itself. One or two of the programs in perl's +own test suite do this. The patch is in file op.patch. It prevents +perl from calling free() on OPs with the magic sequence number (U16)-1. +The compiler declares all OPs as static structures and uses that magic +sequence number. + +(3) Type + perl Makefile.PL +to write a personalised Makefile for your system. If you want the +bytecode modules to support reading bytecode from strings (instead of +just from files) then add the option + -DINDIRECT_BGET_MACROS +into the middle of the definition of the CCCMD macro in the Makefile. +Your C compiler may need to be able to cope with Standard C for this. +I haven't tested this option yet with an old pre-Standard compiler. + +(4) If your platform supports dynamic loading then just type + make +and you can then use + perl -Iblib/arch -MO=foo bar +to use the compiler modules (see later for details). +If you need/want instead to make a statically linked perl which +contains the appropriate modules, then type + make perl + make byteperl +and you can then use + ./perl -MO=foo bar +to use the compiler modules. +In both cases, the byteperl executable is required for running standalone +bytecode programs. It is *not* a standard perl+XSUB perl executable. + +USAGE + +As of the alpha3 release, the Bytecode, C and CC backends are now all +functional enough to compile almost the whole of the main perl test +suite. In the case of the CC backend, any failures are all due to +differences and/or known bugs documented below. See the file TESTS. +In the following examples, you'll need to replace "perl" by + perl -Iblib/arch +if you have built the extensions for a dynamic loading platform but +haven't installed the extensions completely. You'll need to replace +"perl" by + ./perl +if you have built the extensions into a statically linked perl binary. + +(1) To compile perl program foo.pl with the C backend, do + perl -MO=C,-ofoo.c foo.pl +Then use the cc_harness perl program to compile the resulting C source: + perl cc_harness -O2 -o foo foo.c + +If you are using a non-ANSI pre-Standard C compiler that can't handle +pre-declaring static arrays, then add -DBROKEN_STATIC_REDECL to the +options you use: + perl cc_harness -O2 -o foo -DBROKEN_STATIC_REDECL foo.c +If you are using a non-ANSI pre-Standard C compiler that can't handle +static initialisation of structures with union members then add +-DBROKEN_UNION_INIT to the options you use. If you want command line +arguments passed to your executable to be interpreted by perl (e.g. -Dx) +then compile foo.c with -DALLOW_PERL_OPTIONS. Otherwise, all command line +arguments passed to foo will appear directly in @ARGV. The resulting +executable foo is the compiled version of foo.pl. See the file NOTES for +extra options you can pass to -MO=C. + +There are some constraints on the contents on foo.pl if you want to be +able to compile it successfully. Some problems can be fixed fairly easily +by altering foo.pl; some problems with the compiler are known to be +straightforward to solve and I'll do so soon. The file Todo lists a +number of known problems. See the XSUB section lower down for information +about compiling programs which use XSUBs. + +(2) To compile foo.pl with the CC backend (which generates actual +optimised C code for the execution path of your perl program), use + perl -MO=CC,-ofoo.c foo.pl + +and proceed just as with the C backend. You should almost certainly +use an option such as -O2 with the subsequent cc_harness invocation +so that your C compiler uses optimisation. The C code generated by +the Perl compiler's CC backend looks ugly to humans but is easily +optimised by C compilers. + +To make the most of this compiler backend, you need to tell the +compiler when you're using int or double variables so that it can +optimise appropriately (although this part of the compiler is the most +buggy). You currently do that by naming lexical variables ending in +"_i" for ints, "_d" for doubles, "_ir" for int "register" variables or +"_dr" for double "register" variables. Here "register" is a promise +that you won't pass a reference to the variable into a sub which then +modifies the variable. The compiler ought to catch attempts to use +"\$i" just as C compilers catch attempts to do "&i" for a register int +i but it doesn't at the moment. Bugs in the CC backend may make your +program fail in mysterious ways and give wrong answers rather than just +crash in boring ways. But, hey, this is an alpha release so you knew +that anyway. See the XSUB section lower down for information about +compiling programs which use XSUBs. + +If your program uses classes which define methods (or other subs which +are not exported and not apparently used until runtime) then you'll +need to use -u compile-time options (see the NOTES file) to force the +subs to be compiled. Future releases will probably default the other +way, do more auto-detection and provide more fine-grained control. + +Since compiled executables need linking with libperl, you may want +to turn libperl.a into a shared library if your platform supports +it. For example, with Digital UNIX, do something like + ld -shared -o libperl.so -all libperl.a -none -lc +and with Linux/ELF, rebuild the perl .c files with -fPIC (and I +also suggest -fomit-frame-pointer for Linux on Intel architetcures), +do "make libperl.a" and then do + gcc -shared -Wl,-soname,libperl.so.5 -o libperl.so.5.3 `ar t libperl.a` +and then + # cp libperl.so.5.3 /usr/lib + # cd /usr/lib + # ln -s libperl.so.5.3 libperl.so.5 + # ln -s libperl.so.5 libperl.so + # ldconfig +When you compile perl executables with cc_harness, append -L/usr/lib +otherwise the -L for the perl source directory will override it. For +example, + perl -Iblib/arch -MO=CC,-O2,-ofoo3.c foo3.bench + perl cc_harness -o foo3 -O2 foo3.c -L/usr/lib + ls -l foo3 + -rwxr-xr-x 1 mbeattie xzdg 11218 Jul 1 15:28 foo3 +You'll probably also want to link your main perl executable against +libperl.so; it's nice having an 11K perl executable. + +(3) To compile foo.pl into bytecode do + perl -MO=Bytecode,-ofoo foo.pl +To run the resulting bytecode file foo as a standalone program, you +use the program byteperl which should have been built along with the +extensions. + ./byteperl foo +Any extra arguments are passed in as @ARGV; they are not interpreted +as perl options. If you want to load chunks of bytecode into an already +running perl program then use the -m option and investigate the +byteload_fh and byteload_string functions exported by the B module. +See the NOTES file for details of these and other options (including +optimisation options and ways of getting at the intermediate "assembler" +code that the Bytecode backend uses). + +(3) There are little Bourne shell scripts and perl programs to aid with +some common operations: assemble, disassemble, run_bytecode_test, +run_test, cc_harness, test_harness, test_harness_bytecode. + +(4) Walk the op tree in execution order printing terse info about each op + perl -MO=Terse,exec foo.pl + +(5) Walk the op tree in syntax order printing lengthier debug info about +each op. You can also append ",exec" to walk in execution order, but the +formatting is designed to look nice with Terse rather than Debug. + perl -MO=Debug foo.pl + +(6) Produce a cross-reference report of the line numbers at which all +variables, subs and formats are defined and used. + perl -MO=Xref foo.pl + +XSUBS + +The C and CC backends can successfully compile some perl programs which +make use of XSUB extensions. [I'll add more detail to this section in a +later release.] As a prerequisite, such extensions must not need to do +anything in their BOOT: section which needs to be done at runtime rather +than compile time. Normally, the only code in the boot_Foo() function is +a list of newXS() calls which xsubpp puts there and the compiler handles +saving those XS subs itself. For each XSUB used, the C and CC compiler +will generate an initialiser in their C output which refers to the name +of the relevant C function (XS_Foo_somesub). What is not yet automated +is the necessary commands and cc command-line options (e.g. via +"perl cc_harness") which link against the extension libraries. For now, +you need the XSUB extension to have installed files in the right format +for using as C libraries (e.g. Foo.a or Foo.so). As the Foo.so files (or +your platform's version) aren't suitable for linking against, you will +have to reget the extension source and rebuild it as a static extension +to force the generation of a suitable Foo.a file. Then you need to make +a symlink (or copy or rename) of that file into a libFoo.a suitable for +cc linking. Then add the appropriate -L and -l options to your +"perl cc_harness" command line to find and link against those libraries. +You may also need to fix up some platform-dependent environment variable +to ensure that linked-against .so files are found at runtime too. + +DIFFERENCES + +The result of running a compiled Perl program can sometimes be different +from running the same program with standard perl. Think of the compiler +as having a slightly different implementation of the language Perl. +Unfortunately, since Perl has had a single implementation until now, +there are no formal standards or documents defining what behaviour is +guaranteed of Perl the language and what just "happens to work". +Some of the differences below are almost impossible to change because of +the way the compiler works. Others can be changed to produce "standard" +perl behaviour if it's deemed proper and the resulting performance hit +is accepted. I'll use "standard perl" to mean the result of running a +Perl program using the perl executable from the perl distribution. +I'll use "compiled Perl program" to mean running an executable produced +by this compiler kit ("the compiler") with the CC backend. + +Loops + Standard perl calculates the target of "next", "last", and "redo" + at run-time. The compiler calculates the targets at compile-time. + For example, the program + + sub skip_on_odd { next NUMBER if $_[0] % 2 } + NUMBER: for ($i = 0; $i < 5; $i++) { + skip_on_odd($i); + print $i; + } + + produces the output + 024 + with standard perl but gives a compile-time error with the compiler. + +Context of ".." + The context (scalar or array) of the ".." operator determines whether + it behaves as a range or a flip/flop. Standard perl delays until + runtime the decision of which context it is in but the compiler needs + to know the context at compile-time. For example, + @a = (4,6,1,0,0,1); + sub range { (shift @a)..(shift @a) } + print range(); + while (@a) { print scalar(range()) } + generates the output + 456123E0 + with standard Perl but gives a compile-time error with compiled Perl. + +Arithmetic + Compiled Perl programs use native C arithemtic much more frequently + than standard perl. Operations on large numbers or on boundary + cases may produce different behaviour. + +Deprecated features + Features of standard perl such as $[ which have been deprecated + in standard perl since version 5 was released have not been + implemented in the compiler. + +Others + I'll add to this list as I remember what they are. + +BUGS + +Here are some things which may cause the compiler problems. + +The following render the compiler useless (without serious hacking): +* Use of the DATA filehandle (via __END__ or __DATA__ tokens) +* Operator overloading with %OVERLOAD +* The (deprecated) magic array-offset variable $[ does not work +* The following operators are not yet implemented for CC + goto + sort with a non-default comparison (i.e. a named sub or inline block) +* You can't use "last" to exit from a non-loop block. + +The following may give significant problems: +* BEGIN blocks containing complex initialisation code +* Code which is only ever referred to at runtime (e.g. via eval "..." or + via method calls): see the -u option for the C and CC backends. +* Run-time lookups of lexical variables in "outside" closures + +The following may cause problems (not thoroughly tested): +* Dependencies on whether values of some "magic" Perl variables are + determined at compile-time or runtime. +* For the C and CC backends: compile-time strings which are longer than + your C compiler can cope with in a single line or definition. +* Reliance on intimate details of global destruction +* For the Bytecode backend: high -On optimisation numbers with code + that has complex flow of control. +* Any "-w" option in the first line of your perl program is seen and + acted on by perl itself before the compiler starts. The compiler + itself then runs with warnings turned on. This may cause perl to + print out warnings about the compiler itself since I haven't tested + it thoroughly with warnings turned on. + +There is a terser but more complete list in the Todo file. + +Malcolm Beattie +2 September 1996 diff --git a/ext/B/TESTS b/ext/B/TESTS new file mode 100644 index 0000000000..e050f6cfdd --- /dev/null +++ b/ext/B/TESTS @@ -0,0 +1,78 @@ +Test results from compiling t/*/*.t + C Bytecode CC + +base/cond.t OK ok OK +base/if.t OK ok OK +base/lex.t OK ok OK +base/pat.t OK ok OK +base/term.t OK ok OK +cmd/elsif.t OK ok OK +cmd/for.t OK ok ok 1, 2, 3, panic: pp_iter +cmd/mod.t OK ok ok +cmd/subval.t OK ok 1..34, not ok 27,28 (simply + because filename changes). +cmd/switch.t OK ok ok +cmd/while.t OK ok ok +io/argv.t OK ok ok +io/dup.t OK ok ok +io/fs.t OK ok ok +io/inplace.t OK ok ok +io/pipe.t OK ok ok with -umain +io/print.t OK ok ok +io/tell.t OK ok ok +op/append.t OK ok OK +op/array.t OK ok 1..36, not ok 7,10 (no $[) +op/auto.t OK ok OK +op/chop.t OK ok OK +op/cond.t OK ok OK +op/delete.t OK ok OK +op/do.t OK ok OK +op/each.t OK ok OK +op/eval.t OK ok ok 1-6 of 16 then exits +op/exec.t OK ok OK +op/exp.t OK ok OK +op/flip.t OK ok OK +op/fork.t OK ok OK +op/glob.t OK ok OK +op/goto.t OK ok 1..9, Can't find label label1. +op/groups.t OK (s/ucb/bin/ under Linux) OK 1..0 for now. +op/index.t OK ok OK +op/int.t OK ok OK +op/join.t OK ok OK +op/list.t OK ok OK +op/local.t OK ok OK +op/magic.t OK ok OK +op/misc.t no DATA filehandle so succeeds trivially with 1..0 +op/mkdir.t OK ok OK +op/my.t OK ok OK +op/oct.t OK ok OK (C large const warnings) +op/ord.t OK ok OK +op/overload.t Mostly not ok Mostly not ok C errors. +op/pack.t OK ok OK +op/pat.t omit 26 (reset) ok [lots of memory for compile] +op/push.t OK ok OK +op/quotemeta.t OK ok OK +op/rand.t OK ok +op/range.t OK ok OK +op/read.t OK ok OK +op/readdir.t OK ok OK (substcont works too) +op/ref.t omits "ok 40" (lex destruction) ok (Bytecode) + CC: need -u for OBJ,BASEOBJ, + UNIVERSAL,WHATEVER,main. + 1..41, ok1-33,36-38, + then ok 41, ok 39.DESTROY probs +op/regexp.t OK ok ok (trivially all eval'd) +op/repeat.t OK ok ok +op/sleep.t OK ok ok +op/sort.t OK ok 1..10, ok 1, Out of memory! +op/split.t OK ok ok +op/sprintf.t OK ok ok +op/stat.t OK ok ok +op/study.t OK ok ok +op/subst.t OK ok ok +op/substr.t OK ok ok1-22 except 7-9,11 (all $[) +op/time.t OK ok ok +op/undef.t omit 21 ok ok +op/unshift.t OK ok ok +op/vec.t OK ok ok +op/write.t not ok 3 (no CvOUTSIDE lex from runtime eval). CC: 1..3, hang diff --git a/ext/B/Todo b/ext/B/Todo new file mode 100644 index 0000000000..495be2ef3d --- /dev/null +++ b/ext/B/Todo @@ -0,0 +1,37 @@ +* Fixes + +CC backend: goto, sort with non-default comparison. last for non-loop blocks. +Version checking +improve XSUB handling (both static and dynamic) +sv_magic can do SvREFCNT_inc(obj) which messes up precalculated refcounts +allocation of XPV[INAHC]V structures needs fixing: Perl tries to free +them whereas the compiler expects them to be linked to a xpv[inahc]v_root +list the same as X[IPR]V structures. +ref counts +perl_parse replacement +fix cstring for long strings +compile-time initialisation of AvARRAYs +signed/unsigned problems with NV (and IV?) initialisation and elsewhere? +CvOUTSIDE for ordinary subs +DATA filehandle for standalone Bytecode program (easy) +DATA filehandle for multiple bytecode-compiled modules (harder) +DATA filehandle for C-compiled program (yet harder) + +* Features + +type checking +compile time v. runtime initialisation +save PMOPs in compiled form +selection of what to dump +options for cutting out line info etc. +comment output +shared constants +module dependencies + +* Optimisations +collapse LISTOPs to UNOPs or BASEOPs +compile-time qw(), constant subs +global analysis of variables, type hints etc. +demand-loaded bytecode (leader of each basic block replaced by an op +which loads in bytecode for its block) +fast sub calls for CC backend diff --git a/ext/B/byteperl.c b/ext/B/byteperl.c new file mode 100644 index 0000000000..c4bf6d7dd8 --- /dev/null +++ b/ext/B/byteperl.c @@ -0,0 +1,103 @@ +#include "EXTERN.h" +#include "perl.h" +#ifndef PATCHLEVEL +#include "patchlevel.h" +#endif +#include "byterun.h" + +static void xs_init _((void)); +static PerlInterpreter *my_perl; + +int +#ifndef CAN_PROTOTYPE +main(argc, argv, env) +int argc; +char **argv; +char **env; +#else /* def(CAN_PROTOTYPE) */ +main(int argc, char **argv, char **env) +#endif /* def(CAN_PROTOTYPE) */ +{ + int exitstatus; + int i; + char **fakeargv; + FILE *fp; +#ifdef INDIRECT_BGET_MACROS + struct bytestream bs; +#endif /* INDIRECT_BGET_MACROS */ + + INIT_SPECIALSV_LIST; + PERL_SYS_INIT(&argc,&argv); + +#if PATCHLEVEL > 3 || (PATCHLEVEL == 3 && SUBVERSION >= 1) + perl_init_i18nl10n(1); +#else + perl_init_i18nl14n(1); +#endif + + if (!do_undump) { + my_perl = perl_alloc(); + if (!my_perl) + exit(1); + perl_construct( my_perl ); + } + +#ifdef CSH + if (!cshlen) + cshlen = strlen(cshname); +#endif + + if (argc < 2) + fp = stdin; + else { +#ifdef WIN32 + fp = fopen(argv[1], "rb"); +#else + fp = fopen(argv[1], "r"); +#endif + if (!fp) { + perror(argv[1]); + exit(1); + } + argv++; + argc--; + } + New(666, fakeargv, argc + 4, char *); + fakeargv[0] = argv[0]; + fakeargv[1] = "-e"; + fakeargv[2] = ""; + fakeargv[3] = "--"; + for (i = 1; i < argc; i++) + fakeargv[i + 3] = argv[i]; + fakeargv[argc + 3] = 0; + + exitstatus = perl_parse(my_perl, xs_init, argc + 3, fakeargv, NULL); + if (exitstatus) + exit( exitstatus ); + + sv_setpv(GvSV(gv_fetchpv("0", TRUE, SVt_PV)), argv[0]); + main_cv = compcv; + compcv = 0; + +#ifdef INDIRECT_BGET_MACROS + bs.data = fp; + bs.fgetc = (int(*) _((void*)))fgetc; + bs.fread = (int(*) _((char*,size_t,size_t,void*)))fread; + bs.freadpv = freadpv; + byterun(bs); +#else + byterun(fp); +#endif /* INDIRECT_BGET_MACROS */ + + exitstatus = perl_run( my_perl ); + + perl_destruct( my_perl ); + perl_free( my_perl ); + + exit( exitstatus ); +} + +static void +xs_init() +{ +} diff --git a/ext/B/ramblings/cc.notes b/ext/B/ramblings/cc.notes new file mode 100644 index 0000000000..47bd65a09d --- /dev/null +++ b/ext/B/ramblings/cc.notes @@ -0,0 +1,32 @@ +At entry to each basic block, the following can be assumed (and hence +must be forced where necessary at the end of each basic block): + +The shadow stack @stack is empty. +For each lexical object in @pad, VALID_IV holds for each T_INT, +VALID_DOUBLE holds for each T_DOUBLE and VALID_SV holds otherwise. +The C shadow variable sp holds the stack pointer (not necessarily stack_sp). + +write_back_stack + Writes the contents of the shadow stack @stack back to the real stack. + A write-back of each object in the stack is forced so that its + backing SV contains the right value and that SV is then pushed onto the + real stack. On return, @stack is empty. + +write_back_lexicals + Forces a write-back (i.e. achieves VALID_SV), where necessary, for each + lexical object in @pad. Objects with the TEMPORARY flag are skipped. If + write_back_lexicals is called with an (optional) argument, then it is + taken to be a bitmask of more flags: any lexical object with one of those + flags set is also skipped and not written back to its SV. + +invalidate_lexicals($avoid) + The VALID_INT and VALID_DOUBLE flags are turned off for each lexical + object in @pad whose flags field doesn't overlap with $avoid. + +reload_lexicals + For each necessary lexical object in @pad, makes sure that VALID_IV + holds for objects of type T_INT, VALID_DOUBLE holds for objects for + type T_DOUBLE, and VALID_SV holds for other objects. An object is + considered for reloading if its flags field does not overlap with the + (optional) argument passed to reload_lexicals. + diff --git a/ext/B/ramblings/curcop.runtime b/ext/B/ramblings/curcop.runtime new file mode 100644 index 0000000000..9b8b7d52e7 --- /dev/null +++ b/ext/B/ramblings/curcop.runtime @@ -0,0 +1,39 @@ +PP code uses of curcop +---------------------- + +pp_rv2gv + when a new glob is created for an OPpLVAL_INTRO, + curcop->cop_line is stored as GvLINE() in the new GP. +pp_bless + curcop->cop_stash is used as the stash in the one-arg form of bless + +pp_repeat + tests (curcop != &compiling) to warn "Can't x= to readonly value" + +pp_pos +pp_substr +pp_index +pp_rindex +pp_aslice +pp_lslice +pp_splice + curcop->cop_arybase + +pp_sort + curcop->cop_stash used to determine whether to gv_fetchpv $a and $b + +pp_caller + tests (curcop->cop_stash == debstash) to determine whether + to set DB::args + +pp_reset + resets vars in curcop->cop_stash + +pp_dbstate + sets curcop = (COP*)op + +doeval + compiles into curcop->cop_stash + +pp_nextstate + sets curcop = (COP*)op diff --git a/ext/B/ramblings/flip-flop b/ext/B/ramblings/flip-flop new file mode 100644 index 0000000000..183d541b98 --- /dev/null +++ b/ext/B/ramblings/flip-flop @@ -0,0 +1,51 @@ +PP(pp_range) +{ + if (GIMME == G_ARRAY) + return cCONDOP->op_true; + return SvTRUEx(PAD_SV(op->op_targ)) ? cCONDOP->op_false : cCONDOP->op_true; +} + +pp_range is a CONDOP. +In array context, it just returns op_true. +In scalar context it checks the truth of targ and returns +op_false if true, op_true if false. + +flip is an UNOP. +It "looks after" its child which is always a pp_range CONDOP. +In array context, it just returns the child's op_false. +In scalar context, there are three possible outcomes: + (1) set child's targ to 1, our targ to 1 and return op_next. + (2) set child's targ to 1, our targ to 0, sp-- and return child's op_false. + (3) Blank targ and TOPs and return op_next. +Case 1 happens for a "..." with a matching lineno... or true TOPs. +Case 2 happens for a ".." with a matching lineno... or true TOPs. +Case 3 happens for a non-matching lineno or false TOPs. + + $a = lhs..rhs; + + ,-------> range + ^ / \ + | true/ \false + | / \ + first| lhs rhs + | \ first / + ^--- flip <----- flop + \ / + \ / + sassign + + +/* range */ +if (SvTRUE(curpad[op->op_targ])) + goto label(op_false); +/* op_true */ +... +/* flip */ +/* For "..." returns op_next. For ".." returns op_next or op_first->op_false */ +/* end of basic block */ +goto out; +label(range op_false): +... +/* flop */ +out: +... diff --git a/ext/B/ramblings/magic b/ext/B/ramblings/magic new file mode 100644 index 0000000000..e41930a0f0 --- /dev/null +++ b/ext/B/ramblings/magic @@ -0,0 +1,93 @@ +sv_magic() +---------- +av.c +av_store() + Storing a non-undef element into an SMAGICAL array, av, + assigns the equivalent lowercase form of magic (of the first + MAGIC in the chain) to the value (with obj = av, name = 0 and + namlen = array index). + +gv.c +gv_init() + Initialising gv assigns '*' magic to it with obj = gv, name = + GvNAME and namlen = GvNAMELEN. +gv_fetchpv() + @ISA gets 'I' magic with obj = gv, zero name and namlen. + %OVERLOAD gets 'A' magic with obj = gv, zero name and namlen. + $1 to $9, $&, $`, $', $+ get '\0' magic with obj = gv, + name = GvNAME and namlen = len ( = 1 presumably). +Gv_AMupdate() + Stashes for overload magic seem to get 'c' magic with obj = 0, + name = &amt and namlen = sizeof(amt). +hv_magic(hv, gv, how) + Gives magic how to hv with obj = gv and zero name and namlen. + +mg.c +mg_copy(sv, nsv, key, klen) + Traverses the magic chain of sv. Upper case forms of magic + (only) are copied across to nsv, preserving obj but using + name = key and namlen = klen. +magic_setpos() + LvTARG of a PVLV gets 'g' magic with obj = name = 0 and namlen = pos. + +op.c +mod() + PVLV operators give magic to their targs with + obj = name = namlen = 0. OP_POS gives '.', OP_VEC gives 'v' + and OP_SUBSTR gives 'x'. + +perl.c +magicname(sym, name, namlen) + Fetches/creates a GV with name sym and gives it '\0' magic + with obj = gv, name and namlen as passed. +init_postdump_symbols() + Elements of the environment get given SVs with 'e' magic. + obj = sv and name and namlen point to the actual string + within env. + +pp.c +pp_av2arylen() + $#foo gives '#' magic to the new SV with obj = av and + name = namlen = 0. +pp_study() + SV gets 'g' magic with obj = name = namlen = 0. +pp_substr() + PVLV gets 'x' magic with obj = name = namlen = 0. +pp_vec() + PVLV gets 'x' magic with obj = name = namlen = 0. + +pp_hot.c +pp_match() + m//g gets 'g' magic with obj = name = namlen = 0. + +pp_sys.c +pp_tie() + sv gets magic with obj = sv and name = namlen = 0. + If an HV or an AV, it gets 'P' magic, otherwise 'q' magic. +pp_dbmopen() + 'P' magic for the HV just as with pp_tie(). +pp_sysread() + If tainting, the buffer SV gets 't' magic with + obj = name = namlen = 0. + +sv.c +sv_setsv() + Doing sv_setsv(dstr, gv) gives '*' magic to dstr with + obj = dstr, name = GvNAME, namlen = GvNAMELEN. + +util.c +fbm_compile() + The PVBM gets 'B' magic with obj = name = namlen = 0 and SvVALID + is set to indicate that the Boyer-Moore table is valid. + magic_setbm() just clears the SvVALID flag. + +hv_magic() +---------- + +gv.c +gv_fetchfile() + With perldb, the HV of a gvfile gv gets 'L' magic with obj = gv. +gv_fetchpv() + %SIG gets 'S' magic with obj = siggv. +init_postdump_symbols() + %ENV gets 'E' magic with obj = envgv. diff --git a/ext/B/ramblings/reg.alloc b/ext/B/ramblings/reg.alloc new file mode 100644 index 0000000000..7fd69f2ebe --- /dev/null +++ b/ext/B/ramblings/reg.alloc @@ -0,0 +1,32 @@ +while ($i--) { + foo(); +} +exit + + PP code if i an int register if i an int but not a + (i.e. can't be register (i.e. can be + implicitly invalidated) implicitly invalidated) + nextstate + enterloop + + + loop: + gvsv GV (0xe6078) *i validates i validates i + postdec invalidates $i invalidates $i + and if_false goto out; + i valid; $i invalid i valid; $i invalid + + i valid; $i invalid i valid; $i invalid + nextstate + pushmark + gv GV (0xe600c) *foo + entersub validates $i; invals i + + unstack + goto loop: + + i valid; $i invalid + out: + leaveloop + nextstate + exit diff --git a/ext/B/ramblings/runtime.porting b/ext/B/ramblings/runtime.porting new file mode 100644 index 0000000000..4699b255cf --- /dev/null +++ b/ext/B/ramblings/runtime.porting @@ -0,0 +1,350 @@ +Notes on porting the perl runtime PP engine. +Importance: 1 = who cares?, 10 = vital +Difficulty: 1 = trivial, 10 = very difficult. Level assumes a +reasonable implementation of the SV and OP API already ported. + +OP Import Diff Comments +null 10 1 +stub 10 1 +scalar 10 1 +pushmark 10 1 PUSHMARK +wantarray 7 3 cxstack, dopoptosub +const 10 1 +gvsv 10 1 save_scalar +gv 10 1 +gelem 3 3 +padsv 10 2 SAVECLEARSV, provide_ref +padav 10 2 +padhv 10 2 +padany 1 1 +pushre 7 3 pushes an op. Blech. +rv2gv 6 5 +rv2sv 10 4 +av2arylen 7 3 sv_magic +rv2cv 8 5 sv_2cv +anoncode 7 6 cv_clone +prototype 4 4 sv_2cv +refgen 8 3 +srefgen 8 2 +ref 8 3 +bless 7 3 +backtick 5 4 +glob 5 2 do_readline +readline 8 2 do_readline +rcatline 8 2 +regcmaybe 8 1 +regcomp 8 9 pregcomp +match 8 10 +subst 8 10 +substcont 8 7 +trans 7 4 do_trans +sassign 10 3 mg_find, SvSETMAGIC +aassign 10 5 +chop 8 3 do_chop +schop 8 3 do_chop +chomp 8 3 do_chomp +schomp 8 3 do_chomp +defined 10 2 +undef 10 3 +study 4 5 +pos 8 3 PVLV, mg_find +preinc 10 2 sv_inc, SvSETMAGIC +i_preinc +predec 10 2 sv_dec, SvSETMAGIC +i_predec +postinc 10 2 sv_dec, SvSETMAGIC +i_postinc +postdec 10 2 sv_dec, SvSETMAGIC +i_postdec +pow 10 1 +multiply 10 1 +i_multiply 10 1 +divide 10 2 +i_divide 10 1 +modulo 10 2 +i_modulo 10 1 +repeat 6 4 +add 10 1 +i_add 10 1 +subtract 10 1 +i_subtract 10 1 +concat 10 2 mg_get +stringify 10 2 sv_setpvn +left_shift 10 1 +right_shift 10 1 +lt 10 1 +i_lt 10 1 +gt 10 1 +i_gt 10 1 +le 10 1 +i_le 10 1 +ge 10 1 +i_ge 10 1 +eq 10 1 +i_eq 10 1 +ne 10 1 +i_ne 10 1 +ncmp 10 1 +i_ncmp 10 1 +slt 10 2 +sgt 10 2 +sle 10 2 +sge 10 2 +seq 10 2 sv_eq +sne 10 2 +scmp 10 2 +bit_and 10 2 +bit_xor 10 2 +bit_or 10 2 +negate 10 3 +i_negate 10 1 +not 10 1 +complement 10 3 +atan2 6 1 +sin 6 1 +cos 6 1 +rand 5 2 +srand 5 2 +exp 6 1 +log 6 2 +sqrt 6 2 +int 10 2 +hex 9 2 +oct 9 2 +abs 10 1 +length 10 1 +substr 10 4 PVLV +vec 5 4 +index 9 3 +rindex 9 3 +sprintf 9 4 do_sprintf +formline 6 7 +ord 6 2 +chr 6 2 +crypt 3 2 +ucfirst 6 2 +lcfirst 6 2 +uc 6 2 +lc 6 2 +quotemeta 6 3 +rv2av 10 3 save_svref, mg_get, save_ary +aelemfast 10 2 av_fetch +aelem 10 3 +aslice 9 4 +each 10 3 hv_iternext +values 10 3 do_kv +keys 10 3 do_kv +delete 10 3 +exists 10 3 +rv2hv 10 3 save_svref, mg_get, save_ary, do_kv +helem 10 3 save_svref, provide_ref +hslice 9 4 +unpack 9 6 lengthy +pack 9 6 lengthy +split 9 9 +join 10 4 do_join +list 10 2 +lslice 9 4 +anonlist 10 2 +anonhash 10 3 +splice 9 6 +push 10 2 +pop 10 2 +shift 10 2 +unshift 10 2 +sort 6 7 +reverse 9 4 +grepstart 6 5 modifies flow of control +grepwhile 6 5 modifies flow of control +mapstart 1 1 +mapwhile 6 5 modifies flow of control +range 7 3 modifies flow of control +flip 7 4 modifies flow of control +flop 7 4 modifies flow of control +and 10 3 modifies flow of control +or 10 3 modifies flow of control +xor +cond_expr 10 3 modifies flow of control +andassign 7 3 modifies flow of control +orassign 7 3 modifies flow of control +method 8 5 +entersub 10 7 +leavesub 10 5 +caller 2 8 +warn 9 3 +die 9 3 +reset 2 2 +lineseq 1 1 +nextstate 10 1 Update stack_sp from cxstack. FREETMPS. +dbstate 3 7 +unstack +enter 10 3 cxstack, ENTER, SAVETMPS, PUSHBLOCK +leave 10 3 cxstack, SAVETMPS, LEAVE, POPBLOCK +scope 1 1 +enteriter 9 4 cxstack +iter 9 3 cxstack +enterloop 10 4 +leaveloop 10 4 +return 10 5 +last 9 6 +next 9 6 +redo 9 6 +dump 1 9 pp_goto +goto 6 9 +exit 9 2 my_exit +open 9 5 do_open +close 9 3 do_close +pipe_op 7 4 +fileno 9 2 +umask 4 2 +binmode 4 2 +tie 5 5 pp_entersub +untie 5 2 sv_unmagic +tied 5 2 +dbmopen 4 5 +dbmclose 4 2 +sselect 4 4 +select 7 3 +getc 7 2 +read 8 2 pp_sysread +enterwrite 4 4 doform +leavewrite 4 5 +prtf 4 4 do_sprintf +print 8 6 +sysopen 8 2 +sysread 8 4 +syswrite 8 4 pp_send +send 8 4 +recv 8 4 pp_sysread +eof 9 2 +tell 9 3 +seek 9 2 +truncate 8 3 +fcntl 8 4 pp_ioctl +ioctl 8 4 +flock 8 2 +socket 5 3 +sockpair 5 3 +bind 5 3 +connect 5 3 +listen 5 3 +accept 5 3 +shutdown 5 2 +gsockopt 5 3 pp_ssockopt +ssockopt 5 3 +getsockname 5 3 pp_getpeername +getpeername 5 3 +lstat 5 4 pp_stat +stat 5 4 lengthy +ftrread 5 2 cando +ftrwrite 5 2 cando +ftrexec 5 2 cando +fteread 5 2 cando +ftewrite 5 2 cando +fteexec 5 2 cando +ftis 5 2 cando +fteowned 5 2 cando +ftrowned 5 2 cando +ftzero 5 2 cando +ftsize 5 2 cando +ftmtime 5 2 cando +ftatime 5 2 cando +ftctime 5 2 cando +ftsock 5 2 cando +ftchr 5 2 cando +ftblk 5 2 cando +ftfile 5 2 cando +ftdir 5 2 cando +ftpipe 5 2 cando +ftlink 5 2 cando +ftsuid 5 2 cando +ftsgid 5 2 cando +ftsvtx 5 2 cando +fttty 5 2 cando +fttext 5 4 +ftbinary 5 4 fttext +chdir +chown +chroot +unlink +chmod +utime +rename +link +symlink +readlink +mkdir +rmdir +open_dir +readdir +telldir +seekdir +rewinddir +closedir +fork +wait +waitpid +system +exec +kill +getppid +getpgrp +setpgrp +getpriority +setpriority +time +tms +localtime +gmtime +alarm +sleep +shmget +shmctl +shmread +shmwrite +msgget +msgctl +msgsnd +msgrcv +semget +semctl +semop +require 6 9 doeval +dofile 6 9 doeval +entereval 6 9 doeval +leaveeval 6 5 +entertry 7 4 modifies flow of control +leavetry 7 3 +ghbyname +ghbyaddr +ghostent +gnbyname +gnbyaddr +gnetent +gpbyname +gpbynumber +gprotoent +gsbyname +gsbyport +gservent +shostent +snetent +sprotoent +sservent +ehostent +enetent +eprotoent +eservent +gpwnam +gpwuid +gpwent +spwent +epwent +ggrnam +ggrgid +ggrent +sgrent +egrent +getlogin +syscall +
\ No newline at end of file diff --git a/ext/B/typemap b/ext/B/typemap new file mode 100644 index 0000000000..7206a6a2e1 --- /dev/null +++ b/ext/B/typemap @@ -0,0 +1,69 @@ +TYPEMAP + +B::OP T_OP_OBJ +B::UNOP T_OP_OBJ +B::BINOP T_OP_OBJ +B::LOGOP T_OP_OBJ +B::CONDOP T_OP_OBJ +B::LISTOP T_OP_OBJ +B::PMOP T_OP_OBJ +B::SVOP T_OP_OBJ +B::GVOP T_OP_OBJ +B::PVOP T_OP_OBJ +B::CVOP T_OP_OBJ +B::LOOP T_OP_OBJ +B::COP T_OP_OBJ + +B::SV T_SV_OBJ +B::PV T_SV_OBJ +B::IV T_SV_OBJ +B::NV T_SV_OBJ +B::PVMG T_SV_OBJ +B::PVLV T_SV_OBJ +B::BM T_SV_OBJ +B::RV T_SV_OBJ +B::GV T_SV_OBJ +B::CV T_SV_OBJ +B::HV T_SV_OBJ +B::AV T_SV_OBJ +B::IO T_SV_OBJ + +B::MAGIC T_MG_OBJ +SSize_t T_IV +STRLEN T_IV + +INPUT +T_OP_OBJ + if (SvROK($arg)) { + IV tmp = SvIV((SV*)SvRV($arg)); + $var = ($type) tmp; + } + else + croak(\"$var is not a reference\") + +T_SV_OBJ + if (SvROK($arg)) { + IV tmp = SvIV((SV*)SvRV($arg)); + $var = ($type) tmp; + } + else + croak(\"$var is not a reference\") + +T_MG_OBJ + if (SvROK($arg)) { + IV tmp = SvIV((SV*)SvRV($arg)); + $var = ($type) tmp; + } + else + croak(\"$var is not a reference\") + +OUTPUT +T_OP_OBJ + sv_setiv(newSVrv($arg, cc_opclassname((OP*)$var)), (IV)$var); + +T_SV_OBJ + make_sv_object(($arg), (SV*)($var)); + + +T_MG_OBJ + sv_setiv(newSVrv($arg, "B::MAGIC"), (IV)$var); |