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