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