This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Change B::COP::stashlen to stashoff
[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
868 #ifdef USE_ITHREADS
869 #define PMOP_pmoffset_ix        IVp | offsetof(struct pmop, op_pmoffset)
870 #endif
871
872 #  Yes, B::SV::sv and B::SV::gv really do end up generating identical code.
873 #define SVOP_sv_ix              SVp | offsetof(struct svop, op_sv)
874 #define SVOP_gv_ix              SVp | offsetof(struct svop, op_sv)
875
876 #define PADOP_padix_ix          PADOFFSETp | offsetof(struct padop, op_padix)
877
878 #define COP_seq_ix              U32p | offsetof(struct cop, cop_seq)
879 #define COP_line_ix             line_tp | offsetof(struct cop, cop_line)
880 #if PERL_VERSION >= 9
881 #define COP_hints_ix            U32p | offsetof(struct cop, cop_hints)
882 #else
883 #define COP_hints_ix            U8p | offsetof(struct cop, op_private)
884 #endif
885
886 #ifdef USE_ITHREADS
887 #define COP_stashpv_ix          char_pp | offsetof(struct cop, cop_stashpv)
888 #define COP_stashoff_ix     PADOFFSETp | offsetof(struct cop, cop_stashoff)
889 #define COP_file_ix             char_pp | offsetof(struct cop, cop_file)
890 #else
891 #define COP_stash_ix            SVp | offsetof(struct cop, cop_stash)
892 #define COP_filegv_ix           SVp | offsetof(struct cop, cop_filegv)
893 #endif
894
895 MODULE = B      PACKAGE = B::OP
896
897 size_t
898 size(o)
899         B::OP           o
900     CODE:
901         RETVAL = opsizes[cc_opclass(aTHX_ o)];
902     OUTPUT:
903         RETVAL
904
905 # The type checking code in B has always been identical for all OP types,
906 # irrespective of whether the action is actually defined on that OP.
907 # We should fix this
908 void
909 next(o)
910         B::OP           o
911     ALIAS:
912         B::OP::next = OP_next_ix
913         B::OP::sibling = OP_sibling_ix
914         B::OP::targ = OP_targ_ix
915         B::OP::flags = OP_flags_ix
916         B::OP::private = OP_private_ix
917         B::UNOP::first = UNOP_first_ix
918         B::BINOP::last = BINOP_last_ix
919         B::LOGOP::other = LOGOP_other_ix
920         B::PMOP::pmreplstart = PMOP_pmreplstart_ix
921         B::LOOP::redoop = LOOP_redoop_ix
922         B::LOOP::nextop = LOOP_nextop_ix
923         B::LOOP::lastop = LOOP_lastop_ix
924         B::PMOP::pmflags = PMOP_pmflags_ix
925         B::SVOP::sv = SVOP_sv_ix
926         B::SVOP::gv = SVOP_gv_ix
927         B::PADOP::padix = PADOP_padix_ix
928         B::COP::cop_seq = COP_seq_ix
929         B::COP::line = COP_line_ix
930         B::COP::hints = COP_hints_ix
931     PREINIT:
932         char *ptr;
933         SV *ret;
934     PPCODE:
935         ptr = (ix & 0xFFFF) + (char *)o;
936         switch ((U8)(ix >> 16)) {
937         case (U8)(OPp >> 16):
938             ret = make_op_object(aTHX_ *((OP **)ptr));
939             break;
940         case (U8)(PADOFFSETp >> 16):
941             ret = sv_2mortal(newSVuv(*((PADOFFSET*)ptr)));
942             break;
943         case (U8)(U8p >> 16):
944             ret = sv_2mortal(newSVuv(*((U8*)ptr)));
945             break;
946         case (U8)(U32p >> 16):
947             ret = sv_2mortal(newSVuv(*((U32*)ptr)));
948             break;
949         case (U8)(SVp >> 16):
950             ret = make_sv_object(aTHX_ *((SV **)ptr));
951             break;
952         case (U8)(line_tp >> 16):
953             ret = sv_2mortal(newSVuv(*((line_t *)ptr)));
954             break;
955 #ifdef USE_ITHREADS
956         case (U8)(IVp >> 16):
957             ret = sv_2mortal(newSViv(*((IV*)ptr)));
958             break;
959         case (U8)(char_pp >> 16):
960             ret = sv_2mortal(newSVpv(*((char **)ptr), 0));
961             break;
962 #endif
963         default:
964             croak("Illegal alias 0x%08x for B::*next", (unsigned)ix);
965
966         }
967         ST(0) = ret;
968         XSRETURN(1);
969
970 char *
971 name(o)
972         B::OP           o
973     ALIAS:
974         desc = 1
975     CODE:
976         RETVAL = (char *)(ix ? OP_DESC(o) : OP_NAME(o));
977     OUTPUT:
978         RETVAL
979
980 void
981 ppaddr(o)
982         B::OP           o
983     PREINIT:
984         int i;
985         SV *sv;
986     CODE:
987         sv = sv_2mortal(Perl_newSVpvf(aTHX_ "PL_ppaddr[OP_%s]",
988                                       PL_op_name[o->op_type]));
989         for (i=13; (STRLEN)i < SvCUR(sv); ++i)
990             SvPVX(sv)[i] = toUPPER(SvPVX(sv)[i]);
991         ST(0) = sv;
992
993 #if PERL_VERSION >= 9
994 #  These 3 are all bitfields, so we can't take their addresses.
995 UV
996 type(o)
997         B::OP           o
998     ALIAS:
999         opt = 1
1000         spare = 2
1001     CODE:
1002         switch(ix) {
1003           case 1:
1004             RETVAL = o->op_opt;
1005             break;
1006           case 2:
1007             RETVAL = o->op_spare;
1008             break;
1009           default:
1010             RETVAL = o->op_type;
1011         }
1012     OUTPUT:
1013         RETVAL
1014
1015 #else
1016
1017 UV
1018 type(o)
1019         B::OP           o
1020     ALIAS:
1021         seq = 1
1022     CODE:
1023         switch(ix) {
1024           case 1:
1025             RETVAL = o->op_seq;
1026             break;
1027           default:
1028             RETVAL = o->op_type;
1029         }
1030     OUTPUT:
1031         RETVAL
1032
1033 #endif
1034
1035 void
1036 oplist(o)
1037         B::OP           o
1038     PPCODE:
1039         SP = oplist(aTHX_ o, SP);
1040
1041 MODULE = B      PACKAGE = B::LISTOP
1042
1043 U32
1044 children(o)
1045         B::LISTOP       o
1046         OP *            kid = NO_INIT
1047         int             i = NO_INIT
1048     CODE:
1049         i = 0;
1050         for (kid = o->op_first; kid; kid = kid->op_sibling)
1051             i++;
1052         RETVAL = i;
1053     OUTPUT:
1054         RETVAL
1055
1056 MODULE = B      PACKAGE = B::PMOP               PREFIX = PMOP_
1057
1058 #if PERL_VERSION <= 8
1059
1060 void
1061 PMOP_pmreplroot(o)
1062         B::PMOP         o
1063         OP *            root = NO_INIT
1064     CODE:
1065         root = o->op_pmreplroot;
1066         /* OP_PUSHRE stores an SV* instead of an OP* in op_pmreplroot */
1067         if (o->op_type == OP_PUSHRE) {
1068             ST(0) = sv_newmortal();
1069 #  ifdef USE_ITHREADS
1070             sv_setiv(ST(0), INT2PTR(PADOFFSET,root) );
1071 #  else
1072             sv_setiv(newSVrv(ST(0), root ?
1073                              svclassnames[SvTYPE((SV*)root)] : "B::SV"),
1074                      PTR2IV(root));
1075 #  endif
1076         }
1077         else {
1078             ST(0) = make_op_object(aTHX_ root);
1079         }
1080
1081 #else
1082
1083 void
1084 PMOP_pmreplroot(o)
1085         B::PMOP         o
1086     CODE:
1087         if (o->op_type == OP_PUSHRE) {
1088 #  ifdef USE_ITHREADS
1089             ST(0) = sv_newmortal();
1090             sv_setiv(ST(0), o->op_pmreplrootu.op_pmtargetoff);
1091 #  else
1092             GV *const target = o->op_pmreplrootu.op_pmtargetgv;
1093             ST(0) = sv_newmortal();
1094             sv_setiv(newSVrv(ST(0), target ?
1095                              svclassnames[SvTYPE((SV*)target)] : "B::SV"),
1096                      PTR2IV(target));
1097 #  endif
1098         }
1099         else {
1100             OP *const root = o->op_pmreplrootu.op_pmreplroot; 
1101             ST(0) = make_op_object(aTHX_ root);
1102         }
1103
1104 #endif
1105
1106 #ifdef USE_ITHREADS
1107 #define PMOP_pmstashpv(o)       PmopSTASHPV(o);
1108
1109 char*
1110 PMOP_pmstashpv(o)
1111         B::PMOP         o
1112
1113 #else
1114
1115 void
1116 PMOP_pmstash(o)
1117         B::PMOP         o
1118     PPCODE:
1119         PUSHs(make_sv_object(aTHX_ (SV *) PmopSTASH(o)));
1120
1121 #endif
1122
1123 #if PERL_VERSION < 9
1124
1125 void
1126 PMOP_pmnext(o)
1127         B::PMOP         o
1128     PPCODE:
1129         PUSHs(make_op_object(aTHX_ o->op_pmnext));
1130
1131 U32
1132 PMOP_pmpermflags(o)
1133         B::PMOP         o
1134
1135 U8
1136 PMOP_pmdynflags(o)
1137         B::PMOP         o
1138
1139 #endif
1140
1141 void
1142 PMOP_precomp(o)
1143         B::PMOP         o
1144     PREINIT:
1145         dXSI32;
1146         REGEXP *rx;
1147     CODE:
1148         rx = PM_GETRE(o);
1149         ST(0) = sv_newmortal();
1150         if (rx) {
1151 #if PERL_VERSION >= 9
1152             if (ix) {
1153                 sv_setuv(ST(0), RX_EXTFLAGS(rx));
1154             } else
1155 #endif
1156             {
1157                 sv_setpvn(ST(0), RX_PRECOMP(rx), RX_PRELEN(rx));
1158             }
1159         }
1160
1161 BOOT:
1162 {
1163         CV *cv;
1164 #ifdef USE_ITHREADS
1165         cv = newXS("B::PMOP::pmoffset", XS_B__OP_next, __FILE__);
1166         XSANY.any_i32 = PMOP_pmoffset_ix;
1167 # if PERL_VERSION >= 17
1168 #  ifdef CopSTASH_len
1169         cv = newXS("B::COP::stashpv", XS_B__OP_next, __FILE__);
1170         XSANY.any_i32 = COP_stashpv_ix;
1171         cv = newXS("B::COP::file", XS_B__OP_next, __FILE__);
1172         XSANY.any_i32 = COP_file_ix;
1173 #  else
1174         cv = newXS("B::COP::stashoff", XS_B__OP_next, __FILE__);
1175         XSANY.any_i32 = COP_stashoff_ix;
1176 #  endif
1177 # endif
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 #endif
1262
1263 #if !defined(USE_ITHREADS) || (PERL_VERSION > 16 && !defined(CopSTASH_len))
1264
1265 char *
1266 COP_stashpv(o)
1267         B::COP  o
1268     ALIAS:
1269         file = 1
1270     CODE:
1271         RETVAL = ix ? CopFILE(o) : CopSTASHPV(o);
1272     OUTPUT:
1273         RETVAL
1274
1275 #endif
1276
1277 I32
1278 COP_arybase(o)
1279         B::COP  o
1280     CODE:
1281         RETVAL = 0;
1282     OUTPUT:
1283         RETVAL
1284
1285 void
1286 COP_warnings(o)
1287         B::COP  o
1288     ALIAS:
1289         io = 1
1290     PPCODE:
1291 #if PERL_VERSION >= 9
1292         ST(0) = ix ? make_cop_io_object(aTHX_ o) : make_warnings_object(aTHX_ o);
1293 #else
1294         ST(0) = make_sv_object(aTHX_ ix ? o->cop_io : o->cop_warnings);
1295 #endif
1296         XSRETURN(1);
1297
1298 #if PERL_VERSION >= 9
1299
1300 B::RHE
1301 COP_hints_hash(o)
1302         B::COP o
1303     CODE:
1304         RETVAL = CopHINTHASH_get(o);
1305     OUTPUT:
1306         RETVAL
1307
1308 #endif
1309
1310 MODULE = B      PACKAGE = B::SV
1311
1312 #define MAGICAL_FLAG_BITS (SVs_GMG|SVs_SMG|SVs_RMG)
1313
1314 U32
1315 REFCNT(sv)
1316         B::SV   sv
1317     ALIAS:
1318         FLAGS = 0xFFFFFFFF
1319         SvTYPE = SVTYPEMASK
1320         POK = SVf_POK
1321         ROK = SVf_ROK
1322         MAGICAL = MAGICAL_FLAG_BITS
1323     CODE:
1324         RETVAL = ix ? (SvFLAGS(sv) & (U32)ix) : SvREFCNT(sv);
1325     OUTPUT:
1326         RETVAL
1327
1328 void
1329 object_2svref(sv)
1330         B::SV   sv
1331     PPCODE:
1332         ST(0) = sv_2mortal(newRV(sv));
1333         XSRETURN(1);
1334         
1335 MODULE = B      PACKAGE = B::IV         PREFIX = Sv
1336
1337 IV
1338 SvIV(sv)
1339         B::IV   sv
1340
1341 MODULE = B      PACKAGE = B::IV
1342
1343 #define sv_SVp          0x00000
1344 #define sv_IVp          0x10000
1345 #define sv_UVp          0x20000
1346 #define sv_STRLENp      0x30000
1347 #define sv_U32p         0x40000
1348 #define sv_U8p          0x50000
1349 #define sv_char_pp      0x60000
1350 #define sv_NVp          0x70000
1351 #define sv_char_p       0x80000
1352 #define sv_SSize_tp     0x90000
1353 #define sv_I32p         0xA0000
1354 #define sv_U16p         0xB0000
1355
1356 #define IV_ivx_ix       sv_IVp | offsetof(struct xpviv, xiv_iv)
1357 #define IV_uvx_ix       sv_UVp | offsetof(struct xpvuv, xuv_uv)
1358 #define NV_nvx_ix       sv_NVp | offsetof(struct xpvnv, xnv_u.xnv_nv)
1359
1360 #if PERL_VERSION >= 10
1361 #define NV_cop_seq_range_low_ix \
1362                         sv_U32p | offsetof(struct xpvnv, xnv_u.xpad_cop_seq.xlow)
1363 #define NV_cop_seq_range_high_ix \
1364                         sv_U32p | offsetof(struct xpvnv, xnv_u.xpad_cop_seq.xhigh)
1365 #define NV_parent_pad_index_ix \
1366                         sv_U32p | offsetof(struct xpvnv, xnv_u.xpad_cop_seq.xlow)
1367 #define NV_parent_fakelex_flags_ix \
1368                         sv_U32p | offsetof(struct xpvnv, xnv_u.xpad_cop_seq.xhigh)
1369 #else
1370 #define NV_cop_seq_range_low_ix \
1371                         sv_NVp | offsetof(struct xpvnv, xnv_nv)
1372 #define NV_cop_seq_range_high_ix \
1373                         sv_UVp | offsetof(struct xpvnv, xuv_uv)
1374 #define NV_parent_pad_index_ix \
1375                         sv_NVp | offsetof(struct xpvnv, xnv_nv)
1376 #define NV_parent_fakelex_flags_ix \
1377                         sv_UVp | offsetof(struct xpvnv, xuv_uv)
1378 #endif
1379
1380 #define PV_cur_ix       sv_STRLENp | offsetof(struct xpv, xpv_cur)
1381 #define PV_len_ix       sv_STRLENp | offsetof(struct xpv, xpv_len)
1382
1383 #define PVMG_stash_ix   sv_SVp | offsetof(struct xpvmg, xmg_stash)
1384
1385 #if PERL_VERSION >= 10
1386 #  if PERL_VERSION > 14
1387 #    define PVBM_useful_ix      sv_I32p | offsetof(struct xpvgv, xnv_u.xbm_s.xbm_useful)
1388 #    define PVBM_previous_ix    sv_UVp | offsetof(struct xpvuv, xuv_uv)
1389 #  else
1390 #define PVBM_useful_ix  sv_I32p | offsetof(struct xpvgv, xiv_u.xivu_i32)
1391 #define PVBM_previous_ix    sv_U32p | offsetof(struct xpvgv, xnv_u.xbm_s.xbm_previous)
1392 #  endif
1393 #define PVBM_rare_ix    sv_U8p | offsetof(struct xpvgv, xnv_u.xbm_s.xbm_rare)
1394 #else
1395 #define PVBM_useful_ix  sv_I32p | offsetof(struct xpvbm, xbm_useful)
1396 #define PVBM_previous_ix    sv_U16p | offsetof(struct xpvbm, xbm_previous)
1397 #define PVBM_rare_ix    sv_U8p | offsetof(struct xpvbm, xbm_rare)
1398 #endif
1399
1400 #define PVLV_targoff_ix sv_U32p | offsetof(struct xpvlv, xlv_targoff)
1401 #define PVLV_targlen_ix sv_U32p | offsetof(struct xpvlv, xlv_targlen)
1402 #define PVLV_targ_ix    sv_SVp | offsetof(struct xpvlv, xlv_targ)
1403 #define PVLV_type_ix    sv_char_p | offsetof(struct xpvlv, xlv_type)
1404
1405 #if PERL_VERSION >= 10
1406 #define PVGV_stash_ix   sv_SVp | offsetof(struct xpvgv, xnv_u.xgv_stash)
1407 #define PVGV_flags_ix   sv_STRLENp | offsetof(struct xpvgv, xpv_cur)
1408 #define PVIO_lines_ix   sv_IVp | offsetof(struct xpvio, xiv_iv)
1409 #else
1410 #define PVGV_stash_ix   sv_SVp | offsetof(struct xpvgv, xgv_stash)
1411 #define PVGV_flags_ix   sv_U8p | offsetof(struct xpvgv, xgv_flags)
1412 #define PVIO_lines_ix   sv_IVp | offsetof(struct xpvio, xio_lines)
1413 #endif
1414
1415 #define PVIO_page_ix        sv_IVp | offsetof(struct xpvio, xio_page)
1416 #define PVIO_page_len_ix    sv_IVp | offsetof(struct xpvio, xio_page_len)
1417 #define PVIO_lines_left_ix  sv_IVp | offsetof(struct xpvio, xio_lines_left)
1418 #define PVIO_top_name_ix    sv_char_pp | offsetof(struct xpvio, xio_top_name)
1419 #define PVIO_top_gv_ix      sv_SVp | offsetof(struct xpvio, xio_top_gv)
1420 #define PVIO_fmt_name_ix    sv_char_pp | offsetof(struct xpvio, xio_fmt_name)
1421 #define PVIO_fmt_gv_ix      sv_SVp | offsetof(struct xpvio, xio_fmt_gv)
1422 #define PVIO_bottom_name_ix sv_char_pp | offsetof(struct xpvio, xio_bottom_name)
1423 #define PVIO_bottom_gv_ix   sv_SVp | offsetof(struct xpvio, xio_bottom_gv)
1424 #define PVIO_type_ix        sv_char_p | offsetof(struct xpvio, xio_type)
1425 #define PVIO_flags_ix       sv_U8p | offsetof(struct xpvio, xio_flags)
1426
1427 #define PVAV_max_ix     sv_SSize_tp | offsetof(struct xpvav, xav_max)
1428
1429 #define PVFM_lines_ix   sv_IVp | offsetof(struct xpvfm, xfm_lines)
1430
1431 #define PVCV_stash_ix   sv_SVp | offsetof(struct xpvcv, xcv_stash) 
1432 #define PVCV_gv_ix      sv_SVp | offsetof(struct xpvcv, xcv_gv)
1433 #define PVCV_file_ix    sv_char_pp | offsetof(struct xpvcv, xcv_file)
1434 #define PVCV_depth_ix   sv_I32p | offsetof(struct xpvcv, xcv_depth)
1435 #define PVCV_padlist_ix sv_SVp | offsetof(struct xpvcv, xcv_padlist)
1436 #define PVCV_outside_ix sv_SVp | offsetof(struct xpvcv, xcv_outside)
1437 #define PVCV_outside_seq_ix sv_U32p | offsetof(struct xpvcv, xcv_outside_seq)
1438 #define PVCV_flags_ix   sv_U16p | offsetof(struct xpvcv, xcv_flags)
1439
1440 #define PVHV_max_ix     sv_STRLENp | offsetof(struct xpvhv, xhv_max)
1441
1442 #if PERL_VERSION > 12
1443 #define PVHV_keys_ix    sv_STRLENp | offsetof(struct xpvhv, xhv_keys)
1444 #else
1445 #define PVHV_keys_ix    sv_IVp | offsetof(struct xpvhv, xhv_keys)
1446 #endif
1447
1448 # The type checking code in B has always been identical for all SV types,
1449 # irrespective of whether the action is actually defined on that SV.
1450 # We should fix this
1451 void
1452 IVX(sv)
1453         B::SV           sv
1454     ALIAS:
1455         B::IV::IVX = IV_ivx_ix
1456         B::IV::UVX = IV_uvx_ix
1457         B::NV::NVX = NV_nvx_ix
1458         B::NV::COP_SEQ_RANGE_LOW = NV_cop_seq_range_low_ix
1459         B::NV::COP_SEQ_RANGE_HIGH = NV_cop_seq_range_high_ix
1460         B::NV::PARENT_PAD_INDEX = NV_parent_pad_index_ix
1461         B::NV::PARENT_FAKELEX_FLAGS = NV_parent_fakelex_flags_ix
1462         B::PV::CUR = PV_cur_ix
1463         B::PV::LEN = PV_len_ix
1464         B::PVMG::SvSTASH = PVMG_stash_ix
1465         B::PVLV::TARGOFF = PVLV_targoff_ix
1466         B::PVLV::TARGLEN = PVLV_targlen_ix
1467         B::PVLV::TARG = PVLV_targ_ix
1468         B::PVLV::TYPE = PVLV_type_ix
1469         B::GV::STASH = PVGV_stash_ix
1470         B::GV::GvFLAGS = PVGV_flags_ix
1471         B::BM::USEFUL = PVBM_useful_ix
1472         B::BM::PREVIOUS = PVBM_previous_ix
1473         B::BM::RARE = PVBM_rare_ix
1474         B::IO::LINES =  PVIO_lines_ix
1475         B::IO::PAGE = PVIO_page_ix
1476         B::IO::PAGE_LEN = PVIO_page_len_ix
1477         B::IO::LINES_LEFT = PVIO_lines_left_ix
1478         B::IO::TOP_NAME = PVIO_top_name_ix
1479         B::IO::TOP_GV = PVIO_top_gv_ix
1480         B::IO::FMT_NAME = PVIO_fmt_name_ix
1481         B::IO::FMT_GV = PVIO_fmt_gv_ix
1482         B::IO::BOTTOM_NAME = PVIO_bottom_name_ix
1483         B::IO::BOTTOM_GV = PVIO_bottom_gv_ix
1484         B::IO::IoTYPE = PVIO_type_ix
1485         B::IO::IoFLAGS = PVIO_flags_ix
1486         B::AV::MAX = PVAV_max_ix
1487         B::FM::LINES = PVFM_lines_ix
1488         B::CV::STASH = PVCV_stash_ix
1489         B::CV::GV = PVCV_gv_ix
1490         B::CV::FILE = PVCV_file_ix
1491         B::CV::DEPTH = PVCV_depth_ix
1492         B::CV::PADLIST = PVCV_padlist_ix
1493         B::CV::OUTSIDE = PVCV_outside_ix
1494         B::CV::OUTSIDE_SEQ = PVCV_outside_seq_ix
1495         B::CV::CvFLAGS = PVCV_flags_ix
1496         B::HV::MAX = PVHV_max_ix
1497         B::HV::KEYS = PVHV_keys_ix
1498     PREINIT:
1499         char *ptr;
1500         SV *ret;
1501     PPCODE:
1502         ptr = (ix & 0xFFFF) + (char *)SvANY(sv);
1503         switch ((U8)(ix >> 16)) {
1504         case (U8)(sv_SVp >> 16):
1505             ret = make_sv_object(aTHX_ *((SV **)ptr));
1506             break;
1507         case (U8)(sv_IVp >> 16):
1508             ret = sv_2mortal(newSViv(*((IV *)ptr)));
1509             break;
1510         case (U8)(sv_UVp >> 16):
1511             ret = sv_2mortal(newSVuv(*((UV *)ptr)));
1512             break;
1513         case (U8)(sv_STRLENp >> 16):
1514             ret = sv_2mortal(newSVuv(*((STRLEN *)ptr)));
1515             break;
1516         case (U8)(sv_U32p >> 16):
1517             ret = sv_2mortal(newSVuv(*((U32 *)ptr)));
1518             break;
1519         case (U8)(sv_U8p >> 16):
1520             ret = sv_2mortal(newSVuv(*((U8 *)ptr)));
1521             break;
1522         case (U8)(sv_char_pp >> 16):
1523             ret = sv_2mortal(newSVpv(*((char **)ptr), 0));
1524             break;
1525         case (U8)(sv_NVp >> 16):
1526             ret = sv_2mortal(newSVnv(*((NV *)ptr)));
1527             break;
1528         case (U8)(sv_char_p >> 16):
1529             ret = newSVpvn_flags((char *)ptr, 1, SVs_TEMP);
1530             break;
1531         case (U8)(sv_SSize_tp >> 16):
1532             ret = sv_2mortal(newSViv(*((SSize_t *)ptr)));
1533             break;
1534         case (U8)(sv_I32p >> 16):
1535             ret = sv_2mortal(newSVuv(*((I32 *)ptr)));
1536             break;
1537         case (U8)(sv_U16p >> 16):
1538             ret = sv_2mortal(newSVuv(*((U16 *)ptr)));
1539             break;
1540         default:
1541             croak("Illegal alias 0x%08x for B::*IVX", (unsigned)ix);
1542         }
1543         ST(0) = ret;
1544         XSRETURN(1);
1545
1546 void
1547 packiv(sv)
1548         B::IV   sv
1549     ALIAS:
1550         needs64bits = 1
1551     CODE:
1552         if (ix) {
1553             ST(0) = boolSV((I32)SvIVX(sv) != SvIVX(sv));
1554         } else if (sizeof(IV) == 8) {
1555             U32 wp[2];
1556             const IV iv = SvIVX(sv);
1557             /*
1558              * The following way of spelling 32 is to stop compilers on
1559              * 32-bit architectures from moaning about the shift count
1560              * being >= the width of the type. Such architectures don't
1561              * reach this code anyway (unless sizeof(IV) > 8 but then
1562              * everything else breaks too so I'm not fussed at the moment).
1563              */
1564 #ifdef UV_IS_QUAD
1565             wp[0] = htonl(((UV)iv) >> (sizeof(UV)*4));
1566 #else
1567             wp[0] = htonl(((U32)iv) >> (sizeof(UV)*4));
1568 #endif
1569             wp[1] = htonl(iv & 0xffffffff);
1570             ST(0) = newSVpvn_flags((char *)wp, 8, SVs_TEMP);
1571         } else {
1572             U32 w = htonl((U32)SvIVX(sv));
1573             ST(0) = newSVpvn_flags((char *)&w, 4, SVs_TEMP);
1574         }
1575
1576 MODULE = B      PACKAGE = B::NV         PREFIX = Sv
1577
1578 NV
1579 SvNV(sv)
1580         B::NV   sv
1581
1582 #if PERL_VERSION < 11
1583
1584 MODULE = B      PACKAGE = B::RV         PREFIX = Sv
1585
1586 void
1587 SvRV(sv)
1588         B::RV   sv
1589     PPCODE:
1590         PUSHs(make_sv_object(aTHX_ SvRV(sv)));
1591
1592 #else
1593
1594 MODULE = B      PACKAGE = B::REGEXP
1595
1596 void
1597 REGEX(sv)
1598         B::REGEXP       sv
1599     ALIAS:
1600         precomp = 1
1601     PPCODE:
1602         if (ix) {
1603             PUSHs(newSVpvn_flags(RX_PRECOMP(sv), RX_PRELEN(sv), SVs_TEMP));
1604         } else {
1605             dXSTARG;
1606             /* FIXME - can we code this method more efficiently?  */
1607             PUSHi(PTR2IV(sv));
1608         }
1609
1610 #endif
1611
1612 MODULE = B      PACKAGE = B::PV
1613
1614 void
1615 RV(sv)
1616         B::PV   sv
1617     PPCODE:
1618         if (!SvROK(sv))
1619             croak( "argument is not SvROK" );
1620         PUSHs(make_sv_object(aTHX_ SvRV(sv)));
1621
1622 void
1623 PV(sv)
1624         B::PV   sv
1625     ALIAS:
1626         PVX = 1
1627         PVBM = 2
1628         B::BM::TABLE = 3
1629     PREINIT:
1630         const char *p;
1631         STRLEN len = 0;
1632         U32 utf8 = 0;
1633     CODE:
1634         if (ix == 3) {
1635 #ifndef PERL_FBM_TABLE_OFFSET
1636             const MAGIC *const mg = mg_find(sv, PERL_MAGIC_bm);
1637
1638             if (!mg)
1639                 croak("argument to B::BM::TABLE is not a PVBM");
1640             p = mg->mg_ptr;
1641             len = mg->mg_len;
1642 #else
1643             p = SvPV(sv, len);
1644             /* Boyer-Moore table is just after string and its safety-margin \0 */
1645             p += len + PERL_FBM_TABLE_OFFSET;
1646             len = 256;
1647 #endif
1648         } else if (ix == 2) {
1649             /* This used to read 257. I think that that was buggy - should have
1650                been 258. (The "\0", the flags byte, and 256 for the table.)
1651                The only user of this method is B::Bytecode in B::PV::bsave.
1652                I'm guessing that nothing tested the runtime correctness of
1653                output of bytecompiled string constant arguments to index (etc).
1654
1655                Note the start pointer is and has always been SvPVX(sv), not
1656                SvPVX(sv) + SvCUR(sv) PVBM was added in 651aa52ea1faa806, and
1657                first used by the compiler in 651aa52ea1faa806. It's used to
1658                get a "complete" dump of the buffer at SvPVX(), not just the
1659                PVBM table. This permits the generated bytecode to "load"
1660                SvPVX in "one" hit.
1661
1662                5.15 and later store the BM table via MAGIC, so the compiler
1663                should handle this just fine without changes if PVBM now
1664                always returns the SvPVX() buffer.  */
1665             p = SvPVX_const(sv);
1666 #ifdef PERL_FBM_TABLE_OFFSET
1667             len = SvCUR(sv) + (SvVALID(sv) ? 256 + PERL_FBM_TABLE_OFFSET : 0);
1668 #else
1669             len = SvCUR(sv);
1670 #endif
1671         } else if (ix) {
1672             p = SvPVX(sv);
1673             len = strlen(p);
1674         } else if (SvPOK(sv)) {
1675             len = SvCUR(sv);
1676             p = SvPVX_const(sv);
1677             utf8 = SvUTF8(sv);
1678 #if PERL_VERSION < 10
1679             /* Before 5.10 (well 931b58fb28fa5ca7), PAD_COMPNAME_GEN was stored
1680                in SvCUR(), which meant we had to attempt this special casing
1681                to avoid tripping up over variable names in the pads.  */
1682             if((SvLEN(sv) && len >= SvLEN(sv))) {
1683                 /* It claims to be longer than the space allocated for it -
1684                    presumably it's a variable name in the pad  */
1685                 len = strlen(p);
1686             }
1687 #endif
1688         }
1689         else {
1690             /* XXX for backward compatibility, but should fail */
1691             /* croak( "argument is not SvPOK" ); */
1692             p = NULL;
1693         }
1694         ST(0) = newSVpvn_flags(p, len, SVs_TEMP | utf8);
1695
1696 MODULE = B      PACKAGE = B::PVMG
1697
1698 void
1699 MAGIC(sv)
1700         B::PVMG sv
1701         MAGIC * mg = NO_INIT
1702     PPCODE:
1703         for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
1704             XPUSHs(make_mg_object(aTHX_ mg));
1705
1706 MODULE = B      PACKAGE = B::MAGIC
1707
1708 void
1709 MOREMAGIC(mg)
1710         B::MAGIC        mg
1711     ALIAS:
1712         PRIVATE = 1
1713         TYPE = 2
1714         FLAGS = 3
1715         LENGTH = 4
1716         OBJ = 5
1717         PTR = 6
1718         REGEX = 7
1719         precomp = 8
1720     PPCODE:
1721         switch (ix) {
1722         case 0:
1723             XPUSHs(mg->mg_moremagic ? make_mg_object(aTHX_ mg->mg_moremagic)
1724                                     : &PL_sv_undef);
1725             break;
1726         case 1:
1727             mPUSHu(mg->mg_private);
1728             break;
1729         case 2:
1730             PUSHs(newSVpvn_flags(&(mg->mg_type), 1, SVs_TEMP));
1731             break;
1732         case 3:
1733             mPUSHu(mg->mg_flags);
1734             break;
1735         case 4:
1736             mPUSHi(mg->mg_len);
1737             break;
1738         case 5:
1739             PUSHs(make_sv_object(aTHX_ mg->mg_obj));
1740             break;
1741         case 6:
1742             if (mg->mg_ptr) {
1743                 if (mg->mg_len >= 0) {
1744                     PUSHs(newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP));
1745                 } else if (mg->mg_len == HEf_SVKEY) {
1746                     PUSHs(make_sv_object(aTHX_ (SV*)mg->mg_ptr));
1747                 } else
1748                     PUSHs(sv_newmortal());
1749             } else
1750                 PUSHs(sv_newmortal());
1751             break;
1752         case 7:
1753             if(mg->mg_type == PERL_MAGIC_qr) {
1754                 mPUSHi(PTR2IV(mg->mg_obj));
1755             } else {
1756                 croak("REGEX is only meaningful on r-magic");
1757             }
1758             break;
1759         case 8:
1760             if (mg->mg_type == PERL_MAGIC_qr) {
1761                 REGEXP *rx = (REGEXP *)mg->mg_obj;
1762                 PUSHs(newSVpvn_flags(rx ? RX_PRECOMP(rx) : NULL,
1763                                      rx ? RX_PRELEN(rx) : 0, SVs_TEMP));
1764             } else {
1765                 croak( "precomp is only meaningful on r-magic" );
1766             }
1767             break;
1768         }
1769
1770 MODULE = B      PACKAGE = B::GV         PREFIX = Gv
1771
1772 void
1773 GvNAME(gv)
1774         B::GV   gv
1775     ALIAS:
1776         FILE = 1
1777         B::HV::NAME = 2
1778     CODE:
1779 #if PERL_VERSION >= 10
1780         ST(0) = sv_2mortal(newSVhek(!ix ? GvNAME_HEK(gv)
1781                                         : (ix == 1 ? GvFILE_HEK(gv)
1782                                                    : HvNAME_HEK((HV *)gv))));
1783 #else
1784         ST(0) = !ix ? newSVpvn_flags(GvNAME(gv), GvNAMELEN(gv), SVs_TEMP)
1785                     : sv_2mortal(newSVpv(ix == 1 ? GvFILE(gv) : HvNAME((HV *)gv), 0))
1786 #endif
1787
1788 bool
1789 is_empty(gv)
1790         B::GV   gv
1791     ALIAS:
1792         isGV_with_GP = 1
1793     CODE:
1794         if (ix) {
1795 #if PERL_VERSION >= 9
1796             RETVAL = isGV_with_GP(gv) ? TRUE : FALSE;
1797 #else
1798             RETVAL = TRUE; /* In 5.8 and earlier they all are.  */
1799 #endif
1800         } else {
1801             RETVAL = GvGP(gv) == Null(GP*);
1802         }
1803     OUTPUT:
1804         RETVAL
1805
1806 void*
1807 GvGP(gv)
1808         B::GV   gv
1809
1810 #define GP_sv_ix        SVp | offsetof(struct gp, gp_sv)
1811 #define GP_io_ix        SVp | offsetof(struct gp, gp_io)
1812 #define GP_cv_ix        SVp | offsetof(struct gp, gp_cv)
1813 #define GP_cvgen_ix     U32p | offsetof(struct gp, gp_cvgen)
1814 #define GP_refcnt_ix    U32p | offsetof(struct gp, gp_refcnt)
1815 #define GP_hv_ix        SVp | offsetof(struct gp, gp_hv)
1816 #define GP_av_ix        SVp | offsetof(struct gp, gp_av)
1817 #define GP_form_ix      SVp | offsetof(struct gp, gp_form)
1818 #define GP_egv_ix       SVp | offsetof(struct gp, gp_egv)
1819 #define GP_line_ix      line_tp | offsetof(struct gp, gp_line)
1820
1821 void
1822 SV(gv)
1823         B::GV   gv
1824     ALIAS:
1825         SV = GP_sv_ix
1826         IO = GP_io_ix
1827         CV = GP_cv_ix
1828         CVGEN = GP_cvgen_ix
1829         GvREFCNT = GP_refcnt_ix
1830         HV = GP_hv_ix
1831         AV = GP_av_ix
1832         FORM = GP_form_ix
1833         EGV = GP_egv_ix
1834         LINE = GP_line_ix
1835     PREINIT:
1836         GP *gp;
1837         char *ptr;
1838         SV *ret;
1839     PPCODE:
1840         gp = GvGP(gv);
1841         if (!gp) {
1842             const GV *const gv = CvGV(cv);
1843             Perl_croak(aTHX_ "NULL gp in B::GV::%s", gv ? GvNAME(gv) : "???");
1844         }
1845         ptr = (ix & 0xFFFF) + (char *)gp;
1846         switch ((U8)(ix >> 16)) {
1847         case (U8)(SVp >> 16):
1848             ret = make_sv_object(aTHX_ *((SV **)ptr));
1849             break;
1850         case (U8)(U32p >> 16):
1851             ret = sv_2mortal(newSVuv(*((U32*)ptr)));
1852             break;
1853         case (U8)(line_tp >> 16):
1854             ret = sv_2mortal(newSVuv(*((line_t *)ptr)));
1855             break;
1856         default:
1857             croak("Illegal alias 0x%08x for B::*SV", (unsigned)ix);
1858         }
1859         ST(0) = ret;
1860         XSRETURN(1);
1861
1862 void
1863 FILEGV(gv)
1864         B::GV   gv
1865     PPCODE:
1866         PUSHs(make_sv_object(aTHX_ (SV *)GvFILEGV(gv)));
1867
1868 MODULE = B      PACKAGE = B::IO         PREFIX = Io
1869
1870 #if PERL_VERSION <= 8
1871
1872 short
1873 IoSUBPROCESS(io)
1874         B::IO   io
1875
1876 #endif
1877
1878 bool
1879 IsSTD(io,name)
1880         B::IO   io
1881         const char*     name
1882     PREINIT:
1883         PerlIO* handle = 0;
1884     CODE:
1885         if( strEQ( name, "stdin" ) ) {
1886             handle = PerlIO_stdin();
1887         }
1888         else if( strEQ( name, "stdout" ) ) {
1889             handle = PerlIO_stdout();
1890         }
1891         else if( strEQ( name, "stderr" ) ) {
1892             handle = PerlIO_stderr();
1893         }
1894         else {
1895             croak( "Invalid value '%s'", name );
1896         }
1897         RETVAL = handle == IoIFP(io);
1898     OUTPUT:
1899         RETVAL
1900
1901 MODULE = B      PACKAGE = B::AV         PREFIX = Av
1902
1903 SSize_t
1904 AvFILL(av)
1905         B::AV   av
1906
1907 void
1908 AvARRAY(av)
1909         B::AV   av
1910     PPCODE:
1911         if (AvFILL(av) >= 0) {
1912             SV **svp = AvARRAY(av);
1913             I32 i;
1914             for (i = 0; i <= AvFILL(av); i++)
1915                 XPUSHs(make_sv_object(aTHX_ svp[i]));
1916         }
1917
1918 void
1919 AvARRAYelt(av, idx)
1920         B::AV   av
1921         int     idx
1922     PPCODE:
1923         if (idx >= 0 && AvFILL(av) >= 0 && idx <= AvFILL(av))
1924             XPUSHs(make_sv_object(aTHX_ (AvARRAY(av)[idx])));
1925         else
1926             XPUSHs(make_sv_object(aTHX_ NULL));
1927
1928 #if PERL_VERSION < 9
1929                                    
1930 #define AvOFF(av) ((XPVAV*)SvANY(av))->xof_off
1931
1932 IV
1933 AvOFF(av)
1934         B::AV   av
1935
1936 MODULE = B      PACKAGE = B::AV
1937
1938 U8
1939 AvFLAGS(av)
1940         B::AV   av
1941
1942 #endif
1943
1944 MODULE = B      PACKAGE = B::CV         PREFIX = Cv
1945
1946 U32
1947 CvCONST(cv)
1948         B::CV   cv
1949
1950 void
1951 CvSTART(cv)
1952         B::CV   cv
1953     ALIAS:
1954         ROOT = 1
1955     PPCODE:
1956         PUSHs(make_op_object(aTHX_ CvISXSUB(cv) ? NULL
1957                              : ix ? CvROOT(cv) : CvSTART(cv)));
1958
1959 void
1960 CvXSUB(cv)
1961         B::CV   cv
1962     ALIAS:
1963         XSUBANY = 1
1964     CODE:
1965         ST(0) = ix && CvCONST(cv)
1966             ? make_sv_object(aTHX_ (SV *)CvXSUBANY(cv).any_ptr)
1967             : sv_2mortal(newSViv(CvISXSUB(cv)
1968                                  ? (ix ? CvXSUBANY(cv).any_iv
1969                                        : PTR2IV(CvXSUB(cv)))
1970                                  : 0));
1971
1972 void
1973 const_sv(cv)
1974         B::CV   cv
1975     PPCODE:
1976         PUSHs(make_sv_object(aTHX_ (SV *)cv_const_sv(cv)));
1977
1978 MODULE = B      PACKAGE = B::HV         PREFIX = Hv
1979
1980 STRLEN
1981 HvFILL(hv)
1982         B::HV   hv
1983
1984 I32
1985 HvRITER(hv)
1986         B::HV   hv
1987
1988 #if PERL_VERSION < 9
1989
1990 B::PMOP
1991 HvPMROOT(hv)
1992         B::HV   hv
1993     PPCODE:
1994         PUSHs(make_op_object(aTHX_ HvPMROOT(hv)));
1995
1996 #endif
1997
1998 void
1999 HvARRAY(hv)
2000         B::HV   hv
2001     PPCODE:
2002         if (HvUSEDKEYS(hv) > 0) {
2003             SV *sv;
2004             char *key;
2005             I32 len;
2006             (void)hv_iterinit(hv);
2007             EXTEND(sp, HvUSEDKEYS(hv) * 2);
2008             while ((sv = hv_iternextsv(hv, &key, &len))) {
2009                 mPUSHp(key, len);
2010                 PUSHs(make_sv_object(aTHX_ sv));
2011             }
2012         }
2013
2014 MODULE = B      PACKAGE = B::HE         PREFIX = He
2015
2016 void
2017 HeVAL(he)
2018         B::HE he
2019     ALIAS:
2020         SVKEY_force = 1
2021     PPCODE:
2022         PUSHs(make_sv_object(aTHX_ ix ? HeSVKEY_force(he) : HeVAL(he)));
2023
2024 U32
2025 HeHASH(he)
2026         B::HE he
2027
2028 MODULE = B      PACKAGE = B::RHE
2029
2030 #if PERL_VERSION >= 9
2031
2032 SV*
2033 HASH(h)
2034         B::RHE h
2035     CODE:
2036         RETVAL = newRV( (SV*)cophh_2hv(h, 0) );
2037     OUTPUT:
2038         RETVAL
2039
2040 #endif