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