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