X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=indirect.xs;h=1e546d6041e83bc95d1ddcfa547f2afc72751cb2;hb=1a28b9e5abd56be968ae09e9d45327632f1a28c8;hp=67cba846a98299092b75e3e919150c2c711ca843;hpb=3244106ca331b0d58c903b449f3c26af8f2d2d1e;p=perl%2Fmodules%2Findirect.git diff --git a/indirect.xs b/indirect.xs index 67cba84..1e546d6 100644 --- a/indirect.xs +++ b/indirect.xs @@ -1,19 +1,26 @@ +/* This file is part of the indirect Perl module. + * See http://search.cpan.org/dist/indirect/ */ + #define PERL_NO_GET_CONTEXT #include "EXTERN.h" #include "perl.h" #include "XSUB.h" +#ifndef SvPV_const +# define SvPV_const SvPV +#endif + +#ifndef SvPV_nolen_const +# define SvPV_nolen_const SvPV_nolen +#endif + #ifndef SvPVX_const # define SvPVX_const SvPVX #endif -STATIC U32 indirect_initialized = 0; -STATIC U32 indirect_hash = 0; +/* ... Hints ............................................................... */ -STATIC const char indirect_msg[] = "Indirect call of method \"%s\" on object \"%s\""; - -STATIC HV *indirect_map = NULL; -STATIC const char *indirect_linestr = NULL; +STATIC U32 indirect_hash = 0; STATIC UV indirect_hint(pTHX) { #define indirect_hint() indirect_hint(aTHX) @@ -25,6 +32,11 @@ STATIC UV indirect_hint(pTHX) { return SvOK(id) ? SvUV(id) : 0; } +/* ... op -> source position ............................................... */ + +STATIC HV *indirect_map = NULL; +STATIC const char *indirect_linestr = NULL; + STATIC void indirect_map_store(pTHX_ const OP *o, const char *src, SV *sv) { #define indirect_map_store(O, S, N) indirect_map_store(aTHX_ (O), (S), (N)) char buf[32]; @@ -50,12 +62,12 @@ STATIC void indirect_map_store(pTHX_ const OP *o, const char *src, SV *sv) { SvREFCNT_dec(val); } -STATIC const char *indirect_map_fetch(pTHX_ const OP *o, SV **name) { +STATIC const char *indirect_map_fetch(pTHX_ const OP *o, SV ** const name) { #define indirect_map_fetch(O, S) indirect_map_fetch(aTHX_ (O), (S)) char buf[32]; SV **val; - if (indirect_linestr != SvPVX(PL_parser->linestr)) + if (indirect_linestr != SvPVX_const(PL_parser->linestr)) return NULL; val = hv_fetch(indirect_map, buf, sprintf(buf, "%u", PTR2UV(o)), 0); @@ -87,6 +99,8 @@ STATIC const char *indirect_find(pTHX_ SV *sv, const char *s) { return p; } +/* ... ck_const ............................................................ */ + STATIC OP *(*indirect_old_ck_const)(pTHX_ OP *) = 0; STATIC OP *indirect_ck_const(pTHX_ OP *o) { @@ -99,6 +113,8 @@ STATIC OP *indirect_ck_const(pTHX_ OP *o) { return CALL_FPTR(indirect_old_ck_const)(aTHX_ o); } +/* ... ck_rv2sv ............................................................ */ + STATIC OP *(*indirect_old_ck_rv2sv)(pTHX_ OP *) = 0; STATIC OP *indirect_ck_rv2sv(pTHX_ OP *o) { @@ -115,6 +131,8 @@ STATIC OP *indirect_ck_rv2sv(pTHX_ OP *o) { return CALL_FPTR(indirect_old_ck_rv2sv)(aTHX_ o); } +/* ... ck_padany ........................................................... */ + STATIC OP *(*indirect_old_ck_padany)(pTHX_ OP *) = 0; STATIC OP *indirect_ck_padany(pTHX_ OP *o) { @@ -132,6 +150,8 @@ STATIC OP *indirect_ck_padany(pTHX_ OP *o) { return CALL_FPTR(indirect_old_ck_padany)(aTHX_ o); } +/* ... ck_method ........................................................... */ + STATIC OP *(*indirect_old_ck_method)(pTHX_ OP *) = 0; STATIC OP *indirect_ck_method(pTHX_ OP *o) { @@ -156,6 +176,10 @@ done: return CALL_FPTR(indirect_old_ck_method)(aTHX_ o); } +/* ... ck_entersub ......................................................... */ + +STATIC const char indirect_msg[] = "Indirect call of method \"%s\" on object \"%s\""; + STATIC OP *(*indirect_old_ck_entersub)(pTHX_ OP *) = 0; STATIC OP *indirect_ck_entersub(pTHX_ OP *o) { @@ -180,13 +204,18 @@ STATIC OP *indirect_ck_entersub(pTHX_ OP *o) { pm = indirect_map_fetch(om, &svm); po = indirect_map_fetch(oo, &svo); if (pm && po && pm < po) - ((hint == 2) ? croak : warn)(indirect_msg, SvPV_nolen(svm), SvPV_nolen(svo)); + ((hint == 2) ? croak : warn)(indirect_msg, SvPV_nolen_const(svm), + SvPV_nolen_const(svo)); } done: return CALL_FPTR(indirect_old_ck_entersub)(aTHX_ o); } +STATIC U32 indirect_initialized = 0; + +/* --- XS ------------------------------------------------------------------ */ + MODULE = indirect PACKAGE = indirect PROTOTYPES: DISABLE