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 #include "EXTERN.h"
  11 #include "perl.h"
  12 #include "XSUB.h"
  13 #include "INTERN.h"
  14
  15 #ifdef PERL_OBJECT
  16 #undef PL_op_name
  17 #undef PL_opargs
  18 #undef PL_op_desc
  19 #define PL_op_name (pPerl->Perl_get_op_names())
  20 #define PL_opargs (pPerl->Perl_get_opargs())
  21 #define PL_op_desc (pPerl->Perl_get_op_descs())
  22 #endif
  23
  24 #ifdef PerlIO
  25 typedef PerlIO * InputStream;
  26 #else
  27 typedef FILE * InputStream;
  28 #endif
  29
  30
  31 static char *svclassnames[] = {
  32     "B::NULL",
  33     "B::IV",
  34     "B::NV",
  35     "B::RV",
  36     "B::PV",
  37     "B::PVIV",
  38     "B::PVNV",
  39     "B::PVMG",
  40     "B::BM",
  41     "B::PVLV",
  42     "B::AV",
  43     "B::HV",
  44     "B::CV",
  45     "B::GV",
  46     "B::FM",
  47     "B::IO",
  48 };
  49
  50 typedef enum {
  51     OPc_NULL,   /* 0 */
  52     OPc_BASEOP, /* 1 */
  53     OPc_UNOP,   /* 2 */
  54     OPc_BINOP,  /* 3 */
  55     OPc_LOGOP,  /* 4 */
  56     OPc_CONDOP, /* 5 */
  57     OPc_LISTOP, /* 6 */
  58     OPc_PMOP,   /* 7 */
  59     OPc_SVOP,   /* 8 */
  60     OPc_GVOP,   /* 9 */
  61     OPc_PVOP,   /* 10 */
  62     OPc_CVOP,   /* 11 */
  63     OPc_LOOP,   /* 12 */
  64     OPc_COP     /* 13 */
  65 } opclass;
  66
  67 static char *opclassnames[] = {
  68     "B::NULL",
  69     "B::OP",
  70     "B::UNOP",
  71     "B::BINOP",
  72     "B::LOGOP",
  73     "B::CONDOP",
  74     "B::LISTOP",
  75     "B::PMOP",
  76     "B::SVOP",
  77     "B::GVOP",
  78     "B::PVOP",
  79     "B::CVOP",
  80     "B::LOOP",
  81     "B::COP"
  82 };
  83
  84 static int walkoptree_debug = 0;        /* Flag for walkoptree debug hook */
  85
  86 static SV *specialsv_list[4];
  87
  88 static opclass
  89 cc_opclass(pTHX_ OP *o)
  90 {
  91     if (!o)
  92         return OPc_NULL;
  93
  94     if (o->op_type == 0)
  95         return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
  96
  97     if (o->op_type == OP_SASSIGN)
  98         return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
  99
 100     switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
 101     case OA_BASEOP:
 102         return OPc_BASEOP;
 103
 104     case OA_UNOP:
 105         return OPc_UNOP;
 106
 107     case OA_BINOP:
 108         return OPc_BINOP;
 109
 110     case OA_LOGOP:
 111         return OPc_LOGOP;
 112
 113     case OA_CONDOP:
 114         return OPc_CONDOP;
 115
 116     case OA_LISTOP:
 117         return OPc_LISTOP;
 118
 119     case OA_PMOP:
 120         return OPc_PMOP;
 121
 122     case OA_SVOP:
 123         return OPc_SVOP;
 124
 125     case OA_GVOP:
 126         return OPc_GVOP;
 127
 128     case OA_PVOP_OR_SVOP:
 129         /*
 130          * Character translations (tr///) are usually a PVOP, keeping a
 131          * pointer to a table of shorts used to look up translations.
 132          * Under utf8, however, a simple table isn't practical; instead,
 133          * the OP is an SVOP, and the SV is a reference to a swash
 134          * (i.e., an RV pointing to an HV).
 135          */
 136         return (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
 137                 ? OPc_SVOP : OPc_PVOP;
 138
 139     case OA_LOOP:
 140         return OPc_LOOP;
 141
 142     case OA_COP:
 143         return OPc_COP;
 144
 145     case OA_BASEOP_OR_UNOP:
 146         /*
 147          * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
 148          * whether parens were seen. perly.y uses OPf_SPECIAL to
 149          * signal whether a BASEOP had empty parens or none.
 150          * Some other UNOPs are created later, though, so the best
 151          * test is OPf_KIDS, which is set in newUNOP.
 152          */
 153         return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
 154
 155     case OA_FILESTATOP:
 156         /*
 157          * The file stat OPs are created via UNI(OP_foo) in toke.c but use
 158          * the OPf_REF flag to distinguish between OP types instead of the
 159          * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
 160          * return OPc_UNOP so that walkoptree can find our children. If
 161          * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
 162          * (no argument to the operator) it's an OP; with OPf_REF set it's
 163          * a GVOP (and op_gv is the GV for the filehandle argument).
 164          */
 165         return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
 166                 (o->op_flags & OPf_REF) ? OPc_GVOP : OPc_BASEOP);
 167
 168     case OA_LOOPEXOP:
 169         /*
 170          * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
 171          * label was omitted (in which case it's a BASEOP) or else a term was
 172          * seen. In this last case, all except goto are definitely PVOP but
 173          * goto is either a PVOP (with an ordinary constant label), an UNOP
 174          * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
 175          * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
 176          * get set.
 177          */
 178         if (o->op_flags & OPf_STACKED)
 179             return OPc_UNOP;
 180         else if (o->op_flags & OPf_SPECIAL)
 181             return OPc_BASEOP;
 182         else
 183             return OPc_PVOP;
 184     }
 185     warn("can't determine class of operator %s, assuming BASEOP\n",
 186          PL_op_name[o->op_type]);
 187     return OPc_BASEOP;
 188 }
 189
 190 static char *
 191 cc_opclassname(pTHX_ OP *o)
 192 {
 193     return opclassnames[cc_opclass(aTHX_ o)];
 194 }
 195
 196 static SV *
 197 make_sv_object(pTHX_ SV *arg, SV *sv)
 198 {
 199     char *type = 0;
 200     IV iv;
 201
 202     for (iv = 0; iv < sizeof(specialsv_list)/sizeof(SV*); iv++) {
 203         if (sv == specialsv_list[iv]) {
 204             type = "B::SPECIAL";
 205             break;
 206         }
 207     }
 208     if (!type) {
 209         type = svclassnames[SvTYPE(sv)];
 210         iv = (IV)sv;
 211     }
 212     sv_setiv(newSVrv(arg, type), iv);
 213     return arg;
 214 }
 215
 216 static SV *
 217 make_mg_object(pTHX_ SV *arg, MAGIC *mg)
 218 {
 219     sv_setiv(newSVrv(arg, "B::MAGIC"), (IV)mg);
 220     return arg;
 221 }
 222
 223 static SV *
 224 cstring(pTHX_ SV *sv)
 225 {
 226     SV *sstr = newSVpvn("", 0);
 227     STRLEN len;
 228     char *s;
 229
 230     if (!SvOK(sv))
 231         sv_setpvn(sstr, "0", 1);
 232     else
 233     {
 234         /* XXX Optimise? */
 235         s = SvPV(sv, len);
 236         sv_catpv(sstr, "\"");
 237         for (; len; len--, s++)
 238         {
 239             /* At least try a little for readability */
 240             if (*s == '"')
 241                 sv_catpv(sstr, "\\\"");
 242             else if (*s == '\\')
 243                 sv_catpv(sstr, "\\\\");
 244             else if (*s >= ' ' && *s < 127) /* XXX not portable */
 245                 sv_catpvn(sstr, s, 1);
 246             else if (*s == '\n')
 247                 sv_catpv(sstr, "\\n");
 248             else if (*s == '\r')
 249                 sv_catpv(sstr, "\\r");
 250             else if (*s == '\t')
 251                 sv_catpv(sstr, "\\t");
 252             else if (*s == '\a')
 253                 sv_catpv(sstr, "\\a");
 254             else if (*s == '\b')
 255                 sv_catpv(sstr, "\\b");
 256             else if (*s == '\f')
 257                 sv_catpv(sstr, "\\f");
 258             else if (*s == '\v')
 259                 sv_catpv(sstr, "\\v");
 260             else
 261             {
 262                 /* no trigraph support */
 263                 char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
 264                 /* Don't want promotion of a signed -1 char in sprintf args */
 265                 unsigned char c = (unsigned char) *s;
 266                 sprintf(escbuff, "\\%03o", c);
 267                 sv_catpv(sstr, escbuff);
 268             }
 269             /* XXX Add line breaks if string is long */
 270         }
 271         sv_catpv(sstr, "\"");
 272     }
 273     return sstr;
 274 }
 275
 276 static SV *
 277 cchar(pTHX_ SV *sv)
 278 {
 279     SV *sstr = newSVpvn("'", 1);
 280     STRLEN n_a;
 281     char *s = SvPV(sv, n_a);
 282
 283     if (*s == '\'')
 284         sv_catpv(sstr, "\\'");
 285     else if (*s == '\\')
 286         sv_catpv(sstr, "\\\\");
 287     else if (*s >= ' ' && *s < 127) /* XXX not portable */
 288         sv_catpvn(sstr, s, 1);
 289     else if (*s == '\n')
 290         sv_catpv(sstr, "\\n");
 291     else if (*s == '\r')
 292         sv_catpv(sstr, "\\r");
 293     else if (*s == '\t')
 294         sv_catpv(sstr, "\\t");
 295     else if (*s == '\a')
 296         sv_catpv(sstr, "\\a");
 297     else if (*s == '\b')
 298         sv_catpv(sstr, "\\b");
 299     else if (*s == '\f')
 300         sv_catpv(sstr, "\\f");
 301     else if (*s == '\v')
 302         sv_catpv(sstr, "\\v");
 303     else
 304     {
 305         /* no trigraph support */
 306         char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
 307         /* Don't want promotion of a signed -1 char in sprintf args */
 308         unsigned char c = (unsigned char) *s;
 309         sprintf(escbuff, "\\%03o", c);
 310         sv_catpv(sstr, escbuff);
 311     }
 312     sv_catpv(sstr, "'");
 313     return sstr;
 314 }
 315
 316 void
 317 walkoptree(pTHX_ SV *opsv, char *method)
 318 {
 319     dSP;
 320     OP *o;
 321
 322     if (!SvROK(opsv))
 323         croak("opsv is not a reference");
 324     opsv = sv_mortalcopy(opsv);
 325     o = (OP*)SvIV((SV*)SvRV(opsv));
 326     if (walkoptree_debug) {
 327         PUSHMARK(sp);
 328         XPUSHs(opsv);
 329         PUTBACK;
 330         perl_call_method("walkoptree_debug", G_DISCARD);
 331     }
 332     PUSHMARK(sp);
 333     XPUSHs(opsv);
 334     PUTBACK;
 335     perl_call_method(method, G_DISCARD);
 336     if (o && (o->op_flags & OPf_KIDS)) {
 337         OP *kid;
 338         for (kid = ((UNOP*)o)->op_first; kid; kid = kid->op_sibling) {
 339             /* Use the same opsv. Rely on methods not to mess it up. */
 340             sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), (IV)kid);
 341             walkoptree(aTHX_ opsv, method);
 342         }
 343     }
 344 }
 345
 346 typedef OP      *B__OP;
 347 typedef UNOP    *B__UNOP;
 348 typedef BINOP   *B__BINOP;
 349 typedef LOGOP   *B__LOGOP;
 350 typedef CONDOP  *B__CONDOP;
 351 typedef LISTOP  *B__LISTOP;
 352 typedef PMOP    *B__PMOP;
 353 typedef SVOP    *B__SVOP;
 354 typedef GVOP    *B__GVOP;
 355 typedef PVOP    *B__PVOP;
 356 typedef LOOP    *B__LOOP;
 357 typedef COP     *B__COP;
 358
 359 typedef SV      *B__SV;
 360 typedef SV      *B__IV;
 361 typedef SV      *B__PV;
 362 typedef SV      *B__NV;
 363 typedef SV      *B__PVMG;
 364 typedef SV      *B__PVLV;
 365 typedef SV      *B__BM;
 366 typedef SV      *B__RV;
 367 typedef AV      *B__AV;
 368 typedef HV      *B__HV;
 369 typedef CV      *B__CV;
 370 typedef GV      *B__GV;
 371 typedef IO      *B__IO;
 372
 373 typedef MAGIC   *B__MAGIC;
 374
 375 MODULE = B      PACKAGE = B     PREFIX = B_
 376
 377 PROTOTYPES: DISABLE
 378
 379 BOOT:
 380 {
 381     HV *stash = gv_stashpvn("B", 1, TRUE);
 382     AV *export_ok = perl_get_av("B::EXPORT_OK",TRUE);
 383     specialsv_list[0] = Nullsv;
 384     specialsv_list[1] = &PL_sv_undef;
 385     specialsv_list[2] = &PL_sv_yes;
 386     specialsv_list[3] = &PL_sv_no;
 387 #include "defsubs.h"
 388 }
 389
 390 #define B_main_cv()     PL_main_cv
 391 #define B_init_av()     PL_initav
 392 #define B_main_root()   PL_main_root
 393 #define B_main_start()  PL_main_start
 394 #define B_amagic_generation()   PL_amagic_generation
 395 #define B_comppadlist() (PL_main_cv ? CvPADLIST(PL_main_cv) : CvPADLIST(PL_compcv))
 396 #define B_sv_undef()    &PL_sv_undef
 397 #define B_sv_yes()      &PL_sv_yes
 398 #define B_sv_no()       &PL_sv_no
 399
 400 B::AV
 401 B_init_av()
 402
 403 B::CV
 404 B_main_cv()
 405
 406 B::OP
 407 B_main_root()
 408
 409 B::OP
 410 B_main_start()
 411
 412 long
 413 B_amagic_generation()
 414
 415 B::AV
 416 B_comppadlist()
 417
 418 B::SV
 419 B_sv_undef()
 420
 421 B::SV
 422 B_sv_yes()
 423
 424 B::SV
 425 B_sv_no()
 426
 427 MODULE = B      PACKAGE = B
 428
 429
 430 void
 431 walkoptree(opsv, method)
 432         SV *    opsv
 433         char *  method
 434     CODE:
 435         walkoptree(aTHX_ opsv, method);
 436
 437 int
 438 walkoptree_debug(...)
 439     CODE:
 440         RETVAL = walkoptree_debug;
 441         if (items > 0 && SvTRUE(ST(1)))
 442             walkoptree_debug = 1;
 443     OUTPUT:
 444         RETVAL
 445
 446 int
 447 byteload_fh(fp)
 448         InputStream    fp
 449     CODE:
 450         byteload_fh(fp);
 451         RETVAL = 1;
 452     OUTPUT:
 453         RETVAL
 454
 455 void
 456 byteload_string(str)
 457         char *  str
 458
 459 #define address(sv) (IV)sv
 460
 461 IV
 462 address(sv)
 463         SV *    sv
 464
 465 B::SV
 466 svref_2object(sv)
 467         SV *    sv
 468     CODE:
 469         if (!SvROK(sv))
 470             croak("argument is not a reference");
 471         RETVAL = (SV*)SvRV(sv);
 472     OUTPUT:
 473         RETVAL
 474
 475 void
 476 opnumber(name)
 477 char *  name
 478 CODE:
 479 {
 480  int i;
 481  IV  result = -1;
 482  ST(0) = sv_newmortal();
 483  if (strncmp(name,"pp_",3) == 0)
 484    name += 3;
 485  for (i = 0; i < PL_maxo; i++)
 486   {
 487    if (strcmp(name, PL_op_name[i]) == 0)
 488     {
 489      result = i;
 490      break;
 491     }
 492   }
 493  sv_setiv(ST(0),result);
 494 }
 495
 496 void
 497 ppname(opnum)
 498         int     opnum
 499     CODE:
 500         ST(0) = sv_newmortal();
 501         if (opnum >= 0 && opnum < PL_maxo) {
 502             sv_setpvn(ST(0), "pp_", 3);
 503             sv_catpv(ST(0), PL_op_name[opnum]);
 504         }
 505
 506 void
 507 hash(sv)
 508         SV *    sv
 509     CODE:
 510         char *s;
 511         STRLEN len;
 512         U32 hash = 0;
 513         char hexhash[19]; /* must fit "0xffffffff" plus trailing \0 */
 514         s = SvPV(sv, len);
 515         PERL_HASH(hash, s, len);
 516         sprintf(hexhash, "0x%x", hash);
 517         ST(0) = sv_2mortal(newSVpv(hexhash, 0));
 518
 519 #define cast_I32(foo) (I32)foo
 520 IV
 521 cast_I32(i)
 522         IV      i
 523
 524 void
 525 minus_c()
 526     CODE:
 527         PL_minus_c = TRUE;
 528
 529 SV *
 530 cstring(sv)
 531         SV *    sv
 532     CODE:
 533         RETVAL = cstring(aTHX_ sv);
 534     OUTPUT:
 535         RETVAL
 536
 537 SV *
 538 cchar(sv)
 539         SV *    sv
 540     CODE:
 541         RETVAL = cchar(aTHX_ sv);
 542     OUTPUT:
 543         RETVAL
 544
 545 void
 546 threadsv_names()
 547     PPCODE:
 548 #ifdef USE_THREADS
 549         int i;
 550         STRLEN len = strlen(PL_threadsv_names);
 551
 552         EXTEND(sp, len);
 553         for (i = 0; i < len; i++)
 554             PUSHs(sv_2mortal(newSVpvn(&PL_threadsv_names[i], 1)));
 555 #endif
 556
 557
 558 #define OP_next(o)      o->op_next
 559 #define OP_sibling(o)   o->op_sibling
 560 #define OP_desc(o)      PL_op_desc[o->op_type]
 561 #define OP_targ(o)      o->op_targ
 562 #define OP_type(o)      o->op_type
 563 #define OP_seq(o)       o->op_seq
 564 #define OP_flags(o)     o->op_flags
 565 #define OP_private(o)   o->op_private
 566
 567 MODULE = B      PACKAGE = B::OP         PREFIX = OP_
 568
 569 B::OP
 570 OP_next(o)
 571         B::OP           o
 572
 573 B::OP
 574 OP_sibling(o)
 575         B::OP           o
 576
 577 char *
 578 OP_ppaddr(o)
 579         B::OP           o
 580     CODE:
 581         ST(0) = sv_newmortal();
 582         sv_setpvn(ST(0), "pp_", 3);
 583         sv_catpv(ST(0), PL_op_name[o->op_type]);
 584
 585 char *
 586 OP_desc(o)
 587         B::OP           o
 588
 589 U16
 590 OP_targ(o)
 591         B::OP           o
 592
 593 U16
 594 OP_type(o)
 595         B::OP           o
 596
 597 U16
 598 OP_seq(o)
 599         B::OP           o
 600
 601 U8
 602 OP_flags(o)
 603         B::OP           o
 604
 605 U8
 606 OP_private(o)
 607         B::OP           o
 608
 609 #define UNOP_first(o)   o->op_first
 610
 611 MODULE = B      PACKAGE = B::UNOP               PREFIX = UNOP_
 612
 613 B::OP
 614 UNOP_first(o)
 615         B::UNOP o
 616
 617 #define BINOP_last(o)   o->op_last
 618
 619 MODULE = B      PACKAGE = B::BINOP              PREFIX = BINOP_
 620
 621 B::OP
 622 BINOP_last(o)
 623         B::BINOP        o
 624
 625 #define LOGOP_other(o)  o->op_other
 626
 627 MODULE = B      PACKAGE = B::LOGOP              PREFIX = LOGOP_
 628
 629 B::OP
 630 LOGOP_other(o)
 631         B::LOGOP        o
 632
 633 #define CONDOP_true(o)  o->op_true
 634 #define CONDOP_false(o) o->op_false
 635
 636 MODULE = B      PACKAGE = B::CONDOP             PREFIX = CONDOP_
 637
 638 B::OP
 639 CONDOP_true(o)
 640         B::CONDOP       o
 641
 642 B::OP
 643 CONDOP_false(o)
 644         B::CONDOP       o
 645
 646 #define LISTOP_children(o)      o->op_children
 647
 648 MODULE = B      PACKAGE = B::LISTOP             PREFIX = LISTOP_
 649
 650 U32
 651 LISTOP_children(o)
 652         B::LISTOP       o
 653
 654 #define PMOP_pmreplroot(o)      o->op_pmreplroot
 655 #define PMOP_pmreplstart(o)     o->op_pmreplstart
 656 #define PMOP_pmnext(o)          o->op_pmnext
 657 #define PMOP_pmregexp(o)        o->op_pmregexp
 658 #define PMOP_pmflags(o)         o->op_pmflags
 659 #define PMOP_pmpermflags(o)     o->op_pmpermflags
 660
 661 MODULE = B      PACKAGE = B::PMOP               PREFIX = PMOP_
 662
 663 void
 664 PMOP_pmreplroot(o)
 665         B::PMOP         o
 666         OP *            root = NO_INIT
 667     CODE:
 668         ST(0) = sv_newmortal();
 669         root = o->op_pmreplroot;
 670         /* OP_PUSHRE stores an SV* instead of an OP* in op_pmreplroot */
 671         if (o->op_type == OP_PUSHRE) {
 672             sv_setiv(newSVrv(ST(0), root ?
 673                              svclassnames[SvTYPE((SV*)root)] : "B::SV"),
 674                      (IV)root);
 675         }
 676         else {
 677             sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), (IV)root);
 678         }
 679
 680 B::OP
 681 PMOP_pmreplstart(o)
 682         B::PMOP         o
 683
 684 B::PMOP
 685 PMOP_pmnext(o)
 686         B::PMOP         o
 687
 688 U16
 689 PMOP_pmflags(o)
 690         B::PMOP         o
 691
 692 U16
 693 PMOP_pmpermflags(o)
 694         B::PMOP         o
 695
 696 void
 697 PMOP_precomp(o)
 698         B::PMOP         o
 699         REGEXP *        rx = NO_INIT
 700     CODE:
 701         ST(0) = sv_newmortal();
 702         rx = o->op_pmregexp;
 703         if (rx)
 704             sv_setpvn(ST(0), rx->precomp, rx->prelen);
 705
 706 #define SVOP_sv(o)      o->op_sv
 707
 708 MODULE = B      PACKAGE = B::SVOP               PREFIX = SVOP_
 709
 710
 711 B::SV
 712 SVOP_sv(o)
 713         B::SVOP o
 714
 715 #define GVOP_gv(o)      o->op_gv
 716
 717 MODULE = B      PACKAGE = B::GVOP               PREFIX = GVOP_
 718
 719
 720 B::GV
 721 GVOP_gv(o)
 722         B::GVOP o
 723
 724 MODULE = B      PACKAGE = B::PVOP               PREFIX = PVOP_
 725
 726 void
 727 PVOP_pv(o)
 728         B::PVOP o
 729     CODE:
 730         /*
 731          * OP_TRANS uses op_pv to point to a table of 256 shorts
 732          * whereas other PVOPs point to a null terminated string.
 733          */
 734         ST(0) = sv_2mortal(newSVpv(o->op_pv, (o->op_type == OP_TRANS) ?
 735                                    256 * sizeof(short) : 0));
 736
 737 #define LOOP_redoop(o)  o->op_redoop
 738 #define LOOP_nextop(o)  o->op_nextop
 739 #define LOOP_lastop(o)  o->op_lastop
 740
 741 MODULE = B      PACKAGE = B::LOOP               PREFIX = LOOP_
 742
 743
 744 B::OP
 745 LOOP_redoop(o)
 746         B::LOOP o
 747
 748 B::OP
 749 LOOP_nextop(o)
 750         B::LOOP o
 751
 752 B::OP
 753 LOOP_lastop(o)
 754         B::LOOP o
 755
 756 #define COP_label(o)    o->cop_label
 757 #define COP_stash(o)    o->cop_stash
 758 #define COP_filegv(o)   o->cop_filegv
 759 #define COP_cop_seq(o)  o->cop_seq
 760 #define COP_arybase(o)  o->cop_arybase
 761 #define COP_line(o)     o->cop_line
 762 #define COP_warnings(o) o->cop_warnings
 763
 764 MODULE = B      PACKAGE = B::COP                PREFIX = COP_
 765
 766 char *
 767 COP_label(o)
 768         B::COP  o
 769
 770 B::HV
 771 COP_stash(o)
 772         B::COP  o
 773
 774 B::GV
 775 COP_filegv(o)
 776         B::COP  o
 777
 778 U32
 779 COP_cop_seq(o)
 780         B::COP  o
 781
 782 I32
 783 COP_arybase(o)
 784         B::COP  o
 785
 786 U16
 787 COP_line(o)
 788         B::COP  o
 789
 790 B::SV
 791 COP_warnings(o)
 792         B::COP  o
 793
 794 MODULE = B      PACKAGE = B::SV         PREFIX = Sv
 795
 796 U32
 797 SvREFCNT(sv)
 798         B::SV   sv
 799
 800 U32
 801 SvFLAGS(sv)
 802         B::SV   sv
 803
 804 MODULE = B      PACKAGE = B::IV         PREFIX = Sv
 805
 806 IV
 807 SvIV(sv)
 808         B::IV   sv
 809
 810 IV
 811 SvIVX(sv)
 812         B::IV   sv
 813
 814 MODULE = B      PACKAGE = B::IV
 815
 816 #define needs64bits(sv) ((I32)SvIVX(sv) != SvIVX(sv))
 817
 818 int
 819 needs64bits(sv)
 820         B::IV   sv
 821
 822 void
 823 packiv(sv)
 824         B::IV   sv
 825     CODE:
 826         if (sizeof(IV) == 8) {
 827             U32 wp[2];
 828             IV iv = SvIVX(sv);
 829             /*
 830              * The following way of spelling 32 is to stop compilers on
 831              * 32-bit architectures from moaning about the shift count
 832              * being >= the width of the type. Such architectures don't
 833              * reach this code anyway (unless sizeof(IV) > 8 but then
 834              * everything else breaks too so I'm not fussed at the moment).
 835              */
 836             wp[0] = htonl(((U32)iv) >> (sizeof(IV)*4));
 837             wp[1] = htonl(iv & 0xffffffff);
 838             ST(0) = sv_2mortal(newSVpvn((char *)wp, 8));
 839         } else {
 840             U32 w = htonl((U32)SvIVX(sv));
 841             ST(0) = sv_2mortal(newSVpvn((char *)&w, 4));
 842         }
 843
 844 MODULE = B      PACKAGE = B::NV         PREFIX = Sv
 845
 846 double
 847 SvNV(sv)
 848         B::NV   sv
 849
 850 double
 851 SvNVX(sv)
 852         B::NV   sv
 853
 854 MODULE = B      PACKAGE = B::RV         PREFIX = Sv
 855
 856 B::SV
 857 SvRV(sv)
 858         B::RV   sv
 859
 860 MODULE = B      PACKAGE = B::PV         PREFIX = Sv
 861
 862 void
 863 SvPV(sv)
 864         B::PV   sv
 865     CODE:
 866         ST(0) = sv_newmortal();
 867         sv_setpvn(ST(0), SvPVX(sv), SvCUR(sv));
 868
 869 MODULE = B      PACKAGE = B::PVMG       PREFIX = Sv
 870
 871 void
 872 SvMAGIC(sv)
 873         B::PVMG sv
 874         MAGIC * mg = NO_INIT
 875     PPCODE:
 876         for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
 877             XPUSHs(make_mg_object(aTHX_ sv_newmortal(), mg));
 878
 879 MODULE = B      PACKAGE = B::PVMG
 880
 881 B::HV
 882 SvSTASH(sv)
 883         B::PVMG sv
 884
 885 #define MgMOREMAGIC(mg) mg->mg_moremagic
 886 #define MgPRIVATE(mg) mg->mg_private
 887 #define MgTYPE(mg) mg->mg_type
 888 #define MgFLAGS(mg) mg->mg_flags
 889 #define MgOBJ(mg) mg->mg_obj
 890 #define MgLENGTH(mg) mg->mg_len
 891
 892 MODULE = B      PACKAGE = B::MAGIC      PREFIX = Mg
 893
 894 B::MAGIC
 895 MgMOREMAGIC(mg)
 896         B::MAGIC        mg
 897
 898 U16
 899 MgPRIVATE(mg)
 900         B::MAGIC        mg
 901
 902 char
 903 MgTYPE(mg)
 904         B::MAGIC        mg
 905
 906 U8
 907 MgFLAGS(mg)
 908         B::MAGIC        mg
 909
 910 B::SV
 911 MgOBJ(mg)
 912         B::MAGIC        mg
 913
 914 I32
 915 MgLENGTH(mg)
 916         B::MAGIC        mg
 917
 918 void
 919 MgPTR(mg)
 920         B::MAGIC        mg
 921     CODE:
 922         ST(0) = sv_newmortal();
 923         if (mg->mg_ptr){
 924                 if (mg->mg_len >= 0){
 925                         sv_setpvn(ST(0), mg->mg_ptr, mg->mg_len);
 926                 } else {
 927                         if (mg->mg_len == HEf_SVKEY)
 928                                 sv_setsv(ST(0),newRV((SV*)mg->mg_ptr));
 929                 }
 930         }
 931
 932 MODULE = B      PACKAGE = B::PVLV       PREFIX = Lv
 933
 934 U32
 935 LvTARGOFF(sv)
 936         B::PVLV sv
 937
 938 U32
 939 LvTARGLEN(sv)
 940         B::PVLV sv
 941
 942 char
 943 LvTYPE(sv)
 944         B::PVLV sv
 945
 946 B::SV
 947 LvTARG(sv)
 948         B::PVLV sv
 949
 950 MODULE = B      PACKAGE = B::BM         PREFIX = Bm
 951
 952 I32
 953 BmUSEFUL(sv)
 954         B::BM   sv
 955
 956 U16
 957 BmPREVIOUS(sv)
 958         B::BM   sv
 959
 960 U8
 961 BmRARE(sv)
 962         B::BM   sv
 963
 964 void
 965 BmTABLE(sv)
 966         B::BM   sv
 967         STRLEN  len = NO_INIT
 968         char *  str = NO_INIT
 969     CODE:
 970         str = SvPV(sv, len);
 971         /* Boyer-Moore table is just after string and its safety-margin \0 */
 972         ST(0) = sv_2mortal(newSVpvn(str + len + 1, 256));
 973
 974 MODULE = B      PACKAGE = B::GV         PREFIX = Gv
 975
 976 void
 977 GvNAME(gv)
 978         B::GV   gv
 979     CODE:
 980         ST(0) = sv_2mortal(newSVpvn(GvNAME(gv), GvNAMELEN(gv)));
 981
 982 B::HV
 983 GvSTASH(gv)
 984         B::GV   gv
 985
 986 B::SV
 987 GvSV(gv)
 988         B::GV   gv
 989
 990 B::IO
 991 GvIO(gv)
 992         B::GV   gv
 993
 994 B::CV
 995 GvFORM(gv)
 996         B::GV   gv
 997
 998 B::AV
 999 GvAV(gv)
1000         B::GV   gv
1001
1002 B::HV
1003 GvHV(gv)
1004         B::GV   gv
1005
1006 B::GV
1007 GvEGV(gv)
1008         B::GV   gv
1009
1010 B::CV
1011 GvCV(gv)
1012         B::GV   gv
1013
1014 U32
1015 GvCVGEN(gv)
1016         B::GV   gv
1017
1018 U16
1019 GvLINE(gv)
1020         B::GV   gv
1021
1022 B::GV
1023 GvFILEGV(gv)
1024         B::GV   gv
1025
1026 MODULE = B      PACKAGE = B::GV
1027
1028 U32
1029 GvREFCNT(gv)
1030         B::GV   gv
1031
1032 U8
1033 GvFLAGS(gv)
1034         B::GV   gv
1035
1036 MODULE = B      PACKAGE = B::IO         PREFIX = Io
1037
1038 long
1039 IoLINES(io)
1040         B::IO   io
1041
1042 long
1043 IoPAGE(io)
1044         B::IO   io
1045
1046 long
1047 IoPAGE_LEN(io)
1048         B::IO   io
1049
1050 long
1051 IoLINES_LEFT(io)
1052         B::IO   io
1053
1054 char *
1055 IoTOP_NAME(io)
1056         B::IO   io
1057
1058 B::GV
1059 IoTOP_GV(io)
1060         B::IO   io
1061
1062 char *
1063 IoFMT_NAME(io)
1064         B::IO   io
1065
1066 B::GV
1067 IoFMT_GV(io)
1068         B::IO   io
1069
1070 char *
1071 IoBOTTOM_NAME(io)
1072         B::IO   io
1073
1074 B::GV
1075 IoBOTTOM_GV(io)
1076         B::IO   io
1077
1078 short
1079 IoSUBPROCESS(io)
1080         B::IO   io
1081
1082 MODULE = B      PACKAGE = B::IO
1083
1084 char
1085 IoTYPE(io)
1086         B::IO   io
1087
1088 U8
1089 IoFLAGS(io)
1090         B::IO   io
1091
1092 MODULE = B      PACKAGE = B::AV         PREFIX = Av
1093
1094 SSize_t
1095 AvFILL(av)
1096         B::AV   av
1097
1098 SSize_t
1099 AvMAX(av)
1100         B::AV   av
1101
1102 #define AvOFF(av) ((XPVAV*)SvANY(av))->xof_off
1103
1104 IV
1105 AvOFF(av)
1106         B::AV   av
1107
1108 void
1109 AvARRAY(av)
1110         B::AV   av
1111     PPCODE:
1112         if (AvFILL(av) >= 0) {
1113             SV **svp = AvARRAY(av);
1114             I32 i;
1115             for (i = 0; i <= AvFILL(av); i++)
1116                 XPUSHs(make_sv_object(aTHX_ sv_newmortal(), svp[i]));
1117         }
1118
1119 MODULE = B      PACKAGE = B::AV
1120
1121 U8
1122 AvFLAGS(av)
1123         B::AV   av
1124
1125 MODULE = B      PACKAGE = B::CV         PREFIX = Cv
1126
1127 B::HV
1128 CvSTASH(cv)
1129         B::CV   cv
1130
1131 B::OP
1132 CvSTART(cv)
1133         B::CV   cv
1134
1135 B::OP
1136 CvROOT(cv)
1137         B::CV   cv
1138
1139 B::GV
1140 CvGV(cv)
1141         B::CV   cv
1142
1143 B::GV
1144 CvFILEGV(cv)
1145         B::CV   cv
1146
1147 long
1148 CvDEPTH(cv)
1149         B::CV   cv
1150
1151 B::AV
1152 CvPADLIST(cv)
1153         B::CV   cv
1154
1155 B::CV
1156 CvOUTSIDE(cv)
1157         B::CV   cv
1158
1159 void
1160 CvXSUB(cv)
1161         B::CV   cv
1162     CODE:
1163         ST(0) = sv_2mortal(newSViv((IV)CvXSUB(cv)));
1164
1165
1166 void
1167 CvXSUBANY(cv)
1168         B::CV   cv
1169     CODE:
1170         ST(0) = sv_2mortal(newSViv(CvXSUBANY(cv).any_iv));
1171
1172 MODULE = B    PACKAGE = B::CV
1173
1174 U8
1175 CvFLAGS(cv)
1176       B::CV   cv
1177
1178
1179 MODULE = B      PACKAGE = B::HV         PREFIX = Hv
1180
1181 STRLEN
1182 HvFILL(hv)
1183         B::HV   hv
1184
1185 STRLEN
1186 HvMAX(hv)
1187         B::HV   hv
1188
1189 I32
1190 HvKEYS(hv)
1191         B::HV   hv
1192
1193 I32
1194 HvRITER(hv)
1195         B::HV   hv
1196
1197 char *
1198 HvNAME(hv)
1199         B::HV   hv
1200
1201 B::PMOP
1202 HvPMROOT(hv)
1203         B::HV   hv
1204
1205 void
1206 HvARRAY(hv)
1207         B::HV   hv
1208     PPCODE:
1209         if (HvKEYS(hv) > 0) {
1210             SV *sv;
1211             char *key;
1212             I32 len;
1213             (void)hv_iterinit(hv);
1214             EXTEND(sp, HvKEYS(hv) * 2);
1215             while (sv = hv_iternextsv(hv, &key, &len)) {
1216                 PUSHs(newSVpvn(key, len));
1217                 PUSHs(make_sv_object(aTHX_ sv_newmortal(), sv));
1218             }
1219         }