diff options
| author | Ben Morrow <ben@morrow.me.uk> | 2010-11-14 16:13:51 -0800 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2010-11-14 16:44:35 -0800 |
| commit | 1830b3d9c87f8b1473b0a80759846f7a5dccae5a (patch) | |
| tree | beb18022aed134c48b163e704373a677892a1433 /ext | |
| parent | dd2637fb4f1ec3b64aa66be5b50af8823b480ce4 (diff) | |
| download | perl-1830b3d9c87f8b1473b0a80759846f7a5dccae5a.tar.gz | |
Improve custom OP support.
Change the custom op registrations from two separate hashes to one hash
holding structure pointers, and add API functions to register ops and
look them up. This will make it easier to add new properties of custom
ops in the future. Copy entries across from the old hashes where
necessary, to preserve compatibility.
Add two new properties, in addition to the already-existing 'name' and
'description': 'class' and 'peep'. 'class' is one of the OA_*OP
constants, and allows B and other introspection mechanisms to work with
custom ops that aren't BASEOPs. 'peep' is a pointer to a function that
will be called for ops of this type from Perl_rpeep.
Adjust B.xs to take account of the new properties, and also to give
custom ops their registered name rather than simply 'custom'.
Diffstat (limited to 'ext')
| -rw-r--r-- | ext/B/B.xs | 15 |
1 files changed, 11 insertions, 4 deletions
diff --git a/ext/B/B.xs b/ext/B/B.xs index ad9c0a676d..2a950d355c 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -113,6 +113,8 @@ START_MY_CXT static opclass cc_opclass(pTHX_ const OP *o) { + bool custom = 0; + if (!o) return OPc_NULL; @@ -139,7 +141,10 @@ cc_opclass(pTHX_ const OP *o) return OPc_PADOP; #endif - switch (PL_opargs[o->op_type] & OA_CLASS_MASK) { + if (o->op_type == OP_CUSTOM) + custom = 1; + + switch (OP_CLASS(o)) { case OA_BASEOP: return OPc_BASEOP; @@ -173,7 +178,9 @@ cc_opclass(pTHX_ const OP *o) * and the SV is a reference to a swash * (i.e., an RV pointing to an HV). */ - return (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF)) + return (!custom && + (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF)) + ) #if defined(USE_ITHREADS) \ && (PERL_VERSION > 8 || (PERL_VERSION == 8 && PERL_SUBVERSION >= 9)) ? OPc_PADOP : OPc_PVOP; @@ -231,7 +238,7 @@ cc_opclass(pTHX_ const OP *o) return OPc_PVOP; } warn("can't determine class of operator %s, assuming BASEOP\n", - PL_op_name[o->op_type]); + OP_NAME(o)); return OPc_BASEOP; } @@ -962,7 +969,7 @@ name(o) ALIAS: desc = 1 CODE: - RETVAL = (char *)(ix ? PL_op_desc : PL_op_name)[o->op_type]; + RETVAL = (char *)(ix ? OP_DESC(o) : OP_NAME(o)); OUTPUT: RETVAL |