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