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