1			/*	B.xs
     2			 *
     3			 *	Copyright (c) 1996 Malcolm Beattie
     4			 *
     5			 *	You may distribute under the terms of either the GNU General Public
     6			 *	License or the Artistic License, as specified in the README file.
     7			 *
     8			 */
     9			
    10			#define PERL_NO_GET_CONTEXT
    11			#include "EXTERN.h"
    12			#include "perl.h"
    13			#include "XSUB.h"
    14			
    15			#ifdef PerlIO
    16			typedef PerlIO * InputStream;
    17			#else
    18			typedef FILE * InputStream;
    19			#endif
    20			
    21			
    22			static const char* const svclassnames[] = {
    23			    "B::NULL",
    24			    "B::IV",
    25			    "B::NV",
    26			    "B::RV",
    27			    "B::PV",
    28			    "B::PVIV",
    29			    "B::PVNV",
    30			    "B::PVMG",
    31			    "B::BM",
    32			#if PERL_VERSION >= 9
    33			    "B::GV",
    34			#endif
    35			    "B::PVLV",
    36			    "B::AV",
    37			    "B::HV",
    38			    "B::CV",
    39			#if PERL_VERSION <= 8
    40			    "B::GV",
    41			#endif
    42			    "B::FM",
    43			    "B::IO",
    44			};
    45			
    46			typedef enum {
    47			    OPc_NULL,	/* 0 */
    48			    OPc_BASEOP,	/* 1 */
    49			    OPc_UNOP,	/* 2 */
    50			    OPc_BINOP,	/* 3 */
    51			    OPc_LOGOP,	/* 4 */
    52			    OPc_LISTOP,	/* 5 */
    53			    OPc_PMOP,	/* 6 */
    54			    OPc_SVOP,	/* 7 */
    55			    OPc_PADOP,	/* 8 */
    56			    OPc_PVOP,	/* 9 */
    57			    OPc_LOOP,	/* 10 */
    58			    OPc_COP	/* 11 */
    59			} opclass;
    60			
    61			static const char* const opclassnames[] = {
    62			    "B::NULL",
    63			    "B::OP",
    64			    "B::UNOP",
    65			    "B::BINOP",
    66			    "B::LOGOP",
    67			    "B::LISTOP",
    68			    "B::PMOP",
    69			    "B::SVOP",
    70			    "B::PADOP",
    71			    "B::PVOP",
    72			    "B::LOOP",
    73			    "B::COP"	
    74			};
    75			
    76			static const size_t opsizes[] = {
    77			    0,	
    78			    sizeof(OP),
    79			    sizeof(UNOP),
    80			    sizeof(BINOP),
    81			    sizeof(LOGOP),
    82			    sizeof(LISTOP),
    83			    sizeof(PMOP),
    84			    sizeof(SVOP),
    85			    sizeof(PADOP),
    86			    sizeof(PVOP),
    87			    sizeof(LOOP),
    88			    sizeof(COP)	
    89			};
    90			
    91			#define MY_CXT_KEY "B::_guts" XS_VERSION
    92			
    93			typedef struct {
    94			    int		x_walkoptree_debug;	/* Flag for walkoptree debug hook */
    95			    SV *	x_specialsv_list[7];
    96			} my_cxt_t;
    97			
    98			START_MY_CXT
    99			
   100			#define walkoptree_debug	(MY_CXT.x_walkoptree_debug)
   101			#define specialsv_list		(MY_CXT.x_specialsv_list)
   102			
   103			static opclass
   104			cc_opclass(pTHX_ const OP *o)
   105	      245996    {
   106	      245996        if (!o)
   107	       37102    	return OPc_NULL;
   108			
   109	      208894        if (o->op_type == 0)
   110	       14646    	return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
   111			
   112	      194248        if (o->op_type == OP_SASSIGN)
   113	        6569    	return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
   114			
   115			#ifdef USE_ITHREADS
   116			    if (o->op_type == OP_GV || o->op_type == OP_GVSV ||
   117				o->op_type == OP_AELEMFAST || o->op_type == OP_RCATLINE)
   118				return OPc_PADOP;
   119			#endif
   120			
   121	      187679        switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
   122			    case OA_BASEOP:
   123	       57892    	return OPc_BASEOP;
   124			
   125			    case OA_UNOP:
   126	       30071    	return OPc_UNOP;
   127			
   128			    case OA_BINOP:
   129	       16037    	return OPc_BINOP;
   130			
   131			    case OA_LOGOP:
   132	        9932    	return OPc_LOGOP;
   133			
   134			    case OA_LISTOP:
   135	       12489    	return OPc_LISTOP;
   136			
   137			    case OA_PMOP:
   138	        1250    	return OPc_PMOP;
   139			
   140			    case OA_SVOP:
   141	       38572    	return OPc_SVOP;
   142			
   143			    case OA_PADOP:
   144	      ######    	return OPc_PADOP;
   145			
   146			    case OA_PVOP_OR_SVOP:
   147			        /*
   148			         * Character translations (tr///) are usually a PVOP, keeping a 
   149			         * pointer to a table of shorts used to look up translations.
   150			         * Under utf8, however, a simple table isn't practical; instead,
   151			         * the OP is an SVOP, and the SV is a reference to a swash
   152			         * (i.e., an RV pointing to an HV).
   153			         */
   154	          19    	return (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
   155					? OPc_SVOP : OPc_PVOP;
   156			
   157			    case OA_LOOP:
   158	         695    	return OPc_LOOP;
   159			
   160			    case OA_COP:
   161	       17798    	return OPc_COP;
   162			
   163			    case OA_BASEOP_OR_UNOP:
   164				/*
   165				 * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
   166				 * whether parens were seen. perly.y uses OPf_SPECIAL to
   167				 * signal whether a BASEOP had empty parens or none.
   168				 * Some other UNOPs are created later, though, so the best
   169				 * test is OPf_KIDS, which is set in newUNOP.
   170				 */
   171	        2736    	return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
   172			
   173			    case OA_FILESTATOP:
   174				/*
   175				 * The file stat OPs are created via UNI(OP_foo) in toke.c but use
   176				 * the OPf_REF flag to distinguish between OP types instead of the
   177				 * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
   178				 * return OPc_UNOP so that walkoptree can find our children. If
   179				 * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
   180				 * (no argument to the operator) it's an OP; with OPf_REF set it's
   181				 * an SVOP (and op_sv is the GV for the filehandle argument).
   182				 */
   183	      ######    	return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
   184			#ifdef USE_ITHREADS
   185					(o->op_flags & OPf_REF) ? OPc_PADOP : OPc_BASEOP);
   186			#else
   187					(o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP);
   188			#endif
   189			    case OA_LOOPEXOP:
   190				/*
   191				 * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
   192				 * label was omitted (in which case it's a BASEOP) or else a term was
   193				 * seen. In this last case, all except goto are definitely PVOP but
   194				 * goto is either a PVOP (with an ordinary constant label), an UNOP
   195				 * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
   196				 * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
   197				 * get set.
   198				 */
   199	         188    	if (o->op_flags & OPf_STACKED)
   200	      ######    	    return OPc_UNOP;
   201	         188    	else if (o->op_flags & OPf_SPECIAL)
   202	         182    	    return OPc_BASEOP;
   203				else
   204	           6    	    return OPc_PVOP;
   205			    }
   206	      ######        warn("can't determine class of operator %s, assuming BASEOP\n",
   207				 PL_op_name[o->op_type]);
   208	      ######        return OPc_BASEOP;
   209			}
   210			
   211			static char *
   212			cc_opclassname(pTHX_ const OP *o)
   213	      245677    {
   214	      245677        return (char *)opclassnames[cc_opclass(aTHX_ o)];
   215			}
   216			
   217			static SV *
   218			make_sv_object(pTHX_ SV *arg, SV *sv)
   219	      705488    {
   220	      705488        const char *type = 0;
   221	      705488        IV iv;
   222			    dMY_CXT;
   223			    
   224	     2396322        for (iv = 0; iv < sizeof(specialsv_list)/sizeof(SV*); iv++) {
   225	     2225022    	if (sv == specialsv_list[iv]) {
   226	      534188    	    type = "B::SPECIAL";
   227	      534188    	    break;
   228				}
   229			    }
   230	      705488        if (!type) {
   231	      171300    	type = svclassnames[SvTYPE(sv)];
   232	      171300    	iv = PTR2IV(sv);
   233			    }
   234	      705488        sv_setiv(newSVrv(arg, type), iv);
   235	      705488        return arg;
   236			}
   237			
   238			static SV *
   239			make_mg_object(pTHX_ SV *arg, MAGIC *mg)
   240	           4    {
   241	           4        sv_setiv(newSVrv(arg, "B::MAGIC"), PTR2IV(mg));
   242	           4        return arg;
   243			}
   244			
   245			static SV *
   246			cstring(pTHX_ SV *sv, bool perlstyle)
   247	        3840    {
   248	        3840        SV *sstr = newSVpvn("", 0);
   249			
   250	        3840        if (!SvOK(sv))
   251	      ######    	sv_setpvn(sstr, "0", 1);
   252	        3840        else if (perlstyle && SvUTF8(sv)) {
   253	      ######    	SV *tmpsv = sv_newmortal(); /* Temporary SV to feed sv_uni_display */
   254	      ######    	const STRLEN len = SvCUR(sv);
   255	      ######    	const char *s = sv_uni_display(tmpsv, sv, 8*len, UNI_DISPLAY_QQ);
   256	      ######    	sv_setpvn(sstr,"\"",1);
   257	      ######    	while (*s)
   258				{
   259	      ######    	    if (*s == '"')
   260	      ######    		sv_catpvn(sstr, "\\\"", 2);
   261	      ######    	    else if (*s == '$')
   262	      ######    		sv_catpvn(sstr, "\\$", 2);
   263	      ######    	    else if (*s == '@')
   264	      ######    		sv_catpvn(sstr, "\\@", 2);
   265	      ######    	    else if (*s == '\\')
   266				    {
   267	      ######    		if (strchr("nrftax\\",*(s+1)))
   268	      ######    		    sv_catpvn(sstr, s++, 2);
   269					else
   270	      ######    		    sv_catpvn(sstr, "\\\\", 2);
   271				    }
   272				    else /* should always be printable */
   273	      ######    		sv_catpvn(sstr, s, 1);
   274	      ######    	    ++s;
   275				}
   276	      ######    	sv_catpv(sstr, "\"");
   277	      ######    	return sstr;
   278			    }
   279			    else
   280			    {
   281				/* XXX Optimise? */
   282	        3840    	STRLEN len;
   283	        3840    	const char *s = SvPV(sv, len);
   284	        3840    	sv_catpv(sstr, "\"");
   285	       52514    	for (; len; len--, s++)
   286				{
   287				    /* At least try a little for readability */
   288	       24337    	    if (*s == '"')
   289	          32    		sv_catpv(sstr, "\\\"");
   290	       24305    	    else if (*s == '\\')
   291	         295    		sv_catpv(sstr, "\\\\");
   292			            /* trigraphs - bleagh */
   293	       24010                else if (!perlstyle && *s == '?' && len>=3 && s[1] == '?') {
   294	           5    		char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
   295	           5                    sprintf(escbuff, "\\%03o", '?');
   296	           5                    sv_catpv(sstr, escbuff);
   297			            }
   298	       24005    	    else if (perlstyle && *s == '$')
   299	      ######    		sv_catpv(sstr, "\\$");
   300	       24005    	    else if (perlstyle && *s == '@')
   301	      ######    		sv_catpv(sstr, "\\@");
   302			#ifdef EBCDIC
   303				    else if (isPRINT(*s))
   304			#else
   305	       24005    	    else if (*s >= ' ' && *s < 127)
   306			#endif /* EBCDIC */
   307	       23404    		sv_catpvn(sstr, s, 1);
   308	         601    	    else if (*s == '\n')
   309	         169    		sv_catpv(sstr, "\\n");
   310	         432    	    else if (*s == '\r')
   311	      ######    		sv_catpv(sstr, "\\r");
   312	         432    	    else if (*s == '\t')
   313	          17    		sv_catpv(sstr, "\\t");
   314	         415    	    else if (*s == '\a')
   315	      ######    		sv_catpv(sstr, "\\a");
   316	         415    	    else if (*s == '\b')
   317	          11    		sv_catpv(sstr, "\\b");
   318	         404    	    else if (*s == '\f')
   319	           8    		sv_catpv(sstr, "\\f");
   320	         396    	    else if (!perlstyle && *s == '\v')
   321	           7    		sv_catpv(sstr, "\\v");
   322				    else
   323				    {
   324					/* Don't want promotion of a signed -1 char in sprintf args */
   325	         389    		char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
   326	         389    		const unsigned char c = (unsigned char) *s;
   327	         389    		sprintf(escbuff, "\\%03o", c);
   328	         389    		sv_catpv(sstr, escbuff);
   329				    }
   330				    /* XXX Add line breaks if string is long */
   331				}
   332	        3840    	sv_catpv(sstr, "\"");
   333			    }
   334	        3840        return sstr;
   335			}
   336			
   337			static SV *
   338			cchar(pTHX_ SV *sv)
   339	      ######    {
   340	      ######        SV *sstr = newSVpvn("'", 1);
   341	      ######        const char *s = SvPV_nolen(sv);
   342			
   343	      ######        if (*s == '\'')
   344	      ######    	sv_catpvn(sstr, "\\'", 2);
   345	      ######        else if (*s == '\\')
   346	      ######    	sv_catpvn(sstr, "\\\\", 2);
   347			#ifdef EBCDIC
   348			    else if (isPRINT(*s))
   349			#else
   350	      ######        else if (*s >= ' ' && *s < 127)
   351			#endif /* EBCDIC */
   352	      ######    	sv_catpvn(sstr, s, 1);
   353	      ######        else if (*s == '\n')
   354	      ######    	sv_catpvn(sstr, "\\n", 2);
   355	      ######        else if (*s == '\r')
   356	      ######    	sv_catpvn(sstr, "\\r", 2);
   357	      ######        else if (*s == '\t')
   358	      ######    	sv_catpvn(sstr, "\\t", 2);
   359	      ######        else if (*s == '\a')
   360	      ######    	sv_catpvn(sstr, "\\a", 2);
   361	      ######        else if (*s == '\b')
   362	      ######    	sv_catpvn(sstr, "\\b", 2);
   363	      ######        else if (*s == '\f')
   364	      ######    	sv_catpvn(sstr, "\\f", 2);
   365	      ######        else if (*s == '\v')
   366	      ######    	sv_catpvn(sstr, "\\v", 2);
   367			    else
   368			    {
   369				/* no trigraph support */
   370	      ######    	char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
   371				/* Don't want promotion of a signed -1 char in sprintf args */
   372	      ######    	unsigned char c = (unsigned char) *s;
   373	      ######    	sprintf(escbuff, "\\%03o", c);
   374	      ######    	sv_catpv(sstr, escbuff);
   375			    }
   376	      ######        sv_catpvn(sstr, "'", 1);
   377	      ######        return sstr;
   378			}
   379			
   380			static void
   381			walkoptree(pTHX_ SV *opsv, const char *method)
   382	           4    {
   383	           4        dSP;
   384	           4        OP *o, *kid;
   385			    dMY_CXT;
   386			
   387	           4        if (!SvROK(opsv))
   388	      ######    	croak("opsv is not a reference");
   389	           4        opsv = sv_mortalcopy(opsv);
   390	           4        o = INT2PTR(OP*,SvIV((SV*)SvRV(opsv)));
   391	           4        if (walkoptree_debug) {
   392	      ######    	PUSHMARK(sp);
   393	      ######    	XPUSHs(opsv);
   394	      ######    	PUTBACK;
   395	      ######    	perl_call_method("walkoptree_debug", G_DISCARD);
   396			    }
   397	           4        PUSHMARK(sp);
   398	           4        XPUSHs(opsv);
   399	           4        PUTBACK;
   400	           4        perl_call_method(method, G_DISCARD);
   401	           4        if (o && (o->op_flags & OPf_KIDS)) {
   402	           4    	for (kid = ((UNOP*)o)->op_first; kid; kid = kid->op_sibling) {
   403				    /* Use the same opsv. Rely on methods not to mess it up. */
   404	           3    	    sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), PTR2IV(kid));
   405	           3    	    walkoptree(aTHX_ opsv, method);
   406				}
   407			    }
   408	           4        if (o && (cc_opclass(aTHX_ o) == OPc_PMOP) && o->op_type != OP_PUSHRE
   409				    && (kid = cPMOPo->op_pmreplroot))
   410			    {
   411	      ######    	sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), PTR2IV(kid));
   412	      ######    	walkoptree(aTHX_ opsv, method);
   413			    }
   414			}
   415			
   416			static SV **
   417			oplist(pTHX_ OP *o, SV **SP)
   418	          41    {
   419	         661        for(; o; o = o->op_next) {
   420	         321    	SV *opsv;
   421			#if PERL_VERSION >= 9
   422	         321    	if (o->op_opt == 0)
   423	          11    	    break;
   424	         310    	o->op_opt = 0;
   425			#else
   426				if (o->op_seq == 0)
   427				    break;
   428				o->op_seq = 0;
   429			#endif
   430	         310    	opsv = sv_newmortal();
   431	         310    	sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ (OP*)o)), PTR2IV(o));
   432	         310    	XPUSHs(opsv);
   433	         310            switch (o->op_type) {
   434				case OP_SUBST:
   435	           2                SP = oplist(aTHX_ cPMOPo->op_pmreplstart, SP);
   436	           2                continue;
   437				case OP_SORT:
   438	           2    	    if (o->op_flags & OPf_STACKED && o->op_flags & OPf_SPECIAL) {
   439	           2    		OP *kid = cLISTOPo->op_first->op_sibling;   /* pass pushmark */
   440	           2    		kid = kUNOP->op_first;                      /* pass rv2gv */
   441	           2    		kid = kUNOP->op_first;                      /* pass leave */
   442	           2    		SP = oplist(aTHX_ kid->op_next, SP);
   443				    }
   444	           2    	    continue;
   445			        }
   446	         306    	switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
   447				case OA_LOGOP:
   448	           5    	    SP = oplist(aTHX_ cLOGOPo->op_other, SP);
   449	           5    	    break;
   450				case OA_LOOP:
   451	           2    	    SP = oplist(aTHX_ cLOOPo->op_lastop, SP);
   452	           2    	    SP = oplist(aTHX_ cLOOPo->op_nextop, SP);
   453	           2    	    SP = oplist(aTHX_ cLOOPo->op_redoop, SP);
   454				    break;
   455				}
   456			    }
   457	          41        return SP;
   458			}
   459			
   460			typedef OP	*B__OP;
   461			typedef UNOP	*B__UNOP;
   462			typedef BINOP	*B__BINOP;
   463			typedef LOGOP	*B__LOGOP;
   464			typedef LISTOP	*B__LISTOP;
   465			typedef PMOP	*B__PMOP;
   466			typedef SVOP	*B__SVOP;
   467			typedef PADOP	*B__PADOP;
   468			typedef PVOP	*B__PVOP;
   469			typedef LOOP	*B__LOOP;
   470			typedef COP	*B__COP;
   471			
   472			typedef SV	*B__SV;
   473			typedef SV	*B__IV;
   474			typedef SV	*B__PV;
   475			typedef SV	*B__NV;
   476			typedef SV	*B__PVMG;
   477			typedef SV	*B__PVLV;
   478			typedef SV	*B__BM;
   479			typedef SV	*B__RV;
   480			typedef SV	*B__FM;
   481			typedef AV	*B__AV;
   482			typedef HV	*B__HV;
   483			typedef CV	*B__CV;
   484			typedef GV	*B__GV;
   485			typedef IO	*B__IO;
   486			
   487			typedef MAGIC	*B__MAGIC;
   488			
   489			MODULE = B	PACKAGE = B	PREFIX = B_
   490			
   491			PROTOTYPES: DISABLE
   492			
   493			BOOT:
   494			{
   495	         104        HV *stash = gv_stashpvn("B", 1, TRUE);
   496	         104        AV *export_ok = perl_get_av("B::EXPORT_OK",TRUE);
   497	         104        MY_CXT_INIT;
   498	         104        specialsv_list[0] = Nullsv;
   499	         104        specialsv_list[1] = &PL_sv_undef;
   500	         104        specialsv_list[2] = &PL_sv_yes;
   501	         104        specialsv_list[3] = &PL_sv_no;
   502	         104        specialsv_list[4] = pWARN_ALL;
   503	         104        specialsv_list[5] = pWARN_NONE;
   504	         104        specialsv_list[6] = pWARN_STD;
   505			#if PERL_VERSION <= 8
   506			#  define CVf_ASSERTION	0
   507			#endif
   508			#include "defsubs.h"
   509			}
   510			
   511			#define B_main_cv()	PL_main_cv
   512			#define B_init_av()	PL_initav
   513			#define B_inc_gv()	PL_incgv
   514			#define B_check_av()	PL_checkav_save
   515			#define B_begin_av()	PL_beginav_save
   516			#define B_end_av()	PL_endav
   517			#define B_main_root()	PL_main_root
   518			#define B_main_start()	PL_main_start
   519			#define B_amagic_generation()	PL_amagic_generation
   520			#define B_defstash()	PL_defstash
   521			#define B_curstash()	PL_curstash
   522			#define B_dowarn()	PL_dowarn
   523			#define B_comppadlist()	(PL_main_cv ? CvPADLIST(PL_main_cv) : CvPADLIST(PL_compcv))
   524			#define B_sv_undef()	&PL_sv_undef
   525			#define B_sv_yes()	&PL_sv_yes
   526			#define B_sv_no()	&PL_sv_no
   527			#define B_formfeed()	PL_formfeed
   528			#ifdef USE_ITHREADS
   529			#define B_regex_padav()	PL_regex_padav
   530			#endif
   531			
   532			B::AV
   533			B_init_av()
   534			
   535			B::AV
   536			B_check_av()
   537			
   538			B::AV
   539			B_begin_av()
   540			
   541			B::AV
   542			B_end_av()
   543			
   544			B::GV
   545			B_inc_gv()
   546			
   547			#ifdef USE_ITHREADS
   548			
   549			B::AV
   550			B_regex_padav()
   551			
   552			#endif
   553			
   554			B::CV
   555			B_main_cv()
   556			
   557			B::OP
   558			B_main_root()
   559			
   560			B::OP
   561			B_main_start()
   562			
   563			long 
   564			B_amagic_generation()
   565			
   566			B::AV
   567			B_comppadlist()
   568			
   569			B::SV
   570			B_sv_undef()
   571			
   572			B::SV
   573			B_sv_yes()
   574			
   575			B::SV
   576			B_sv_no()
   577			
   578			B::HV
   579			B_curstash()
   580			
   581			B::HV
   582			B_defstash()
   583			
   584			U8
   585			B_dowarn()
   586			
   587			B::SV
   588			B_formfeed()
   589			
   590			void
   591			B_warnhook()
   592			    CODE:
   593	          19    	ST(0) = make_sv_object(aTHX_ sv_newmortal(), PL_warnhook);
   594			
   595			void
   596			B_diehook()
   597			    CODE:
   598	      ######    	ST(0) = make_sv_object(aTHX_ sv_newmortal(), PL_diehook);
   599			
   600			MODULE = B	PACKAGE = B
   601			
   602			void
   603			walkoptree(opsv, method)
   604				SV *	opsv
   605				const char *	method
   606			    CODE:
   607	           1    	walkoptree(aTHX_ opsv, method);
   608			
   609			int
   610			walkoptree_debug(...)
   611			    CODE:
   612				dMY_CXT;
   613	      ######    	RETVAL = walkoptree_debug;
   614	      ######    	if (items > 0 && SvTRUE(ST(1)))
   615	      ######    	    walkoptree_debug = 1;
   616			    OUTPUT:
   617				RETVAL
   618			
   619			#define address(sv) PTR2IV(sv)
   620			
   621			IV
   622			address(sv)
   623				SV *	sv
   624			
   625			B::SV
   626			svref_2object(sv)
   627				SV *	sv
   628			    CODE:
   629	        2793    	if (!SvROK(sv))
   630	           1    	    croak("argument is not a reference");
   631	        2792    	RETVAL = (SV*)SvRV(sv);
   632			    OUTPUT:
   633				RETVAL              
   634			
   635			void
   636			opnumber(name)
   637			const char *	name
   638			CODE:
   639			{
   640	          26     int i; 
   641	          26     IV  result = -1;
   642	          26     ST(0) = sv_newmortal();
   643	          26     if (strncmp(name,"pp_",3) == 0)
   644	      ######       name += 3;
   645	        2090     for (i = 0; i < PL_maxo; i++)
   646			  {
   647	        2090       if (strcmp(name, PL_op_name[i]) == 0)
   648			    {
   649	          26         result = i;
   650	          26         break;
   651			    }
   652			  }
   653	          26     sv_setiv(ST(0),result);
   654			}
   655			
   656			void
   657			ppname(opnum)
   658				int	opnum
   659			    CODE:
   660	        9941    	ST(0) = sv_newmortal();
   661	        9941    	if (opnum >= 0 && opnum < PL_maxo) {
   662	        9921    	    sv_setpvn(ST(0), "pp_", 3);
   663	        9921    	    sv_catpv(ST(0), PL_op_name[opnum]);
   664				}
   665			
   666			void
   667			hash(sv)
   668				SV *	sv
   669			    CODE:
   670	      ######    	STRLEN len;
   671	      ######    	U32 hash = 0;
   672	      ######    	char hexhash[19]; /* must fit "0xffffffffffffffff" plus trailing \0 */
   673	      ######    	const char *s = SvPV(sv, len);
   674	      ######    	PERL_HASH(hash, s, len);
   675	      ######    	sprintf(hexhash, "0x%"UVxf, (UV)hash);
   676	      ######    	ST(0) = sv_2mortal(newSVpv(hexhash, 0));
   677			
   678			#define cast_I32(foo) (I32)foo
   679			IV
   680			cast_I32(i)
   681				IV	i
   682			
   683			void
   684			minus_c()
   685			    CODE:
   686	          79    	PL_minus_c = TRUE;
   687			
   688			void
   689			save_BEGINs()
   690			    CODE:
   691	          79    	PL_savebegin = TRUE;
   692			
   693			SV *
   694			cstring(sv)
   695				SV *	sv
   696			    CODE:
   697	        3837    	RETVAL = cstring(aTHX_ sv, 0);
   698			    OUTPUT:
   699				RETVAL
   700			
   701			SV *
   702			perlstring(sv)
   703				SV *	sv
   704			    CODE:
   705	           3    	RETVAL = cstring(aTHX_ sv, 1);
   706			    OUTPUT:
   707				RETVAL
   708			
   709			SV *
   710			cchar(sv)
   711				SV *	sv
   712			    CODE:
   713	      ######    	RETVAL = cchar(aTHX_ sv);
   714			    OUTPUT:
   715				RETVAL
   716			
   717			void
   718			threadsv_names()
   719			    PPCODE:
   720			#if PERL_VERSION <= 8
   721			# ifdef USE_5005THREADS
   722				int i;
   723				const STRLEN len = strlen(PL_threadsv_names);
   724			
   725				EXTEND(sp, len);
   726				for (i = 0; i < len; i++)
   727				    PUSHs(sv_2mortal(newSVpvn(&PL_threadsv_names[i], 1)));
   728			# endif
   729			#endif
   730			
   731			#define OP_next(o)	o->op_next
   732			#define OP_sibling(o)	o->op_sibling
   733			#define OP_desc(o)	(char *)PL_op_desc[o->op_type]
   734			#define OP_targ(o)	o->op_targ
   735			#define OP_type(o)	o->op_type
   736			#if PERL_VERSION >= 9
   737			#  define OP_opt(o)	o->op_opt
   738			#  define OP_static(o)	o->op_static
   739			#else
   740			#  define OP_seq(o)	o->op_seq
   741			#endif
   742			#define OP_flags(o)	o->op_flags
   743			#define OP_private(o)	o->op_private
   744			#define OP_spare(o)	o->op_spare
   745			
   746			MODULE = B	PACKAGE = B::OP		PREFIX = OP_
   747			
   748			size_t
   749			OP_size(o)
   750				B::OP		o
   751			    CODE:
   752	         315    	RETVAL = opsizes[cc_opclass(aTHX_ o)];
   753			    OUTPUT:
   754				RETVAL
   755			
   756			B::OP
   757			OP_next(o)
   758				B::OP		o
   759			
   760			B::OP
   761			OP_sibling(o)
   762				B::OP		o
   763			
   764			char *
   765			OP_name(o)
   766				B::OP		o
   767			    CODE:
   768	      117131    	RETVAL = (char *)PL_op_name[o->op_type];
   769			    OUTPUT:
   770				RETVAL
   771			
   772			
   773			void
   774			OP_ppaddr(o)
   775				B::OP		o
   776			    PREINIT:
   777	           4    	int i;
   778	           4    	SV *sv = sv_newmortal();
   779			    CODE:
   780	           4    	sv_setpvn(sv, "PL_ppaddr[OP_", 13);
   781	           4    	sv_catpv(sv, PL_op_name[o->op_type]);
   782	          27    	for (i=13; (STRLEN)i < SvCUR(sv); ++i)
   783	          23    	    SvPVX(sv)[i] = toUPPER(SvPVX(sv)[i]);
   784	           4    	sv_catpv(sv, "]");
   785	           4    	ST(0) = sv;
   786			
   787			char *
   788			OP_desc(o)
   789				B::OP		o
   790			
   791			PADOFFSET
   792			OP_targ(o)
   793				B::OP		o
   794			
   795			U16
   796			OP_type(o)
   797				B::OP		o
   798			
   799			#if PERL_VERSION >= 9
   800			
   801			U8
   802			OP_opt(o)
   803				B::OP		o
   804			
   805			U8
   806			OP_static(o)
   807				B::OP		o
   808			
   809			#else
   810			
   811			U16
   812			OP_seq(o)
   813				B::OP		o
   814			
   815			#endif
   816			
   817			U8
   818			OP_flags(o)
   819				B::OP		o
   820			
   821			U8
   822			OP_private(o)
   823				B::OP		o
   824			
   825			#if PERL_VERSION >= 9
   826			
   827			U8
   828			OP_spare(o)
   829				B::OP		o
   830			
   831			#endif
   832			
   833			void
   834			OP_oplist(o)
   835				B::OP		o
   836			    PPCODE:
   837	          26    	SP = oplist(aTHX_ o, SP);
   838			
   839			#define UNOP_first(o)	o->op_first
   840			
   841			MODULE = B	PACKAGE = B::UNOP		PREFIX = UNOP_
   842			
   843			B::OP 
   844			UNOP_first(o)
   845				B::UNOP	o
   846			
   847			#define BINOP_last(o)	o->op_last
   848			
   849			MODULE = B	PACKAGE = B::BINOP		PREFIX = BINOP_
   850			
   851			B::OP
   852			BINOP_last(o)
   853				B::BINOP	o
   854			
   855			#define LOGOP_other(o)	o->op_other
   856			
   857			MODULE = B	PACKAGE = B::LOGOP		PREFIX = LOGOP_
   858			
   859			B::OP
   860			LOGOP_other(o)
   861				B::LOGOP	o
   862			
   863			MODULE = B	PACKAGE = B::LISTOP		PREFIX = LISTOP_
   864			
   865			U32
   866			LISTOP_children(o)
   867				B::LISTOP	o
   868				OP *		kid = NO_INIT
   869				int		i = NO_INIT
   870			    CODE:
   871	           1    	i = 0;
   872	           4    	for (kid = o->op_first; kid; kid = kid->op_sibling)
   873	           3    	    i++;
   874	           1    	RETVAL = i;
   875			    OUTPUT:
   876			        RETVAL
   877			
   878			#define PMOP_pmreplroot(o)	o->op_pmreplroot
   879			#define PMOP_pmreplstart(o)	o->op_pmreplstart
   880			#define PMOP_pmnext(o)		o->op_pmnext
   881			#define PMOP_pmregexp(o)	PM_GETRE(o)
   882			#ifdef USE_ITHREADS
   883			#define PMOP_pmoffset(o)	o->op_pmoffset
   884			#define PMOP_pmstashpv(o)	o->op_pmstashpv
   885			#else
   886			#define PMOP_pmstash(o)		o->op_pmstash
   887			#endif
   888			#define PMOP_pmflags(o)		o->op_pmflags
   889			#define PMOP_pmpermflags(o)	o->op_pmpermflags
   890			#define PMOP_pmdynflags(o)      o->op_pmdynflags
   891			
   892			MODULE = B	PACKAGE = B::PMOP		PREFIX = PMOP_
   893			
   894			void
   895			PMOP_pmreplroot(o)
   896				B::PMOP		o
   897				OP *		root = NO_INIT
   898			    CODE:
   899	         194    	ST(0) = sv_newmortal();
   900	         194    	root = o->op_pmreplroot;
   901				/* OP_PUSHRE stores an SV* instead of an OP* in op_pmreplroot */
   902	         194    	if (o->op_type == OP_PUSHRE) {
   903			#ifdef USE_ITHREADS
   904			            sv_setiv(ST(0), INT2PTR(PADOFFSET,root) );
   905			#else
   906	          23    	    sv_setiv(newSVrv(ST(0), root ?
   907						     svclassnames[SvTYPE((SV*)root)] : "B::SV"),
   908					     PTR2IV(root));
   909			#endif
   910				}
   911				else {
   912	         171    	    sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), PTR2IV(root));
   913				}
   914			
   915			B::OP
   916			PMOP_pmreplstart(o)
   917				B::PMOP		o
   918			
   919			B::PMOP
   920			PMOP_pmnext(o)
   921				B::PMOP		o
   922			
   923			#ifdef USE_ITHREADS
   924			
   925			IV
   926			PMOP_pmoffset(o)
   927				B::PMOP		o
   928			
   929			char*
   930			PMOP_pmstashpv(o)
   931				B::PMOP		o
   932			
   933			#else
   934			
   935			B::HV
   936			PMOP_pmstash(o)
   937				B::PMOP		o
   938			
   939			#endif
   940			
   941			U32
   942			PMOP_pmflags(o)
   943				B::PMOP		o
   944			
   945			U32
   946			PMOP_pmpermflags(o)
   947				B::PMOP		o
   948			
   949			U8
   950			PMOP_pmdynflags(o)
   951			        B::PMOP         o
   952			
   953			void
   954			PMOP_precomp(o)
   955				B::PMOP		o
   956				REGEXP *	rx = NO_INIT
   957			    CODE:
   958	         177    	ST(0) = sv_newmortal();
   959	         177    	rx = PM_GETRE(o);
   960	         177    	if (rx)
   961	         172    	    sv_setpvn(ST(0), rx->precomp, rx->prelen);
   962			
   963			#define SVOP_sv(o)     cSVOPo->op_sv
   964			#define SVOP_gv(o)     ((GV*)cSVOPo->op_sv)
   965			
   966			MODULE = B	PACKAGE = B::SVOP		PREFIX = SVOP_
   967			
   968			B::SV
   969			SVOP_sv(o)
   970				B::SVOP	o
   971			
   972			B::GV
   973			SVOP_gv(o)
   974				B::SVOP	o
   975			
   976			#define PADOP_padix(o)	o->op_padix
   977			#define PADOP_sv(o)	(o->op_padix ? PAD_SVl(o->op_padix) : Nullsv)
   978			#define PADOP_gv(o)	((o->op_padix \
   979						  && SvTYPE(PAD_SVl(o->op_padix)) == SVt_PVGV) \
   980						 ? (GV*)PAD_SVl(o->op_padix) : Nullgv)
   981			
   982			MODULE = B	PACKAGE = B::PADOP		PREFIX = PADOP_
   983			
   984			PADOFFSET
   985			PADOP_padix(o)
   986				B::PADOP o
   987			
   988			B::SV
   989			PADOP_sv(o)
   990				B::PADOP o
   991			
   992			B::GV
   993			PADOP_gv(o)
   994				B::PADOP o
   995			
   996			MODULE = B	PACKAGE = B::PVOP		PREFIX = PVOP_
   997			
   998			void
   999			PVOP_pv(o)
  1000				B::PVOP	o
  1001			    CODE:
  1002				/*
  1003				 * OP_TRANS uses op_pv to point to a table of 256 or >=258 shorts
  1004				 * whereas other PVOPs point to a null terminated string.
  1005				 */
  1006	           2    	if (o->op_type == OP_TRANS &&
  1007					(o->op_private & OPpTRANS_COMPLEMENT) &&
  1008					!(o->op_private & OPpTRANS_DELETE))
  1009				{
  1010	      ######    	    const short* const tbl = (short*)o->op_pv;
  1011	      ######    	    const short entries = 257 + tbl[256];
  1012	      ######    	    ST(0) = sv_2mortal(newSVpv(o->op_pv, entries * sizeof(short)));
  1013				}
  1014	           2    	else if (o->op_type == OP_TRANS) {
  1015	      ######    	    ST(0) = sv_2mortal(newSVpv(o->op_pv, 256 * sizeof(short)));
  1016				}
  1017				else
  1018	           2    	    ST(0) = sv_2mortal(newSVpv(o->op_pv, 0));
  1019			
  1020			#define LOOP_redoop(o)	o->op_redoop
  1021			#define LOOP_nextop(o)	o->op_nextop
  1022			#define LOOP_lastop(o)	o->op_lastop
  1023			
  1024			MODULE = B	PACKAGE = B::LOOP		PREFIX = LOOP_
  1025			
  1026			
  1027			B::OP
  1028			LOOP_redoop(o)
  1029				B::LOOP	o
  1030			
  1031			B::OP
  1032			LOOP_nextop(o)
  1033				B::LOOP	o
  1034			
  1035			B::OP
  1036			LOOP_lastop(o)
  1037				B::LOOP	o
  1038			
  1039			#define COP_label(o)	o->cop_label
  1040			#define COP_stashpv(o)	CopSTASHPV(o)
  1041			#define COP_stash(o)	CopSTASH(o)
  1042			#define COP_file(o)	CopFILE(o)
  1043			#define COP_filegv(o)	CopFILEGV(o)
  1044			#define COP_cop_seq(o)	o->cop_seq
  1045			#define COP_arybase(o)	o->cop_arybase
  1046			#define COP_line(o)	CopLINE(o)
  1047			#define COP_warnings(o)	o->cop_warnings
  1048			#define COP_io(o)	o->cop_io
  1049			
  1050			MODULE = B	PACKAGE = B::COP		PREFIX = COP_
  1051			
  1052			char *
  1053			COP_label(o)
  1054				B::COP	o
  1055			
  1056			char *
  1057			COP_stashpv(o)
  1058				B::COP	o
  1059			
  1060			B::HV
  1061			COP_stash(o)
  1062				B::COP	o
  1063			
  1064			char *
  1065			COP_file(o)
  1066				B::COP	o
  1067			
  1068			B::GV
  1069			COP_filegv(o)
  1070			       B::COP  o
  1071			
  1072			
  1073			U32
  1074			COP_cop_seq(o)
  1075				B::COP	o
  1076			
  1077			I32
  1078			COP_arybase(o)
  1079				B::COP	o
  1080			
  1081			U32
  1082			COP_line(o)
  1083				B::COP	o
  1084			
  1085			B::SV
  1086			COP_warnings(o)
  1087				B::COP	o
  1088			
  1089			B::SV
  1090			COP_io(o)
  1091				B::COP	o
  1092			
  1093			MODULE = B	PACKAGE = B::SV
  1094			
  1095			U32
  1096			SvTYPE(sv)
  1097				B::SV	sv
  1098			
  1099			#define object_2svref(sv)	sv
  1100			#define SVREF SV *
  1101				
  1102			SVREF
  1103			object_2svref(sv)
  1104				B::SV	sv
  1105			
  1106			MODULE = B	PACKAGE = B::SV		PREFIX = Sv
  1107			
  1108			U32
  1109			SvREFCNT(sv)
  1110				B::SV	sv
  1111			
  1112			U32
  1113			SvFLAGS(sv)
  1114				B::SV	sv
  1115			
  1116			U32
  1117			SvPOK(sv)
  1118				B::SV	sv
  1119			
  1120			U32
  1121			SvROK(sv)
  1122				B::SV	sv
  1123			
  1124			U32
  1125			SvMAGICAL(sv)
  1126				B::SV	sv
  1127			
  1128			MODULE = B	PACKAGE = B::IV		PREFIX = Sv
  1129			
  1130			IV
  1131			SvIV(sv)
  1132				B::IV	sv
  1133			
  1134			IV
  1135			SvIVX(sv)
  1136				B::IV	sv
  1137			
  1138			UV 
  1139			SvUVX(sv) 
  1140				B::IV   sv
  1141			                      
  1142			
  1143			MODULE = B	PACKAGE = B::IV
  1144			
  1145			#define needs64bits(sv) ((I32)SvIVX(sv) != SvIVX(sv))
  1146			
  1147			int
  1148			needs64bits(sv)
  1149				B::IV	sv
  1150			
  1151			void
  1152			packiv(sv)
  1153				B::IV	sv
  1154			    CODE:
  1155	      ######    	if (sizeof(IV) == 8) {
  1156	      ######    	    U32 wp[2];
  1157	      ######    	    const IV iv = SvIVX(sv);
  1158				    /*
  1159				     * The following way of spelling 32 is to stop compilers on
  1160				     * 32-bit architectures from moaning about the shift count
  1161				     * being >= the width of the type. Such architectures don't
  1162				     * reach this code anyway (unless sizeof(IV) > 8 but then
  1163				     * everything else breaks too so I'm not fussed at the moment).
  1164				     */
  1165			#ifdef UV_IS_QUAD
  1166				    wp[0] = htonl(((UV)iv) >> (sizeof(UV)*4));
  1167			#else
  1168	      ######    	    wp[0] = htonl(((U32)iv) >> (sizeof(UV)*4));
  1169			#endif
  1170	      ######    	    wp[1] = htonl(iv & 0xffffffff);
  1171	      ######    	    ST(0) = sv_2mortal(newSVpvn((char *)wp, 8));
  1172				} else {
  1173	      ######    	    U32 w = htonl((U32)SvIVX(sv));
  1174	      ######    	    ST(0) = sv_2mortal(newSVpvn((char *)&w, 4));
  1175				}
  1176			
  1177			MODULE = B	PACKAGE = B::NV		PREFIX = Sv
  1178			
  1179			NV
  1180			SvNV(sv)
  1181				B::NV	sv
  1182			
  1183			NV
  1184			SvNVX(sv)
  1185				B::NV	sv
  1186			
  1187			MODULE = B	PACKAGE = B::RV		PREFIX = Sv
  1188			
  1189			B::SV
  1190			SvRV(sv)
  1191				B::RV	sv
  1192			
  1193			MODULE = B	PACKAGE = B::PV		PREFIX = Sv
  1194			
  1195			char*
  1196			SvPVX(sv)
  1197				B::PV	sv
  1198			
  1199			B::SV
  1200			SvRV(sv)
  1201			        B::PV   sv
  1202			    CODE:
  1203	           2            if( SvROK(sv) ) {
  1204	           1                RETVAL = SvRV(sv);
  1205			        }
  1206			        else {
  1207	           1                croak( "argument is not SvROK" );
  1208			        }
  1209			    OUTPUT:
  1210			        RETVAL
  1211			
  1212			void
  1213			SvPV(sv)
  1214				B::PV	sv
  1215			    CODE:
  1216	        4039            ST(0) = sv_newmortal();
  1217	        4039            if( SvPOK(sv) ) {
  1218				    /* FIXME - we need a better way for B to identify PVs that are
  1219				       in the pads as variable names.  */
  1220	        4039    	    if((SvLEN(sv) && SvCUR(sv) >= SvLEN(sv))) {
  1221					/* It claims to be longer than the space allocated for it -
  1222					   presuambly it's a variable name in the pad  */
  1223	           6    		sv_setpv(ST(0), SvPV_nolen_const(sv));
  1224				    } else {
  1225	        4033    		sv_setpvn(ST(0), SvPVX_const(sv), SvCUR(sv));
  1226				    }
  1227	        4039                SvFLAGS(ST(0)) |= SvUTF8(sv);
  1228			        }
  1229			        else {
  1230			            /* XXX for backward compatibility, but should fail */
  1231			            /* croak( "argument is not SvPOK" ); */
  1232	      ######                sv_setpvn(ST(0), NULL, 0);
  1233			        }
  1234			
  1235			void
  1236			SvPVBM(sv)
  1237				B::PV	sv
  1238			    CODE:
  1239	          51            ST(0) = sv_newmortal();
  1240	          51    	sv_setpvn(ST(0), SvPVX_const(sv),
  1241				    SvCUR(sv) + (SvTYPE(sv) == SVt_PVBM ? 257 : 0));
  1242			
  1243			
  1244			STRLEN
  1245			SvLEN(sv)
  1246				B::PV	sv
  1247			
  1248			STRLEN
  1249			SvCUR(sv)
  1250				B::PV	sv
  1251			
  1252			MODULE = B	PACKAGE = B::PVMG	PREFIX = Sv
  1253			
  1254			void
  1255			SvMAGIC(sv)
  1256				B::PVMG	sv
  1257				MAGIC *	mg = NO_INIT
  1258			    PPCODE:
  1259	           8    	for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
  1260	           4    	    XPUSHs(make_mg_object(aTHX_ sv_newmortal(), mg));
  1261			
  1262			MODULE = B	PACKAGE = B::PVMG
  1263			
  1264			B::HV
  1265			SvSTASH(sv)
  1266				B::PVMG	sv
  1267			
  1268			#define MgMOREMAGIC(mg) mg->mg_moremagic
  1269			#define MgPRIVATE(mg) mg->mg_private
  1270			#define MgTYPE(mg) mg->mg_type
  1271			#define MgFLAGS(mg) mg->mg_flags
  1272			#define MgOBJ(mg) mg->mg_obj
  1273			#define MgLENGTH(mg) mg->mg_len
  1274			#define MgREGEX(mg) PTR2IV(mg->mg_obj)
  1275			
  1276			MODULE = B	PACKAGE = B::MAGIC	PREFIX = Mg	
  1277			
  1278			B::MAGIC
  1279			MgMOREMAGIC(mg)
  1280				B::MAGIC	mg
  1281			     CODE:
  1282	           1    	if( MgMOREMAGIC(mg) ) {
  1283	      ######    	    RETVAL = MgMOREMAGIC(mg);
  1284				}
  1285				else {
  1286	           1    	    XSRETURN_UNDEF;
  1287				}
  1288			     OUTPUT:
  1289				RETVAL
  1290			
  1291			U16
  1292			MgPRIVATE(mg)
  1293				B::MAGIC	mg
  1294			
  1295			char
  1296			MgTYPE(mg)
  1297				B::MAGIC	mg
  1298			
  1299			U8
  1300			MgFLAGS(mg)
  1301				B::MAGIC	mg
  1302			
  1303			B::SV
  1304			MgOBJ(mg)
  1305				B::MAGIC	mg
  1306			
  1307			IV
  1308			MgREGEX(mg)
  1309				B::MAGIC	mg
  1310			    CODE:
  1311	      ######            if( mg->mg_type == 'r' ) {
  1312	      ######                RETVAL = MgREGEX(mg);
  1313			        }
  1314			        else {
  1315	      ######                croak( "REGEX is only meaningful on r-magic" );
  1316			        }
  1317			    OUTPUT:
  1318			        RETVAL
  1319			
  1320			SV*
  1321			precomp(mg)
  1322			        B::MAGIC        mg
  1323			    CODE:
  1324	      ######            if (mg->mg_type == 'r') {
  1325	      ######                REGEXP* rx = (REGEXP*)mg->mg_obj;
  1326	      ######                if( rx )
  1327	      ######                    RETVAL = newSVpvn( rx->precomp, rx->prelen );
  1328			        }
  1329			        else {
  1330	      ######                croak( "precomp is only meaningful on r-magic" );
  1331			        }
  1332			    OUTPUT:
  1333			        RETVAL
  1334			
  1335			I32 
  1336			MgLENGTH(mg)
  1337				B::MAGIC	mg
  1338			 
  1339			void
  1340			MgPTR(mg)
  1341				B::MAGIC	mg
  1342			    CODE:
  1343	      ######    	ST(0) = sv_newmortal();
  1344	      ######     	if (mg->mg_ptr){
  1345	      ######    		if (mg->mg_len >= 0){
  1346	      ######    	    		sv_setpvn(ST(0), mg->mg_ptr, mg->mg_len);
  1347	      ######    		} else if (mg->mg_len == HEf_SVKEY) {
  1348	      ######    			ST(0) = make_sv_object(aTHX_
  1349							    sv_newmortal(), (SV*)mg->mg_ptr);
  1350					}
  1351				}
  1352			
  1353			MODULE = B	PACKAGE = B::PVLV	PREFIX = Lv
  1354			
  1355			U32
  1356			LvTARGOFF(sv)
  1357				B::PVLV	sv
  1358			
  1359			U32
  1360			LvTARGLEN(sv)
  1361				B::PVLV	sv
  1362			
  1363			char
  1364			LvTYPE(sv)
  1365				B::PVLV	sv
  1366			
  1367			B::SV
  1368			LvTARG(sv)
  1369				B::PVLV sv
  1370			
  1371			MODULE = B	PACKAGE = B::BM		PREFIX = Bm
  1372			
  1373			I32
  1374			BmUSEFUL(sv)
  1375				B::BM	sv
  1376			
  1377			U16
  1378			BmPREVIOUS(sv)
  1379				B::BM	sv
  1380			
  1381			U8
  1382			BmRARE(sv)
  1383				B::BM	sv
  1384			
  1385			void
  1386			BmTABLE(sv)
  1387				B::BM	sv
  1388				STRLEN	len = NO_INIT
  1389				char *	str = NO_INIT
  1390			    CODE:
  1391	      ######    	str = SvPV(sv, len);
  1392				/* Boyer-Moore table is just after string and its safety-margin \0 */
  1393	      ######    	ST(0) = sv_2mortal(newSVpvn(str + len + 1, 256));
  1394			
  1395			MODULE = B	PACKAGE = B::GV		PREFIX = Gv
  1396			
  1397			void
  1398			GvNAME(gv)
  1399				B::GV	gv
  1400			    CODE:
  1401	        4269    	ST(0) = sv_2mortal(newSVpvn(GvNAME(gv), GvNAMELEN(gv)));
  1402			
  1403			bool
  1404			is_empty(gv)
  1405			        B::GV   gv
  1406			    CODE:
  1407	           1            RETVAL = GvGP(gv) == Null(GP*);
  1408			    OUTPUT:
  1409			        RETVAL
  1410			
  1411			void*
  1412			GvGP(gv)
  1413				B::GV	gv
  1414			
  1415			B::HV
  1416			GvSTASH(gv)
  1417				B::GV	gv
  1418			
  1419			B::SV
  1420			GvSV(gv)
  1421				B::GV	gv
  1422			
  1423			B::IO
  1424			GvIO(gv)
  1425				B::GV	gv
  1426			
  1427			B::FM
  1428			GvFORM(gv)
  1429				B::GV	gv
  1430			    CODE:
  1431	       18429    	RETVAL = (SV*)GvFORM(gv);
  1432			    OUTPUT:
  1433				RETVAL
  1434			
  1435			B::AV
  1436			GvAV(gv)
  1437				B::GV	gv
  1438			
  1439			B::HV
  1440			GvHV(gv)
  1441				B::GV	gv
  1442			
  1443			B::GV
  1444			GvEGV(gv)
  1445				B::GV	gv
  1446			
  1447			B::CV
  1448			GvCV(gv)
  1449				B::GV	gv
  1450			
  1451			U32
  1452			GvCVGEN(gv)
  1453				B::GV	gv
  1454			
  1455			U32
  1456			GvLINE(gv)
  1457				B::GV	gv
  1458			
  1459			char *
  1460			GvFILE(gv)
  1461				B::GV	gv
  1462			
  1463			B::GV
  1464			GvFILEGV(gv)
  1465				B::GV	gv
  1466			
  1467			MODULE = B	PACKAGE = B::GV
  1468			
  1469			U32
  1470			GvREFCNT(gv)
  1471				B::GV	gv
  1472			
  1473			U8
  1474			GvFLAGS(gv)
  1475				B::GV	gv
  1476			
  1477			MODULE = B	PACKAGE = B::IO		PREFIX = Io
  1478			
  1479			long
  1480			IoLINES(io)
  1481				B::IO	io
  1482			
  1483			long
  1484			IoPAGE(io)
  1485				B::IO	io
  1486			
  1487			long
  1488			IoPAGE_LEN(io)
  1489				B::IO	io
  1490			
  1491			long
  1492			IoLINES_LEFT(io)
  1493				B::IO	io
  1494			
  1495			char *
  1496			IoTOP_NAME(io)
  1497				B::IO	io
  1498			
  1499			B::GV
  1500			IoTOP_GV(io)
  1501				B::IO	io
  1502			
  1503			char *
  1504			IoFMT_NAME(io)
  1505				B::IO	io
  1506			
  1507			B::GV
  1508			IoFMT_GV(io)
  1509				B::IO	io
  1510			
  1511			char *
  1512			IoBOTTOM_NAME(io)
  1513				B::IO	io
  1514			
  1515			B::GV
  1516			IoBOTTOM_GV(io)
  1517				B::IO	io
  1518			
  1519			short
  1520			IoSUBPROCESS(io)
  1521				B::IO	io
  1522			
  1523			bool
  1524			IsSTD(io,name)
  1525				B::IO	io
  1526				const char*	name
  1527			    PREINIT:
  1528	      ######    	PerlIO* handle = 0;
  1529			    CODE:
  1530	      ######    	if( strEQ( name, "stdin" ) ) {
  1531	      ######    	    handle = PerlIO_stdin();
  1532				}
  1533	      ######    	else if( strEQ( name, "stdout" ) ) {
  1534	      ######    	    handle = PerlIO_stdout();
  1535				}
  1536	      ######    	else if( strEQ( name, "stderr" ) ) {
  1537	      ######    	    handle = PerlIO_stderr();
  1538				}
  1539				else {
  1540	      ######    	    croak( "Invalid value '%s'", name );
  1541				}
  1542	      ######    	RETVAL = handle == IoIFP(io);
  1543			    OUTPUT:
  1544				RETVAL
  1545			
  1546			MODULE = B	PACKAGE = B::IO
  1547			
  1548			char
  1549			IoTYPE(io)
  1550				B::IO	io
  1551			
  1552			U8
  1553			IoFLAGS(io)
  1554				B::IO	io
  1555			
  1556			MODULE = B	PACKAGE = B::AV		PREFIX = Av
  1557			
  1558			SSize_t
  1559			AvFILL(av)
  1560				B::AV	av
  1561			
  1562			SSize_t
  1563			AvMAX(av)
  1564				B::AV	av
  1565			
  1566			void
  1567			AvARRAY(av)
  1568				B::AV	av
  1569			    PPCODE:
  1570	       18755    	if (AvFILL(av) >= 0) {
  1571	       18720    	    SV **svp = AvARRAY(av);
  1572	       18720    	    I32 i;
  1573	      614234    	    for (i = 0; i <= AvFILL(av); i++)
  1574	      595514    		XPUSHs(make_sv_object(aTHX_ sv_newmortal(), svp[i]));
  1575				}
  1576			
  1577			void
  1578			AvARRAYelt(av, idx)
  1579				B::AV	av
  1580				int	idx
  1581			    PPCODE:
  1582	        1690        	if (idx >= 0 && AvFILL(av) >= 0 && idx <= AvFILL(av))
  1583	        1690    	    XPUSHs(make_sv_object(aTHX_ sv_newmortal(), (AvARRAY(av)[idx])));
  1584				else
  1585	      ######    	    XPUSHs(make_sv_object(aTHX_ sv_newmortal(), NULL));
  1586			
  1587			MODULE = B	PACKAGE = B::FM		PREFIX = Fm
  1588			
  1589			IV
  1590			FmLINES(form)
  1591				B::FM	form
  1592			
  1593			MODULE = B	PACKAGE = B::CV		PREFIX = Cv
  1594			
  1595			U32
  1596			CvCONST(cv)
  1597				B::CV	cv
  1598			
  1599			B::HV
  1600			CvSTASH(cv)
  1601				B::CV	cv
  1602			
  1603			B::OP
  1604			CvSTART(cv)
  1605				B::CV	cv
  1606			
  1607			B::OP
  1608			CvROOT(cv)
  1609				B::CV	cv
  1610			
  1611			B::GV
  1612			CvGV(cv)
  1613				B::CV	cv
  1614			
  1615			char *
  1616			CvFILE(cv)
  1617				B::CV	cv
  1618			
  1619			long
  1620			CvDEPTH(cv)
  1621				B::CV	cv
  1622			
  1623			B::AV
  1624			CvPADLIST(cv)
  1625				B::CV	cv
  1626			
  1627			B::CV
  1628			CvOUTSIDE(cv)
  1629				B::CV	cv
  1630			
  1631			U32
  1632			CvOUTSIDE_SEQ(cv)
  1633				B::CV	cv
  1634			
  1635			void
  1636			CvXSUB(cv)
  1637				B::CV	cv
  1638			    CODE:
  1639	         925    	ST(0) = sv_2mortal(newSViv(PTR2IV(CvXSUB(cv))));
  1640			
  1641			
  1642			void
  1643			CvXSUBANY(cv)
  1644				B::CV	cv
  1645			    CODE:
  1646	      ######    	ST(0) = CvCONST(cv) ?
  1647				    make_sv_object(aTHX_ sv_newmortal(),(SV *)CvXSUBANY(cv).any_ptr) :
  1648				    sv_2mortal(newSViv(CvXSUBANY(cv).any_iv));
  1649			
  1650			MODULE = B    PACKAGE = B::CV
  1651			
  1652			U16
  1653			CvFLAGS(cv)
  1654			      B::CV   cv
  1655			
  1656			MODULE = B	PACKAGE = B::CV		PREFIX = cv_
  1657			
  1658			B::SV
  1659			cv_const_sv(cv)
  1660				B::CV	cv
  1661			
  1662			
  1663			MODULE = B	PACKAGE = B::HV		PREFIX = Hv
  1664			
  1665			STRLEN
  1666			HvFILL(hv)
  1667				B::HV	hv
  1668			
  1669			STRLEN
  1670			HvMAX(hv)
  1671				B::HV	hv
  1672			
  1673			I32
  1674			HvKEYS(hv)
  1675				B::HV	hv
  1676			
  1677			I32
  1678			HvRITER(hv)
  1679				B::HV	hv
  1680			
  1681			char *
  1682			HvNAME(hv)
  1683				B::HV	hv
  1684			
  1685			void
  1686			HvARRAY(hv)
  1687				B::HV	hv
  1688			    PPCODE:
  1689	        1230    	if (HvKEYS(hv) > 0) {
  1690	        1163    	    SV *sv;
  1691	        1163    	    char *key;
  1692	        1163    	    I32 len;
  1693	        1163    	    (void)hv_iterinit(hv);
  1694	        1163    	    EXTEND(sp, HvKEYS(hv) * 2);
  1695	       19380    	    while ((sv = hv_iternextsv(hv, &key, &len))) {
  1696	       18217    		PUSHs(newSVpvn(key, len));
  1697	       18217    		PUSHs(make_sv_object(aTHX_ sv_newmortal(), sv));
  1698				    }
  1699				}
  1700				}