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