This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Eliminate SVt_RV, and use SVt_IV to store plain references.
[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::ORANGE",
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 static SV *
239 make_sv_object(pTHX_ SV *arg, SV *sv)
240 {
241     const char *type = 0;
242     IV iv;
243     dMY_CXT;
244     
245     for (iv = 0; iv < sizeof(specialsv_list)/sizeof(SV*); iv++) {
246         if (sv == specialsv_list[iv]) {
247             type = "B::SPECIAL";
248             break;
249         }
250     }
251     if (!type) {
252         type = svclassnames[SvTYPE(sv)];
253         iv = PTR2IV(sv);
254     }
255     sv_setiv(newSVrv(arg, type), iv);
256     return arg;
257 }
258
259 #if PERL_VERSION >= 9
260 static SV *
261 make_temp_object(pTHX_ SV *arg, SV *temp)
262 {
263     SV *target;
264     const char *const type = svclassnames[SvTYPE(temp)];
265     const IV iv = PTR2IV(temp);
266
267     target = newSVrv(arg, type);
268     sv_setiv(target, iv);
269
270     /* Need to keep our "temp" around as long as the target exists.
271        Simplest way seems to be to hang it from magic, and let that clear
272        it up.  No vtable, so won't actually get in the way of anything.  */
273     sv_magicext(target, temp, PERL_MAGIC_sv, NULL, NULL, 0);
274     /* magic object has had its reference count increased, so we must drop
275        our reference.  */
276     SvREFCNT_dec(temp);
277     return arg;
278 }
279
280 static SV *
281 make_warnings_object(pTHX_ SV *arg, STRLEN *warnings)
282 {
283     const char *type = 0;
284     dMY_CXT;
285     IV iv = sizeof(specialsv_list)/sizeof(SV*);
286
287     /* Counting down is deliberate. Before the split between make_sv_object
288        and make_warnings_obj there appeared to be a bug - Nullsv and pWARN_STD
289        were both 0, so you could never get a B::SPECIAL for pWARN_STD  */
290
291     while (iv--) {
292         if ((SV*)warnings == specialsv_list[iv]) {
293             type = "B::SPECIAL";
294             break;
295         }
296     }
297     if (type) {
298         sv_setiv(newSVrv(arg, type), iv);
299         return arg;
300     } else {
301         /* B assumes that warnings are a regular SV. Seems easier to keep it
302            happy by making them into a regular SV.  */
303         return make_temp_object(aTHX_ arg,
304                                 newSVpvn((char *)(warnings + 1), *warnings));
305     }
306 }
307
308 static SV *
309 make_cop_io_object(pTHX_ SV *arg, COP *cop)
310 {
311     SV *const value = newSV(0);
312
313     Perl_emulate_cop_io(aTHX_ cop, value);
314
315     if(SvOK(value)) {
316         return make_temp_object(aTHX_ arg, newSVsv(value));
317     } else {
318         SvREFCNT_dec(value);
319         return make_sv_object(aTHX_ arg, NULL);
320     }
321 }
322 #endif
323
324 static SV *
325 make_mg_object(pTHX_ SV *arg, MAGIC *mg)
326 {
327     sv_setiv(newSVrv(arg, "B::MAGIC"), PTR2IV(mg));
328     return arg;
329 }
330
331 static SV *
332 cstring(pTHX_ SV *sv, bool perlstyle)
333 {
334     SV *sstr = newSVpvn("", 0);
335
336     if (!SvOK(sv))
337         sv_setpvn(sstr, "0", 1);
338     else if (perlstyle && SvUTF8(sv)) {
339         SV *tmpsv = sv_newmortal(); /* Temporary SV to feed sv_uni_display */
340         const STRLEN len = SvCUR(sv);
341         const char *s = sv_uni_display(tmpsv, sv, 8*len, UNI_DISPLAY_QQ);
342         sv_setpvn(sstr,"\"",1);
343         while (*s)
344         {
345             if (*s == '"')
346                 sv_catpvn(sstr, "\\\"", 2);
347             else if (*s == '$')
348                 sv_catpvn(sstr, "\\$", 2);
349             else if (*s == '@')
350                 sv_catpvn(sstr, "\\@", 2);
351             else if (*s == '\\')
352             {
353                 if (strchr("nrftax\\",*(s+1)))
354                     sv_catpvn(sstr, s++, 2);
355                 else
356                     sv_catpvn(sstr, "\\\\", 2);
357             }
358             else /* should always be printable */
359                 sv_catpvn(sstr, s, 1);
360             ++s;
361         }
362         sv_catpv(sstr, "\"");
363         return sstr;
364     }
365     else
366     {
367         /* XXX Optimise? */
368         STRLEN len;
369         const char *s = SvPV(sv, len);
370         sv_catpv(sstr, "\"");
371         for (; len; len--, s++)
372         {
373             /* At least try a little for readability */
374             if (*s == '"')
375                 sv_catpv(sstr, "\\\"");
376             else if (*s == '\\')
377                 sv_catpv(sstr, "\\\\");
378             /* trigraphs - bleagh */
379             else if (!perlstyle && *s == '?' && len>=3 && s[1] == '?') {
380                 char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
381                 sprintf(escbuff, "\\%03o", '?');
382                 sv_catpv(sstr, escbuff);
383             }
384             else if (perlstyle && *s == '$')
385                 sv_catpv(sstr, "\\$");
386             else if (perlstyle && *s == '@')
387                 sv_catpv(sstr, "\\@");
388 #ifdef EBCDIC
389             else if (isPRINT(*s))
390 #else
391             else if (*s >= ' ' && *s < 127)
392 #endif /* EBCDIC */
393                 sv_catpvn(sstr, s, 1);
394             else if (*s == '\n')
395                 sv_catpv(sstr, "\\n");
396             else if (*s == '\r')
397                 sv_catpv(sstr, "\\r");
398             else if (*s == '\t')
399                 sv_catpv(sstr, "\\t");
400             else if (*s == '\a')
401                 sv_catpv(sstr, "\\a");
402             else if (*s == '\b')
403                 sv_catpv(sstr, "\\b");
404             else if (*s == '\f')
405                 sv_catpv(sstr, "\\f");
406             else if (!perlstyle && *s == '\v')
407                 sv_catpv(sstr, "\\v");
408             else
409             {
410                 /* Don't want promotion of a signed -1 char in sprintf args */
411                 char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
412                 const unsigned char c = (unsigned char) *s;
413                 sprintf(escbuff, "\\%03o", c);
414                 sv_catpv(sstr, escbuff);
415             }
416             /* XXX Add line breaks if string is long */
417         }
418         sv_catpv(sstr, "\"");
419     }
420     return sstr;
421 }
422
423 static SV *
424 cchar(pTHX_ SV *sv)
425 {
426     SV *sstr = newSVpvn("'", 1);
427     const char *s = SvPV_nolen(sv);
428
429     if (*s == '\'')
430         sv_catpvn(sstr, "\\'", 2);
431     else if (*s == '\\')
432         sv_catpvn(sstr, "\\\\", 2);
433 #ifdef EBCDIC
434     else if (isPRINT(*s))
435 #else
436     else if (*s >= ' ' && *s < 127)
437 #endif /* EBCDIC */
438         sv_catpvn(sstr, s, 1);
439     else if (*s == '\n')
440         sv_catpvn(sstr, "\\n", 2);
441     else if (*s == '\r')
442         sv_catpvn(sstr, "\\r", 2);
443     else if (*s == '\t')
444         sv_catpvn(sstr, "\\t", 2);
445     else if (*s == '\a')
446         sv_catpvn(sstr, "\\a", 2);
447     else if (*s == '\b')
448         sv_catpvn(sstr, "\\b", 2);
449     else if (*s == '\f')
450         sv_catpvn(sstr, "\\f", 2);
451     else if (*s == '\v')
452         sv_catpvn(sstr, "\\v", 2);
453     else
454     {
455         /* no trigraph support */
456         char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
457         /* Don't want promotion of a signed -1 char in sprintf args */
458         unsigned char c = (unsigned char) *s;
459         sprintf(escbuff, "\\%03o", c);
460         sv_catpv(sstr, escbuff);
461     }
462     sv_catpvn(sstr, "'", 1);
463     return sstr;
464 }
465
466 static void
467 walkoptree(pTHX_ SV *opsv, const char *method)
468 {
469     dSP;
470     OP *o, *kid;
471     dMY_CXT;
472
473     if (!SvROK(opsv))
474         croak("opsv is not a reference");
475     opsv = sv_mortalcopy(opsv);
476     o = INT2PTR(OP*,SvIV((SV*)SvRV(opsv)));
477     if (walkoptree_debug) {
478         PUSHMARK(sp);
479         XPUSHs(opsv);
480         PUTBACK;
481         perl_call_method("walkoptree_debug", G_DISCARD);
482     }
483     PUSHMARK(sp);
484     XPUSHs(opsv);
485     PUTBACK;
486     perl_call_method(method, G_DISCARD);
487     if (o && (o->op_flags & OPf_KIDS)) {
488         for (kid = ((UNOP*)o)->op_first; kid; kid = kid->op_sibling) {
489             /* Use the same opsv. Rely on methods not to mess it up. */
490             sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), PTR2IV(kid));
491             walkoptree(aTHX_ opsv, method);
492         }
493     }
494     if (o && (cc_opclass(aTHX_ o) == OPc_PMOP) && o->op_type != OP_PUSHRE
495 #if PERL_VERSION >= 9
496             && (kid = cPMOPo->op_pmreplrootu.op_pmreplroot)
497 #else
498             && (kid = cPMOPo->op_pmreplroot)
499 #endif
500         )
501     {
502         sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), PTR2IV(kid));
503         walkoptree(aTHX_ opsv, method);
504     }
505 }
506
507 static SV **
508 oplist(pTHX_ OP *o, SV **SP)
509 {
510     for(; o; o = o->op_next) {
511         SV *opsv;
512 #if PERL_VERSION >= 9
513         if (o->op_opt == 0)
514             break;
515         o->op_opt = 0;
516 #else
517         if (o->op_seq == 0)
518             break;
519         o->op_seq = 0;
520 #endif
521         opsv = sv_newmortal();
522         sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ (OP*)o)), PTR2IV(o));
523         XPUSHs(opsv);
524         switch (o->op_type) {
525         case OP_SUBST:
526 #if PERL_VERSION >= 9
527             SP = oplist(aTHX_ cPMOPo->op_pmstashstartu.op_pmreplstart, SP);
528 #else
529             SP = oplist(aTHX_ cPMOPo->op_pmreplstart, SP);
530 #endif
531             continue;
532         case OP_SORT:
533             if (o->op_flags & OPf_STACKED && o->op_flags & OPf_SPECIAL) {
534                 OP *kid = cLISTOPo->op_first->op_sibling;   /* pass pushmark */
535                 kid = kUNOP->op_first;                      /* pass rv2gv */
536                 kid = kUNOP->op_first;                      /* pass leave */
537                 SP = oplist(aTHX_ kid->op_next, SP);
538             }
539             continue;
540         }
541         switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
542         case OA_LOGOP:
543             SP = oplist(aTHX_ cLOGOPo->op_other, SP);
544             break;
545         case OA_LOOP:
546             SP = oplist(aTHX_ cLOOPo->op_lastop, SP);
547             SP = oplist(aTHX_ cLOOPo->op_nextop, SP);
548             SP = oplist(aTHX_ cLOOPo->op_redoop, SP);
549             break;
550         }
551     }
552     return SP;
553 }
554
555 typedef OP      *B__OP;
556 typedef UNOP    *B__UNOP;
557 typedef BINOP   *B__BINOP;
558 typedef LOGOP   *B__LOGOP;
559 typedef LISTOP  *B__LISTOP;
560 typedef PMOP    *B__PMOP;
561 typedef SVOP    *B__SVOP;
562 typedef PADOP   *B__PADOP;
563 typedef PVOP    *B__PVOP;
564 typedef LOOP    *B__LOOP;
565 typedef COP     *B__COP;
566
567 typedef SV      *B__SV;
568 typedef SV      *B__IV;
569 typedef SV      *B__PV;
570 typedef SV      *B__NV;
571 typedef SV      *B__PVMG;
572 typedef SV      *B__PVLV;
573 typedef SV      *B__BM;
574 typedef SV      *B__RV;
575 typedef SV      *B__FM;
576 typedef AV      *B__AV;
577 typedef HV      *B__HV;
578 typedef CV      *B__CV;
579 typedef GV      *B__GV;
580 typedef IO      *B__IO;
581
582 typedef MAGIC   *B__MAGIC;
583 typedef HE      *B__HE;
584 #if PERL_VERSION >= 9
585 typedef struct refcounted_he    *B__RHE;
586 #endif
587
588 MODULE = B      PACKAGE = B     PREFIX = B_
589
590 PROTOTYPES: DISABLE
591
592 BOOT:
593 {
594     HV *stash = gv_stashpvn("B", 1, GV_ADD);
595     AV *export_ok = perl_get_av("B::EXPORT_OK",TRUE);
596     MY_CXT_INIT;
597     specialsv_list[0] = Nullsv;
598     specialsv_list[1] = &PL_sv_undef;
599     specialsv_list[2] = &PL_sv_yes;
600     specialsv_list[3] = &PL_sv_no;
601     specialsv_list[4] = (SV *) pWARN_ALL;
602     specialsv_list[5] = (SV *) pWARN_NONE;
603     specialsv_list[6] = (SV *) pWARN_STD;
604 #if PERL_VERSION <= 8
605 #  define OPpPAD_STATE 0
606 #endif
607 #include "defsubs.h"
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_ sv_newmortal(), PL_warnhook);
709
710 void
711 B_diehook()
712     CODE:
713         ST(0) = make_sv_object(aTHX_ sv_newmortal(), 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_setpvn(ST(0), "pp_", 3);
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         char hexhash[19]; /* must fit "0xffffffffffffffff" plus trailing \0 */
788         const char *s = SvPV(sv, len);
789         PERL_HASH(hash, s, len);
790         sprintf(hexhash, "0x%"UVxf, (UV)hash);
791         ST(0) = sv_2mortal(newSVpv(hexhash, 0));
792
793 #define cast_I32(foo) (I32)foo
794 IV
795 cast_I32(i)
796         IV      i
797
798 void
799 minus_c()
800     CODE:
801         PL_minus_c = TRUE;
802
803 void
804 save_BEGINs()
805     CODE:
806         PL_savebegin = TRUE;
807
808 SV *
809 cstring(sv)
810         SV *    sv
811     CODE:
812         RETVAL = cstring(aTHX_ sv, 0);
813     OUTPUT:
814         RETVAL
815
816 SV *
817 perlstring(sv)
818         SV *    sv
819     CODE:
820         RETVAL = cstring(aTHX_ sv, 1);
821     OUTPUT:
822         RETVAL
823
824 SV *
825 cchar(sv)
826         SV *    sv
827     CODE:
828         RETVAL = cchar(aTHX_ sv);
829     OUTPUT:
830         RETVAL
831
832 void
833 threadsv_names()
834     PPCODE:
835 #if PERL_VERSION <= 8
836 # ifdef USE_5005THREADS
837         int i;
838         const STRLEN len = strlen(PL_threadsv_names);
839
840         EXTEND(sp, len);
841         for (i = 0; i < len; i++)
842             PUSHs(sv_2mortal(newSVpvn(&PL_threadsv_names[i], 1)));
843 # endif
844 #endif
845
846 #define OP_next(o)      o->op_next
847 #define OP_sibling(o)   o->op_sibling
848 #define OP_desc(o)      (char *)PL_op_desc[o->op_type]
849 #define OP_targ(o)      o->op_targ
850 #define OP_type(o)      o->op_type
851 #if PERL_VERSION >= 9
852 #  define OP_opt(o)     o->op_opt
853 #else
854 #  define OP_seq(o)     o->op_seq
855 #endif
856 #define OP_flags(o)     o->op_flags
857 #define OP_private(o)   o->op_private
858 #define OP_spare(o)     o->op_spare
859
860 MODULE = B      PACKAGE = B::OP         PREFIX = OP_
861
862 size_t
863 OP_size(o)
864         B::OP           o
865     CODE:
866         RETVAL = opsizes[cc_opclass(aTHX_ o)];
867     OUTPUT:
868         RETVAL
869
870 B::OP
871 OP_next(o)
872         B::OP           o
873
874 B::OP
875 OP_sibling(o)
876         B::OP           o
877
878 char *
879 OP_name(o)
880         B::OP           o
881     CODE:
882         RETVAL = (char *)PL_op_name[o->op_type];
883     OUTPUT:
884         RETVAL
885
886
887 void
888 OP_ppaddr(o)
889         B::OP           o
890     PREINIT:
891         int i;
892         SV *sv = sv_newmortal();
893     CODE:
894         sv_setpvn(sv, "PL_ppaddr[OP_", 13);
895         sv_catpv(sv, PL_op_name[o->op_type]);
896         for (i=13; (STRLEN)i < SvCUR(sv); ++i)
897             SvPVX(sv)[i] = toUPPER(SvPVX(sv)[i]);
898         sv_catpv(sv, "]");
899         ST(0) = sv;
900
901 char *
902 OP_desc(o)
903         B::OP           o
904
905 PADOFFSET
906 OP_targ(o)
907         B::OP           o
908
909 U16
910 OP_type(o)
911         B::OP           o
912
913 #if PERL_VERSION >= 9
914
915 U8
916 OP_opt(o)
917         B::OP           o
918
919 #else
920
921 U16
922 OP_seq(o)
923         B::OP           o
924
925 #endif
926
927 U8
928 OP_flags(o)
929         B::OP           o
930
931 U8
932 OP_private(o)
933         B::OP           o
934
935 #if PERL_VERSION >= 9
936
937 U8
938 OP_spare(o)
939         B::OP           o
940
941 #endif
942
943 void
944 OP_oplist(o)
945         B::OP           o
946     PPCODE:
947         SP = oplist(aTHX_ o, SP);
948
949 #define UNOP_first(o)   o->op_first
950
951 MODULE = B      PACKAGE = B::UNOP               PREFIX = UNOP_
952
953 B::OP 
954 UNOP_first(o)
955         B::UNOP o
956
957 #define BINOP_last(o)   o->op_last
958
959 MODULE = B      PACKAGE = B::BINOP              PREFIX = BINOP_
960
961 B::OP
962 BINOP_last(o)
963         B::BINOP        o
964
965 #define LOGOP_other(o)  o->op_other
966
967 MODULE = B      PACKAGE = B::LOGOP              PREFIX = LOGOP_
968
969 B::OP
970 LOGOP_other(o)
971         B::LOGOP        o
972
973 MODULE = B      PACKAGE = B::LISTOP             PREFIX = LISTOP_
974
975 U32
976 LISTOP_children(o)
977         B::LISTOP       o
978         OP *            kid = NO_INIT
979         int             i = NO_INIT
980     CODE:
981         i = 0;
982         for (kid = o->op_first; kid; kid = kid->op_sibling)
983             i++;
984         RETVAL = i;
985     OUTPUT:
986         RETVAL
987
988 #if PERL_VERSION >= 9
989 #  define PMOP_pmreplstart(o)   o->op_pmstashstartu.op_pmreplstart
990 #else
991 #  define PMOP_pmreplstart(o)   o->op_pmreplstart
992 #  define PMOP_pmpermflags(o)   o->op_pmpermflags
993 #  define PMOP_pmdynflags(o)      o->op_pmdynflags
994 #endif
995 #define PMOP_pmnext(o)          o->op_pmnext
996 #define PMOP_pmregexp(o)        PM_GETRE(o)
997 #ifdef USE_ITHREADS
998 #define PMOP_pmoffset(o)        o->op_pmoffset
999 #define PMOP_pmstashpv(o)       PmopSTASHPV(o);
1000 #else
1001 #define PMOP_pmstash(o)         PmopSTASH(o);
1002 #endif
1003 #define PMOP_pmflags(o)         o->op_pmflags
1004
1005 MODULE = B      PACKAGE = B::PMOP               PREFIX = PMOP_
1006
1007 #if PERL_VERSION <= 8
1008
1009 void
1010 PMOP_pmreplroot(o)
1011         B::PMOP         o
1012         OP *            root = NO_INIT
1013     CODE:
1014         ST(0) = sv_newmortal();
1015         root = o->op_pmreplroot;
1016         /* OP_PUSHRE stores an SV* instead of an OP* in op_pmreplroot */
1017         if (o->op_type == OP_PUSHRE) {
1018 #  ifdef USE_ITHREADS
1019             sv_setiv(ST(0), INT2PTR(PADOFFSET,root) );
1020 #  else
1021             sv_setiv(newSVrv(ST(0), root ?
1022                              svclassnames[SvTYPE((SV*)root)] : "B::SV"),
1023                      PTR2IV(root));
1024 #  endif
1025         }
1026         else {
1027             sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), PTR2IV(root));
1028         }
1029
1030 #else
1031
1032 void
1033 PMOP_pmreplroot(o)
1034         B::PMOP         o
1035     CODE:
1036         ST(0) = sv_newmortal();
1037         if (o->op_type == OP_PUSHRE) {
1038 #  ifdef USE_ITHREADS
1039             sv_setiv(ST(0), o->op_pmreplrootu.op_pmtargetoff);
1040 #  else
1041             GV *const target = o->op_pmreplrootu.op_pmtargetgv;
1042             sv_setiv(newSVrv(ST(0), target ?
1043                              svclassnames[SvTYPE((SV*)target)] : "B::SV"),
1044                      PTR2IV(target));
1045 #  endif
1046         }
1047         else {
1048             OP *const root = o->op_pmreplrootu.op_pmreplroot; 
1049             sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)),
1050                      PTR2IV(root));
1051         }
1052
1053 #endif
1054
1055 B::OP
1056 PMOP_pmreplstart(o)
1057         B::PMOP         o
1058
1059 #if PERL_VERSION < 9
1060
1061 B::PMOP
1062 PMOP_pmnext(o)
1063         B::PMOP         o
1064
1065 #endif
1066
1067 #ifdef USE_ITHREADS
1068
1069 IV
1070 PMOP_pmoffset(o)
1071         B::PMOP         o
1072
1073 char*
1074 PMOP_pmstashpv(o)
1075         B::PMOP         o
1076
1077 #else
1078
1079 B::HV
1080 PMOP_pmstash(o)
1081         B::PMOP         o
1082
1083 #endif
1084
1085 U32
1086 PMOP_pmflags(o)
1087         B::PMOP         o
1088
1089 #if PERL_VERSION < 9
1090
1091 U32
1092 PMOP_pmpermflags(o)
1093         B::PMOP         o
1094
1095 U8
1096 PMOP_pmdynflags(o)
1097         B::PMOP         o
1098
1099 #endif
1100
1101 void
1102 PMOP_precomp(o)
1103         B::PMOP         o
1104         REGEXP *        rx = NO_INIT
1105     CODE:
1106         ST(0) = sv_newmortal();
1107         rx = PM_GETRE(o);
1108         if (rx)
1109             sv_setpvn(ST(0), rx->precomp, rx->prelen);
1110
1111 #if PERL_VERSION >= 9
1112
1113 void
1114 PMOP_reflags(o)
1115         B::PMOP         o
1116         REGEXP *        rx = NO_INIT
1117     CODE:
1118         ST(0) = sv_newmortal();
1119         rx = PM_GETRE(o);
1120         if (rx)
1121             sv_setuv(ST(0), rx->extflags);
1122
1123 #endif
1124
1125 #define SVOP_sv(o)     cSVOPo->op_sv
1126 #define SVOP_gv(o)     ((GV*)cSVOPo->op_sv)
1127
1128 MODULE = B      PACKAGE = B::SVOP               PREFIX = SVOP_
1129
1130 B::SV
1131 SVOP_sv(o)
1132         B::SVOP o
1133
1134 B::GV
1135 SVOP_gv(o)
1136         B::SVOP o
1137
1138 #define PADOP_padix(o)  o->op_padix
1139 #define PADOP_sv(o)     (o->op_padix ? PAD_SVl(o->op_padix) : Nullsv)
1140 #define PADOP_gv(o)     ((o->op_padix \
1141                           && SvTYPE(PAD_SVl(o->op_padix)) == SVt_PVGV) \
1142                          ? (GV*)PAD_SVl(o->op_padix) : Nullgv)
1143
1144 MODULE = B      PACKAGE = B::PADOP              PREFIX = PADOP_
1145
1146 PADOFFSET
1147 PADOP_padix(o)
1148         B::PADOP o
1149
1150 B::SV
1151 PADOP_sv(o)
1152         B::PADOP o
1153
1154 B::GV
1155 PADOP_gv(o)
1156         B::PADOP o
1157
1158 MODULE = B      PACKAGE = B::PVOP               PREFIX = PVOP_
1159
1160 void
1161 PVOP_pv(o)
1162         B::PVOP o
1163     CODE:
1164         /*
1165          * OP_TRANS uses op_pv to point to a table of 256 or >=258 shorts
1166          * whereas other PVOPs point to a null terminated string.
1167          */
1168         if (o->op_type == OP_TRANS &&
1169                 (o->op_private & OPpTRANS_COMPLEMENT) &&
1170                 !(o->op_private & OPpTRANS_DELETE))
1171         {
1172             const short* const tbl = (short*)o->op_pv;
1173             const short entries = 257 + tbl[256];
1174             ST(0) = sv_2mortal(newSVpv(o->op_pv, entries * sizeof(short)));
1175         }
1176         else if (o->op_type == OP_TRANS) {
1177             ST(0) = sv_2mortal(newSVpv(o->op_pv, 256 * sizeof(short)));
1178         }
1179         else
1180             ST(0) = sv_2mortal(newSVpv(o->op_pv, 0));
1181
1182 #define LOOP_redoop(o)  o->op_redoop
1183 #define LOOP_nextop(o)  o->op_nextop
1184 #define LOOP_lastop(o)  o->op_lastop
1185
1186 MODULE = B      PACKAGE = B::LOOP               PREFIX = LOOP_
1187
1188
1189 B::OP
1190 LOOP_redoop(o)
1191         B::LOOP o
1192
1193 B::OP
1194 LOOP_nextop(o)
1195         B::LOOP o
1196
1197 B::OP
1198 LOOP_lastop(o)
1199         B::LOOP o
1200
1201 #define COP_label(o)    o->cop_label
1202 #define COP_stashpv(o)  CopSTASHPV(o)
1203 #define COP_stash(o)    CopSTASH(o)
1204 #define COP_file(o)     CopFILE(o)
1205 #define COP_filegv(o)   CopFILEGV(o)
1206 #define COP_cop_seq(o)  o->cop_seq
1207 #define COP_arybase(o)  CopARYBASE_get(o)
1208 #define COP_line(o)     CopLINE(o)
1209 #define COP_hints(o)    CopHINTS_get(o)
1210 #if PERL_VERSION < 9
1211 #  define COP_warnings(o)  o->cop_warnings
1212 #  define COP_io(o)     o->cop_io
1213 #endif
1214
1215 MODULE = B      PACKAGE = B::COP                PREFIX = COP_
1216
1217 char *
1218 COP_label(o)
1219         B::COP  o
1220
1221 char *
1222 COP_stashpv(o)
1223         B::COP  o
1224
1225 B::HV
1226 COP_stash(o)
1227         B::COP  o
1228
1229 char *
1230 COP_file(o)
1231         B::COP  o
1232
1233 B::GV
1234 COP_filegv(o)
1235        B::COP  o
1236
1237
1238 U32
1239 COP_cop_seq(o)
1240         B::COP  o
1241
1242 I32
1243 COP_arybase(o)
1244         B::COP  o
1245
1246 U32
1247 COP_line(o)
1248         B::COP  o
1249
1250 #if PERL_VERSION >= 9
1251
1252 void
1253 COP_warnings(o)
1254         B::COP  o
1255         PPCODE:
1256         ST(0) = make_warnings_object(aTHX_ sv_newmortal(), o->cop_warnings);
1257         XSRETURN(1);
1258
1259 void
1260 COP_io(o)
1261         B::COP  o
1262         PPCODE:
1263         ST(0) = make_cop_io_object(aTHX_ sv_newmortal(), o);
1264         XSRETURN(1);
1265
1266 B::RHE
1267 COP_hints_hash(o)
1268         B::COP o
1269     CODE:
1270         RETVAL = o->cop_hints_hash;
1271     OUTPUT:
1272         RETVAL
1273
1274 #else
1275
1276 B::SV
1277 COP_warnings(o)
1278         B::COP  o
1279
1280 B::SV
1281 COP_io(o)
1282         B::COP  o
1283
1284 #endif
1285
1286 U32
1287 COP_hints(o)
1288         B::COP  o
1289
1290 MODULE = B      PACKAGE = B::SV
1291
1292 U32
1293 SvTYPE(sv)
1294         B::SV   sv
1295
1296 #define object_2svref(sv)       sv
1297 #define SVREF SV *
1298         
1299 SVREF
1300 object_2svref(sv)
1301         B::SV   sv
1302
1303 MODULE = B      PACKAGE = B::SV         PREFIX = Sv
1304
1305 U32
1306 SvREFCNT(sv)
1307         B::SV   sv
1308
1309 U32
1310 SvFLAGS(sv)
1311         B::SV   sv
1312
1313 U32
1314 SvPOK(sv)
1315         B::SV   sv
1316
1317 U32
1318 SvROK(sv)
1319         B::SV   sv
1320
1321 U32
1322 SvMAGICAL(sv)
1323         B::SV   sv
1324
1325 MODULE = B      PACKAGE = B::IV         PREFIX = Sv
1326
1327 IV
1328 SvIV(sv)
1329         B::IV   sv
1330
1331 IV
1332 SvIVX(sv)
1333         B::IV   sv
1334
1335 UV 
1336 SvUVX(sv) 
1337         B::IV   sv
1338                       
1339
1340 MODULE = B      PACKAGE = B::IV
1341
1342 #define needs64bits(sv) ((I32)SvIVX(sv) != SvIVX(sv))
1343
1344 int
1345 needs64bits(sv)
1346         B::IV   sv
1347
1348 void
1349 packiv(sv)
1350         B::IV   sv
1351     CODE:
1352         if (sizeof(IV) == 8) {
1353             U32 wp[2];
1354             const IV iv = SvIVX(sv);
1355             /*
1356              * The following way of spelling 32 is to stop compilers on
1357              * 32-bit architectures from moaning about the shift count
1358              * being >= the width of the type. Such architectures don't
1359              * reach this code anyway (unless sizeof(IV) > 8 but then
1360              * everything else breaks too so I'm not fussed at the moment).
1361              */
1362 #ifdef UV_IS_QUAD
1363             wp[0] = htonl(((UV)iv) >> (sizeof(UV)*4));
1364 #else
1365             wp[0] = htonl(((U32)iv) >> (sizeof(UV)*4));
1366 #endif
1367             wp[1] = htonl(iv & 0xffffffff);
1368             ST(0) = sv_2mortal(newSVpvn((char *)wp, 8));
1369         } else {
1370             U32 w = htonl((U32)SvIVX(sv));
1371             ST(0) = sv_2mortal(newSVpvn((char *)&w, 4));
1372         }
1373
1374
1375 #if PERL_VERSION >= 11
1376
1377 B::SV
1378 RV(sv)
1379         B::IV   sv
1380     CODE:
1381         if( SvROK(sv) ) {
1382             RETVAL = SvRV(sv);
1383         }
1384         else {
1385             croak( "argument is not SvROK" );
1386         }
1387     OUTPUT:
1388         RETVAL
1389
1390 #endif
1391
1392 MODULE = B      PACKAGE = B::NV         PREFIX = Sv
1393
1394 NV
1395 SvNV(sv)
1396         B::NV   sv
1397
1398 NV
1399 SvNVX(sv)
1400         B::NV   sv
1401
1402 U32
1403 COP_SEQ_RANGE_LOW(sv)
1404         B::NV   sv
1405
1406 U32
1407 COP_SEQ_RANGE_HIGH(sv)
1408         B::NV   sv
1409
1410 U32
1411 PARENT_PAD_INDEX(sv)
1412         B::NV   sv
1413
1414 U32
1415 PARENT_FAKELEX_FLAGS(sv)
1416         B::NV   sv
1417
1418 #if PERL_VERSION < 11
1419
1420 MODULE = B      PACKAGE = B::RV         PREFIX = Sv
1421
1422 B::SV
1423 SvRV(sv)
1424         B::RV   sv
1425
1426 #endif
1427
1428 MODULE = B      PACKAGE = B::PV         PREFIX = Sv
1429
1430 char*
1431 SvPVX(sv)
1432         B::PV   sv
1433
1434 B::SV
1435 SvRV(sv)
1436         B::PV   sv
1437     CODE:
1438         if( SvROK(sv) ) {
1439             RETVAL = SvRV(sv);
1440         }
1441         else {
1442             croak( "argument is not SvROK" );
1443         }
1444     OUTPUT:
1445         RETVAL
1446
1447 void
1448 SvPV(sv)
1449         B::PV   sv
1450     CODE:
1451         ST(0) = sv_newmortal();
1452         if( SvPOK(sv) ) {
1453             /* FIXME - we need a better way for B to identify PVs that are
1454                in the pads as variable names.  */
1455             if((SvLEN(sv) && SvCUR(sv) >= SvLEN(sv))) {
1456                 /* It claims to be longer than the space allocated for it -
1457                    presuambly it's a variable name in the pad  */
1458                 sv_setpv(ST(0), SvPV_nolen_const(sv));
1459             } else {
1460                 sv_setpvn(ST(0), SvPVX_const(sv), SvCUR(sv));
1461             }
1462             SvFLAGS(ST(0)) |= SvUTF8(sv);
1463         }
1464         else {
1465             /* XXX for backward compatibility, but should fail */
1466             /* croak( "argument is not SvPOK" ); */
1467             sv_setpvn(ST(0), NULL, 0);
1468         }
1469
1470 # This used to read 257. I think that that was buggy - should have been 258.
1471 # (The "\0", the flags byte, and 256 for the table.  Not that anything
1472 # anywhere calls this method.  NWC.
1473 void
1474 SvPVBM(sv)
1475         B::PV   sv
1476     CODE:
1477         ST(0) = sv_newmortal();
1478         sv_setpvn(ST(0), SvPVX_const(sv),
1479             SvCUR(sv) + (SvVALID(sv) ? 256 + PERL_FBM_TABLE_OFFSET : 0));
1480
1481
1482 STRLEN
1483 SvLEN(sv)
1484         B::PV   sv
1485
1486 STRLEN
1487 SvCUR(sv)
1488         B::PV   sv
1489
1490 MODULE = B      PACKAGE = B::PVMG       PREFIX = Sv
1491
1492 void
1493 SvMAGIC(sv)
1494         B::PVMG sv
1495         MAGIC * mg = NO_INIT
1496     PPCODE:
1497         for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
1498             XPUSHs(make_mg_object(aTHX_ sv_newmortal(), mg));
1499
1500 MODULE = B      PACKAGE = B::PVMG
1501
1502 B::HV
1503 SvSTASH(sv)
1504         B::PVMG sv
1505
1506 #define MgMOREMAGIC(mg) mg->mg_moremagic
1507 #define MgPRIVATE(mg) mg->mg_private
1508 #define MgTYPE(mg) mg->mg_type
1509 #define MgFLAGS(mg) mg->mg_flags
1510 #define MgOBJ(mg) mg->mg_obj
1511 #define MgLENGTH(mg) mg->mg_len
1512 #define MgREGEX(mg) PTR2IV(mg->mg_obj)
1513
1514 MODULE = B      PACKAGE = B::MAGIC      PREFIX = Mg     
1515
1516 B::MAGIC
1517 MgMOREMAGIC(mg)
1518         B::MAGIC        mg
1519      CODE:
1520         if( MgMOREMAGIC(mg) ) {
1521             RETVAL = MgMOREMAGIC(mg);
1522         }
1523         else {
1524             XSRETURN_UNDEF;
1525         }
1526      OUTPUT:
1527         RETVAL
1528
1529 U16
1530 MgPRIVATE(mg)
1531         B::MAGIC        mg
1532
1533 char
1534 MgTYPE(mg)
1535         B::MAGIC        mg
1536
1537 U8
1538 MgFLAGS(mg)
1539         B::MAGIC        mg
1540
1541 B::SV
1542 MgOBJ(mg)
1543         B::MAGIC        mg
1544
1545 IV
1546 MgREGEX(mg)
1547         B::MAGIC        mg
1548     CODE:
1549         if(mg->mg_type == PERL_MAGIC_qr) {
1550             RETVAL = MgREGEX(mg);
1551         }
1552         else {
1553             croak( "REGEX is only meaningful on r-magic" );
1554         }
1555     OUTPUT:
1556         RETVAL
1557
1558 SV*
1559 precomp(mg)
1560         B::MAGIC        mg
1561     CODE:
1562         if (mg->mg_type == PERL_MAGIC_qr) {
1563             REGEXP* rx = (REGEXP*)mg->mg_obj;
1564             RETVAL = Nullsv;
1565             if( rx )
1566                 RETVAL = newSVpvn( rx->precomp, rx->prelen );
1567         }
1568         else {
1569             croak( "precomp is only meaningful on r-magic" );
1570         }
1571     OUTPUT:
1572         RETVAL
1573
1574 I32 
1575 MgLENGTH(mg)
1576         B::MAGIC        mg
1577  
1578 void
1579 MgPTR(mg)
1580         B::MAGIC        mg
1581     CODE:
1582         ST(0) = sv_newmortal();
1583         if (mg->mg_ptr){
1584                 if (mg->mg_len >= 0){
1585                         sv_setpvn(ST(0), mg->mg_ptr, mg->mg_len);
1586                 } else if (mg->mg_len == HEf_SVKEY) {
1587                         ST(0) = make_sv_object(aTHX_
1588                                     sv_newmortal(), (SV*)mg->mg_ptr);
1589                 }
1590         }
1591
1592 MODULE = B      PACKAGE = B::PVLV       PREFIX = Lv
1593
1594 U32
1595 LvTARGOFF(sv)
1596         B::PVLV sv
1597
1598 U32
1599 LvTARGLEN(sv)
1600         B::PVLV sv
1601
1602 char
1603 LvTYPE(sv)
1604         B::PVLV sv
1605
1606 B::SV
1607 LvTARG(sv)
1608         B::PVLV sv
1609
1610 MODULE = B      PACKAGE = B::BM         PREFIX = Bm
1611
1612 I32
1613 BmUSEFUL(sv)
1614         B::BM   sv
1615
1616 U32
1617 BmPREVIOUS(sv)
1618         B::BM   sv
1619
1620 U8
1621 BmRARE(sv)
1622         B::BM   sv
1623
1624 void
1625 BmTABLE(sv)
1626         B::BM   sv
1627         STRLEN  len = NO_INIT
1628         char *  str = NO_INIT
1629     CODE:
1630         str = SvPV(sv, len);
1631         /* Boyer-Moore table is just after string and its safety-margin \0 */
1632         ST(0) = sv_2mortal(newSVpvn(str + len + PERL_FBM_TABLE_OFFSET, 256));
1633
1634 MODULE = B      PACKAGE = B::GV         PREFIX = Gv
1635
1636 void
1637 GvNAME(gv)
1638         B::GV   gv
1639     CODE:
1640         ST(0) = sv_2mortal(newSVpvn(GvNAME(gv), GvNAMELEN(gv)));
1641
1642 bool
1643 is_empty(gv)
1644         B::GV   gv
1645     CODE:
1646         RETVAL = GvGP(gv) == Null(GP*);
1647     OUTPUT:
1648         RETVAL
1649
1650 bool
1651 isGV_with_GP(gv)
1652         B::GV   gv
1653     CODE:
1654 #if PERL_VERSION >= 9
1655         RETVAL = isGV_with_GP(gv) ? TRUE : FALSE;
1656 #else
1657         RETVAL = TRUE; /* In 5.8 and earlier they all are.  */
1658 #endif
1659     OUTPUT:
1660         RETVAL
1661
1662 void*
1663 GvGP(gv)
1664         B::GV   gv
1665
1666 B::HV
1667 GvSTASH(gv)
1668         B::GV   gv
1669
1670 B::SV
1671 GvSV(gv)
1672         B::GV   gv
1673
1674 B::IO
1675 GvIO(gv)
1676         B::GV   gv
1677
1678 B::FM
1679 GvFORM(gv)
1680         B::GV   gv
1681     CODE:
1682         RETVAL = (SV*)GvFORM(gv);
1683     OUTPUT:
1684         RETVAL
1685
1686 B::AV
1687 GvAV(gv)
1688         B::GV   gv
1689
1690 B::HV
1691 GvHV(gv)
1692         B::GV   gv
1693
1694 B::GV
1695 GvEGV(gv)
1696         B::GV   gv
1697
1698 B::CV
1699 GvCV(gv)
1700         B::GV   gv
1701
1702 U32
1703 GvCVGEN(gv)
1704         B::GV   gv
1705
1706 U32
1707 GvLINE(gv)
1708         B::GV   gv
1709
1710 char *
1711 GvFILE(gv)
1712         B::GV   gv
1713
1714 B::GV
1715 GvFILEGV(gv)
1716         B::GV   gv
1717
1718 MODULE = B      PACKAGE = B::GV
1719
1720 U32
1721 GvREFCNT(gv)
1722         B::GV   gv
1723
1724 U8
1725 GvFLAGS(gv)
1726         B::GV   gv
1727
1728 MODULE = B      PACKAGE = B::IO         PREFIX = Io
1729
1730 long
1731 IoLINES(io)
1732         B::IO   io
1733
1734 long
1735 IoPAGE(io)
1736         B::IO   io
1737
1738 long
1739 IoPAGE_LEN(io)
1740         B::IO   io
1741
1742 long
1743 IoLINES_LEFT(io)
1744         B::IO   io
1745
1746 char *
1747 IoTOP_NAME(io)
1748         B::IO   io
1749
1750 B::GV
1751 IoTOP_GV(io)
1752         B::IO   io
1753
1754 char *
1755 IoFMT_NAME(io)
1756         B::IO   io
1757
1758 B::GV
1759 IoFMT_GV(io)
1760         B::IO   io
1761
1762 char *
1763 IoBOTTOM_NAME(io)
1764         B::IO   io
1765
1766 B::GV
1767 IoBOTTOM_GV(io)
1768         B::IO   io
1769
1770 #if PERL_VERSION <= 8
1771
1772 short
1773 IoSUBPROCESS(io)
1774         B::IO   io
1775
1776 #endif
1777
1778 bool
1779 IsSTD(io,name)
1780         B::IO   io
1781         const char*     name
1782     PREINIT:
1783         PerlIO* handle = 0;
1784     CODE:
1785         if( strEQ( name, "stdin" ) ) {
1786             handle = PerlIO_stdin();
1787         }
1788         else if( strEQ( name, "stdout" ) ) {
1789             handle = PerlIO_stdout();
1790         }
1791         else if( strEQ( name, "stderr" ) ) {
1792             handle = PerlIO_stderr();
1793         }
1794         else {
1795             croak( "Invalid value '%s'", name );
1796         }
1797         RETVAL = handle == IoIFP(io);
1798     OUTPUT:
1799         RETVAL
1800
1801 MODULE = B      PACKAGE = B::IO
1802
1803 char
1804 IoTYPE(io)
1805         B::IO   io
1806
1807 U8
1808 IoFLAGS(io)
1809         B::IO   io
1810
1811 MODULE = B      PACKAGE = B::AV         PREFIX = Av
1812
1813 SSize_t
1814 AvFILL(av)
1815         B::AV   av
1816
1817 SSize_t
1818 AvMAX(av)
1819         B::AV   av
1820
1821 #if PERL_VERSION < 9
1822                            
1823
1824 #define AvOFF(av) ((XPVAV*)SvANY(av))->xof_off
1825
1826 IV
1827 AvOFF(av)
1828         B::AV   av
1829
1830 #endif
1831
1832 void
1833 AvARRAY(av)
1834         B::AV   av
1835     PPCODE:
1836         if (AvFILL(av) >= 0) {
1837             SV **svp = AvARRAY(av);
1838             I32 i;
1839             for (i = 0; i <= AvFILL(av); i++)
1840                 XPUSHs(make_sv_object(aTHX_ sv_newmortal(), svp[i]));
1841         }
1842
1843 void
1844 AvARRAYelt(av, idx)
1845         B::AV   av
1846         int     idx
1847     PPCODE:
1848         if (idx >= 0 && AvFILL(av) >= 0 && idx <= AvFILL(av))
1849             XPUSHs(make_sv_object(aTHX_ sv_newmortal(), (AvARRAY(av)[idx])));
1850         else
1851             XPUSHs(make_sv_object(aTHX_ sv_newmortal(), NULL));
1852
1853 #if PERL_VERSION < 9
1854                                    
1855 MODULE = B      PACKAGE = B::AV
1856
1857 U8
1858 AvFLAGS(av)
1859         B::AV   av
1860
1861 #endif
1862
1863 MODULE = B      PACKAGE = B::FM         PREFIX = Fm
1864
1865 IV
1866 FmLINES(form)
1867         B::FM   form
1868
1869 MODULE = B      PACKAGE = B::CV         PREFIX = Cv
1870
1871 U32
1872 CvCONST(cv)
1873         B::CV   cv
1874
1875 B::HV
1876 CvSTASH(cv)
1877         B::CV   cv
1878
1879 B::OP
1880 CvSTART(cv)
1881         B::CV   cv
1882     CODE:
1883         RETVAL = CvISXSUB(cv) ? NULL : CvSTART(cv);
1884     OUTPUT:
1885         RETVAL
1886
1887 B::OP
1888 CvROOT(cv)
1889         B::CV   cv
1890     CODE:
1891         RETVAL = CvISXSUB(cv) ? NULL : CvROOT(cv);
1892     OUTPUT:
1893         RETVAL
1894
1895 B::GV
1896 CvGV(cv)
1897         B::CV   cv
1898
1899 char *
1900 CvFILE(cv)
1901         B::CV   cv
1902
1903 long
1904 CvDEPTH(cv)
1905         B::CV   cv
1906
1907 B::AV
1908 CvPADLIST(cv)
1909         B::CV   cv
1910
1911 B::CV
1912 CvOUTSIDE(cv)
1913         B::CV   cv
1914
1915 U32
1916 CvOUTSIDE_SEQ(cv)
1917         B::CV   cv
1918
1919 void
1920 CvXSUB(cv)
1921         B::CV   cv
1922     CODE:
1923         ST(0) = sv_2mortal(newSViv(CvISXSUB(cv) ? PTR2IV(CvXSUB(cv)) : 0));
1924
1925
1926 void
1927 CvXSUBANY(cv)
1928         B::CV   cv
1929     CODE:
1930         ST(0) = CvCONST(cv) ?
1931             make_sv_object(aTHX_ sv_newmortal(),(SV *)CvXSUBANY(cv).any_ptr) :
1932             sv_2mortal(newSViv(CvISXSUB(cv) ? CvXSUBANY(cv).any_iv : 0));
1933
1934 MODULE = B    PACKAGE = B::CV
1935
1936 U16
1937 CvFLAGS(cv)
1938       B::CV   cv
1939
1940 MODULE = B      PACKAGE = B::CV         PREFIX = cv_
1941
1942 B::SV
1943 cv_const_sv(cv)
1944         B::CV   cv
1945
1946
1947 MODULE = B      PACKAGE = B::HV         PREFIX = Hv
1948
1949 STRLEN
1950 HvFILL(hv)
1951         B::HV   hv
1952
1953 STRLEN
1954 HvMAX(hv)
1955         B::HV   hv
1956
1957 I32
1958 HvKEYS(hv)
1959         B::HV   hv
1960
1961 I32
1962 HvRITER(hv)
1963         B::HV   hv
1964
1965 char *
1966 HvNAME(hv)
1967         B::HV   hv
1968
1969 #if PERL_VERSION < 9
1970
1971 B::PMOP
1972 HvPMROOT(hv)
1973         B::HV   hv
1974
1975 #endif
1976
1977 void
1978 HvARRAY(hv)
1979         B::HV   hv
1980     PPCODE:
1981         if (HvKEYS(hv) > 0) {
1982             SV *sv;
1983             char *key;
1984             I32 len;
1985             (void)hv_iterinit(hv);
1986             EXTEND(sp, HvKEYS(hv) * 2);
1987             while ((sv = hv_iternextsv(hv, &key, &len))) {
1988                 PUSHs(newSVpvn(key, len));
1989                 PUSHs(make_sv_object(aTHX_ sv_newmortal(), sv));
1990             }
1991         }
1992
1993 MODULE = B      PACKAGE = B::HE         PREFIX = He
1994
1995 B::SV
1996 HeVAL(he)
1997         B::HE he
1998
1999 U32
2000 HeHASH(he)
2001         B::HE he
2002
2003 B::SV
2004 HeSVKEY_force(he)
2005         B::HE he
2006
2007 MODULE = B      PACKAGE = B::RHE        PREFIX = RHE_
2008
2009 #if PERL_VERSION >= 9
2010
2011 SV*
2012 RHE_HASH(h)
2013         B::RHE h
2014     CODE:
2015         RETVAL = newRV( (SV*)Perl_refcounted_he_chain_2hv(aTHX_ h) );
2016     OUTPUT:
2017         RETVAL
2018
2019 #endif