This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
B.xs: rationalise all methods aliased to next()
[perl5.git] / ext / B / B.xs
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::BIND",
25     "B::IV",
26     "B::NV",
27 #if PERL_VERSION <= 10
28     "B::RV",
29 #endif
30     "B::PV",
31     "B::PVIV",
32     "B::PVNV",
33     "B::PVMG",
34 #if PERL_VERSION >= 11
35     "B::REGEXP",
36 #endif
37     "B::GV",
38     "B::PVLV",
39     "B::AV",
40     "B::HV",
41     "B::CV",
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 {
106     bool custom = 0;
107
108     if (!o)
109         return OPc_NULL;
110
111     if (o->op_type == 0)
112         return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
113
114     if (o->op_type == OP_SASSIGN)
115         return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
116
117     if (o->op_type == OP_AELEMFAST) {
118 #if PERL_VERSION <= 14
119         if (o->op_flags & OPf_SPECIAL)
120             return OPc_BASEOP;
121         else
122 #endif
123 #ifdef USE_ITHREADS
124             return OPc_PADOP;
125 #else
126             return OPc_SVOP;
127 #endif
128     }
129     
130 #ifdef USE_ITHREADS
131     if (o->op_type == OP_GV || o->op_type == OP_GVSV ||
132         o->op_type == OP_RCATLINE)
133         return OPc_PADOP;
134 #endif
135
136     if (o->op_type == OP_CUSTOM)
137         custom = 1;
138
139     switch (OP_CLASS(o)) {
140     case OA_BASEOP:
141         return OPc_BASEOP;
142
143     case OA_UNOP:
144         return OPc_UNOP;
145
146     case OA_BINOP:
147         return OPc_BINOP;
148
149     case OA_LOGOP:
150         return OPc_LOGOP;
151
152     case OA_LISTOP:
153         return OPc_LISTOP;
154
155     case OA_PMOP:
156         return OPc_PMOP;
157
158     case OA_SVOP:
159         return OPc_SVOP;
160
161     case OA_PADOP:
162         return OPc_PADOP;
163
164     case OA_PVOP_OR_SVOP:
165         /*
166          * Character translations (tr///) are usually a PVOP, keeping a 
167          * pointer to a table of shorts used to look up translations.
168          * Under utf8, however, a simple table isn't practical; instead,
169          * the OP is an SVOP (or, under threads, a PADOP),
170          * and the SV is a reference to a swash
171          * (i.e., an RV pointing to an HV).
172          */
173         return (!custom &&
174                    (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
175                )
176 #if  defined(USE_ITHREADS)
177                 ? OPc_PADOP : OPc_PVOP;
178 #else
179                 ? OPc_SVOP : OPc_PVOP;
180 #endif
181
182     case OA_LOOP:
183         return OPc_LOOP;
184
185     case OA_COP:
186         return OPc_COP;
187
188     case OA_BASEOP_OR_UNOP:
189         /*
190          * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
191          * whether parens were seen. perly.y uses OPf_SPECIAL to
192          * signal whether a BASEOP had empty parens or none.
193          * Some other UNOPs are created later, though, so the best
194          * test is OPf_KIDS, which is set in newUNOP.
195          */
196         return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
197
198     case OA_FILESTATOP:
199         /*
200          * The file stat OPs are created via UNI(OP_foo) in toke.c but use
201          * the OPf_REF flag to distinguish between OP types instead of the
202          * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
203          * return OPc_UNOP so that walkoptree can find our children. If
204          * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
205          * (no argument to the operator) it's an OP; with OPf_REF set it's
206          * an SVOP (and op_sv is the GV for the filehandle argument).
207          */
208         return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
209 #ifdef USE_ITHREADS
210                 (o->op_flags & OPf_REF) ? OPc_PADOP : OPc_BASEOP);
211 #else
212                 (o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP);
213 #endif
214     case OA_LOOPEXOP:
215         /*
216          * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
217          * label was omitted (in which case it's a BASEOP) or else a term was
218          * seen. In this last case, all except goto are definitely PVOP but
219          * goto is either a PVOP (with an ordinary constant label), an UNOP
220          * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
221          * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
222          * get set.
223          */
224         if (o->op_flags & OPf_STACKED)
225             return OPc_UNOP;
226         else if (o->op_flags & OPf_SPECIAL)
227             return OPc_BASEOP;
228         else
229             return OPc_PVOP;
230     }
231     warn("can't determine class of operator %s, assuming BASEOP\n",
232          OP_NAME(o));
233     return OPc_BASEOP;
234 }
235
236 static SV *
237 make_op_object(pTHX_ const OP *o)
238 {
239     SV *opsv = sv_newmortal();
240     sv_setiv(newSVrv(opsv, opclassnames[cc_opclass(aTHX_ o)]), PTR2IV(o));
241     return opsv;
242 }
243
244 static SV *
245 make_sv_object(pTHX_ SV *sv)
246 {
247     SV *const arg = sv_newmortal();
248     const char *type = 0;
249     IV iv;
250     dMY_CXT;
251
252     for (iv = 0; iv < (IV)(sizeof(specialsv_list)/sizeof(SV*)); iv++) {
253         if (sv == specialsv_list[iv]) {
254             type = "B::SPECIAL";
255             break;
256         }
257     }
258     if (!type) {
259         type = svclassnames[SvTYPE(sv)];
260         iv = PTR2IV(sv);
261     }
262     sv_setiv(newSVrv(arg, type), iv);
263     return arg;
264 }
265
266 static SV *
267 make_temp_object(pTHX_ SV *temp)
268 {
269     SV *target;
270     SV *arg = sv_newmortal();
271     const char *const type = svclassnames[SvTYPE(temp)];
272     const IV iv = PTR2IV(temp);
273
274     target = newSVrv(arg, type);
275     sv_setiv(target, iv);
276
277     /* Need to keep our "temp" around as long as the target exists.
278        Simplest way seems to be to hang it from magic, and let that clear
279        it up.  No vtable, so won't actually get in the way of anything.  */
280     sv_magicext(target, temp, PERL_MAGIC_sv, NULL, NULL, 0);
281     /* magic object has had its reference count increased, so we must drop
282        our reference.  */
283     SvREFCNT_dec(temp);
284     return arg;
285 }
286
287 static SV *
288 make_warnings_object(pTHX_ const COP *const cop)
289 {
290     const STRLEN *const warnings = cop->cop_warnings;
291     const char *type = 0;
292     dMY_CXT;
293     IV iv = sizeof(specialsv_list)/sizeof(SV*);
294
295     /* Counting down is deliberate. Before the split between make_sv_object
296        and make_warnings_obj there appeared to be a bug - Nullsv and pWARN_STD
297        were both 0, so you could never get a B::SPECIAL for pWARN_STD  */
298
299     while (iv--) {
300         if ((SV*)warnings == specialsv_list[iv]) {
301             type = "B::SPECIAL";
302             break;
303         }
304     }
305     if (type) {
306         SV *arg = sv_newmortal();
307         sv_setiv(newSVrv(arg, type), iv);
308         return arg;
309     } else {
310         /* B assumes that warnings are a regular SV. Seems easier to keep it
311            happy by making them into a regular SV.  */
312         return make_temp_object(aTHX_ newSVpvn((char *)(warnings + 1), *warnings));
313     }
314 }
315
316 static SV *
317 make_cop_io_object(pTHX_ COP *cop)
318 {
319     SV *const value = newSV(0);
320
321     Perl_emulate_cop_io(aTHX_ cop, value);
322
323     if(SvOK(value)) {
324         return make_sv_object(aTHX_ value);
325     } else {
326         SvREFCNT_dec(value);
327         return make_sv_object(aTHX_ NULL);
328     }
329 }
330
331 static SV *
332 make_mg_object(pTHX_ MAGIC *mg)
333 {
334     SV *arg = sv_newmortal();
335     sv_setiv(newSVrv(arg, "B::MAGIC"), PTR2IV(mg));
336     return arg;
337 }
338
339 static SV *
340 cstring(pTHX_ SV *sv, bool perlstyle)
341 {
342     SV *sstr;
343
344     if (!SvOK(sv))
345         return newSVpvs_flags("0", SVs_TEMP);
346
347     sstr = newSVpvs_flags("\"", SVs_TEMP);
348
349     if (perlstyle && SvUTF8(sv)) {
350         SV *tmpsv = sv_newmortal(); /* Temporary SV to feed sv_uni_display */
351         const STRLEN len = SvCUR(sv);
352         const char *s = sv_uni_display(tmpsv, sv, 8*len, UNI_DISPLAY_QQ);
353         while (*s)
354         {
355             if (*s == '"')
356                 sv_catpvs(sstr, "\\\"");
357             else if (*s == '$')
358                 sv_catpvs(sstr, "\\$");
359             else if (*s == '@')
360                 sv_catpvs(sstr, "\\@");
361             else if (*s == '\\')
362             {
363                 if (strchr("nrftax\\",*(s+1)))
364                     sv_catpvn(sstr, s++, 2);
365                 else
366                     sv_catpvs(sstr, "\\\\");
367             }
368             else /* should always be printable */
369                 sv_catpvn(sstr, s, 1);
370             ++s;
371         }
372     }
373     else
374     {
375         /* XXX Optimise? */
376         STRLEN len;
377         const char *s = SvPV(sv, len);
378         for (; len; len--, s++)
379         {
380             /* At least try a little for readability */
381             if (*s == '"')
382                 sv_catpvs(sstr, "\\\"");
383             else if (*s == '\\')
384                 sv_catpvs(sstr, "\\\\");
385             /* trigraphs - bleagh */
386             else if (!perlstyle && *s == '?' && len>=3 && s[1] == '?') {
387                 Perl_sv_catpvf(aTHX_ sstr, "\\%03o", '?');
388             }
389             else if (perlstyle && *s == '$')
390                 sv_catpvs(sstr, "\\$");
391             else if (perlstyle && *s == '@')
392                 sv_catpvs(sstr, "\\@");
393             else if (isPRINT(*s))
394                 sv_catpvn(sstr, s, 1);
395             else if (*s == '\n')
396                 sv_catpvs(sstr, "\\n");
397             else if (*s == '\r')
398                 sv_catpvs(sstr, "\\r");
399             else if (*s == '\t')
400                 sv_catpvs(sstr, "\\t");
401             else if (*s == '\a')
402                 sv_catpvs(sstr, "\\a");
403             else if (*s == '\b')
404                 sv_catpvs(sstr, "\\b");
405             else if (*s == '\f')
406                 sv_catpvs(sstr, "\\f");
407             else if (!perlstyle && *s == '\v')
408                 sv_catpvs(sstr, "\\v");
409             else
410             {
411                 /* Don't want promotion of a signed -1 char in sprintf args */
412                 const unsigned char c = (unsigned char) *s;
413                 Perl_sv_catpvf(aTHX_ sstr, "\\%03o", c);
414             }
415             /* XXX Add line breaks if string is long */
416         }
417     }
418     sv_catpvs(sstr, "\"");
419     return sstr;
420 }
421
422 static SV *
423 cchar(pTHX_ SV *sv)
424 {
425     SV *sstr = newSVpvs_flags("'", SVs_TEMP);
426     const char *s = SvPV_nolen(sv);
427     /* Don't want promotion of a signed -1 char in sprintf args */
428     const unsigned char c = (unsigned char) *s;
429
430     if (c == '\'')
431         sv_catpvs(sstr, "\\'");
432     else if (c == '\\')
433         sv_catpvs(sstr, "\\\\");
434     else if (isPRINT(c))
435         sv_catpvn(sstr, s, 1);
436     else if (c == '\n')
437         sv_catpvs(sstr, "\\n");
438     else if (c == '\r')
439         sv_catpvs(sstr, "\\r");
440     else if (c == '\t')
441         sv_catpvs(sstr, "\\t");
442     else if (c == '\a')
443         sv_catpvs(sstr, "\\a");
444     else if (c == '\b')
445         sv_catpvs(sstr, "\\b");
446     else if (c == '\f')
447         sv_catpvs(sstr, "\\f");
448     else if (c == '\v')
449         sv_catpvs(sstr, "\\v");
450     else
451         Perl_sv_catpvf(aTHX_ sstr, "\\%03o", c);
452     sv_catpvs(sstr, "'");
453     return sstr;
454 }
455
456 #define PMOP_pmreplstart(o)     o->op_pmstashstartu.op_pmreplstart
457 #define PMOP_pmreplroot(o)      o->op_pmreplrootu.op_pmreplroot
458
459 static SV *
460 walkoptree(pTHX_ OP *o, const char *method, SV *ref)
461 {
462     dSP;
463     OP *kid;
464     SV *object;
465     const char *const classname = opclassnames[cc_opclass(aTHX_ o)];
466     dMY_CXT;
467
468     /* Check that no-one has changed our reference, or is holding a reference
469        to it.  */
470     if (SvREFCNT(ref) == 1 && SvROK(ref) && SvTYPE(ref) == SVt_RV
471         && (object = SvRV(ref)) && SvREFCNT(object) == 1
472         && SvTYPE(object) == SVt_PVMG && SvIOK_only(object)
473         && !SvMAGICAL(object) && !SvMAGIC(object) && SvSTASH(object)) {
474         /* Looks good, so rebless it for the class we need:  */
475         sv_bless(ref, gv_stashpv(classname, GV_ADD));
476     } else {
477         /* Need to make a new one. */
478         ref = sv_newmortal();
479         object = newSVrv(ref, classname);
480     }
481     sv_setiv(object, PTR2IV(o));
482
483     if (walkoptree_debug) {
484         PUSHMARK(sp);
485         XPUSHs(ref);
486         PUTBACK;
487         perl_call_method("walkoptree_debug", G_DISCARD);
488     }
489     PUSHMARK(sp);
490     XPUSHs(ref);
491     PUTBACK;
492     perl_call_method(method, G_DISCARD);
493     if (o && (o->op_flags & OPf_KIDS)) {
494         for (kid = ((UNOP*)o)->op_first; kid; kid = kid->op_sibling) {
495             ref = walkoptree(aTHX_ kid, method, ref);
496         }
497     }
498     if (o && (cc_opclass(aTHX_ o) == OPc_PMOP) && o->op_type != OP_PUSHRE
499            && (kid = PMOP_pmreplroot(cPMOPo)))
500     {
501         ref = walkoptree(aTHX_ kid, method, ref);
502     }
503     return ref;
504 }
505
506 static SV **
507 oplist(pTHX_ OP *o, SV **SP)
508 {
509     for(; o; o = o->op_next) {
510         if (o->op_opt == 0)
511             break;
512         o->op_opt = 0;
513         XPUSHs(make_op_object(aTHX_ o));
514         switch (o->op_type) {
515         case OP_SUBST:
516             SP = oplist(aTHX_ PMOP_pmreplstart(cPMOPo), SP);
517             continue;
518         case OP_SORT:
519             if (o->op_flags & OPf_STACKED && o->op_flags & OPf_SPECIAL) {
520                 OP *kid = cLISTOPo->op_first->op_sibling;   /* pass pushmark */
521                 kid = kUNOP->op_first;                      /* pass rv2gv */
522                 kid = kUNOP->op_first;                      /* pass leave */
523                 SP = oplist(aTHX_ kid->op_next, SP);
524             }
525             continue;
526         }
527         switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
528         case OA_LOGOP:
529             SP = oplist(aTHX_ cLOGOPo->op_other, SP);
530             break;
531         case OA_LOOP:
532             SP = oplist(aTHX_ cLOOPo->op_lastop, SP);
533             SP = oplist(aTHX_ cLOOPo->op_nextop, SP);
534             SP = oplist(aTHX_ cLOOPo->op_redoop, SP);
535             break;
536         }
537     }
538     return SP;
539 }
540
541 typedef OP      *B__OP;
542 typedef UNOP    *B__UNOP;
543 typedef BINOP   *B__BINOP;
544 typedef LOGOP   *B__LOGOP;
545 typedef LISTOP  *B__LISTOP;
546 typedef PMOP    *B__PMOP;
547 typedef SVOP    *B__SVOP;
548 typedef PADOP   *B__PADOP;
549 typedef PVOP    *B__PVOP;
550 typedef LOOP    *B__LOOP;
551 typedef COP     *B__COP;
552
553 typedef SV      *B__SV;
554 typedef SV      *B__IV;
555 typedef SV      *B__PV;
556 typedef SV      *B__NV;
557 typedef SV      *B__PVMG;
558 #if PERL_VERSION >= 11
559 typedef SV      *B__REGEXP;
560 #endif
561 typedef SV      *B__PVLV;
562 typedef SV      *B__BM;
563 typedef SV      *B__RV;
564 typedef SV      *B__FM;
565 typedef AV      *B__AV;
566 typedef HV      *B__HV;
567 typedef CV      *B__CV;
568 typedef GV      *B__GV;
569 typedef IO      *B__IO;
570
571 typedef MAGIC   *B__MAGIC;
572 typedef HE      *B__HE;
573 typedef struct refcounted_he    *B__RHE;
574 #ifdef PadlistARRAY
575 typedef PADLIST *B__PADLIST;
576 #endif
577
578 #ifdef MULTIPLICITY
579 #  define ASSIGN_COMMON_ALIAS(prefix, var) \
580     STMT_START { XSANY.any_i32 = offsetof(struct interpreter, prefix##var); } STMT_END
581 #else
582 #  define ASSIGN_COMMON_ALIAS(prefix, var) \
583     STMT_START { XSANY.any_ptr = (void *)&PL_##var; } STMT_END
584 #endif
585
586 /* This needs to be ALIASed in a custom way, hence can't easily be defined as
587    a regular XSUB.  */
588 static XSPROTO(intrpvar_sv_common); /* prototype to pass -Wmissing-prototypes */
589 static XSPROTO(intrpvar_sv_common)
590 {
591     dVAR;
592     dXSARGS;
593     SV *ret;
594     if (items != 0)
595        croak_xs_usage(cv,  "");
596 #ifdef MULTIPLICITY
597     ret = *(SV **)(XSANY.any_i32 + (char *)my_perl);
598 #else
599     ret = *(SV **)(XSANY.any_ptr);
600 #endif
601     ST(0) = make_sv_object(aTHX_ ret);
602     XSRETURN(1);
603 }
604
605
606
607 #define SVp            0x00000
608 #define U32p           0x10000
609 #define line_tp        0x20000
610 #define OPp            0x30000
611 #define PADOFFSETp     0x40000
612 #define U8p            0x50000
613 #define IVp            0x60000
614 #define char_pp        0x70000
615
616 /* table that drives most of the B::*OP methods */
617
618 struct OP_methods {
619     const char *name;
620     STRLEN namelen;
621     I32    type;
622     size_t offset; /* if -1, access is handled on a case-by-case basis */
623 } op_methods[] = {
624     STR_WITH_LEN("next"),    OPp,    offsetof(struct op, op_next),       /* 0*/
625     STR_WITH_LEN("sibling"), OPp,    offsetof(struct op, op_sibling),    /* 1*/
626     STR_WITH_LEN("targ"),    PADOFFSETp, offsetof(struct op, op_targ),   /* 2*/
627     STR_WITH_LEN("flags"),   U8p,    offsetof(struct op, op_flags),      /* 3*/
628     STR_WITH_LEN("private"), U8p,    offsetof(struct op, op_private),    /* 4*/
629     STR_WITH_LEN("first"),   OPp,    offsetof(struct unop, op_first),     /* 5*/
630     STR_WITH_LEN("last"),    OPp,    offsetof(struct binop, op_last),    /* 6*/
631     STR_WITH_LEN("other"),   OPp,    offsetof(struct logop, op_other),   /* 7*/
632     STR_WITH_LEN("pmreplstart"), OPp,
633              offsetof(struct pmop,   op_pmstashstartu.op_pmreplstart),   /* 8*/
634     STR_WITH_LEN("redoop"),  OPp,    offsetof(struct loop, op_redoop),   /* 9*/
635     STR_WITH_LEN("nextop"),  OPp,    offsetof(struct loop, op_nextop),   /*10*/
636     STR_WITH_LEN("lastop"),  OPp,    offsetof(struct loop, op_lastop),   /*11*/
637     STR_WITH_LEN("pmflags"), U32p,   offsetof(struct pmop, op_pmflags),  /*12*/
638 #if PERL_VERSION >= 17
639     STR_WITH_LEN("code_list"),OPp,   offsetof(struct pmop, op_code_list),/*13*/
640 #else
641     STR_WITH_LEN("code_list"),0,     -1,
642 #endif
643     STR_WITH_LEN("sv"),      SVp,     offsetof(struct svop, op_sv),      /*14*/
644     STR_WITH_LEN("gv"),      SVp,     offsetof(struct svop, op_sv),      /*15*/
645     STR_WITH_LEN("padix"),   PADOFFSETp,offsetof(struct padop, op_padix),/*16*/
646     STR_WITH_LEN("cop_seq"), U32p,    offsetof(struct cop, cop_seq),     /*17*/
647     STR_WITH_LEN("line"),    line_tp, offsetof(struct cop, cop_line),    /*18*/
648     STR_WITH_LEN("hints"),   U32p,    offsetof(struct cop, cop_hints),   /*19*/
649 #ifdef USE_ITHREADS
650     STR_WITH_LEN("pmoffset"),IVp,     offsetof(struct pmop, op_pmoffset),/*20*/
651     STR_WITH_LEN("filegv"),  0,       -1,                                /*21*/
652     STR_WITH_LEN("file"),    char_pp, offsetof(struct cop, cop_file),    /*22*/
653     STR_WITH_LEN("stash"),   0,       -1,                                /*23*/
654 #  if PERL_VERSION < 17
655     STR_WITH_LEN("stashpv"), char_pp, offsetof(struct cop, cop_stashpv), /*24*/
656     STR_WITH_LEN("stashoff"),0,       -1,                                /*25*/
657 #  else
658     STR_WITH_LEN("stashpv"), 0,       -1,                                /*24*/
659     STR_WITH_LEN("stashoff"),PADOFFSETp,offsetof(struct cop, cop_stashoff),/*25*/
660 #  endif
661 #else
662     STR_WITH_LEN("pmoffset"),0,       -1,                                /*20*/
663     STR_WITH_LEN("filegv"),  SVp,     offsetof(struct cop, cop_filegv),  /*21*/
664     STR_WITH_LEN("file"),    0,       -1,                                /*22*/
665     STR_WITH_LEN("stash"),   SVp,     offsetof(struct cop, cop_stash),   /*23*/
666     STR_WITH_LEN("stashpv"), 0,       -1,                                /*24*/
667     STR_WITH_LEN("stashoff"),0,       -1,                              /*25*/
668 #endif
669 };
670
671 #include "const-c.inc"
672
673 MODULE = B      PACKAGE = B
674
675 INCLUDE: const-xs.inc
676
677 PROTOTYPES: DISABLE
678
679 BOOT:
680 {
681     CV *cv;
682     const char *file = __FILE__;
683     MY_CXT_INIT;
684     specialsv_list[0] = Nullsv;
685     specialsv_list[1] = &PL_sv_undef;
686     specialsv_list[2] = &PL_sv_yes;
687     specialsv_list[3] = &PL_sv_no;
688     specialsv_list[4] = (SV *) pWARN_ALL;
689     specialsv_list[5] = (SV *) pWARN_NONE;
690     specialsv_list[6] = (SV *) pWARN_STD;
691     
692     cv = newXS("B::init_av", intrpvar_sv_common, file);
693     ASSIGN_COMMON_ALIAS(I, initav);
694     cv = newXS("B::check_av", intrpvar_sv_common, file);
695     ASSIGN_COMMON_ALIAS(I, checkav_save);
696     cv = newXS("B::unitcheck_av", intrpvar_sv_common, file);
697     ASSIGN_COMMON_ALIAS(I, unitcheckav_save);
698     cv = newXS("B::begin_av", intrpvar_sv_common, file);
699     ASSIGN_COMMON_ALIAS(I, beginav_save);
700     cv = newXS("B::end_av", intrpvar_sv_common, file);
701     ASSIGN_COMMON_ALIAS(I, endav);
702     cv = newXS("B::main_cv", intrpvar_sv_common, file);
703     ASSIGN_COMMON_ALIAS(I, main_cv);
704     cv = newXS("B::inc_gv", intrpvar_sv_common, file);
705     ASSIGN_COMMON_ALIAS(I, incgv);
706     cv = newXS("B::defstash", intrpvar_sv_common, file);
707     ASSIGN_COMMON_ALIAS(I, defstash);
708     cv = newXS("B::curstash", intrpvar_sv_common, file);
709     ASSIGN_COMMON_ALIAS(I, curstash);
710 #ifdef PL_formfeed
711     cv = newXS("B::formfeed", intrpvar_sv_common, file);
712     ASSIGN_COMMON_ALIAS(I, formfeed);
713 #endif
714 #ifdef USE_ITHREADS
715     cv = newXS("B::regex_padav", intrpvar_sv_common, file);
716     ASSIGN_COMMON_ALIAS(I, regex_padav);
717 #endif
718     cv = newXS("B::warnhook", intrpvar_sv_common, file);
719     ASSIGN_COMMON_ALIAS(I, warnhook);
720     cv = newXS("B::diehook", intrpvar_sv_common, file);
721     ASSIGN_COMMON_ALIAS(I, diehook);
722 }
723
724 #ifndef PL_formfeed
725
726 void
727 formfeed()
728     PPCODE:
729         PUSHs(make_sv_object(aTHX_ GvSV(gv_fetchpvs("\f", GV_ADD, SVt_PV))));
730
731 #endif
732
733 long 
734 amagic_generation()
735     CODE:
736         RETVAL = PL_amagic_generation;
737     OUTPUT:
738         RETVAL
739
740 void
741 comppadlist()
742     PREINIT:
743         PADLIST *padlist = CvPADLIST(PL_main_cv ? PL_main_cv : PL_compcv);
744     PPCODE:
745 #ifdef PadlistARRAY
746         {
747             SV * const rv = sv_newmortal();
748             sv_setiv(newSVrv(rv, padlist ? "B::PADLIST" : "B::NULL"),
749                      PTR2IV(padlist));
750             PUSHs(rv);
751         }
752 #else
753         PUSHs(make_sv_object(aTHX_ (SV *)padlist));
754 #endif
755
756 void
757 sv_undef()
758     ALIAS:
759         sv_no = 1
760         sv_yes = 2
761     PPCODE:
762         PUSHs(make_sv_object(aTHX_ ix > 1 ? &PL_sv_yes
763                                           : ix < 1 ? &PL_sv_undef
764                                                    : &PL_sv_no));
765
766 void
767 main_root()
768     ALIAS:
769         main_start = 1
770     PPCODE:
771         PUSHs(make_op_object(aTHX_ ix ? PL_main_start : PL_main_root));
772
773 UV
774 sub_generation()
775     ALIAS:
776         dowarn = 1
777     CODE:
778         RETVAL = ix ? PL_dowarn : PL_sub_generation;
779     OUTPUT:
780         RETVAL
781
782 void
783 walkoptree(op, method)
784         B::OP op
785         const char *    method
786     CODE:
787         (void) walkoptree(aTHX_ op, method, &PL_sv_undef);
788
789 int
790 walkoptree_debug(...)
791     CODE:
792         dMY_CXT;
793         RETVAL = walkoptree_debug;
794         if (items > 0 && SvTRUE(ST(1)))
795             walkoptree_debug = 1;
796     OUTPUT:
797         RETVAL
798
799 #define address(sv) PTR2IV(sv)
800
801 IV
802 address(sv)
803         SV *    sv
804
805 void
806 svref_2object(sv)
807         SV *    sv
808     PPCODE:
809         if (!SvROK(sv))
810             croak("argument is not a reference");
811         PUSHs(make_sv_object(aTHX_ SvRV(sv)));
812
813 void
814 opnumber(name)
815 const char *    name
816 CODE:
817 {
818  int i; 
819  IV  result = -1;
820  ST(0) = sv_newmortal();
821  if (strncmp(name,"pp_",3) == 0)
822    name += 3;
823  for (i = 0; i < PL_maxo; i++)
824   {
825    if (strcmp(name, PL_op_name[i]) == 0)
826     {
827      result = i;
828      break;
829     }
830   }
831  sv_setiv(ST(0),result);
832 }
833
834 void
835 ppname(opnum)
836         int     opnum
837     CODE:
838         ST(0) = sv_newmortal();
839         if (opnum >= 0 && opnum < PL_maxo)
840             Perl_sv_setpvf(aTHX_ ST(0), "pp_%s", PL_op_name[opnum]);
841
842 void
843 hash(sv)
844         SV *    sv
845     CODE:
846         STRLEN len;
847         U32 hash = 0;
848         const char *s = SvPVbyte(sv, len);
849         PERL_HASH(hash, s, len);
850         ST(0) = sv_2mortal(Perl_newSVpvf(aTHX_ "0x%"UVxf, (UV)hash));
851
852 #define cast_I32(foo) (I32)foo
853 IV
854 cast_I32(i)
855         IV      i
856
857 void
858 minus_c()
859     ALIAS:
860         save_BEGINs = 1
861     CODE:
862         if (ix)
863             PL_savebegin = TRUE;
864         else
865             PL_minus_c = TRUE;
866
867 void
868 cstring(sv)
869         SV *    sv
870     ALIAS:
871         perlstring = 1
872         cchar = 2
873     PPCODE:
874         PUSHs(ix == 2 ? cchar(aTHX_ sv) : cstring(aTHX_ sv, (bool)ix));
875
876 void
877 threadsv_names()
878     PPCODE:
879
880
881
882
883 MODULE = B      PACKAGE = B::OP
884
885 size_t
886 size(o)
887         B::OP           o
888     CODE:
889         RETVAL = opsizes[cc_opclass(aTHX_ o)];
890     OUTPUT:
891         RETVAL
892
893 # The type checking code in B has always been identical for all OP types,
894 # irrespective of whether the action is actually defined on that OP.
895 # We should fix this
896 void
897 next(o)
898         B::OP           o
899     ALIAS:
900         B::OP::next          =  0
901         B::OP::sibling       =  1
902         B::OP::targ          =  2
903         B::OP::flags         =  3
904         B::OP::private       =  4
905         B::UNOP::first       =  5
906         B::BINOP::last       =  6
907         B::LOGOP::other      =  7
908         B::PMOP::pmreplstart =  8
909         B::LOOP::redoop      =  9
910         B::LOOP::nextop      = 10
911         B::LOOP::lastop      = 11
912         B::PMOP::pmflags     = 12
913         B::PMOP::code_list   = 13
914         B::SVOP::sv          = 14
915         B::SVOP::gv          = 15
916         B::PADOP::padix      = 16
917         B::COP::cop_seq      = 17
918         B::COP::line         = 18
919         B::COP::hints        = 19
920         B::PMOP::pmoffset    = 20
921         B::COP::filegv       = 21
922         B::COP::file         = 22
923         B::COP::stash        = 23
924         B::COP::stashpv      = 24
925         B::COP::stashoff     = 25
926     PREINIT:
927         char *ptr;
928         SV *ret;
929         I32 type;
930         I32 offset;
931         STRLEN len;
932     PPCODE:
933         if (ix < 0 || ix > 25)
934             croak("Illegal alias %d for B::*next", (int)ix);
935         offset = op_methods[ix].offset;
936
937         /* handle non-direct field access */
938
939         if (offset < 0) {
940             switch (ix) {
941 #ifdef USE_ITHREADS
942             case 21: /* filegv */
943                 ret = make_sv_object(aTHX_ (SV *)CopFILEGV((COP*)o));
944                 break;
945 #endif
946 #ifndef USE_ITHREADS
947             case 22: /* file */
948                 ret = sv_2mortal(newSVpv(CopFILE((COP*)o), 0));
949                 break;
950 #endif
951 #ifdef USE_ITHREADS
952             case 23: /* stash */
953                 ret = make_sv_object(aTHX_ (SV *)CopSTASH((COP*)o));
954                 break;
955 #endif
956 #if PERL_VERSION >= 17 || !defined USE_ITHREADS
957             case 24: /* stashpv */
958 #  if PERL_VERSION >= 17
959                 ret = sv_2mortal(CopSTASH((COP*)o)
960                                 && SvTYPE(CopSTASH((COP*)o)) == SVt_PVHV
961                     ? newSVhek(HvNAME_HEK(CopSTASH((COP*)o)))
962                     : &PL_sv_undef);
963 #  else
964                 ret = sv_2mortal(newSVpv(CopSTASHPV((COP*)o), 0));
965 #  endif
966                 break;
967 #endif
968             default:
969                 croak("method %s not implemented", op_methods[ix].name);
970             }
971             ST(0) = ret;
972             XSRETURN(1);
973         }
974
975         /* do a direct structure offset lookup */
976
977         ptr  = (char *)o + offset;
978         type = op_methods[ix].type;
979         switch ((U8)(type >> 16)) {
980         case  (U8)(OPp >> 16):
981             ret = make_op_object(aTHX_ *((OP **)ptr));
982             break;
983         case  (U8)(PADOFFSETp >> 16):
984             ret = sv_2mortal(newSVuv(*((PADOFFSET*)ptr)));
985             break;
986         case (U8)(U8p >> 16):
987             ret = sv_2mortal(newSVuv(*((U8*)ptr)));
988             break;
989         case (U8)(U32p >> 16):
990             ret = sv_2mortal(newSVuv(*((U32*)ptr)));
991             break;
992         case (U8)(SVp >> 16):
993             ret = make_sv_object(aTHX_ *((SV **)ptr));
994             break;
995         case (U8)(line_tp >> 16):
996             ret = sv_2mortal(newSVuv(*((line_t *)ptr)));
997             break;
998         case (U8)(IVp >> 16):
999             ret = sv_2mortal(newSViv(*((IV*)ptr)));
1000             break;
1001         case (U8)(char_pp >> 16):
1002             ret = sv_2mortal(newSVpv(*((char **)ptr), 0));
1003             break;
1004         default:
1005             croak("Illegal type 0x%08x for B::*next", (unsigned)type);
1006
1007         }
1008         ST(0) = ret;
1009         XSRETURN(1);
1010
1011 char *
1012 name(o)
1013         B::OP           o
1014     ALIAS:
1015         desc = 1
1016     CODE:
1017         RETVAL = (char *)(ix ? OP_DESC(o) : OP_NAME(o));
1018     OUTPUT:
1019         RETVAL
1020
1021 void
1022 ppaddr(o)
1023         B::OP           o
1024     PREINIT:
1025         int i;
1026         SV *sv;
1027     CODE:
1028         sv = sv_2mortal(Perl_newSVpvf(aTHX_ "PL_ppaddr[OP_%s]",
1029                                       PL_op_name[o->op_type]));
1030         for (i=13; (STRLEN)i < SvCUR(sv); ++i)
1031             SvPVX(sv)[i] = toUPPER(SvPVX(sv)[i]);
1032         ST(0) = sv;
1033
1034 #  These 3 are all bitfields, so we can't take their addresses.
1035 UV
1036 type(o)
1037         B::OP           o
1038     ALIAS:
1039         opt = 1
1040         spare = 2
1041     CODE:
1042         switch(ix) {
1043           case 1:
1044             RETVAL = o->op_opt;
1045             break;
1046           case 2:
1047             RETVAL = o->op_spare;
1048             break;
1049           default:
1050             RETVAL = o->op_type;
1051         }
1052     OUTPUT:
1053         RETVAL
1054
1055
1056 void
1057 oplist(o)
1058         B::OP           o
1059     PPCODE:
1060         SP = oplist(aTHX_ o, SP);
1061
1062 MODULE = B      PACKAGE = B::LISTOP
1063
1064 U32
1065 children(o)
1066         B::LISTOP       o
1067         OP *            kid = NO_INIT
1068         int             i = NO_INIT
1069     CODE:
1070         i = 0;
1071         for (kid = o->op_first; kid; kid = kid->op_sibling)
1072             i++;
1073         RETVAL = i;
1074     OUTPUT:
1075         RETVAL
1076
1077 MODULE = B      PACKAGE = B::PMOP               PREFIX = PMOP_
1078
1079
1080 void
1081 PMOP_pmreplroot(o)
1082         B::PMOP         o
1083     CODE:
1084         if (o->op_type == OP_PUSHRE) {
1085 #ifdef USE_ITHREADS
1086             ST(0) = sv_newmortal();
1087             sv_setiv(ST(0), o->op_pmreplrootu.op_pmtargetoff);
1088 #else
1089             GV *const target = o->op_pmreplrootu.op_pmtargetgv;
1090             ST(0) = sv_newmortal();
1091             sv_setiv(newSVrv(ST(0), target ?
1092                              svclassnames[SvTYPE((SV*)target)] : "B::SV"),
1093                      PTR2IV(target));
1094 #endif
1095         }
1096         else {
1097             OP *const root = o->op_pmreplrootu.op_pmreplroot; 
1098             ST(0) = make_op_object(aTHX_ root);
1099         }
1100
1101
1102 #ifdef USE_ITHREADS
1103 #define PMOP_pmstashpv(o)       PmopSTASHPV(o);
1104
1105 char*
1106 PMOP_pmstashpv(o)
1107         B::PMOP         o
1108
1109 #else
1110
1111 void
1112 PMOP_pmstash(o)
1113         B::PMOP         o
1114     PPCODE:
1115         PUSHs(make_sv_object(aTHX_ (SV *) PmopSTASH(o)));
1116
1117 #endif
1118
1119
1120 void
1121 PMOP_precomp(o)
1122         B::PMOP         o
1123     PREINIT:
1124         dXSI32;
1125         REGEXP *rx;
1126     CODE:
1127         rx = PM_GETRE(o);
1128         ST(0) = sv_newmortal();
1129         if (rx) {
1130             if (ix) {
1131                 sv_setuv(ST(0), RX_EXTFLAGS(rx));
1132             }
1133             else {
1134                 sv_setpvn(ST(0), RX_PRECOMP(rx), RX_PRELEN(rx));
1135             }
1136         }
1137
1138 BOOT:
1139 {
1140         CV *cv;
1141         cv = newXS("B::PMOP::reflags", XS_B__PMOP_precomp, __FILE__);
1142         XSANY.any_i32 = 1;
1143 }
1144
1145 MODULE = B      PACKAGE = B::PADOP
1146
1147 void
1148 sv(o)
1149         B::PADOP o
1150     PREINIT:
1151         SV *ret;
1152     ALIAS:
1153         gv = 1
1154     PPCODE:
1155         /* It happens that the output typemaps for B::SV and B::GV are
1156            identical. The "smarts" are in make_sv_object(), which determines
1157            which class to use based on SvTYPE(), rather than anything baked in
1158            at compile time.  */    
1159         if (o->op_padix) {
1160             ret = PAD_SVl(o->op_padix);
1161             if (ix && SvTYPE(ret) != SVt_PVGV)
1162                 ret = NULL;
1163         } else {
1164             ret = NULL;
1165         }
1166         PUSHs(make_sv_object(aTHX_ ret));
1167
1168 MODULE = B      PACKAGE = B::PVOP
1169
1170 void
1171 pv(o)
1172         B::PVOP o
1173     CODE:
1174         /*
1175          * OP_TRANS uses op_pv to point to a table of 256 or >=258 shorts
1176          * whereas other PVOPs point to a null terminated string.
1177          */
1178         if ((o->op_type == OP_TRANS || o->op_type == OP_TRANSR) &&
1179                 (o->op_private & OPpTRANS_COMPLEMENT) &&
1180                 !(o->op_private & OPpTRANS_DELETE))
1181         {
1182             const short* const tbl = (short*)o->op_pv;
1183             const short entries = 257 + tbl[256];
1184             ST(0) = newSVpvn_flags(o->op_pv, entries * sizeof(short), SVs_TEMP);
1185         }
1186         else if (o->op_type == OP_TRANS || o->op_type == OP_TRANSR) {
1187             ST(0) = newSVpvn_flags(o->op_pv, 256 * sizeof(short), SVs_TEMP);
1188         }
1189         else
1190             ST(0) = newSVpvn_flags(o->op_pv, strlen(o->op_pv), SVs_TEMP);
1191
1192 #define COP_label(o)    CopLABEL(o)
1193
1194 MODULE = B      PACKAGE = B::COP                PREFIX = COP_
1195
1196 const char *
1197 COP_label(o)
1198         B::COP  o
1199
1200
1201
1202 I32
1203 COP_arybase(o)
1204         B::COP  o
1205     CODE:
1206         RETVAL = 0;
1207     OUTPUT:
1208         RETVAL
1209
1210 void
1211 COP_warnings(o)
1212         B::COP  o
1213     ALIAS:
1214         io = 1
1215     PPCODE:
1216         ST(0) = ix ? make_cop_io_object(aTHX_ o) : make_warnings_object(aTHX_ o);
1217         XSRETURN(1);
1218
1219
1220 B::RHE
1221 COP_hints_hash(o)
1222         B::COP o
1223     CODE:
1224         RETVAL = CopHINTHASH_get(o);
1225     OUTPUT:
1226         RETVAL
1227
1228
1229 MODULE = B      PACKAGE = B::SV
1230
1231 #define MAGICAL_FLAG_BITS (SVs_GMG|SVs_SMG|SVs_RMG)
1232
1233 U32
1234 REFCNT(sv)
1235         B::SV   sv
1236     ALIAS:
1237         FLAGS = 0xFFFFFFFF
1238         SvTYPE = SVTYPEMASK
1239         POK = SVf_POK
1240         ROK = SVf_ROK
1241         MAGICAL = MAGICAL_FLAG_BITS
1242     CODE:
1243         RETVAL = ix ? (SvFLAGS(sv) & (U32)ix) : SvREFCNT(sv);
1244     OUTPUT:
1245         RETVAL
1246
1247 void
1248 object_2svref(sv)
1249         B::SV   sv
1250     PPCODE:
1251         ST(0) = sv_2mortal(newRV(sv));
1252         XSRETURN(1);
1253         
1254 MODULE = B      PACKAGE = B::IV         PREFIX = Sv
1255
1256 IV
1257 SvIV(sv)
1258         B::IV   sv
1259
1260 MODULE = B      PACKAGE = B::IV
1261
1262 #define sv_SVp          0x00000
1263 #define sv_IVp          0x10000
1264 #define sv_UVp          0x20000
1265 #define sv_STRLENp      0x30000
1266 #define sv_U32p         0x40000
1267 #define sv_U8p          0x50000
1268 #define sv_char_pp      0x60000
1269 #define sv_NVp          0x70000
1270 #define sv_char_p       0x80000
1271 #define sv_SSize_tp     0x90000
1272 #define sv_I32p         0xA0000
1273 #define sv_U16p         0xB0000
1274
1275 #define IV_ivx_ix       sv_IVp | offsetof(struct xpviv, xiv_iv)
1276 #define IV_uvx_ix       sv_UVp | offsetof(struct xpvuv, xuv_uv)
1277 #define NV_nvx_ix       sv_NVp | offsetof(struct xpvnv, xnv_u.xnv_nv)
1278
1279 #define NV_cop_seq_range_low_ix \
1280                         sv_U32p | offsetof(struct xpvnv, xnv_u.xpad_cop_seq.xlow)
1281 #define NV_cop_seq_range_high_ix \
1282                         sv_U32p | offsetof(struct xpvnv, xnv_u.xpad_cop_seq.xhigh)
1283 #define NV_parent_pad_index_ix \
1284                         sv_U32p | offsetof(struct xpvnv, xnv_u.xpad_cop_seq.xlow)
1285 #define NV_parent_fakelex_flags_ix \
1286                         sv_U32p | offsetof(struct xpvnv, xnv_u.xpad_cop_seq.xhigh)
1287
1288 #define PV_cur_ix       sv_STRLENp | offsetof(struct xpv, xpv_cur)
1289 #define PV_len_ix       sv_STRLENp | offsetof(struct xpv, xpv_len)
1290
1291 #define PVMG_stash_ix   sv_SVp | offsetof(struct xpvmg, xmg_stash)
1292
1293 #if PERL_VERSION > 14
1294 #    define PVBM_useful_ix      sv_I32p | offsetof(struct xpvgv, xnv_u.xbm_s.xbm_useful)
1295 #    define PVBM_previous_ix    sv_UVp | offsetof(struct xpvuv, xuv_uv)
1296 #else
1297 #define PVBM_useful_ix  sv_I32p | offsetof(struct xpvgv, xiv_u.xivu_i32)
1298 #define PVBM_previous_ix    sv_U32p | offsetof(struct xpvgv, xnv_u.xbm_s.xbm_previous)
1299 #endif
1300
1301 #define PVBM_rare_ix    sv_U8p | offsetof(struct xpvgv, xnv_u.xbm_s.xbm_rare)
1302
1303 #define PVLV_targoff_ix sv_U32p | offsetof(struct xpvlv, xlv_targoff)
1304 #define PVLV_targlen_ix sv_U32p | offsetof(struct xpvlv, xlv_targlen)
1305 #define PVLV_targ_ix    sv_SVp | offsetof(struct xpvlv, xlv_targ)
1306 #define PVLV_type_ix    sv_char_p | offsetof(struct xpvlv, xlv_type)
1307
1308 #define PVGV_stash_ix   sv_SVp | offsetof(struct xpvgv, xnv_u.xgv_stash)
1309 #define PVGV_flags_ix   sv_STRLENp | offsetof(struct xpvgv, xpv_cur)
1310 #define PVIO_lines_ix   sv_IVp | offsetof(struct xpvio, xiv_iv)
1311
1312 #define PVIO_page_ix        sv_IVp | offsetof(struct xpvio, xio_page)
1313 #define PVIO_page_len_ix    sv_IVp | offsetof(struct xpvio, xio_page_len)
1314 #define PVIO_lines_left_ix  sv_IVp | offsetof(struct xpvio, xio_lines_left)
1315 #define PVIO_top_name_ix    sv_char_pp | offsetof(struct xpvio, xio_top_name)
1316 #define PVIO_top_gv_ix      sv_SVp | offsetof(struct xpvio, xio_top_gv)
1317 #define PVIO_fmt_name_ix    sv_char_pp | offsetof(struct xpvio, xio_fmt_name)
1318 #define PVIO_fmt_gv_ix      sv_SVp | offsetof(struct xpvio, xio_fmt_gv)
1319 #define PVIO_bottom_name_ix sv_char_pp | offsetof(struct xpvio, xio_bottom_name)
1320 #define PVIO_bottom_gv_ix   sv_SVp | offsetof(struct xpvio, xio_bottom_gv)
1321 #define PVIO_type_ix        sv_char_p | offsetof(struct xpvio, xio_type)
1322 #define PVIO_flags_ix       sv_U8p | offsetof(struct xpvio, xio_flags)
1323
1324 #define PVAV_max_ix     sv_SSize_tp | offsetof(struct xpvav, xav_max)
1325
1326 #define PVCV_stash_ix   sv_SVp | offsetof(struct xpvcv, xcv_stash) 
1327 #if PERL_VERSION > 17 || (PERL_VERSION == 17 && PERL_SUBVERSION >= 3)
1328 # define PVCV_gv_ix     sv_SVp | offsetof(struct xpvcv, xcv_gv_u.xcv_gv)
1329 #else
1330 # define PVCV_gv_ix     sv_SVp | offsetof(struct xpvcv, xcv_gv)
1331 #endif
1332 #define PVCV_file_ix    sv_char_pp | offsetof(struct xpvcv, xcv_file)
1333 #define PVCV_outside_ix sv_SVp | offsetof(struct xpvcv, xcv_outside)
1334 #define PVCV_outside_seq_ix sv_U32p | offsetof(struct xpvcv, xcv_outside_seq)
1335 #define PVCV_flags_ix   sv_U16p | offsetof(struct xpvcv, xcv_flags)
1336
1337 #define PVHV_max_ix     sv_STRLENp | offsetof(struct xpvhv, xhv_max)
1338
1339 #if PERL_VERSION > 12
1340 #define PVHV_keys_ix    sv_STRLENp | offsetof(struct xpvhv, xhv_keys)
1341 #else
1342 #define PVHV_keys_ix    sv_IVp | offsetof(struct xpvhv, xhv_keys)
1343 #endif
1344
1345 # The type checking code in B has always been identical for all SV types,
1346 # irrespective of whether the action is actually defined on that SV.
1347 # We should fix this
1348 void
1349 IVX(sv)
1350         B::SV           sv
1351     ALIAS:
1352         B::IV::IVX = IV_ivx_ix
1353         B::IV::UVX = IV_uvx_ix
1354         B::NV::NVX = NV_nvx_ix
1355         B::NV::COP_SEQ_RANGE_LOW = NV_cop_seq_range_low_ix
1356         B::NV::COP_SEQ_RANGE_HIGH = NV_cop_seq_range_high_ix
1357         B::NV::PARENT_PAD_INDEX = NV_parent_pad_index_ix
1358         B::NV::PARENT_FAKELEX_FLAGS = NV_parent_fakelex_flags_ix
1359         B::PV::CUR = PV_cur_ix
1360         B::PV::LEN = PV_len_ix
1361         B::PVMG::SvSTASH = PVMG_stash_ix
1362         B::PVLV::TARGOFF = PVLV_targoff_ix
1363         B::PVLV::TARGLEN = PVLV_targlen_ix
1364         B::PVLV::TARG = PVLV_targ_ix
1365         B::PVLV::TYPE = PVLV_type_ix
1366         B::GV::STASH = PVGV_stash_ix
1367         B::GV::GvFLAGS = PVGV_flags_ix
1368         B::BM::USEFUL = PVBM_useful_ix
1369         B::BM::PREVIOUS = PVBM_previous_ix
1370         B::BM::RARE = PVBM_rare_ix
1371         B::IO::LINES =  PVIO_lines_ix
1372         B::IO::PAGE = PVIO_page_ix
1373         B::IO::PAGE_LEN = PVIO_page_len_ix
1374         B::IO::LINES_LEFT = PVIO_lines_left_ix
1375         B::IO::TOP_NAME = PVIO_top_name_ix
1376         B::IO::TOP_GV = PVIO_top_gv_ix
1377         B::IO::FMT_NAME = PVIO_fmt_name_ix
1378         B::IO::FMT_GV = PVIO_fmt_gv_ix
1379         B::IO::BOTTOM_NAME = PVIO_bottom_name_ix
1380         B::IO::BOTTOM_GV = PVIO_bottom_gv_ix
1381         B::IO::IoTYPE = PVIO_type_ix
1382         B::IO::IoFLAGS = PVIO_flags_ix
1383         B::AV::MAX = PVAV_max_ix
1384         B::CV::STASH = PVCV_stash_ix
1385         B::CV::GV = PVCV_gv_ix
1386         B::CV::FILE = PVCV_file_ix
1387         B::CV::OUTSIDE = PVCV_outside_ix
1388         B::CV::OUTSIDE_SEQ = PVCV_outside_seq_ix
1389         B::CV::CvFLAGS = PVCV_flags_ix
1390         B::HV::MAX = PVHV_max_ix
1391         B::HV::KEYS = PVHV_keys_ix
1392     PREINIT:
1393         char *ptr;
1394         SV *ret;
1395     PPCODE:
1396         ptr = (ix & 0xFFFF) + (char *)SvANY(sv);
1397         switch ((U8)(ix >> 16)) {
1398         case (U8)(sv_SVp >> 16):
1399             ret = make_sv_object(aTHX_ *((SV **)ptr));
1400             break;
1401         case (U8)(sv_IVp >> 16):
1402             ret = sv_2mortal(newSViv(*((IV *)ptr)));
1403             break;
1404         case (U8)(sv_UVp >> 16):
1405             ret = sv_2mortal(newSVuv(*((UV *)ptr)));
1406             break;
1407         case (U8)(sv_STRLENp >> 16):
1408             ret = sv_2mortal(newSVuv(*((STRLEN *)ptr)));
1409             break;
1410         case (U8)(sv_U32p >> 16):
1411             ret = sv_2mortal(newSVuv(*((U32 *)ptr)));
1412             break;
1413         case (U8)(sv_U8p >> 16):
1414             ret = sv_2mortal(newSVuv(*((U8 *)ptr)));
1415             break;
1416         case (U8)(sv_char_pp >> 16):
1417             ret = sv_2mortal(newSVpv(*((char **)ptr), 0));
1418             break;
1419         case (U8)(sv_NVp >> 16):
1420             ret = sv_2mortal(newSVnv(*((NV *)ptr)));
1421             break;
1422         case (U8)(sv_char_p >> 16):
1423             ret = newSVpvn_flags((char *)ptr, 1, SVs_TEMP);
1424             break;
1425         case (U8)(sv_SSize_tp >> 16):
1426             ret = sv_2mortal(newSViv(*((SSize_t *)ptr)));
1427             break;
1428         case (U8)(sv_I32p >> 16):
1429             ret = sv_2mortal(newSVuv(*((I32 *)ptr)));
1430             break;
1431         case (U8)(sv_U16p >> 16):
1432             ret = sv_2mortal(newSVuv(*((U16 *)ptr)));
1433             break;
1434         default:
1435             croak("Illegal alias 0x%08x for B::*IVX", (unsigned)ix);
1436         }
1437         ST(0) = ret;
1438         XSRETURN(1);
1439
1440 void
1441 packiv(sv)
1442         B::IV   sv
1443     ALIAS:
1444         needs64bits = 1
1445     CODE:
1446         if (ix) {
1447             ST(0) = boolSV((I32)SvIVX(sv) != SvIVX(sv));
1448         } else if (sizeof(IV) == 8) {
1449             U32 wp[2];
1450             const IV iv = SvIVX(sv);
1451             /*
1452              * The following way of spelling 32 is to stop compilers on
1453              * 32-bit architectures from moaning about the shift count
1454              * being >= the width of the type. Such architectures don't
1455              * reach this code anyway (unless sizeof(IV) > 8 but then
1456              * everything else breaks too so I'm not fussed at the moment).
1457              */
1458 #ifdef UV_IS_QUAD
1459             wp[0] = htonl(((UV)iv) >> (sizeof(UV)*4));
1460 #else
1461             wp[0] = htonl(((U32)iv) >> (sizeof(UV)*4));
1462 #endif
1463             wp[1] = htonl(iv & 0xffffffff);
1464             ST(0) = newSVpvn_flags((char *)wp, 8, SVs_TEMP);
1465         } else {
1466             U32 w = htonl((U32)SvIVX(sv));
1467             ST(0) = newSVpvn_flags((char *)&w, 4, SVs_TEMP);
1468         }
1469
1470 MODULE = B      PACKAGE = B::NV         PREFIX = Sv
1471
1472 NV
1473 SvNV(sv)
1474         B::NV   sv
1475
1476 #if PERL_VERSION < 11
1477
1478 MODULE = B      PACKAGE = B::RV         PREFIX = Sv
1479
1480 void
1481 SvRV(sv)
1482         B::RV   sv
1483     PPCODE:
1484         PUSHs(make_sv_object(aTHX_ SvRV(sv)));
1485
1486 #else
1487
1488 MODULE = B      PACKAGE = B::REGEXP
1489
1490 void
1491 REGEX(sv)
1492         B::REGEXP       sv
1493     ALIAS:
1494         precomp = 1
1495     PPCODE:
1496         if (ix) {
1497             PUSHs(newSVpvn_flags(RX_PRECOMP(sv), RX_PRELEN(sv), SVs_TEMP));
1498         } else {
1499             dXSTARG;
1500             /* FIXME - can we code this method more efficiently?  */
1501             PUSHi(PTR2IV(sv));
1502         }
1503
1504 #endif
1505
1506 MODULE = B      PACKAGE = B::PV
1507
1508 void
1509 RV(sv)
1510         B::PV   sv
1511     PPCODE:
1512         if (!SvROK(sv))
1513             croak( "argument is not SvROK" );
1514         PUSHs(make_sv_object(aTHX_ SvRV(sv)));
1515
1516 void
1517 PV(sv)
1518         B::PV   sv
1519     ALIAS:
1520         PVX = 1
1521         PVBM = 2
1522         B::BM::TABLE = 3
1523     PREINIT:
1524         const char *p;
1525         STRLEN len = 0;
1526         U32 utf8 = 0;
1527     CODE:
1528         if (ix == 3) {
1529 #ifndef PERL_FBM_TABLE_OFFSET
1530             const MAGIC *const mg = mg_find(sv, PERL_MAGIC_bm);
1531
1532             if (!mg)
1533                 croak("argument to B::BM::TABLE is not a PVBM");
1534             p = mg->mg_ptr;
1535             len = mg->mg_len;
1536 #else
1537             p = SvPV(sv, len);
1538             /* Boyer-Moore table is just after string and its safety-margin \0 */
1539             p += len + PERL_FBM_TABLE_OFFSET;
1540             len = 256;
1541 #endif
1542         } else if (ix == 2) {
1543             /* This used to read 257. I think that that was buggy - should have
1544                been 258. (The "\0", the flags byte, and 256 for the table.)
1545                The only user of this method is B::Bytecode in B::PV::bsave.
1546                I'm guessing that nothing tested the runtime correctness of
1547                output of bytecompiled string constant arguments to index (etc).
1548
1549                Note the start pointer is and has always been SvPVX(sv), not
1550                SvPVX(sv) + SvCUR(sv) PVBM was added in 651aa52ea1faa806, and
1551                first used by the compiler in 651aa52ea1faa806. It's used to
1552                get a "complete" dump of the buffer at SvPVX(), not just the
1553                PVBM table. This permits the generated bytecode to "load"
1554                SvPVX in "one" hit.
1555
1556                5.15 and later store the BM table via MAGIC, so the compiler
1557                should handle this just fine without changes if PVBM now
1558                always returns the SvPVX() buffer.  */
1559             p = SvPVX_const(sv);
1560 #ifdef PERL_FBM_TABLE_OFFSET
1561             len = SvCUR(sv) + (SvVALID(sv) ? 256 + PERL_FBM_TABLE_OFFSET : 0);
1562 #else
1563             len = SvCUR(sv);
1564 #endif
1565         } else if (ix) {
1566             p = SvPVX(sv);
1567             len = strlen(p);
1568         } else if (SvPOK(sv)) {
1569             len = SvCUR(sv);
1570             p = SvPVX_const(sv);
1571             utf8 = SvUTF8(sv);
1572         }
1573         else {
1574             /* XXX for backward compatibility, but should fail */
1575             /* croak( "argument is not SvPOK" ); */
1576             p = NULL;
1577         }
1578         ST(0) = newSVpvn_flags(p, len, SVs_TEMP | utf8);
1579
1580 MODULE = B      PACKAGE = B::PVMG
1581
1582 void
1583 MAGIC(sv)
1584         B::PVMG sv
1585         MAGIC * mg = NO_INIT
1586     PPCODE:
1587         for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
1588             XPUSHs(make_mg_object(aTHX_ mg));
1589
1590 MODULE = B      PACKAGE = B::MAGIC
1591
1592 void
1593 MOREMAGIC(mg)
1594         B::MAGIC        mg
1595     ALIAS:
1596         PRIVATE = 1
1597         TYPE = 2
1598         FLAGS = 3
1599         LENGTH = 4
1600         OBJ = 5
1601         PTR = 6
1602         REGEX = 7
1603         precomp = 8
1604     PPCODE:
1605         switch (ix) {
1606         case 0:
1607             XPUSHs(mg->mg_moremagic ? make_mg_object(aTHX_ mg->mg_moremagic)
1608                                     : &PL_sv_undef);
1609             break;
1610         case 1:
1611             mPUSHu(mg->mg_private);
1612             break;
1613         case 2:
1614             PUSHs(newSVpvn_flags(&(mg->mg_type), 1, SVs_TEMP));
1615             break;
1616         case 3:
1617             mPUSHu(mg->mg_flags);
1618             break;
1619         case 4:
1620             mPUSHi(mg->mg_len);
1621             break;
1622         case 5:
1623             PUSHs(make_sv_object(aTHX_ mg->mg_obj));
1624             break;
1625         case 6:
1626             if (mg->mg_ptr) {
1627                 if (mg->mg_len >= 0) {
1628                     PUSHs(newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP));
1629                 } else if (mg->mg_len == HEf_SVKEY) {
1630                     PUSHs(make_sv_object(aTHX_ (SV*)mg->mg_ptr));
1631                 } else
1632                     PUSHs(sv_newmortal());
1633             } else
1634                 PUSHs(sv_newmortal());
1635             break;
1636         case 7:
1637             if(mg->mg_type == PERL_MAGIC_qr) {
1638                 mPUSHi(PTR2IV(mg->mg_obj));
1639             } else {
1640                 croak("REGEX is only meaningful on r-magic");
1641             }
1642             break;
1643         case 8:
1644             if (mg->mg_type == PERL_MAGIC_qr) {
1645                 REGEXP *rx = (REGEXP *)mg->mg_obj;
1646                 PUSHs(newSVpvn_flags(rx ? RX_PRECOMP(rx) : NULL,
1647                                      rx ? RX_PRELEN(rx) : 0, SVs_TEMP));
1648             } else {
1649                 croak( "precomp is only meaningful on r-magic" );
1650             }
1651             break;
1652         }
1653
1654 MODULE = B      PACKAGE = B::GV         PREFIX = Gv
1655
1656 void
1657 GvNAME(gv)
1658         B::GV   gv
1659     ALIAS:
1660         FILE = 1
1661         B::HV::NAME = 2
1662     CODE:
1663         ST(0) = sv_2mortal(newSVhek(!ix ? GvNAME_HEK(gv)
1664                                         : (ix == 1 ? GvFILE_HEK(gv)
1665                                                    : HvNAME_HEK((HV *)gv))));
1666
1667 bool
1668 is_empty(gv)
1669         B::GV   gv
1670     ALIAS:
1671         isGV_with_GP = 1
1672     CODE:
1673         if (ix) {
1674             RETVAL = isGV_with_GP(gv) ? TRUE : FALSE;
1675         } else {
1676             RETVAL = GvGP(gv) == Null(GP*);
1677         }
1678     OUTPUT:
1679         RETVAL
1680
1681 void*
1682 GvGP(gv)
1683         B::GV   gv
1684
1685 #define GP_sv_ix        SVp | offsetof(struct gp, gp_sv)
1686 #define GP_io_ix        SVp | offsetof(struct gp, gp_io)
1687 #define GP_cv_ix        SVp | offsetof(struct gp, gp_cv)
1688 #define GP_cvgen_ix     U32p | offsetof(struct gp, gp_cvgen)
1689 #define GP_refcnt_ix    U32p | offsetof(struct gp, gp_refcnt)
1690 #define GP_hv_ix        SVp | offsetof(struct gp, gp_hv)
1691 #define GP_av_ix        SVp | offsetof(struct gp, gp_av)
1692 #define GP_form_ix      SVp | offsetof(struct gp, gp_form)
1693 #define GP_egv_ix       SVp | offsetof(struct gp, gp_egv)
1694 #define GP_line_ix      line_tp | offsetof(struct gp, gp_line)
1695
1696 void
1697 SV(gv)
1698         B::GV   gv
1699     ALIAS:
1700         SV = GP_sv_ix
1701         IO = GP_io_ix
1702         CV = GP_cv_ix
1703         CVGEN = GP_cvgen_ix
1704         GvREFCNT = GP_refcnt_ix
1705         HV = GP_hv_ix
1706         AV = GP_av_ix
1707         FORM = GP_form_ix
1708         EGV = GP_egv_ix
1709         LINE = GP_line_ix
1710     PREINIT:
1711         GP *gp;
1712         char *ptr;
1713         SV *ret;
1714     PPCODE:
1715         gp = GvGP(gv);
1716         if (!gp) {
1717             const GV *const gv = CvGV(cv);
1718             Perl_croak(aTHX_ "NULL gp in B::GV::%s", gv ? GvNAME(gv) : "???");
1719         }
1720         ptr = (ix & 0xFFFF) + (char *)gp;
1721         switch ((U8)(ix >> 16)) {
1722         case (U8)(SVp >> 16):
1723             ret = make_sv_object(aTHX_ *((SV **)ptr));
1724             break;
1725         case (U8)(U32p >> 16):
1726             ret = sv_2mortal(newSVuv(*((U32*)ptr)));
1727             break;
1728         case (U8)(line_tp >> 16):
1729             ret = sv_2mortal(newSVuv(*((line_t *)ptr)));
1730             break;
1731         default:
1732             croak("Illegal alias 0x%08x for B::*SV", (unsigned)ix);
1733         }
1734         ST(0) = ret;
1735         XSRETURN(1);
1736
1737 void
1738 FILEGV(gv)
1739         B::GV   gv
1740     PPCODE:
1741         PUSHs(make_sv_object(aTHX_ (SV *)GvFILEGV(gv)));
1742
1743 MODULE = B      PACKAGE = B::IO         PREFIX = Io
1744
1745
1746 bool
1747 IsSTD(io,name)
1748         B::IO   io
1749         const char*     name
1750     PREINIT:
1751         PerlIO* handle = 0;
1752     CODE:
1753         if( strEQ( name, "stdin" ) ) {
1754             handle = PerlIO_stdin();
1755         }
1756         else if( strEQ( name, "stdout" ) ) {
1757             handle = PerlIO_stdout();
1758         }
1759         else if( strEQ( name, "stderr" ) ) {
1760             handle = PerlIO_stderr();
1761         }
1762         else {
1763             croak( "Invalid value '%s'", name );
1764         }
1765         RETVAL = handle == IoIFP(io);
1766     OUTPUT:
1767         RETVAL
1768
1769 MODULE = B      PACKAGE = B::AV         PREFIX = Av
1770
1771 SSize_t
1772 AvFILL(av)
1773         B::AV   av
1774
1775 void
1776 AvARRAY(av)
1777         B::AV   av
1778     PPCODE:
1779         if (AvFILL(av) >= 0) {
1780             SV **svp = AvARRAY(av);
1781             I32 i;
1782             for (i = 0; i <= AvFILL(av); i++)
1783                 XPUSHs(make_sv_object(aTHX_ svp[i]));
1784         }
1785
1786 void
1787 AvARRAYelt(av, idx)
1788         B::AV   av
1789         int     idx
1790     PPCODE:
1791         if (idx >= 0 && AvFILL(av) >= 0 && idx <= AvFILL(av))
1792             XPUSHs(make_sv_object(aTHX_ (AvARRAY(av)[idx])));
1793         else
1794             XPUSHs(make_sv_object(aTHX_ NULL));
1795
1796
1797 MODULE = B      PACKAGE = B::FM         PREFIX = Fm
1798
1799 #undef FmLINES
1800 #define FmLINES(sv) 0
1801
1802 IV
1803 FmLINES(form)
1804         B::FM   form
1805
1806 MODULE = B      PACKAGE = B::CV         PREFIX = Cv
1807
1808 U32
1809 CvCONST(cv)
1810         B::CV   cv
1811
1812 void
1813 CvSTART(cv)
1814         B::CV   cv
1815     ALIAS:
1816         ROOT = 1
1817     PPCODE:
1818         PUSHs(make_op_object(aTHX_ CvISXSUB(cv) ? NULL
1819                              : ix ? CvROOT(cv) : CvSTART(cv)));
1820
1821 I32
1822 CvDEPTH(cv)
1823         B::CV   cv
1824
1825 #ifdef PadlistARRAY
1826
1827 B::PADLIST
1828 CvPADLIST(cv)
1829         B::CV   cv
1830
1831 #else
1832
1833 B::AV
1834 CvPADLIST(cv)
1835         B::CV   cv
1836     PPCODE:
1837         PUSHs(make_sv_object(aTHX_ (SV *)CvPADLIST(cv)));
1838
1839
1840 #endif
1841
1842 void
1843 CvXSUB(cv)
1844         B::CV   cv
1845     ALIAS:
1846         XSUBANY = 1
1847     CODE:
1848         ST(0) = ix && CvCONST(cv)
1849             ? make_sv_object(aTHX_ (SV *)CvXSUBANY(cv).any_ptr)
1850             : sv_2mortal(newSViv(CvISXSUB(cv)
1851                                  ? (ix ? CvXSUBANY(cv).any_iv
1852                                        : PTR2IV(CvXSUB(cv)))
1853                                  : 0));
1854
1855 void
1856 const_sv(cv)
1857         B::CV   cv
1858     PPCODE:
1859         PUSHs(make_sv_object(aTHX_ (SV *)cv_const_sv(cv)));
1860
1861 MODULE = B      PACKAGE = B::HV         PREFIX = Hv
1862
1863 STRLEN
1864 HvFILL(hv)
1865         B::HV   hv
1866
1867 I32
1868 HvRITER(hv)
1869         B::HV   hv
1870
1871 void
1872 HvARRAY(hv)
1873         B::HV   hv
1874     PPCODE:
1875         if (HvUSEDKEYS(hv) > 0) {
1876             SV *sv;
1877             char *key;
1878             I32 len;
1879             (void)hv_iterinit(hv);
1880             EXTEND(sp, HvUSEDKEYS(hv) * 2);
1881             while ((sv = hv_iternextsv(hv, &key, &len))) {
1882                 mPUSHp(key, len);
1883                 PUSHs(make_sv_object(aTHX_ sv));
1884             }
1885         }
1886
1887 MODULE = B      PACKAGE = B::HE         PREFIX = He
1888
1889 void
1890 HeVAL(he)
1891         B::HE he
1892     ALIAS:
1893         SVKEY_force = 1
1894     PPCODE:
1895         PUSHs(make_sv_object(aTHX_ ix ? HeSVKEY_force(he) : HeVAL(he)));
1896
1897 U32
1898 HeHASH(he)
1899         B::HE he
1900
1901 MODULE = B      PACKAGE = B::RHE
1902
1903 SV*
1904 HASH(h)
1905         B::RHE h
1906     CODE:
1907         RETVAL = newRV( (SV*)cophh_2hv(h, 0) );
1908     OUTPUT:
1909         RETVAL
1910
1911
1912 #ifdef PadlistARRAY
1913
1914 MODULE = B      PACKAGE = B::PADLIST    PREFIX = Padlist
1915
1916 SSize_t
1917 PadlistMAX(padlist)
1918         B::PADLIST      padlist
1919
1920 void
1921 PadlistARRAY(padlist)
1922         B::PADLIST      padlist
1923     PPCODE:
1924         if (PadlistMAX(padlist) >= 0) {
1925             PAD **padp = PadlistARRAY(padlist);
1926             PADOFFSET i;
1927             for (i = 0; i <= PadlistMAX(padlist); i++)
1928                 XPUSHs(make_sv_object(aTHX_ (SV *)padp[i]));
1929         }
1930
1931 void
1932 PadlistARRAYelt(padlist, idx)
1933         B::PADLIST      padlist
1934         PADOFFSET       idx
1935     PPCODE:
1936         if (idx >= 0 && PadlistMAX(padlist) >= 0
1937          && idx <= PadlistMAX(padlist))
1938             XPUSHs(make_sv_object(aTHX_
1939                                   (SV *)PadlistARRAY(padlist)[idx]));
1940         else
1941             XPUSHs(make_sv_object(aTHX_ NULL));
1942
1943 U32
1944 PadlistREFCNT(padlist)
1945         B::PADLIST      padlist
1946     CODE:
1947         RETVAL = PadlistREFCNT(padlist);
1948     OUTPUT:
1949         RETVAL
1950
1951 #endif