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