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