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_io(o)       o->cop_io
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
1151 MODULE = B      PACKAGE = B::SV
1152
1153 U32
1154 SvTYPE(sv)
1155         B::SV   sv
1156
1157 #define object_2svref(sv)       sv
1158 #define SVREF SV *
1159
1160 SVREF
1161 object_2svref(sv)
1162         B::SV   sv
1163
1164 MODULE = B      PACKAGE = B::SV         PREFIX = Sv
1165
1166 U32
1167 SvREFCNT(sv)
1168         B::SV   sv
1169
1170 U32
1171 SvFLAGS(sv)
1172         B::SV   sv
1173
1174 U32
1175 SvPOK(sv)
1176         B::SV   sv
1177
1178 U32
1179 SvROK(sv)
1180         B::SV   sv
1181
1182 U32
1183 SvMAGICAL(sv)
1184         B::SV   sv
1185
1186 MODULE = B      PACKAGE = B::IV         PREFIX = Sv
1187
1188 IV
1189 SvIV(sv)
1190         B::IV   sv
1191
1192 IV
1193 SvIVX(sv)
1194         B::IV   sv
1195
1196 UV
1197 SvUVX(sv)
1198         B::IV   sv
1199
1200
1201 MODULE = B      PACKAGE = B::IV
1202
1203 #define needs64bits(sv) ((I32)SvIVX(sv) != SvIVX(sv))
1204
1205 int
1206 needs64bits(sv)
1207         B::IV   sv
1208
1209 void
1210 packiv(sv)
1211         B::IV   sv
1212     CODE:
1213         if (sizeof(IV) == 8) {
1214             U32 wp[2];
1215             const IV iv = SvIVX(sv);
1216             /*
1217              * The following way of spelling 32 is to stop compilers on
1218              * 32-bit architectures from moaning about the shift count
1219              * being >= the width of the type. Such architectures don't
1220              * reach this code anyway (unless sizeof(IV) > 8 but then
1221              * everything else breaks too so I'm not fussed at the moment).
1222              */
1223 #ifdef UV_IS_QUAD
1224             wp[0] = htonl(((UV)iv) >> (sizeof(UV)*4));
1225 #else
1226             wp[0] = htonl(((U32)iv) >> (sizeof(UV)*4));
1227 #endif
1228             wp[1] = htonl(iv & 0xffffffff);
1229             ST(0) = sv_2mortal(newSVpvn((char *)wp, 8));
1230         } else {
1231             U32 w = htonl((U32)SvIVX(sv));
1232             ST(0) = sv_2mortal(newSVpvn((char *)&w, 4));
1233         }
1234
1235 MODULE = B      PACKAGE = B::NV         PREFIX = Sv
1236
1237 NV
1238 SvNV(sv)
1239         B::NV   sv
1240
1241 NV
1242 SvNVX(sv)
1243         B::NV   sv
1244
1245 MODULE = B      PACKAGE = B::RV         PREFIX = Sv
1246
1247 B::SV
1248 SvRV(sv)
1249         B::RV   sv
1250
1251 MODULE = B      PACKAGE = B::PV         PREFIX = Sv
1252
1253 char*
1254 SvPVX(sv)
1255         B::PV   sv
1256
1257 B::SV
1258 SvRV(sv)
1259         B::PV   sv
1260     CODE:
1261         if( SvROK(sv) ) {
1262             RETVAL = SvRV(sv);
1263         }
1264         else {
1265             croak( "argument is not SvROK" );
1266         }
1267     OUTPUT:
1268         RETVAL
1269
1270 void
1271 SvPV(sv)
1272         B::PV   sv
1273     CODE:
1274         ST(0) = sv_newmortal();
1275         if( SvPOK(sv) ) {
1276             /* FIXME - we need a better way for B to identify PVs that are
1277                in the pads as variable names.  */
1278             if((SvLEN(sv) && SvCUR(sv) >= SvLEN(sv))) {
1279                 /* It claims to be longer than the space allocated for it -
1280                    presuambly it's a variable name in the pad  */
1281                 sv_setpv(ST(0), SvPV_nolen_const(sv));
1282             } else {
1283                 sv_setpvn(ST(0), SvPVX_const(sv), SvCUR(sv));
1284             }
1285             SvFLAGS(ST(0)) |= SvUTF8(sv);
1286         }
1287         else {
1288             /* XXX for backward compatibility, but should fail */
1289             /* croak( "argument is not SvPOK" ); */
1290             sv_setpvn(ST(0), NULL, 0);
1291         }
1292
1293 void
1294 SvPVBM(sv)
1295         B::PV   sv
1296     CODE:
1297         ST(0) = sv_newmortal();
1298         sv_setpvn(ST(0), SvPVX_const(sv),
1299             SvCUR(sv) + (SvTYPE(sv) == SVt_PVBM ? 257 : 0));
1300
1301
1302 STRLEN
1303 SvLEN(sv)
1304         B::PV   sv
1305
1306 STRLEN
1307 SvCUR(sv)
1308         B::PV   sv
1309
1310 MODULE = B      PACKAGE = B::PVMG       PREFIX = Sv
1311
1312 void
1313 SvMAGIC(sv)
1314         B::PVMG sv
1315         MAGIC * mg = NO_INIT
1316     PPCODE:
1317         for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
1318             XPUSHs(make_mg_object(aTHX_ sv_newmortal(), mg));
1319
1320 MODULE = B      PACKAGE = B::PVMG
1321
1322 B::HV
1323 SvSTASH(sv)
1324         B::PVMG sv
1325
1326 #define MgMOREMAGIC(mg) mg->mg_moremagic
1327 #define MgPRIVATE(mg) mg->mg_private
1328 #define MgTYPE(mg) mg->mg_type
1329 #define MgFLAGS(mg) mg->mg_flags
1330 #define MgOBJ(mg) mg->mg_obj
1331 #define MgLENGTH(mg) mg->mg_len
1332 #define MgREGEX(mg) PTR2IV(mg->mg_obj)
1333
1334 MODULE = B      PACKAGE = B::MAGIC      PREFIX = Mg
1335
1336 B::MAGIC
1337 MgMOREMAGIC(mg)
1338         B::MAGIC        mg
1339      CODE:
1340         if( MgMOREMAGIC(mg) ) {
1341             RETVAL = MgMOREMAGIC(mg);
1342         }
1343         else {
1344             XSRETURN_UNDEF;
1345         }
1346      OUTPUT:
1347         RETVAL
1348
1349 U16
1350 MgPRIVATE(mg)
1351         B::MAGIC        mg
1352
1353 char
1354 MgTYPE(mg)
1355         B::MAGIC        mg
1356
1357 U8
1358 MgFLAGS(mg)
1359         B::MAGIC        mg
1360
1361 B::SV
1362 MgOBJ(mg)
1363         B::MAGIC        mg
1364
1365 IV
1366 MgREGEX(mg)
1367         B::MAGIC        mg
1368     CODE:
1369         if(mg->mg_type == PERL_MAGIC_qr) {
1370             RETVAL = MgREGEX(mg);
1371         }
1372         else {
1373             croak( "REGEX is only meaningful on r-magic" );
1374         }
1375     OUTPUT:
1376         RETVAL
1377
1378 SV*
1379 precomp(mg)
1380         B::MAGIC        mg
1381     CODE:
1382         if (mg->mg_type == PERL_MAGIC_qr) {
1383             REGEXP* rx = (REGEXP*)mg->mg_obj;
1384             RETVAL = Nullsv;
1385             if( rx )
1386                 RETVAL = newSVpvn( rx->precomp, rx->prelen );
1387         }
1388         else {
1389             croak( "precomp is only meaningful on r-magic" );
1390         }
1391     OUTPUT:
1392         RETVAL
1393
1394 I32
1395 MgLENGTH(mg)
1396         B::MAGIC        mg
1397
1398 void
1399 MgPTR(mg)
1400         B::MAGIC        mg
1401     CODE:
1402         ST(0) = sv_newmortal();
1403         if (mg->mg_ptr){
1404                 if (mg->mg_len >= 0){
1405                         sv_setpvn(ST(0), mg->mg_ptr, mg->mg_len);
1406                 } else if (mg->mg_len == HEf_SVKEY) {
1407                         ST(0) = make_sv_object(aTHX_
1408                                     sv_newmortal(), (SV*)mg->mg_ptr);
1409                 }
1410         }
1411
1412 MODULE = B      PACKAGE = B::PVLV       PREFIX = Lv
1413
1414 U32
1415 LvTARGOFF(sv)
1416         B::PVLV sv
1417
1418 U32
1419 LvTARGLEN(sv)
1420         B::PVLV sv
1421
1422 char
1423 LvTYPE(sv)
1424         B::PVLV sv
1425
1426 B::SV
1427 LvTARG(sv)
1428         B::PVLV sv
1429
1430 MODULE = B      PACKAGE = B::BM         PREFIX = Bm
1431
1432 I32
1433 BmUSEFUL(sv)
1434         B::BM   sv
1435
1436 U16
1437 BmPREVIOUS(sv)
1438         B::BM   sv
1439
1440 U8
1441 BmRARE(sv)
1442         B::BM   sv
1443
1444 void
1445 BmTABLE(sv)
1446         B::BM   sv
1447         STRLEN  len = NO_INIT
1448         char *  str = NO_INIT
1449     CODE:
1450         str = SvPV(sv, len);
1451         /* Boyer-Moore table is just after string and its safety-margin \0 */
1452         ST(0) = sv_2mortal(newSVpvn(str + len + 1, 256));
1453
1454 MODULE = B      PACKAGE = B::GV         PREFIX = Gv
1455
1456 void
1457 GvNAME(gv)
1458         B::GV   gv
1459     CODE:
1460         ST(0) = sv_2mortal(newSVpvn(GvNAME(gv), GvNAMELEN(gv)));
1461
1462 bool
1463 is_empty(gv)
1464         B::GV   gv
1465     CODE:
1466         RETVAL = GvGP(gv) == Null(GP*);
1467     OUTPUT:
1468         RETVAL
1469
1470 void*
1471 GvGP(gv)
1472         B::GV   gv
1473
1474 B::HV
1475 GvSTASH(gv)
1476         B::GV   gv
1477
1478 B::SV
1479 GvSV(gv)
1480         B::GV   gv
1481
1482 B::IO
1483 GvIO(gv)
1484         B::GV   gv
1485
1486 B::FM
1487 GvFORM(gv)
1488         B::GV   gv
1489     CODE:
1490         RETVAL = (SV*)GvFORM(gv);
1491     OUTPUT:
1492         RETVAL
1493
1494 B::AV
1495 GvAV(gv)
1496         B::GV   gv
1497
1498 B::HV
1499 GvHV(gv)
1500         B::GV   gv
1501
1502 B::GV
1503 GvEGV(gv)
1504         B::GV   gv
1505
1506 B::CV
1507 GvCV(gv)
1508         B::GV   gv
1509
1510 U32
1511 GvCVGEN(gv)
1512         B::GV   gv
1513
1514 U32
1515 GvLINE(gv)
1516         B::GV   gv
1517
1518 char *
1519 GvFILE(gv)
1520         B::GV   gv
1521
1522 B::GV
1523 GvFILEGV(gv)
1524         B::GV   gv
1525
1526 MODULE = B      PACKAGE = B::GV
1527
1528 U32
1529 GvREFCNT(gv)
1530         B::GV   gv
1531
1532 U8
1533 GvFLAGS(gv)
1534         B::GV   gv
1535
1536 MODULE = B      PACKAGE = B::IO         PREFIX = Io
1537
1538 long
1539 IoLINES(io)
1540         B::IO   io
1541
1542 long
1543 IoPAGE(io)
1544         B::IO   io
1545
1546 long
1547 IoPAGE_LEN(io)
1548         B::IO   io
1549
1550 long
1551 IoLINES_LEFT(io)
1552         B::IO   io
1553
1554 char *
1555 IoTOP_NAME(io)
1556         B::IO   io
1557
1558 B::GV
1559 IoTOP_GV(io)
1560         B::IO   io
1561
1562 char *
1563 IoFMT_NAME(io)
1564         B::IO   io
1565
1566 B::GV
1567 IoFMT_GV(io)
1568         B::IO   io
1569
1570 char *
1571 IoBOTTOM_NAME(io)
1572         B::IO   io
1573
1574 B::GV
1575 IoBOTTOM_GV(io)
1576         B::IO   io
1577
1578 short
1579 IoSUBPROCESS(io)
1580         B::IO   io
1581
1582 bool
1583 IsSTD(io,name)
1584         B::IO   io
1585         const char*     name
1586     PREINIT:
1587         PerlIO* handle = 0;
1588     CODE:
1589         if( strEQ( name, "stdin" ) ) {
1590             handle = PerlIO_stdin();
1591         }
1592         else if( strEQ( name, "stdout" ) ) {
1593             handle = PerlIO_stdout();
1594         }
1595         else if( strEQ( name, "stderr" ) ) {
1596             handle = PerlIO_stderr();
1597         }
1598         else {
1599             croak( "Invalid value '%s'", name );
1600         }
1601         RETVAL = handle == IoIFP(io);
1602     OUTPUT:
1603         RETVAL
1604
1605 MODULE = B      PACKAGE = B::IO
1606
1607 char
1608 IoTYPE(io)
1609         B::IO   io
1610
1611 U8
1612 IoFLAGS(io)
1613         B::IO   io
1614
1615 MODULE = B      PACKAGE = B::AV         PREFIX = Av
1616
1617 SSize_t
1618 AvFILL(av)
1619         B::AV   av
1620
1621 SSize_t
1622 AvMAX(av)
1623         B::AV   av
1624
1625 #if PERL_VERSION < 9
1626
1627
1628 #define AvOFF(av) ((XPVAV*)SvANY(av))->xof_off
1629
1630 IV
1631 AvOFF(av)
1632         B::AV   av
1633
1634 #endif
1635
1636 void
1637 AvARRAY(av)
1638         B::AV   av
1639     PPCODE:
1640         if (AvFILL(av) >= 0) {
1641             SV **svp = AvARRAY(av);
1642             I32 i;
1643             for (i = 0; i <= AvFILL(av); i++)
1644                 XPUSHs(make_sv_object(aTHX_ sv_newmortal(), svp[i]));
1645         }
1646
1647 void
1648 AvARRAYelt(av, idx)
1649         B::AV   av
1650         int     idx
1651     PPCODE:
1652         if (idx >= 0 && AvFILL(av) >= 0 && idx <= AvFILL(av))
1653             XPUSHs(make_sv_object(aTHX_ sv_newmortal(), (AvARRAY(av)[idx])));
1654         else
1655             XPUSHs(make_sv_object(aTHX_ sv_newmortal(), NULL));
1656
1657 #if PERL_VERSION < 9
1658
1659 MODULE = B      PACKAGE = B::AV
1660
1661 U8
1662 AvFLAGS(av)
1663         B::AV   av
1664
1665 #endif
1666
1667 MODULE = B      PACKAGE = B::FM         PREFIX = Fm
1668
1669 IV
1670 FmLINES(form)
1671         B::FM   form
1672
1673 MODULE = B      PACKAGE = B::CV         PREFIX = Cv
1674
1675 U32
1676 CvCONST(cv)
1677         B::CV   cv
1678
1679 B::HV
1680 CvSTASH(cv)
1681         B::CV   cv
1682
1683 B::OP
1684 CvSTART(cv)
1685         B::CV   cv
1686     CODE:
1687         RETVAL = CvISXSUB(cv) ? NULL : CvSTART(cv);
1688     OUTPUT:
1689         RETVAL
1690
1691 B::OP
1692 CvROOT(cv)
1693         B::CV   cv
1694     CODE:
1695         RETVAL = CvISXSUB(cv) ? NULL : CvROOT(cv);
1696     OUTPUT:
1697         RETVAL
1698
1699 B::GV
1700 CvGV(cv)
1701         B::CV   cv
1702
1703 char *
1704 CvFILE(cv)
1705         B::CV   cv
1706
1707 long
1708 CvDEPTH(cv)
1709         B::CV   cv
1710
1711 B::AV
1712 CvPADLIST(cv)
1713         B::CV   cv
1714
1715 B::CV
1716 CvOUTSIDE(cv)
1717         B::CV   cv
1718
1719 U32
1720 CvOUTSIDE_SEQ(cv)
1721         B::CV   cv
1722
1723 void
1724 CvXSUB(cv)
1725         B::CV   cv
1726     CODE:
1727         ST(0) = sv_2mortal(newSViv(CvISXSUB(cv) ? PTR2IV(CvXSUB(cv)) : 0));
1728
1729
1730 void
1731 CvXSUBANY(cv)
1732         B::CV   cv
1733     CODE:
1734         ST(0) = CvCONST(cv) ?
1735             make_sv_object(aTHX_ sv_newmortal(),(SV *)CvXSUBANY(cv).any_ptr) :
1736             sv_2mortal(newSViv(CvISXSUB(cv) ? CvXSUBANY(cv).any_iv : 0));
1737
1738 MODULE = B    PACKAGE = B::CV
1739
1740 U16
1741 CvFLAGS(cv)
1742       B::CV   cv
1743
1744 MODULE = B      PACKAGE = B::CV         PREFIX = cv_
1745
1746 B::SV
1747 cv_const_sv(cv)
1748         B::CV   cv
1749
1750
1751 MODULE = B      PACKAGE = B::HV         PREFIX = Hv
1752
1753 STRLEN
1754 HvFILL(hv)
1755         B::HV   hv
1756
1757 STRLEN
1758 HvMAX(hv)
1759         B::HV   hv
1760
1761 I32
1762 HvKEYS(hv)
1763         B::HV   hv
1764
1765 I32
1766 HvRITER(hv)
1767         B::HV   hv
1768
1769 char *
1770 HvNAME(hv)
1771         B::HV   hv
1772
1773 #if PERL_VERSION < 9
1774
1775 B::PMOP
1776 HvPMROOT(hv)
1777         B::HV   hv
1778
1779 #endif
1780
1781 void
1782 HvARRAY(hv)
1783         B::HV   hv
1784     PPCODE:
1785         if (HvKEYS(hv) > 0) {
1786             SV *sv;
1787             char *key;
1788             I32 len;
1789             (void)hv_iterinit(hv);
1790             EXTEND(sp, HvKEYS(hv) * 2);
1791             while ((sv = hv_iternextsv(hv, &key, &len))) {
1792                 PUSHs(newSVpvn(key, len));
1793                 PUSHs(make_sv_object(aTHX_ sv_newmortal(), sv));
1794             }
1795         }