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