     1			/*
     2			 * This file was generated automatically by ExtUtils::ParseXS version 2.10 from the
     3			 * contents of Opcode.xs. Do not edit this file, edit Opcode.xs instead.
     4			 *
     5			 *	ANY CHANGES MADE HERE WILL BE LOST! 
     6			 *
     7			 */
     8			
     9			#line 1 "Opcode.xs"
    10			#define PERL_NO_GET_CONTEXT
    11			#include "EXTERN.h"
    12			#include "perl.h"
    13			#include "XSUB.h"
    14			
    15			/* PL_maxo shouldn't differ from MAXO but leave room anyway (see BOOT:)	*/
    16			#define OP_MASK_BUF_SIZE (MAXO + 100)
    17			
    18			/* XXX op_named_bits and opset_all are never freed */
    19			#define MY_CXT_KEY "Opcode::_guts" XS_VERSION
    20			
    21			typedef struct {
    22			    HV *	x_op_named_bits;	/* cache shared for whole process */
    23			    SV *	x_opset_all;		/* mask with all bits set	*/
    24			    IV		x_opset_len;		/* length of opmasks in bytes	*/
    25			    int		x_opcode_debug;
    26			} my_cxt_t;
    27			
    28			START_MY_CXT
    29			
    30			#define op_named_bits		(MY_CXT.x_op_named_bits)
    31			#define opset_all		(MY_CXT.x_opset_all)
    32			#define opset_len		(MY_CXT.x_opset_len)
    33			#define opcode_debug		(MY_CXT.x_opcode_debug)
    34			
    35			static SV  *new_opset (pTHX_ SV *old_opset);
    36			static int  verify_opset (pTHX_ SV *opset, int fatal);
    37			static void set_opset_bits (pTHX_ char *bitmap, SV *bitspec, int on, const char *opname);
    38			static void put_op_bitspec (pTHX_ const char *optag,  STRLEN len, SV *opset);
    39			static SV  *get_op_bitspec (pTHX_ const char *opname, STRLEN len, int fatal);
    40			
    41			
    42			/* Initialise our private op_named_bits HV.
    43			 * It is first loaded with the name and number of each perl operator.
    44			 * Then the builtin tags :none and :all are added.
    45			 * Opcode.pm loads the standard optags from __DATA__
    46			 * XXX leak-alert: data allocated here is never freed, call this
    47			 *     at most once
    48			 */
    49			
    50			static void
    51			op_names_init(pTHX)
    52			{
    53			    int i;
    54			    STRLEN len;
    55			    char **op_names;
    56			    char *bitmap;
    57			    dMY_CXT;
    58			
    59			    op_named_bits = newHV();
    60			    op_names = get_op_names();
    61			    for(i=0; i < PL_maxo; ++i) {
    62				SV * const sv = newSViv(i);
    63				SvREADONLY_on(sv);
    64				hv_store(op_named_bits, op_names[i], strlen(op_names[i]), sv, 0);
    65			    }
    66			
    67			    put_op_bitspec(aTHX_ ":none",0, sv_2mortal(new_opset(aTHX_ Nullsv)));
    68			
    69			    opset_all = new_opset(aTHX_ Nullsv);
    70			    bitmap = SvPV(opset_all, len);
    71			    i = len-1; /* deal with last byte specially, see below */
    72			    while(i-- > 0)
    73				bitmap[i] = (char)0xFF;
    74			    /* Take care to set the right number of bits in the last byte */
    75			    bitmap[len-1] = (PL_maxo & 0x07) ? ~(0xFF << (PL_maxo & 0x07)) : 0xFF;
    76			    put_op_bitspec(aTHX_ ":all",0, opset_all); /* don't mortalise */
    77			}
    78			
    79			
    80			/* Store a new tag definition. Always a mask.
    81			 * The tag must not already be defined.
    82			 * SV *mask is copied not referenced.
    83			 */
    84			
    85			static void
    86			put_op_bitspec(pTHX_ const char *optag, STRLEN len, SV *mask)
    87			{
    88			    SV **svp;
    89			    dMY_CXT;
    90			
    91			    verify_opset(aTHX_ mask,1);
    92			    if (!len)
    93				len = strlen(optag);
    94			    svp = hv_fetch(op_named_bits, optag, len, 1);
    95			    if (SvOK(*svp))
    96				croak("Opcode tag \"%s\" already defined", optag);
    97			    sv_setsv(*svp, mask);
    98			    SvREADONLY_on(*svp);
    99			}
   100			
   101			
   102			
   103			/* Fetch a 'bits' entry for an opname or optag (IV/PV).
   104			 * Note that we return the actual entry for speed.
   105			 * Always sv_mortalcopy() if returing it to user code.
   106			 */
   107			
   108			static SV *
   109			get_op_bitspec(pTHX_ const char *opname, STRLEN len, int fatal)
   110			{
   111			    SV **svp;
   112			    dMY_CXT;
   113			
   114			    if (!len)
   115				len = strlen(opname);
   116			    svp = hv_fetch(op_named_bits, opname, len, 0);
   117			    if (!svp || !SvOK(*svp)) {
   118				if (!fatal)
   119				    return Nullsv;
   120				if (*opname == ':')
   121				    croak("Unknown operator tag \"%s\"", opname);
   122				if (*opname == '!')	/* XXX here later, or elsewhere? */
   123				    croak("Can't negate operators here (\"%s\")", opname);
   124				if (isALPHA(*opname))
   125				    croak("Unknown operator name \"%s\"", opname);
   126				croak("Unknown operator prefix \"%s\"", opname);
   127			    }
   128			    return *svp;
   129			}
   130			
   131			
   132			
   133			static SV *
   134			new_opset(pTHX_ SV *old_opset)
   135			{
   136			    SV *opset;
   137			    dMY_CXT;
   138			
   139			    if (old_opset) {
   140				verify_opset(aTHX_ old_opset,1);
   141				opset = newSVsv(old_opset);
   142			    }
   143			    else {
   144				opset = NEWSV(1156, opset_len);
   145				Zero(SvPVX_const(opset), opset_len + 1, char);
   146				SvCUR_set(opset, opset_len);
   147				(void)SvPOK_only(opset);
   148			    }
   149			    /* not mortalised here */
   150			    return opset;
   151			}
   152			
   153			
   154			static int
   155			verify_opset(pTHX_ SV *opset, int fatal)
   156			{
   157			    const char *err = Nullch;
   158			    dMY_CXT;
   159			
   160			    if      (!SvOK(opset))              err = "undefined";
   161			    else if (!SvPOK(opset))             err = "wrong type";
   162			    else if (SvCUR(opset) != (STRLEN)opset_len) err = "wrong size";
   163			    if (err && fatal) {
   164				croak("Invalid opset: %s", err);
   165			    }
   166			    return !err;
   167			}
   168			
   169			
   170			static void
   171			set_opset_bits(pTHX_ char *bitmap, SV *bitspec, int on, const char *opname)
   172			{
   173			    dMY_CXT;
   174			
   175			    if (SvIOK(bitspec)) {
   176				const int myopcode = SvIV(bitspec);
   177				const int offset = myopcode >> 3;
   178				const int bit    = myopcode & 0x07;
   179				if (myopcode >= PL_maxo || myopcode < 0)
   180				    croak("panic: opcode \"%s\" value %d is invalid", opname, myopcode);
   181				if (opcode_debug >= 2)
   182				    warn("set_opset_bits bit %2d (off=%d, bit=%d) %s %s\n",
   183						myopcode, offset, bit, opname, (on)?"on":"off");
   184				if (on)
   185				    bitmap[offset] |= 1 << bit;
   186				else
   187				    bitmap[offset] &= ~(1 << bit);
   188			    }
   189			    else if (SvPOK(bitspec) && SvCUR(bitspec) == (STRLEN)opset_len) {
   190			
   191				STRLEN len;
   192				const char * const specbits = SvPV(bitspec, len);
   193				if (opcode_debug >= 2)
   194				    warn("set_opset_bits opset %s %s\n", opname, (on)?"on":"off");
   195				if (on) 
   196				    while(len-- > 0) bitmap[len] |=  specbits[len];
   197				else
   198				    while(len-- > 0) bitmap[len] &= ~specbits[len];
   199			    }
   200			    else
   201				croak("panic: invalid bitspec for \"%s\" (type %u)",
   202					opname, (unsigned)SvTYPE(bitspec));
   203			}
   204			
   205			
   206			static void
   207			opmask_add(pTHX_ SV *opset)	/* THE ONLY FUNCTION TO EDIT PL_op_mask ITSELF	*/
   208			{
   209			    int i,j;
   210			    char *bitmask;
   211			    STRLEN len;
   212			    int myopcode = 0;
   213			    dMY_CXT;
   214			
   215			    verify_opset(aTHX_ opset,1);		/* croaks on bad opset	*/
   216			
   217			    if (!PL_op_mask)		/* caller must ensure PL_op_mask exists	*/
   218				croak("Can't add to uninitialised PL_op_mask");
   219			
   220			    /* OPCODES ALREADY MASKED ARE NEVER UNMASKED. See opmask_addlocal()	*/
   221			
   222			    bitmask = SvPV(opset, len);
   223			    for (i=0; i < opset_len; i++) {
   224				const U16 bits = bitmask[i];
   225				if (!bits) {	/* optimise for sparse masks */
   226				    myopcode += 8;
   227				    continue;
   228				}
   229				for (j=0; j < 8 && myopcode < PL_maxo; )
   230				    PL_op_mask[myopcode++] |= bits & (1 << j++);
   231			    }
   232			}
   233			
   234			static void
   235			opmask_addlocal(pTHX_ SV *opset, char *op_mask_buf) /* Localise PL_op_mask then opmask_add() */
   236			{
   237			    char *orig_op_mask = PL_op_mask;
   238			    dMY_CXT;
   239			
   240			    SAVEVPTR(PL_op_mask);
   241			    /* XXX casting to an ordinary function ptr from a member function ptr
   242			     * is disallowed by Borland
   243			     */
   244			    if (opcode_debug >= 2)
   245				SAVEDESTRUCTOR((void(*)(void*))Perl_warn,"PL_op_mask restored");
   246			    PL_op_mask = &op_mask_buf[0];
   247			    if (orig_op_mask)
   248				Copy(orig_op_mask, PL_op_mask, PL_maxo, char);
   249			    else
   250				Zero(PL_op_mask, PL_maxo, char);
   251			    opmask_add(aTHX_ opset);
   252			}
   253			
   254			
   255			
   256			#ifndef PERL_UNUSED_VAR
   257			#  define PERL_UNUSED_VAR(var) if (0) var = var
   258			#endif
   259			
   260			#line 261 "Opcode.c"
   261			
   262			XS(XS_Opcode__safe_pkg_prep); /* prototype to pass -Wmissing-prototypes */
   263			XS(XS_Opcode__safe_pkg_prep)
   264	         308    {
   265	         308        dXSARGS;
   266	         308        if (items != 1)
   267	      ######    	Perl_croak(aTHX_ "Usage: Opcode::_safe_pkg_prep(Package)");
   268	         308        PERL_UNUSED_VAR(cv); /* -W */
   269	         308        PERL_UNUSED_VAR(ax); /* -Wall */
   270	         308        SP -= items;
   271			    {
   272	         308    	const char *	Package = (const char *)SvPV_nolen(ST(0));
   273			#line 265 "Opcode.xs"
   274			    HV *hv; 
   275			    ENTER;
   276			
   277			    hv = gv_stashpv(Package, GV_ADDWARN); /* should exist already	*/
   278			
   279			    if (strNE(HvNAME_get(hv),"main")) {
   280			        /* make it think it's in main:: */
   281				Perl_hv_name_set(aTHX_ hv, "main", 4, 0);
   282			        hv_store(hv,"_",1,(SV *)PL_defgv,0);  /* connect _ to global */
   283			        SvREFCNT_inc((SV *)PL_defgv);  /* want to keep _ around! */
   284			    }
   285			    LEAVE;
   286			#line 287 "Opcode.c"
   287	         308    	PUTBACK;
   288				return;
   289			    }
   290			}
   291			
   292			
   293			XS(XS_Opcode__safe_call_sv); /* prototype to pass -Wmissing-prototypes */
   294			XS(XS_Opcode__safe_call_sv)
   295	         332    {
   296	         332        dXSARGS;
   297	         332        if (items != 3)
   298	      ######    	Perl_croak(aTHX_ "Usage: Opcode::_safe_call_sv(Package, mask, codesv)");
   299	         332        PERL_UNUSED_VAR(cv); /* -W */
   300	         332        PERL_UNUSED_VAR(ax); /* -Wall */
   301	         332        SP -= items;
   302			    {
   303	         332    	char *	Package = (char *)SvPV_nolen(ST(0));
   304	         332    	SV *	mask = ST(1);
   305	         332    	SV *	codesv = ST(2);
   306			#line 288 "Opcode.xs"
   307			    char op_mask_buf[OP_MASK_BUF_SIZE];
   308			    GV *gv;
   309			    HV *dummy_hv;
   310			
   311			    ENTER;
   312			
   313			    opmask_addlocal(aTHX_ mask, op_mask_buf);
   314			
   315			    save_aptr(&PL_endav);
   316			    PL_endav = (AV*)sv_2mortal((SV*)newAV()); /* ignore END blocks for now	*/
   317			
   318			    save_hptr(&PL_defstash);		/* save current default stash	*/
   319			    /* the assignment to global defstash changes our sense of 'main'	*/
   320			    PL_defstash = gv_stashpv(Package, GV_ADDWARN); /* should exist already	*/
   321			
   322			    save_hptr(&PL_curstash);
   323			    PL_curstash = PL_defstash;
   324			
   325			    /* defstash must itself contain a main:: so we'll add that now	*/
   326			    /* take care with the ref counts (was cause of long standing bug)	*/
   327			    /* XXX I'm still not sure if this is right, GV_ADDWARN should warn!	*/
   328			    gv = gv_fetchpv("main::", GV_ADDWARN, SVt_PVHV);
   329			    sv_free((SV*)GvHV(gv));
   330			    GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash);
   331			
   332			    /* %INC must be clean for use/require in compartment */
   333			    dummy_hv = save_hash(PL_incgv);
   334			    GvHV(PL_incgv) = (HV*)SvREFCNT_inc(GvHV(gv_HVadd(gv_fetchpv("INC",TRUE,SVt_PVHV))));
   335			
   336			    PUSHMARK(SP);
   337			    perl_call_sv(codesv, GIMME|G_EVAL|G_KEEPERR); /* use callers context */
   338			    sv_free( (SV *) dummy_hv);  /* get rid of what save_hash gave us*/
   339			    SPAGAIN; /* for the PUTBACK added by xsubpp */
   340			    LEAVE;
   341			#line 342 "Opcode.c"
   342	         332    	PUTBACK;
   343				return;
   344			    }
   345			}
   346			
   347			
   348			XS(XS_Opcode_verify_opset); /* prototype to pass -Wmissing-prototypes */
   349			XS(XS_Opcode_verify_opset)
   350	           2    {
   351	           2        dXSARGS;
   352	           2        if (items < 1 || items > 2)
   353	      ######    	Perl_croak(aTHX_ "Usage: Opcode::verify_opset(opset, fatal = 0)");
   354	           2        PERL_UNUSED_VAR(cv); /* -W */
   355			    {
   356	           2    	SV *	opset = ST(0);
   357	           2    	int	fatal;
   358	           2    	int	RETVAL;
   359	           2    	dXSTARG;
   360			
   361	           2    	if (items < 2)
   362	           2    	    fatal = 0;
   363				else {
   364	      ######    	    fatal = (int)SvIV(ST(1));
   365				}
   366			#line 329 "Opcode.xs"
   367			    RETVAL = verify_opset(aTHX_ opset,fatal);
   368			#line 369 "Opcode.c"
   369	           2    	XSprePUSH; PUSHi((IV)RETVAL);
   370			    }
   371	           2        XSRETURN(1);
   372			}
   373			
   374			
   375			XS(XS_Opcode_invert_opset); /* prototype to pass -Wmissing-prototypes */
   376			XS(XS_Opcode_invert_opset)
   377	         312    {
   378	         312        dXSARGS;
   379	         312        if (items != 1)
   380	      ######    	Perl_croak(aTHX_ "Usage: Opcode::invert_opset(opset)");
   381	         312        PERL_UNUSED_VAR(cv); /* -W */
   382			    {
   383	         312    	SV *	opset = ST(0);
   384			#line 337 "Opcode.xs"
   385			    {
   386			    char *bitmap;
   387			    dMY_CXT;
   388			    STRLEN len = opset_len;
   389			
   390			    opset = sv_2mortal(new_opset(aTHX_ opset));	/* verify and clone opset */
   391			    bitmap = SvPVX(opset);
   392			    while(len-- > 0)
   393				bitmap[len] = ~bitmap[len];
   394			    /* take care of extra bits beyond PL_maxo in last byte	*/
   395			    if (PL_maxo & 07)
   396				bitmap[opset_len-1] &= ~(0xFF << (PL_maxo & 0x07));
   397			    }
   398			    ST(0) = opset;
   399			#line 400 "Opcode.c"
   400			    }
   401	         312        XSRETURN(1);
   402			}
   403			
   404			
   405			XS(XS_Opcode_opset_to_ops); /* prototype to pass -Wmissing-prototypes */
   406			XS(XS_Opcode_opset_to_ops)
   407	          18    {
   408	          18        dXSARGS;
   409	          18        if (items < 1 || items > 2)
   410	      ######    	Perl_croak(aTHX_ "Usage: Opcode::opset_to_ops(opset, desc = 0)");
   411	          18        PERL_UNUSED_VAR(cv); /* -W */
   412	          18        PERL_UNUSED_VAR(ax); /* -Wall */
   413	          18        SP -= items;
   414			    {
   415	          18    	SV *	opset = ST(0);
   416	          18    	int	desc;
   417			
   418	          18    	if (items < 2)
   419	          18    	    desc = 0;
   420				else {
   421	      ######    	    desc = (int)SvIV(ST(1));
   422				}
   423			#line 358 "Opcode.xs"
   424			    {
   425			    STRLEN len;
   426			    int i, j, myopcode;
   427			    const char * const bitmap = SvPV(opset, len);
   428			    char **names = (desc) ? get_op_descs() : get_op_names();
   429			    dMY_CXT;
   430			
   431			    verify_opset(aTHX_ opset,1);
   432			    for (myopcode=0, i=0; i < opset_len; i++) {
   433				const U16 bits = bitmap[i];
   434				for (j=0; j < 8 && myopcode < PL_maxo; j++, myopcode++) {
   435				    if ( bits & (1 << j) )
   436					XPUSHs(sv_2mortal(newSVpv(names[myopcode], 0)));
   437				}
   438			    }
   439			    }
   440			#line 441 "Opcode.c"
   441	          18    	PUTBACK;
   442				return;
   443			    }
   444			}
   445			
   446			
   447			XS(XS_Opcode_opset); /* prototype to pass -Wmissing-prototypes */
   448			XS(XS_Opcode_opset)
   449	         810    {
   450	         810        dXSARGS;
   451	         810        PERL_UNUSED_VAR(cv); /* -W */
   452			    {
   453			#line 379 "Opcode.xs"
   454			    int i;
   455			    SV *bitspec;
   456			    STRLEN len, on;
   457			
   458			    SV * const opset = sv_2mortal(new_opset(aTHX_ Nullsv));
   459			    char * const bitmap = SvPVX(opset);
   460			    for (i = 0; i < items; i++) {
   461				const char *opname;
   462				on = 1;
   463				if (verify_opset(aTHX_ ST(i),0)) {
   464				    opname = "(opset)";
   465				    bitspec = ST(i);
   466				}
   467				else {
   468				    opname = SvPV(ST(i), len);
   469				    if (*opname == '!') { on=0; ++opname;--len; }
   470				    bitspec = get_op_bitspec(aTHX_ opname, len, 1);
   471				}
   472				set_opset_bits(aTHX_ bitmap, bitspec, on, opname);
   473			    }
   474			    ST(0) = opset;
   475			#line 476 "Opcode.c"
   476			    }
   477	         808        XSRETURN(1);
   478			}
   479			
   480			#define PERMITING  (ix == 0 || ix == 1)
   481			#define ONLY_THESE (ix == 0 || ix == 2)
   482			
   483			XS(XS_Opcode_permit_only); /* prototype to pass -Wmissing-prototypes */
   484			XS(XS_Opcode_permit_only)
   485	      ######    {
   486	      ######        dXSARGS;
   487	      ######        dXSI32;
   488	      ######        if (items < 1)
   489	      ######           Perl_croak(aTHX_ "Usage: %s(safe, ...)", GvNAME(CvGV(cv)));
   490	      ######        PERL_UNUSED_VAR(cv); /* -W */
   491			    {
   492	      ######    	SV *	safe = ST(0);
   493			#line 413 "Opcode.xs"
   494			    int i;
   495			    SV *bitspec, *mask;
   496			    char *bitmap;
   497			    STRLEN len;
   498			    dMY_CXT;
   499			
   500			    if (!SvROK(safe) || !SvOBJECT(SvRV(safe)) || SvTYPE(SvRV(safe))!=SVt_PVHV)
   501				croak("Not a Safe object");
   502			    mask = *hv_fetch((HV*)SvRV(safe), "Mask",4, 1);
   503			    if (ONLY_THESE)	/* *_only = new mask, else edit current	*/
   504				sv_setsv(mask, sv_2mortal(new_opset(aTHX_ PERMITING ? opset_all : Nullsv)));
   505			    else
   506				verify_opset(aTHX_ mask,1); /* croaks */
   507			    bitmap = SvPVX(mask);
   508			    for (i = 1; i < items; i++) {
   509				const char *opname;
   510				int on = PERMITING ? 0 : 1;		/* deny = mask bit on	*/
   511				if (verify_opset(aTHX_ ST(i),0)) {	/* it's a valid mask	*/
   512				    opname = "(opset)";
   513				    bitspec = ST(i);
   514				}
   515				else {				/* it's an opname/optag	*/
   516				    opname = SvPV(ST(i), len);
   517				    /* invert if op has ! prefix (only one allowed)	*/
   518				    if (*opname == '!') { on = !on; ++opname; --len; }
   519				    bitspec = get_op_bitspec(aTHX_ opname, len, 1); /* croaks */
   520				}
   521				set_opset_bits(aTHX_ bitmap, bitspec, on, opname);
   522			    }
   523			    ST(0) = &PL_sv_yes;
   524			#line 525 "Opcode.c"
   525			    }
   526	      ######        XSRETURN(1);
   527			}
   528			
   529			
   530			XS(XS_Opcode_opdesc); /* prototype to pass -Wmissing-prototypes */
   531			XS(XS_Opcode_opdesc)
   532	           2    {
   533	           2        dXSARGS;
   534	           2        PERL_UNUSED_VAR(cv); /* -W */
   535	           2        PERL_UNUSED_VAR(ax); /* -Wall */
   536	           2        SP -= items;
   537			    {
   538			#line 449 "Opcode.xs"
   539			    int i;
   540			    STRLEN len;
   541			    SV **args;
   542			    char **op_desc = get_op_descs(); 
   543			    dMY_CXT;
   544			
   545			    /* copy args to a scratch area since we may push output values onto	*/
   546			    /* the stack faster than we read values off it if masks are used.	*/
   547			    args = (SV**)SvPVX(sv_2mortal(newSVpvn((char*)&ST(0), items*sizeof(SV*))));
   548			    for (i = 0; i < items; i++) {
   549				const char * const opname = SvPV(args[i], len);
   550				SV *bitspec = get_op_bitspec(aTHX_ opname, len, 1);
   551				if (SvIOK(bitspec)) {
   552				    const int myopcode = SvIV(bitspec);
   553				    if (myopcode < 0 || myopcode >= PL_maxo)
   554					croak("panic: opcode %d (%s) out of range",myopcode,opname);
   555				    XPUSHs(sv_2mortal(newSVpv(op_desc[myopcode], 0)));
   556				}
   557				else if (SvPOK(bitspec) && SvCUR(bitspec) == (STRLEN)opset_len) {
   558				    int b, j;
   559				    STRLEN n_a;
   560				    const char * const bitmap = SvPV(bitspec,n_a);
   561				    int myopcode = 0;
   562				    for (b=0; b < opset_len; b++) {
   563					const U16 bits = bitmap[b];
   564					for (j=0; j < 8 && myopcode < PL_maxo; j++, myopcode++)
   565					    if (bits & (1 << j))
   566						XPUSHs(sv_2mortal(newSVpv(op_desc[myopcode], 0)));
   567				    }
   568				}
   569				else
   570				    croak("panic: invalid bitspec for \"%s\" (type %u)",
   571					opname, (unsigned)SvTYPE(bitspec));
   572			    }
   573			#line 574 "Opcode.c"
   574	           2    	PUTBACK;
   575				return;
   576			    }
   577			}
   578			
   579			
   580			XS(XS_Opcode_define_optag); /* prototype to pass -Wmissing-prototypes */
   581			XS(XS_Opcode_define_optag)
   582	         181    {
   583	         181        dXSARGS;
   584	         181        if (items != 2)
   585	      ######    	Perl_croak(aTHX_ "Usage: Opcode::define_optag(optagsv, mask)");
   586	         181        PERL_UNUSED_VAR(cv); /* -W */
   587			    {
   588	         181    	SV *	optagsv = ST(0);
   589	         181    	SV *	mask = ST(1);
   590			#line 490 "Opcode.xs"
   591			    STRLEN len;
   592			    const char *optag = SvPV(optagsv, len);
   593			
   594			    put_op_bitspec(aTHX_ optag, len, mask); /* croaks */
   595			    ST(0) = &PL_sv_yes;
   596			#line 597 "Opcode.c"
   597			    }
   598	         181        XSRETURN(1);
   599			}
   600			
   601			
   602			XS(XS_Opcode_empty_opset); /* prototype to pass -Wmissing-prototypes */
   603			XS(XS_Opcode_empty_opset)
   604	           3    {
   605	           3        dXSARGS;
   606	           3        if (items != 0)
   607	      ######    	Perl_croak(aTHX_ "Usage: Opcode::empty_opset()");
   608	           3        PERL_UNUSED_VAR(cv); /* -W */
   609			    {
   610			#line 500 "Opcode.xs"
   611			    ST(0) = sv_2mortal(new_opset(aTHX_ Nullsv));
   612			#line 613 "Opcode.c"
   613			    }
   614	           3        XSRETURN(1);
   615			}
   616			
   617			
   618			XS(XS_Opcode_full_opset); /* prototype to pass -Wmissing-prototypes */
   619			XS(XS_Opcode_full_opset)
   620	          11    {
   621	          11        dXSARGS;
   622	          11        if (items != 0)
   623	      ######    	Perl_croak(aTHX_ "Usage: Opcode::full_opset()");
   624	          11        PERL_UNUSED_VAR(cv); /* -W */
   625			    {
   626			#line 505 "Opcode.xs"
   627			    dMY_CXT;
   628			    ST(0) = sv_2mortal(new_opset(aTHX_ opset_all));
   629			#line 630 "Opcode.c"
   630			    }
   631	          11        XSRETURN(1);
   632			}
   633			
   634			
   635			XS(XS_Opcode_opmask_add); /* prototype to pass -Wmissing-prototypes */
   636			XS(XS_Opcode_opmask_add)
   637	           3    {
   638	           3        dXSARGS;
   639	           3        if (items != 1)
   640	      ######    	Perl_croak(aTHX_ "Usage: Opcode::opmask_add(opset)");
   641	           3        PERL_UNUSED_VAR(cv); /* -W */
   642			    {
   643	           3    	SV *	opset = ST(0);
   644			#line 512 "Opcode.xs"
   645			    if (!PL_op_mask)
   646				Newz(0, PL_op_mask, PL_maxo, char);
   647			#line 648 "Opcode.c"
   648			#line 515 "Opcode.xs"
   649			    opmask_add(aTHX_ opset);
   650			#line 651 "Opcode.c"
   651			    }
   652	           3        XSRETURN_EMPTY;
   653			}
   654			
   655			
   656			XS(XS_Opcode_opcodes); /* prototype to pass -Wmissing-prototypes */
   657			XS(XS_Opcode_opcodes)
   658	           5    {
   659	           5        dXSARGS;
   660	           5        if (items != 0)
   661	      ######    	Perl_croak(aTHX_ "Usage: Opcode::opcodes()");
   662	           5        PERL_UNUSED_VAR(cv); /* -W */
   663	           5        PERL_UNUSED_VAR(ax); /* -Wall */
   664	           5        SP -= items;
   665			    {
   666			#line 520 "Opcode.xs"
   667			    if (GIMME == G_ARRAY) {
   668				croak("opcodes in list context not yet implemented"); /* XXX */
   669			    }
   670			    else {
   671				XPUSHs(sv_2mortal(newSViv(PL_maxo)));
   672			    }
   673			#line 674 "Opcode.c"
   674	           5    	PUTBACK;
   675				return;
   676			    }
   677			}
   678			
   679			
   680			XS(XS_Opcode_opmask); /* prototype to pass -Wmissing-prototypes */
   681			XS(XS_Opcode_opmask)
   682	           2    {
   683	           2        dXSARGS;
   684	           2        if (items != 0)
   685	      ######    	Perl_croak(aTHX_ "Usage: Opcode::opmask()");
   686	           2        PERL_UNUSED_VAR(cv); /* -W */
   687			    {
   688			#line 530 "Opcode.xs"
   689			    ST(0) = sv_2mortal(new_opset(aTHX_ Nullsv));
   690			    if (PL_op_mask) {
   691				char * const bitmap = SvPVX(ST(0));
   692				int myopcode;
   693				for(myopcode=0; myopcode < PL_maxo; ++myopcode) {
   694				    if (PL_op_mask[myopcode])
   695					bitmap[myopcode >> 3] |= 1 << (myopcode & 0x07);
   696				}
   697			    }
   698			#line 699 "Opcode.c"
   699			    }
   700	           2        XSRETURN(1);
   701			}
   702			
   703			#ifdef __cplusplus
   704			extern "C"
   705			#endif
   706			XS(boot_Opcode); /* prototype to pass -Wmissing-prototypes */
   707			XS(boot_Opcode)
   708	          10    {
   709	          10        dXSARGS;
   710	          10        char* file = __FILE__;
   711			
   712	          10        PERL_UNUSED_VAR(cv); /* -W */
   713	          10        PERL_UNUSED_VAR(items); /* -W */
   714	          10        XS_VERSION_BOOTCHECK ;
   715			
   716			    {
   717	          10            CV * cv ;
   718			
   719	          10            newXSproto("Opcode::_safe_pkg_prep", XS_Opcode__safe_pkg_prep, file, "$");
   720	          10            newXSproto("Opcode::_safe_call_sv", XS_Opcode__safe_call_sv, file, "$$$");
   721	          10            newXSproto("Opcode::verify_opset", XS_Opcode_verify_opset, file, "$;$");
   722	          10            newXSproto("Opcode::invert_opset", XS_Opcode_invert_opset, file, "$");
   723	          10            newXSproto("Opcode::opset_to_ops", XS_Opcode_opset_to_ops, file, "$;$");
   724	          10            newXSproto("Opcode::opset", XS_Opcode_opset, file, ";@");
   725	          10            cv = newXS("Opcode::permit_only", XS_Opcode_permit_only, file);
   726	          10            XSANY.any_i32 = 0 ;
   727	          10            sv_setpv((SV*)cv, "$;@") ;
   728	          10            cv = newXS("Opcode::deny", XS_Opcode_permit_only, file);
   729	          10            XSANY.any_i32 = 3 ;
   730	          10            sv_setpv((SV*)cv, "$;@") ;
   731	          10            cv = newXS("Opcode::deny_only", XS_Opcode_permit_only, file);
   732	          10            XSANY.any_i32 = 2 ;
   733	          10            sv_setpv((SV*)cv, "$;@") ;
   734	          10            cv = newXS("Opcode::permit", XS_Opcode_permit_only, file);
   735	          10            XSANY.any_i32 = 1 ;
   736	          10            sv_setpv((SV*)cv, "$;@") ;
   737	          10            newXSproto("Opcode::opdesc", XS_Opcode_opdesc, file, ";@");
   738	          10            newXSproto("Opcode::define_optag", XS_Opcode_define_optag, file, "$$");
   739	          10            newXSproto("Opcode::empty_opset", XS_Opcode_empty_opset, file, "");
   740	          10            newXSproto("Opcode::full_opset", XS_Opcode_full_opset, file, "");
   741	          10            newXSproto("Opcode::opmask_add", XS_Opcode_opmask_add, file, "$");
   742	          10            newXSproto("Opcode::opcodes", XS_Opcode_opcodes, file, "");
   743	          10            newXSproto("Opcode::opmask", XS_Opcode_opmask, file, "");
   744			    }
   745			
   746			    /* Initialisation Section */
   747			
   748			#line 252 "Opcode.xs"
   749			{
   750			    MY_CXT_INIT;
   751			    assert(PL_maxo < OP_MASK_BUF_SIZE);
   752			    opset_len = (PL_maxo + 7) / 8;
   753			    if (opcode_debug >= 1)
   754				warn("opset_len %ld\n", (long)opset_len);
   755			    op_names_init(aTHX);
   756			}
   757			
   758			#line 759 "Opcode.c"
   759			
   760			    /* End of Initialisation Section */
   761			
   762	          10        XSRETURN_YES;
   763			}
   764			
