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