This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Merge op_pmreplstart and op_pmstash/op_pmstashpv into a union in
[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     "B::RV",
30     "B::PV",
31     "B::PVIV",
32     "B::PVNV",
33     "B::PVMG",
34 #if PERL_VERSION <= 8
35     "B::BM",
36 #endif
37 #if PERL_VERSION >= 9
38     "B::GV",
39 #endif
40     "B::PVLV",
41     "B::AV",
42     "B::HV",
43     "B::CV",
44 #if PERL_VERSION <= 8
45     "B::GV",
46 #endif
47     "B::FM",
48     "B::IO",
49 };
50
51 typedef enum {
52     OPc_NULL,   /* 0 */
53     OPc_BASEOP, /* 1 */
54     OPc_UNOP,   /* 2 */
55     OPc_BINOP,  /* 3 */
56     OPc_LOGOP,  /* 4 */
57     OPc_LISTOP, /* 5 */
58     OPc_PMOP,   /* 6 */
59     OPc_SVOP,   /* 7 */
60     OPc_PADOP,  /* 8 */
61     OPc_PVOP,   /* 9 */
62     OPc_LOOP,   /* 10 */
63     OPc_COP     /* 11 */
64 } opclass;
65
66 static const char* const opclassnames[] = {
67     "B::NULL",
68     "B::OP",
69     "B::UNOP",
70     "B::BINOP",
71     "B::LOGOP",
72     "B::LISTOP",
73     "B::PMOP",
74     "B::SVOP",
75     "B::PADOP",
76     "B::PVOP",
77     "B::LOOP",
78     "B::COP"    
79 };
80
81 static const size_t opsizes[] = {
82     0,  
83     sizeof(OP),
84     sizeof(UNOP),
85     sizeof(BINOP),
86     sizeof(LOGOP),
87     sizeof(LISTOP),
88     sizeof(PMOP),
89     sizeof(SVOP),
90     sizeof(PADOP),
91     sizeof(PVOP),
92     sizeof(LOOP),
93     sizeof(COP) 
94 };
95
96 #define MY_CXT_KEY "B::_guts" XS_VERSION
97
98 typedef struct {
99     int         x_walkoptree_debug;     /* Flag for walkoptree debug hook */
100     SV *        x_specialsv_list[7];
101 } my_cxt_t;
102
103 START_MY_CXT
104
105 #define walkoptree_debug        (MY_CXT.x_walkoptree_debug)
106 #define specialsv_list          (MY_CXT.x_specialsv_list)
107
108 static opclass
109 cc_opclass(pTHX_ const OP *o)
110 {
111     if (!o)
112         return OPc_NULL;
113
114     if (o->op_type == 0)
115         return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
116
117     if (o->op_type == OP_SASSIGN)
118         return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
119
120     if (o->op_type == OP_AELEMFAST) {
121         if (o->op_flags & OPf_SPECIAL)
122             return OPc_BASEOP;
123         else
124 #ifdef USE_ITHREADS
125             return OPc_PADOP;
126 #else
127             return OPc_SVOP;
128 #endif
129     }
130     
131 #ifdef USE_ITHREADS
132     if (o->op_type == OP_GV || o->op_type == OP_GVSV ||
133         o->op_type == OP_RCATLINE)
134         return OPc_PADOP;
135 #endif
136
137     switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
138     case OA_BASEOP:
139         return OPc_BASEOP;
140
141     case OA_UNOP:
142         return OPc_UNOP;
143
144     case OA_BINOP:
145         return OPc_BINOP;
146
147     case OA_LOGOP:
148         return OPc_LOGOP;
149
150     case OA_LISTOP:
151         return OPc_LISTOP;
152
153     case OA_PMOP:
154         return OPc_PMOP;
155
156     case OA_SVOP:
157         return OPc_SVOP;
158
159     case OA_PADOP:
160         return OPc_PADOP;
161
162     case OA_PVOP_OR_SVOP:
163         /*
164          * Character translations (tr///) are usually a PVOP, keeping a 
165          * pointer to a table of shorts used to look up translations.
166          * Under utf8, however, a simple table isn't practical; instead,
167          * the OP is an SVOP, and the SV is a reference to a swash
168          * (i.e., an RV pointing to an HV).
169          */
170         return (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
171                 ? OPc_SVOP : OPc_PVOP;
172
173     case OA_LOOP:
174         return OPc_LOOP;
175
176     case OA_COP:
177         return OPc_COP;
178
179     case OA_BASEOP_OR_UNOP:
180         /*
181          * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
182          * whether parens were seen. perly.y uses OPf_SPECIAL to
183          * signal whether a BASEOP had empty parens or none.
184          * Some other UNOPs are created later, though, so the best
185          * test is OPf_KIDS, which is set in newUNOP.
186          */
187         return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
188
189     case OA_FILESTATOP:
190         /*
191          * The file stat OPs are created via UNI(OP_foo) in toke.c but use
192          * the OPf_REF flag to distinguish between OP types instead of the
193          * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
194          * return OPc_UNOP so that walkoptree can find our children. If
195          * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
196          * (no argument to the operator) it's an OP; with OPf_REF set it's
197          * an SVOP (and op_sv is the GV for the filehandle argument).
198          */
199         return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
200 #ifdef USE_ITHREADS
201                 (o->op_flags & OPf_REF) ? OPc_PADOP : OPc_BASEOP);
202 #else
203                 (o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP);
204 #endif
205     case OA_LOOPEXOP:
206         /*
207          * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
208          * label was omitted (in which case it's a BASEOP) or else a term was
209          * seen. In this last case, all except goto are definitely PVOP but
210          * goto is either a PVOP (with an ordinary constant label), an UNOP
211          * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
212          * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
213          * get set.
214          */
215         if (o->op_flags & OPf_STACKED)
216             return OPc_UNOP;
217         else if (o->op_flags & OPf_SPECIAL)
218             return OPc_BASEOP;
219         else
220             return OPc_PVOP;
221     }
222     warn("can't determine class of operator %s, assuming BASEOP\n",
223          PL_op_name[o->op_type]);
224     return OPc_BASEOP;
225 }
226
227 static char *
228 cc_opclassname(pTHX_ const OP *o)
229 {
230     return (char *)opclassnames[cc_opclass(aTHX_ o)];
231 }
232
233 static SV *
234 make_sv_object(pTHX_ SV *arg, SV *sv)
235 {
236     const char *type = 0;
237     IV iv;
238     dMY_CXT;
239     
240     for (iv = 0; iv < sizeof(specialsv_list)/sizeof(SV*); iv++) {
241         if (sv == specialsv_list[iv]) {
242             type = "B::SPECIAL";
243             break;
244         }
245     }
246     if (!type) {
247         type = svclassnames[SvTYPE(sv)];
248         iv = PTR2IV(sv);
249     }
250     sv_setiv(newSVrv(arg, type), iv);
251     return arg;
252 }
253
254 #if PERL_VERSION >= 9
255 static SV *
256 make_temp_object(pTHX_ SV *arg, SV *temp)
257 {
258     SV *target;
259     const char *const type = svclassnames[SvTYPE(temp)];
260     const IV iv = PTR2IV(temp);
261
262     target = newSVrv(arg, type);
263     sv_setiv(target, iv);
264
265     /* Need to keep our "temp" around as long as the target exists.
266        Simplest way seems to be to hang it from magic, and let that clear
267        it up.  No vtable, so won't actually get in the way of anything.  */
268     sv_magicext(target, temp, PERL_MAGIC_sv, NULL, NULL, 0);
269     /* magic object has had its reference count increased, so we must drop
270        our reference.  */
271     SvREFCNT_dec(temp);
272     return arg;
273 }
274
275 static SV *
276 make_warnings_object(pTHX_ SV *arg, STRLEN *warnings)
277 {
278     const char *type = 0;
279     dMY_CXT;
280     IV iv = sizeof(specialsv_list)/sizeof(SV*);
281
282     /* Counting down is deliberate. Before the split between make_sv_object
283        and make_warnings_obj there appeared to be a bug - Nullsv and pWARN_STD
284        were both 0, so you could never get a B::SPECIAL for pWARN_STD  */
285
286     while (iv--) {
287         if ((SV*)warnings == specialsv_list[iv]) {
288             type = "B::SPECIAL";
289             break;
290         }
291     }
292     if (type) {
293         sv_setiv(newSVrv(arg, type), iv);
294         return arg;
295     } else {
296         /* B assumes that warnings are a regular SV. Seems easier to keep it
297            happy by making them into a regular SV.  */
298         return make_temp_object(aTHX_ arg,
299                                 newSVpvn((char *)(warnings + 1), *warnings));
300     }
301 }
302
303 static SV *
304 make_cop_io_object(pTHX_ SV *arg, COP *cop)
305 {
306     SV *const value = newSV(0);
307
308     Perl_emulate_cop_io(aTHX_ cop, value);
309
310     if(SvOK(value)) {
311         return make_temp_object(aTHX_ arg, newSVsv(value));
312     } else {
313         SvREFCNT_dec(value);
314         return make_sv_object(aTHX_ arg, NULL);
315     }
316 }
317 #endif
318
319 static SV *
320 make_mg_object(pTHX_ SV *arg, MAGIC *mg)
321 {
322     sv_setiv(newSVrv(arg, "B::MAGIC"), PTR2IV(mg));
323     return arg;
324 }
325
326 static SV *
327 cstring(pTHX_ SV *sv, bool perlstyle)
328 {
329     SV *sstr = newSVpvn("", 0);
330
331     if (!SvOK(sv))
332         sv_setpvn(sstr, "0", 1);
333     else if (perlstyle && SvUTF8(sv)) {
334         SV *tmpsv = sv_newmortal(); /* Temporary SV to feed sv_uni_display */
335         const STRLEN len = SvCUR(sv);
336         const char *s = sv_uni_display(tmpsv, sv, 8*len, UNI_DISPLAY_QQ);
337         sv_setpvn(sstr,"\"",1);
338         while (*s)
339         {
340             if (*s == '"')
341                 sv_catpvn(sstr, "\\\"", 2);
342             else if (*s == '$')
343                 sv_catpvn(sstr, "\\$", 2);
344             else if (*s == '@')
345                 sv_catpvn(sstr, "\\@", 2);
346             else if (*s == '\\')
347             {
348                 if (strchr("nrftax\\",*(s+1)))
349                     sv_catpvn(sstr, s++, 2);
350                 else
351                     sv_catpvn(sstr, "\\\\", 2);
352             }
353             else /* should always be printable */
354                 sv_catpvn(sstr, s, 1);
355             ++s;
356         }
357         sv_catpv(sstr, "\"");
358         return sstr;
359     }
360     else
361     {
362         /* XXX Optimise? */
363         STRLEN len;
364         const char *s = SvPV(sv, len);
365         sv_catpv(sstr, "\"");
366         for (; len; len--, s++)
367         {
368             /* At least try a little for readability */
369             if (*s == '"')
370                 sv_catpv(sstr, "\\\"");
371             else if (*s == '\\')
372                 sv_catpv(sstr, "\\\\");
373             /* trigraphs - bleagh */
374             else if (!perlstyle && *s == '?' && len>=3 && s[1] == '?') {
375                 char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
376                 sprintf(escbuff, "\\%03o", '?');
377                 sv_catpv(sstr, escbuff);
378             }
379             else if (perlstyle && *s == '$')
380                 sv_catpv(sstr, "\\$");
381             else if (perlstyle && *s == '@')
382                 sv_catpv(sstr, "\\@");
383 #ifdef EBCDIC
384             else if (isPRINT(*s))
385 #else
386             else if (*s >= ' ' && *s < 127)
387 #endif /* EBCDIC */
388                 sv_catpvn(sstr, s, 1);
389             else if (*s == '\n')
390                 sv_catpv(sstr, "\\n");
391             else if (*s == '\r')
392                 sv_catpv(sstr, "\\r");
393             else if (*s == '\t')
394                 sv_catpv(sstr, "\\t");
395             else if (*s == '\a')
396                 sv_catpv(sstr, "\\a");
397             else if (*s == '\b')
398                 sv_catpv(sstr, "\\b");
399             else if (*s == '\f')
400                 sv_catpv(sstr, "\\f");
401             else if (!perlstyle && *s == '\v')
402                 sv_catpv(sstr, "\\v");
403             else
404             {
405                 /* Don't want promotion of a signed -1 char in sprintf args */
406                 char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
407                 const unsigned char c = (unsigned char) *s;
408                 sprintf(escbuff, "\\%03o", c);
409                 sv_catpv(sstr, escbuff);
410             }
411             /* XXX Add line breaks if string is long */
412         }
413         sv_catpv(sstr, "\"");
414     }
415     return sstr;
416 }
417
418 static SV *
419 cchar(pTHX_ SV *sv)
420 {
421     SV *sstr = newSVpvn("'", 1);
422     const char *s = SvPV_nolen(sv);
423
424     if (*s == '\'')
425         sv_catpvn(sstr, "\\'", 2);
426     else if (*s == '\\')
427         sv_catpvn(sstr, "\\\\", 2);
428 #ifdef EBCDIC
429     else if (isPRINT(*s))
430 #else
431     else if (*s >= ' ' && *s < 127)
432 #endif /* EBCDIC */
433         sv_catpvn(sstr, s, 1);
434     else if (*s == '\n')
435         sv_catpvn(sstr, "\\n", 2);
436     else if (*s == '\r')
437         sv_catpvn(sstr, "\\r", 2);
438     else if (*s == '\t')
439         sv_catpvn(sstr, "\\t", 2);
440     else if (*s == '\a')
441         sv_catpvn(sstr, "\\a", 2);
442     else if (*s == '\b')
443         sv_catpvn(sstr, "\\b", 2);
444     else if (*s == '\f')
445         sv_catpvn(sstr, "\\f", 2);
446     else if (*s == '\v')
447         sv_catpvn(sstr, "\\v", 2);
448     else
449     {
450         /* no trigraph support */
451         char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
452         /* Don't want promotion of a signed -1 char in sprintf args */
453         unsigned char c = (unsigned char) *s;
454         sprintf(escbuff, "\\%03o", c);
455         sv_catpv(sstr, escbuff);
456     }
457     sv_catpvn(sstr, "'", 1);
458     return sstr;
459 }
460
461 static void
462 walkoptree(pTHX_ SV *opsv, const char *method)
463 {
464     dSP;
465     OP *o, *kid;
466     dMY_CXT;
467
468     if (!SvROK(opsv))
469         croak("opsv is not a reference");
470     opsv = sv_mortalcopy(opsv);
471     o = INT2PTR(OP*,SvIV((SV*)SvRV(opsv)));
472     if (walkoptree_debug) {
473         PUSHMARK(sp);
474         XPUSHs(opsv);
475         PUTBACK;
476         perl_call_method("walkoptree_debug", G_DISCARD);
477     }
478     PUSHMARK(sp);
479     XPUSHs(opsv);
480     PUTBACK;
481     perl_call_method(method, G_DISCARD);
482     if (o && (o->op_flags & OPf_KIDS)) {
483         for (kid = ((UNOP*)o)->op_first; kid; kid = kid->op_sibling) {
484             /* Use the same opsv. Rely on methods not to mess it up. */
485             sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), PTR2IV(kid));
486             walkoptree(aTHX_ opsv, method);
487         }
488     }
489     if (o && (cc_opclass(aTHX_ o) == OPc_PMOP) && o->op_type != OP_PUSHRE
490             && (kid = cPMOPo->op_pmreplroot))
491     {
492         sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), PTR2IV(kid));
493         walkoptree(aTHX_ opsv, method);
494     }
495 }
496
497 static SV **
498 oplist(pTHX_ OP *o, SV **SP)
499 {
500     for(; o; o = o->op_next) {
501         SV *opsv;
502 #if PERL_VERSION >= 9
503         if (o->op_opt == 0)
504             break;
505         o->op_opt = 0;
506 #else
507         if (o->op_seq == 0)
508             break;
509         o->op_seq = 0;
510 #endif
511         opsv = sv_newmortal();
512         sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ (OP*)o)), PTR2IV(o));
513         XPUSHs(opsv);
514         switch (o->op_type) {
515         case OP_SUBST:
516 #if PERL_VERSION >= 9
517             SP = oplist(aTHX_ cPMOPo->op_pmstashstartu.op_pmreplstart, SP);
518 #else
519             SP = oplist(aTHX_ cPMOPo->op_pmreplstart, SP);
520 #endif
521             continue;
522         case OP_SORT:
523             if (o->op_flags & OPf_STACKED && o->op_flags & OPf_SPECIAL) {
524                 OP *kid = cLISTOPo->op_first->op_sibling;   /* pass pushmark */
525                 kid = kUNOP->op_first;                      /* pass rv2gv */
526                 kid = kUNOP->op_first;                      /* pass leave */
527                 SP = oplist(aTHX_ kid->op_next, SP);
528             }
529             continue;
530         }
531         switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
532         case OA_LOGOP:
533             SP = oplist(aTHX_ cLOGOPo->op_other, SP);
534             break;
535         case OA_LOOP:
536             SP = oplist(aTHX_ cLOOPo->op_lastop, SP);
537             SP = oplist(aTHX_ cLOOPo->op_nextop, SP);
538             SP = oplist(aTHX_ cLOOPo->op_redoop, SP);
539             break;
540         }
541     }
542     return SP;
543 }
544
545 typedef OP      *B__OP;
546 typedef UNOP    *B__UNOP;
547 typedef BINOP   *B__BINOP;
548 typedef LOGOP   *B__LOGOP;
549 typedef LISTOP  *B__LISTOP;
550 typedef PMOP    *B__PMOP;
551 typedef SVOP    *B__SVOP;
552 typedef PADOP   *B__PADOP;
553 typedef PVOP    *B__PVOP;
554 typedef LOOP    *B__LOOP;
555 typedef COP     *B__COP;
556
557 typedef SV      *B__SV;
558 typedef SV      *B__IV;
559 typedef SV      *B__PV;
560 typedef SV      *B__NV;
561 typedef SV      *B__PVMG;
562 typedef SV      *B__PVLV;
563 typedef SV      *B__BM;
564 typedef SV      *B__RV;
565 typedef SV      *B__FM;
566 typedef AV      *B__AV;
567 typedef HV      *B__HV;
568 typedef CV      *B__CV;
569 typedef GV      *B__GV;
570 typedef IO      *B__IO;
571
572 typedef MAGIC   *B__MAGIC;
573 typedef HE      *B__HE;
574 #if PERL_VERSION >= 9
575 typedef struct refcounted_he    *B__RHE;
576 #endif
577
578 MODULE = B      PACKAGE = B     PREFIX = B_
579
580 PROTOTYPES: DISABLE
581
582 BOOT:
583 {
584     HV *stash = gv_stashpvn("B", 1, GV_ADD);
585     AV *export_ok = perl_get_av("B::EXPORT_OK",TRUE);
586     MY_CXT_INIT;
587     specialsv_list[0] = Nullsv;
588     specialsv_list[1] = &PL_sv_undef;
589     specialsv_list[2] = &PL_sv_yes;
590     specialsv_list[3] = &PL_sv_no;
591     specialsv_list[4] = (SV *) pWARN_ALL;
592     specialsv_list[5] = (SV *) pWARN_NONE;
593     specialsv_list[6] = (SV *) pWARN_STD;
594 #if PERL_VERSION <= 8
595 #  define CVf_ASSERTION 0
596 #  define OPpPAD_STATE 0
597 #endif
598 #include "defsubs.h"
599 }
600
601 #define B_main_cv()     PL_main_cv
602 #define B_init_av()     PL_initav
603 #define B_inc_gv()      PL_incgv
604 #define B_check_av()    PL_checkav_save
605 #if PERL_VERSION > 8
606 #  define B_unitcheck_av()      PL_unitcheckav_save
607 #else
608 #  define B_unitcheck_av()      NULL
609 #endif
610 #define B_begin_av()    PL_beginav_save
611 #define B_end_av()      PL_endav
612 #define B_main_root()   PL_main_root
613 #define B_main_start()  PL_main_start
614 #define B_amagic_generation()   PL_amagic_generation
615 #define B_sub_generation()      PL_sub_generation
616 #define B_defstash()    PL_defstash
617 #define B_curstash()    PL_curstash
618 #define B_dowarn()      PL_dowarn
619 #define B_comppadlist() (PL_main_cv ? CvPADLIST(PL_main_cv) : CvPADLIST(PL_compcv))
620 #define B_sv_undef()    &PL_sv_undef
621 #define B_sv_yes()      &PL_sv_yes
622 #define B_sv_no()       &PL_sv_no
623 #define B_formfeed()    PL_formfeed
624 #ifdef USE_ITHREADS
625 #define B_regex_padav() PL_regex_padav
626 #endif
627
628 B::AV
629 B_init_av()
630
631 B::AV
632 B_check_av()
633
634 #if PERL_VERSION >= 9
635
636 B::AV
637 B_unitcheck_av()
638
639 #endif
640
641 B::AV
642 B_begin_av()
643
644 B::AV
645 B_end_av()
646
647 B::GV
648 B_inc_gv()
649
650 #ifdef USE_ITHREADS
651
652 B::AV
653 B_regex_padav()
654
655 #endif
656
657 B::CV
658 B_main_cv()
659
660 B::OP
661 B_main_root()
662
663 B::OP
664 B_main_start()
665
666 long 
667 B_amagic_generation()
668
669 long
670 B_sub_generation()
671
672 B::AV
673 B_comppadlist()
674
675 B::SV
676 B_sv_undef()
677
678 B::SV
679 B_sv_yes()
680
681 B::SV
682 B_sv_no()
683
684 B::HV
685 B_curstash()
686
687 B::HV
688 B_defstash()
689
690 U8
691 B_dowarn()
692
693 B::SV
694 B_formfeed()
695
696 void
697 B_warnhook()
698     CODE:
699         ST(0) = make_sv_object(aTHX_ sv_newmortal(), PL_warnhook);
700
701 void
702 B_diehook()
703     CODE:
704         ST(0) = make_sv_object(aTHX_ sv_newmortal(), PL_diehook);
705
706 MODULE = B      PACKAGE = B
707
708 void
709 walkoptree(opsv, method)
710         SV *    opsv
711         const char *    method
712     CODE:
713         walkoptree(aTHX_ opsv, method);
714
715 int
716 walkoptree_debug(...)
717     CODE:
718         dMY_CXT;
719         RETVAL = walkoptree_debug;
720         if (items > 0 && SvTRUE(ST(1)))
721             walkoptree_debug = 1;
722     OUTPUT:
723         RETVAL
724
725 #define address(sv) PTR2IV(sv)
726
727 IV
728 address(sv)
729         SV *    sv
730
731 B::SV
732 svref_2object(sv)
733         SV *    sv
734     CODE:
735         if (!SvROK(sv))
736             croak("argument is not a reference");
737         RETVAL = (SV*)SvRV(sv);
738     OUTPUT:
739         RETVAL              
740
741 void
742 opnumber(name)
743 const char *    name
744 CODE:
745 {
746  int i; 
747  IV  result = -1;
748  ST(0) = sv_newmortal();
749  if (strncmp(name,"pp_",3) == 0)
750    name += 3;
751  for (i = 0; i < PL_maxo; i++)
752   {
753    if (strcmp(name, PL_op_name[i]) == 0)
754     {
755      result = i;
756      break;
757     }
758   }
759  sv_setiv(ST(0),result);
760 }
761
762 void
763 ppname(opnum)
764         int     opnum
765     CODE:
766         ST(0) = sv_newmortal();
767         if (opnum >= 0 && opnum < PL_maxo) {
768             sv_setpvn(ST(0), "pp_", 3);
769             sv_catpv(ST(0), PL_op_name[opnum]);
770         }
771
772 void
773 hash(sv)
774         SV *    sv
775     CODE:
776         STRLEN len;
777         U32 hash = 0;
778         char hexhash[19]; /* must fit "0xffffffffffffffff" plus trailing \0 */
779         const char *s = SvPV(sv, len);
780         PERL_HASH(hash, s, len);
781         sprintf(hexhash, "0x%"UVxf, (UV)hash);
782         ST(0) = sv_2mortal(newSVpv(hexhash, 0));
783
784 #define cast_I32(foo) (I32)foo
785 IV
786 cast_I32(i)
787         IV      i
788
789 void
790 minus_c()
791     CODE:
792         PL_minus_c = TRUE;
793
794 void
795 save_BEGINs()
796     CODE:
797         PL_savebegin = TRUE;
798
799 SV *
800 cstring(sv)
801         SV *    sv
802     CODE:
803         RETVAL = cstring(aTHX_ sv, 0);
804     OUTPUT:
805         RETVAL
806
807 SV *
808 perlstring(sv)
809         SV *    sv
810     CODE:
811         RETVAL = cstring(aTHX_ sv, 1);
812     OUTPUT:
813         RETVAL
814
815 SV *
816 cchar(sv)
817         SV *    sv
818     CODE:
819         RETVAL = cchar(aTHX_ sv);
820     OUTPUT:
821         RETVAL
822
823 void
824 threadsv_names()
825     PPCODE:
826 #if PERL_VERSION <= 8
827 # ifdef USE_5005THREADS
828         int i;
829         const STRLEN len = strlen(PL_threadsv_names);
830
831         EXTEND(sp, len);
832         for (i = 0; i < len; i++)
833             PUSHs(sv_2mortal(newSVpvn(&PL_threadsv_names[i], 1)));
834 # endif
835 #endif
836
837 #define OP_next(o)      o->op_next
838 #define OP_sibling(o)   o->op_sibling
839 #define OP_desc(o)      (char *)PL_op_desc[o->op_type]
840 #define OP_targ(o)      o->op_targ
841 #define OP_type(o)      o->op_type
842 #if PERL_VERSION >= 9
843 #  define OP_opt(o)     o->op_opt
844 #  define OP_static(o)  o->op_static
845 #else
846 #  define OP_seq(o)     o->op_seq
847 #endif
848 #define OP_flags(o)     o->op_flags
849 #define OP_private(o)   o->op_private
850 #define OP_spare(o)     o->op_spare
851
852 MODULE = B      PACKAGE = B::OP         PREFIX = OP_
853
854 size_t
855 OP_size(o)
856         B::OP           o
857     CODE:
858         RETVAL = opsizes[cc_opclass(aTHX_ o)];
859     OUTPUT:
860         RETVAL
861
862 B::OP
863 OP_next(o)
864         B::OP           o
865
866 B::OP
867 OP_sibling(o)
868         B::OP           o
869
870 char *
871 OP_name(o)
872         B::OP           o
873     CODE:
874         RETVAL = (char *)PL_op_name[o->op_type];
875     OUTPUT:
876         RETVAL
877
878
879 void
880 OP_ppaddr(o)
881         B::OP           o
882     PREINIT:
883         int i;
884         SV *sv = sv_newmortal();
885     CODE:
886         sv_setpvn(sv, "PL_ppaddr[OP_", 13);
887         sv_catpv(sv, PL_op_name[o->op_type]);
888         for (i=13; (STRLEN)i < SvCUR(sv); ++i)
889             SvPVX(sv)[i] = toUPPER(SvPVX(sv)[i]);
890         sv_catpv(sv, "]");
891         ST(0) = sv;
892
893 char *
894 OP_desc(o)
895         B::OP           o
896
897 PADOFFSET
898 OP_targ(o)
899         B::OP           o
900
901 U16
902 OP_type(o)
903         B::OP           o
904
905 #if PERL_VERSION >= 9
906
907 U8
908 OP_opt(o)
909         B::OP           o
910
911 U8
912 OP_static(o)
913         B::OP           o
914
915 #else
916
917 U16
918 OP_seq(o)
919         B::OP           o
920
921 #endif
922
923 U8
924 OP_flags(o)
925         B::OP           o
926
927 U8
928 OP_private(o)
929         B::OP           o
930
931 #if PERL_VERSION >= 9
932
933 U8
934 OP_spare(o)
935         B::OP           o
936
937 #endif
938
939 void
940 OP_oplist(o)
941         B::OP           o
942     PPCODE:
943         SP = oplist(aTHX_ o, SP);
944
945 #define UNOP_first(o)   o->op_first
946
947 MODULE = B      PACKAGE = B::UNOP               PREFIX = UNOP_
948
949 B::OP 
950 UNOP_first(o)
951         B::UNOP o
952
953 #define BINOP_last(o)   o->op_last
954
955 MODULE = B      PACKAGE = B::BINOP              PREFIX = BINOP_
956
957 B::OP
958 BINOP_last(o)
959         B::BINOP        o
960
961 #define LOGOP_other(o)  o->op_other
962
963 MODULE = B      PACKAGE = B::LOGOP              PREFIX = LOGOP_
964
965 B::OP
966 LOGOP_other(o)
967         B::LOGOP        o
968
969 MODULE = B      PACKAGE = B::LISTOP             PREFIX = LISTOP_
970
971 U32
972 LISTOP_children(o)
973         B::LISTOP       o
974         OP *            kid = NO_INIT
975         int             i = NO_INIT
976     CODE:
977         i = 0;
978         for (kid = o->op_first; kid; kid = kid->op_sibling)
979             i++;
980         RETVAL = i;
981     OUTPUT:
982         RETVAL
983
984 #define PMOP_pmreplroot(o)      o->op_pmreplroot
985 #if PERL_VERSION >= 9
986 #  define PMOP_pmreplstart(o)   o->op_pmstashstartu.op_pmreplstart
987 #else
988 #  define PMOP_pmreplstart(o)   o->op_pmreplstart
989 #endif
990 #define PMOP_pmnext(o)          o->op_pmnext
991 #define PMOP_pmregexp(o)        PM_GETRE(o)
992 #ifdef USE_ITHREADS
993 #define PMOP_pmoffset(o)        o->op_pmoffset
994 #define PMOP_pmstashpv(o)       PmopSTASHPV(o);
995 #else
996 #define PMOP_pmstash(o)         PmopSTASH(o);
997 #endif
998 #define PMOP_pmflags(o)         o->op_pmflags
999
1000 MODULE = B      PACKAGE = B::PMOP               PREFIX = PMOP_
1001
1002 void
1003 PMOP_pmreplroot(o)
1004         B::PMOP         o
1005         OP *            root = NO_INIT
1006     CODE:
1007         ST(0) = sv_newmortal();
1008         root = o->op_pmreplroot;
1009         /* OP_PUSHRE stores an SV* instead of an OP* in op_pmreplroot */
1010         if (o->op_type == OP_PUSHRE) {
1011 #ifdef USE_ITHREADS
1012             sv_setiv(ST(0), INT2PTR(PADOFFSET,root) );
1013 #else
1014             sv_setiv(newSVrv(ST(0), root ?
1015                              svclassnames[SvTYPE((SV*)root)] : "B::SV"),
1016                      PTR2IV(root));
1017 #endif
1018         }
1019         else {
1020             sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), PTR2IV(root));
1021         }
1022
1023 B::OP
1024 PMOP_pmreplstart(o)
1025         B::PMOP         o
1026
1027 #if PERL_VERSION < 9
1028
1029 B::PMOP
1030 PMOP_pmnext(o)
1031         B::PMOP         o
1032
1033 #endif
1034
1035 #ifdef USE_ITHREADS
1036
1037 IV
1038 PMOP_pmoffset(o)
1039         B::PMOP         o
1040
1041 char*
1042 PMOP_pmstashpv(o)
1043         B::PMOP         o
1044
1045 #else
1046
1047 B::HV
1048 PMOP_pmstash(o)
1049         B::PMOP         o
1050
1051 #endif
1052
1053 U32
1054 PMOP_pmflags(o)
1055         B::PMOP         o
1056
1057 void
1058 PMOP_precomp(o)
1059         B::PMOP         o
1060         REGEXP *        rx = NO_INIT
1061     CODE:
1062         ST(0) = sv_newmortal();
1063         rx = PM_GETRE(o);
1064         if (rx)
1065             sv_setpvn(ST(0), rx->precomp, rx->prelen);
1066
1067 void
1068 PMOP_reflags(o)
1069         B::PMOP         o
1070         REGEXP *        rx = NO_INIT
1071     CODE:
1072         ST(0) = sv_newmortal();
1073         rx = PM_GETRE(o);
1074         if (rx)
1075             sv_setuv(ST(0), rx->extflags);
1076
1077 #define SVOP_sv(o)     cSVOPo->op_sv
1078 #define SVOP_gv(o)     ((GV*)cSVOPo->op_sv)
1079
1080 MODULE = B      PACKAGE = B::SVOP               PREFIX = SVOP_
1081
1082 B::SV
1083 SVOP_sv(o)
1084         B::SVOP o
1085
1086 B::GV
1087 SVOP_gv(o)
1088         B::SVOP o
1089
1090 #define PADOP_padix(o)  o->op_padix
1091 #define PADOP_sv(o)     (o->op_padix ? PAD_SVl(o->op_padix) : Nullsv)
1092 #define PADOP_gv(o)     ((o->op_padix \
1093                           && SvTYPE(PAD_SVl(o->op_padix)) == SVt_PVGV) \
1094                          ? (GV*)PAD_SVl(o->op_padix) : Nullgv)
1095
1096 MODULE = B      PACKAGE = B::PADOP              PREFIX = PADOP_
1097
1098 PADOFFSET
1099 PADOP_padix(o)
1100         B::PADOP o
1101
1102 B::SV
1103 PADOP_sv(o)
1104         B::PADOP o
1105
1106 B::GV
1107 PADOP_gv(o)
1108         B::PADOP o
1109
1110 MODULE = B      PACKAGE = B::PVOP               PREFIX = PVOP_
1111
1112 void
1113 PVOP_pv(o)
1114         B::PVOP o
1115     CODE:
1116         /*
1117          * OP_TRANS uses op_pv to point to a table of 256 or >=258 shorts
1118          * whereas other PVOPs point to a null terminated string.
1119          */
1120         if (o->op_type == OP_TRANS &&
1121                 (o->op_private & OPpTRANS_COMPLEMENT) &&
1122                 !(o->op_private & OPpTRANS_DELETE))
1123         {
1124             const short* const tbl = (short*)o->op_pv;
1125             const short entries = 257 + tbl[256];
1126             ST(0) = sv_2mortal(newSVpv(o->op_pv, entries * sizeof(short)));
1127         }
1128         else if (o->op_type == OP_TRANS) {
1129             ST(0) = sv_2mortal(newSVpv(o->op_pv, 256 * sizeof(short)));
1130         }
1131         else
1132             ST(0) = sv_2mortal(newSVpv(o->op_pv, 0));
1133
1134 #define LOOP_redoop(o)  o->op_redoop
1135 #define LOOP_nextop(o)  o->op_nextop
1136 #define LOOP_lastop(o)  o->op_lastop
1137
1138 MODULE = B      PACKAGE = B::LOOP               PREFIX = LOOP_
1139
1140
1141 B::OP
1142 LOOP_redoop(o)
1143         B::LOOP o
1144
1145 B::OP
1146 LOOP_nextop(o)
1147         B::LOOP o
1148
1149 B::OP
1150 LOOP_lastop(o)
1151         B::LOOP o
1152
1153 #define COP_label(o)    o->cop_label
1154 #define COP_stashpv(o)  CopSTASHPV(o)
1155 #define COP_stash(o)    CopSTASH(o)
1156 #define COP_file(o)     CopFILE(o)
1157 #define COP_filegv(o)   CopFILEGV(o)
1158 #define COP_cop_seq(o)  o->cop_seq
1159 #define COP_arybase(o)  CopARYBASE_get(o)
1160 #define COP_line(o)     CopLINE(o)
1161 #define COP_hints(o)    CopHINTS_get(o)
1162 #if PERL_VERSION < 9
1163 #  define COP_warnings(o)  o->cop_warnings
1164 #  define COP_io(o)     o->cop_io
1165 #endif
1166
1167 MODULE = B      PACKAGE = B::COP                PREFIX = COP_
1168
1169 char *
1170 COP_label(o)
1171         B::COP  o
1172
1173 char *
1174 COP_stashpv(o)
1175         B::COP  o
1176
1177 B::HV
1178 COP_stash(o)
1179         B::COP  o
1180
1181 char *
1182 COP_file(o)
1183         B::COP  o
1184
1185 B::GV
1186 COP_filegv(o)
1187        B::COP  o
1188
1189
1190 U32
1191 COP_cop_seq(o)
1192         B::COP  o
1193
1194 I32
1195 COP_arybase(o)
1196         B::COP  o
1197
1198 U32
1199 COP_line(o)
1200         B::COP  o
1201
1202 #if PERL_VERSION >= 9
1203
1204 void
1205 COP_warnings(o)
1206         B::COP  o
1207         PPCODE:
1208         ST(0) = make_warnings_object(aTHX_ sv_newmortal(), o->cop_warnings);
1209         XSRETURN(1);
1210
1211 void
1212 COP_io(o)
1213         B::COP  o
1214         PPCODE:
1215         ST(0) = make_cop_io_object(aTHX_ sv_newmortal(), o);
1216         XSRETURN(1);
1217
1218 B::RHE
1219 COP_hints_hash(o)
1220         B::COP o
1221     CODE:
1222         RETVAL = o->cop_hints_hash;
1223     OUTPUT:
1224         RETVAL
1225
1226 #else
1227
1228 B::SV
1229 COP_warnings(o)
1230         B::COP  o
1231
1232 B::SV
1233 COP_io(o)
1234         B::COP  o
1235
1236 #endif
1237
1238 U32
1239 COP_hints(o)
1240         B::COP  o
1241
1242 MODULE = B      PACKAGE = B::SV
1243
1244 U32
1245 SvTYPE(sv)
1246         B::SV   sv
1247
1248 #define object_2svref(sv)       sv
1249 #define SVREF SV *
1250         
1251 SVREF
1252 object_2svref(sv)
1253         B::SV   sv
1254
1255 MODULE = B      PACKAGE = B::SV         PREFIX = Sv
1256
1257 U32
1258 SvREFCNT(sv)
1259         B::SV   sv
1260
1261 U32
1262 SvFLAGS(sv)
1263         B::SV   sv
1264
1265 U32
1266 SvPOK(sv)
1267         B::SV   sv
1268
1269 U32
1270 SvROK(sv)
1271         B::SV   sv
1272
1273 U32
1274 SvMAGICAL(sv)
1275         B::SV   sv
1276
1277 MODULE = B      PACKAGE = B::IV         PREFIX = Sv
1278
1279 IV
1280 SvIV(sv)
1281         B::IV   sv
1282
1283 IV
1284 SvIVX(sv)
1285         B::IV   sv
1286
1287 UV 
1288 SvUVX(sv) 
1289         B::IV   sv
1290                       
1291
1292 MODULE = B      PACKAGE = B::IV
1293
1294 #define needs64bits(sv) ((I32)SvIVX(sv) != SvIVX(sv))
1295
1296 int
1297 needs64bits(sv)
1298         B::IV   sv
1299
1300 void
1301 packiv(sv)
1302         B::IV   sv
1303     CODE:
1304         if (sizeof(IV) == 8) {
1305             U32 wp[2];
1306             const IV iv = SvIVX(sv);
1307             /*
1308              * The following way of spelling 32 is to stop compilers on
1309              * 32-bit architectures from moaning about the shift count
1310              * being >= the width of the type. Such architectures don't
1311              * reach this code anyway (unless sizeof(IV) > 8 but then
1312              * everything else breaks too so I'm not fussed at the moment).
1313              */
1314 #ifdef UV_IS_QUAD
1315             wp[0] = htonl(((UV)iv) >> (sizeof(UV)*4));
1316 #else
1317             wp[0] = htonl(((U32)iv) >> (sizeof(UV)*4));
1318 #endif
1319             wp[1] = htonl(iv & 0xffffffff);
1320             ST(0) = sv_2mortal(newSVpvn((char *)wp, 8));
1321         } else {
1322             U32 w = htonl((U32)SvIVX(sv));
1323             ST(0) = sv_2mortal(newSVpvn((char *)&w, 4));
1324         }
1325
1326 MODULE = B      PACKAGE = B::NV         PREFIX = Sv
1327
1328 NV
1329 SvNV(sv)
1330         B::NV   sv
1331
1332 NV
1333 SvNVX(sv)
1334         B::NV   sv
1335
1336 U32
1337 COP_SEQ_RANGE_LOW(sv)
1338         B::NV   sv
1339
1340 U32
1341 COP_SEQ_RANGE_HIGH(sv)
1342         B::NV   sv
1343
1344 U32
1345 PARENT_PAD_INDEX(sv)
1346         B::NV   sv
1347
1348 U32
1349 PARENT_FAKELEX_FLAGS(sv)
1350         B::NV   sv
1351
1352 MODULE = B      PACKAGE = B::RV         PREFIX = Sv
1353
1354 B::SV
1355 SvRV(sv)
1356         B::RV   sv
1357
1358 MODULE = B      PACKAGE = B::PV         PREFIX = Sv
1359
1360 char*
1361 SvPVX(sv)
1362         B::PV   sv
1363
1364 B::SV
1365 SvRV(sv)
1366         B::PV   sv
1367     CODE:
1368         if( SvROK(sv) ) {
1369             RETVAL = SvRV(sv);
1370         }
1371         else {
1372             croak( "argument is not SvROK" );
1373         }
1374     OUTPUT:
1375         RETVAL
1376
1377 void
1378 SvPV(sv)
1379         B::PV   sv
1380     CODE:
1381         ST(0) = sv_newmortal();
1382         if( SvPOK(sv) ) {
1383             /* FIXME - we need a better way for B to identify PVs that are
1384                in the pads as variable names.  */
1385             if((SvLEN(sv) && SvCUR(sv) >= SvLEN(sv))) {
1386                 /* It claims to be longer than the space allocated for it -
1387                    presuambly it's a variable name in the pad  */
1388                 sv_setpv(ST(0), SvPV_nolen_const(sv));
1389             } else {
1390                 sv_setpvn(ST(0), SvPVX_const(sv), SvCUR(sv));
1391             }
1392             SvFLAGS(ST(0)) |= SvUTF8(sv);
1393         }
1394         else {
1395             /* XXX for backward compatibility, but should fail */
1396             /* croak( "argument is not SvPOK" ); */
1397             sv_setpvn(ST(0), NULL, 0);
1398         }
1399
1400 # This used to read 257. I think that that was buggy - should have been 258.
1401 # (The "\0", the flags byte, and 256 for the table.  Not that anything
1402 # anywhere calls this method.  NWC.
1403 void
1404 SvPVBM(sv)
1405         B::PV   sv
1406     CODE:
1407         ST(0) = sv_newmortal();
1408         sv_setpvn(ST(0), SvPVX_const(sv),
1409             SvCUR(sv) + (SvVALID(sv) ? 256 + PERL_FBM_TABLE_OFFSET : 0));
1410
1411
1412 STRLEN
1413 SvLEN(sv)
1414         B::PV   sv
1415
1416 STRLEN
1417 SvCUR(sv)
1418         B::PV   sv
1419
1420 MODULE = B      PACKAGE = B::PVMG       PREFIX = Sv
1421
1422 void
1423 SvMAGIC(sv)
1424         B::PVMG sv
1425         MAGIC * mg = NO_INIT
1426     PPCODE:
1427         for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
1428             XPUSHs(make_mg_object(aTHX_ sv_newmortal(), mg));
1429
1430 MODULE = B      PACKAGE = B::PVMG
1431
1432 B::HV
1433 SvSTASH(sv)
1434         B::PVMG sv
1435
1436 #define MgMOREMAGIC(mg) mg->mg_moremagic
1437 #define MgPRIVATE(mg) mg->mg_private
1438 #define MgTYPE(mg) mg->mg_type
1439 #define MgFLAGS(mg) mg->mg_flags
1440 #define MgOBJ(mg) mg->mg_obj
1441 #define MgLENGTH(mg) mg->mg_len
1442 #define MgREGEX(mg) PTR2IV(mg->mg_obj)
1443
1444 MODULE = B      PACKAGE = B::MAGIC      PREFIX = Mg     
1445
1446 B::MAGIC
1447 MgMOREMAGIC(mg)
1448         B::MAGIC        mg
1449      CODE:
1450         if( MgMOREMAGIC(mg) ) {
1451             RETVAL = MgMOREMAGIC(mg);
1452         }
1453         else {
1454             XSRETURN_UNDEF;
1455         }
1456      OUTPUT:
1457         RETVAL
1458
1459 U16
1460 MgPRIVATE(mg)
1461         B::MAGIC        mg
1462
1463 char
1464 MgTYPE(mg)
1465         B::MAGIC        mg
1466
1467 U8
1468 MgFLAGS(mg)
1469         B::MAGIC        mg
1470
1471 B::SV
1472 MgOBJ(mg)
1473         B::MAGIC        mg
1474
1475 IV
1476 MgREGEX(mg)
1477         B::MAGIC        mg
1478     CODE:
1479         if(mg->mg_type == PERL_MAGIC_qr) {
1480             RETVAL = MgREGEX(mg);
1481         }
1482         else {
1483             croak( "REGEX is only meaningful on r-magic" );
1484         }
1485     OUTPUT:
1486         RETVAL
1487
1488 SV*
1489 precomp(mg)
1490         B::MAGIC        mg
1491     CODE:
1492         if (mg->mg_type == PERL_MAGIC_qr) {
1493             REGEXP* rx = (REGEXP*)mg->mg_obj;
1494             RETVAL = Nullsv;
1495             if( rx )
1496                 RETVAL = newSVpvn( rx->precomp, rx->prelen );
1497         }
1498         else {
1499             croak( "precomp is only meaningful on r-magic" );
1500         }
1501     OUTPUT:
1502         RETVAL
1503
1504 I32 
1505 MgLENGTH(mg)
1506         B::MAGIC        mg
1507  
1508 void
1509 MgPTR(mg)
1510         B::MAGIC        mg
1511     CODE:
1512         ST(0) = sv_newmortal();
1513         if (mg->mg_ptr){
1514                 if (mg->mg_len >= 0){
1515                         sv_setpvn(ST(0), mg->mg_ptr, mg->mg_len);
1516                 } else if (mg->mg_len == HEf_SVKEY) {
1517                         ST(0) = make_sv_object(aTHX_
1518                                     sv_newmortal(), (SV*)mg->mg_ptr);
1519                 }
1520         }
1521
1522 MODULE = B      PACKAGE = B::PVLV       PREFIX = Lv
1523
1524 U32
1525 LvTARGOFF(sv)
1526         B::PVLV sv
1527
1528 U32
1529 LvTARGLEN(sv)
1530         B::PVLV sv
1531
1532 char
1533 LvTYPE(sv)
1534         B::PVLV sv
1535
1536 B::SV
1537 LvTARG(sv)
1538         B::PVLV sv
1539
1540 MODULE = B      PACKAGE = B::BM         PREFIX = Bm
1541
1542 I32
1543 BmUSEFUL(sv)
1544         B::BM   sv
1545
1546 U32
1547 BmPREVIOUS(sv)
1548         B::BM   sv
1549
1550 U8
1551 BmRARE(sv)
1552         B::BM   sv
1553
1554 void
1555 BmTABLE(sv)
1556         B::BM   sv
1557         STRLEN  len = NO_INIT
1558         char *  str = NO_INIT
1559     CODE:
1560         str = SvPV(sv, len);
1561         /* Boyer-Moore table is just after string and its safety-margin \0 */
1562         ST(0) = sv_2mortal(newSVpvn(str + len + PERL_FBM_TABLE_OFFSET, 256));
1563
1564 MODULE = B      PACKAGE = B::GV         PREFIX = Gv
1565
1566 void
1567 GvNAME(gv)
1568         B::GV   gv
1569     CODE:
1570         ST(0) = sv_2mortal(newSVpvn(GvNAME(gv), GvNAMELEN(gv)));
1571
1572 bool
1573 is_empty(gv)
1574         B::GV   gv
1575     CODE:
1576         RETVAL = GvGP(gv) == Null(GP*);
1577     OUTPUT:
1578         RETVAL
1579
1580 void*
1581 GvGP(gv)
1582         B::GV   gv
1583
1584 B::HV
1585 GvSTASH(gv)
1586         B::GV   gv
1587
1588 B::SV
1589 GvSV(gv)
1590         B::GV   gv
1591
1592 B::IO
1593 GvIO(gv)
1594         B::GV   gv
1595
1596 B::FM
1597 GvFORM(gv)
1598         B::GV   gv
1599     CODE:
1600         RETVAL = (SV*)GvFORM(gv);
1601     OUTPUT:
1602         RETVAL
1603
1604 B::AV
1605 GvAV(gv)
1606         B::GV   gv
1607
1608 B::HV
1609 GvHV(gv)
1610         B::GV   gv
1611
1612 B::GV
1613 GvEGV(gv)
1614         B::GV   gv
1615
1616 B::CV
1617 GvCV(gv)
1618         B::GV   gv
1619
1620 U32
1621 GvCVGEN(gv)
1622         B::GV   gv
1623
1624 U32
1625 GvLINE(gv)
1626         B::GV   gv
1627
1628 char *
1629 GvFILE(gv)
1630         B::GV   gv
1631
1632 B::GV
1633 GvFILEGV(gv)
1634         B::GV   gv
1635
1636 MODULE = B      PACKAGE = B::GV
1637
1638 U32
1639 GvREFCNT(gv)
1640         B::GV   gv
1641
1642 U8
1643 GvFLAGS(gv)
1644         B::GV   gv
1645
1646 MODULE = B      PACKAGE = B::IO         PREFIX = Io
1647
1648 long
1649 IoLINES(io)
1650         B::IO   io
1651
1652 long
1653 IoPAGE(io)
1654         B::IO   io
1655
1656 long
1657 IoPAGE_LEN(io)
1658         B::IO   io
1659
1660 long
1661 IoLINES_LEFT(io)
1662         B::IO   io
1663
1664 char *
1665 IoTOP_NAME(io)
1666         B::IO   io
1667
1668 B::GV
1669 IoTOP_GV(io)
1670         B::IO   io
1671
1672 char *
1673 IoFMT_NAME(io)
1674         B::IO   io
1675
1676 B::GV
1677 IoFMT_GV(io)
1678         B::IO   io
1679
1680 char *
1681 IoBOTTOM_NAME(io)
1682         B::IO   io
1683
1684 B::GV
1685 IoBOTTOM_GV(io)
1686         B::IO   io
1687
1688 short
1689 IoSUBPROCESS(io)
1690         B::IO   io
1691
1692 bool
1693 IsSTD(io,name)
1694         B::IO   io
1695         const char*     name
1696     PREINIT:
1697         PerlIO* handle = 0;
1698     CODE:
1699         if( strEQ( name, "stdin" ) ) {
1700             handle = PerlIO_stdin();
1701         }
1702         else if( strEQ( name, "stdout" ) ) {
1703             handle = PerlIO_stdout();
1704         }
1705         else if( strEQ( name, "stderr" ) ) {
1706             handle = PerlIO_stderr();
1707         }
1708         else {
1709             croak( "Invalid value '%s'", name );
1710         }
1711         RETVAL = handle == IoIFP(io);
1712     OUTPUT:
1713         RETVAL
1714
1715 MODULE = B      PACKAGE = B::IO
1716
1717 char
1718 IoTYPE(io)
1719         B::IO   io
1720
1721 U8
1722 IoFLAGS(io)
1723         B::IO   io
1724
1725 MODULE = B      PACKAGE = B::AV         PREFIX = Av
1726
1727 SSize_t
1728 AvFILL(av)
1729         B::AV   av
1730
1731 SSize_t
1732 AvMAX(av)
1733         B::AV   av
1734
1735 #if PERL_VERSION < 9
1736                            
1737
1738 #define AvOFF(av) ((XPVAV*)SvANY(av))->xof_off
1739
1740 IV
1741 AvOFF(av)
1742         B::AV   av
1743
1744 #endif
1745
1746 void
1747 AvARRAY(av)
1748         B::AV   av
1749     PPCODE:
1750         if (AvFILL(av) >= 0) {
1751             SV **svp = AvARRAY(av);
1752             I32 i;
1753             for (i = 0; i <= AvFILL(av); i++)
1754                 XPUSHs(make_sv_object(aTHX_ sv_newmortal(), svp[i]));
1755         }
1756
1757 void
1758 AvARRAYelt(av, idx)
1759         B::AV   av
1760         int     idx
1761     PPCODE:
1762         if (idx >= 0 && AvFILL(av) >= 0 && idx <= AvFILL(av))
1763             XPUSHs(make_sv_object(aTHX_ sv_newmortal(), (AvARRAY(av)[idx])));
1764         else
1765             XPUSHs(make_sv_object(aTHX_ sv_newmortal(), NULL));
1766
1767 #if PERL_VERSION < 9
1768                                    
1769 MODULE = B      PACKAGE = B::AV
1770
1771 U8
1772 AvFLAGS(av)
1773         B::AV   av
1774
1775 #endif
1776
1777 MODULE = B      PACKAGE = B::FM         PREFIX = Fm
1778
1779 IV
1780 FmLINES(form)
1781         B::FM   form
1782
1783 MODULE = B      PACKAGE = B::CV         PREFIX = Cv
1784
1785 U32
1786 CvCONST(cv)
1787         B::CV   cv
1788
1789 B::HV
1790 CvSTASH(cv)
1791         B::CV   cv
1792
1793 B::OP
1794 CvSTART(cv)
1795         B::CV   cv
1796     CODE:
1797         RETVAL = CvISXSUB(cv) ? NULL : CvSTART(cv);
1798     OUTPUT:
1799         RETVAL
1800
1801 B::OP
1802 CvROOT(cv)
1803         B::CV   cv
1804     CODE:
1805         RETVAL = CvISXSUB(cv) ? NULL : CvROOT(cv);
1806     OUTPUT:
1807         RETVAL
1808
1809 B::GV
1810 CvGV(cv)
1811         B::CV   cv
1812
1813 char *
1814 CvFILE(cv)
1815         B::CV   cv
1816
1817 long
1818 CvDEPTH(cv)
1819         B::CV   cv
1820
1821 B::AV
1822 CvPADLIST(cv)
1823         B::CV   cv
1824
1825 B::CV
1826 CvOUTSIDE(cv)
1827         B::CV   cv
1828
1829 U32
1830 CvOUTSIDE_SEQ(cv)
1831         B::CV   cv
1832
1833 void
1834 CvXSUB(cv)
1835         B::CV   cv
1836     CODE:
1837         ST(0) = sv_2mortal(newSViv(CvISXSUB(cv) ? PTR2IV(CvXSUB(cv)) : 0));
1838
1839
1840 void
1841 CvXSUBANY(cv)
1842         B::CV   cv
1843     CODE:
1844         ST(0) = CvCONST(cv) ?
1845             make_sv_object(aTHX_ sv_newmortal(),(SV *)CvXSUBANY(cv).any_ptr) :
1846             sv_2mortal(newSViv(CvISXSUB(cv) ? CvXSUBANY(cv).any_iv : 0));
1847
1848 MODULE = B    PACKAGE = B::CV
1849
1850 U16
1851 CvFLAGS(cv)
1852       B::CV   cv
1853
1854 MODULE = B      PACKAGE = B::CV         PREFIX = cv_
1855
1856 B::SV
1857 cv_const_sv(cv)
1858         B::CV   cv
1859
1860
1861 MODULE = B      PACKAGE = B::HV         PREFIX = Hv
1862
1863 STRLEN
1864 HvFILL(hv)
1865         B::HV   hv
1866
1867 STRLEN
1868 HvMAX(hv)
1869         B::HV   hv
1870
1871 I32
1872 HvKEYS(hv)
1873         B::HV   hv
1874
1875 I32
1876 HvRITER(hv)
1877         B::HV   hv
1878
1879 char *
1880 HvNAME(hv)
1881         B::HV   hv
1882
1883 #if PERL_VERSION < 9
1884
1885 B::PMOP
1886 HvPMROOT(hv)
1887         B::HV   hv
1888
1889 #endif
1890
1891 void
1892 HvARRAY(hv)
1893         B::HV   hv
1894     PPCODE:
1895         if (HvKEYS(hv) > 0) {
1896             SV *sv;
1897             char *key;
1898             I32 len;
1899             (void)hv_iterinit(hv);
1900             EXTEND(sp, HvKEYS(hv) * 2);
1901             while ((sv = hv_iternextsv(hv, &key, &len))) {
1902                 PUSHs(newSVpvn(key, len));
1903                 PUSHs(make_sv_object(aTHX_ sv_newmortal(), sv));
1904             }
1905         }
1906
1907 MODULE = B      PACKAGE = B::HE         PREFIX = He
1908
1909 B::SV
1910 HeVAL(he)
1911         B::HE he
1912
1913 U32
1914 HeHASH(he)
1915         B::HE he
1916
1917 B::SV
1918 HeSVKEY_force(he)
1919         B::HE he
1920
1921 MODULE = B      PACKAGE = B::RHE        PREFIX = RHE_
1922
1923 #if PERL_VERSION >= 9
1924
1925 SV*
1926 RHE_HASH(h)
1927         B::RHE h
1928     CODE:
1929         RETVAL = newRV( (SV*)Perl_refcounted_he_chain_2hv(aTHX_ h) );
1930     OUTPUT:
1931         RETVAL
1932
1933 #endif