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