ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Faster/Faster.xs
Revision: 1.7
Committed: Fri Mar 10 22:18:39 2006 UTC (18 years, 3 months ago) by root
Branch: MAIN
Changes since 1.6: +3 -0 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 #include "EXTERN.h"
2     #include "perl.h"
3     #include "XSUB.h"
4    
5 root 1.3 typedef CV *B__CV;
6    
7 root 1.1 static OP *(*old_entersub)(pTHX);
8    
9     // this is, of course, a slower entersub
10     static OP *
11     faster_entersub (pTHX)
12     {
13     dSP;
14     dTOPss;
15    
16     if (SvTYPE (sv) == SVt_PVGV)
17 root 1.2 sv = (SV *)GvCV (sv);
18 root 1.1
19     if (sv)
20     {
21     // only once for now
22     PL_op->op_ppaddr = old_entersub;
23    
24     // only simple cv calls for now
25 root 1.2 if (!PL_perldb && !PL_tainting
26 root 1.3 && SvTYPE (sv) == SVt_PVCV && !CvXSUB (sv)
27 root 1.4 && CvSTART (sv) // must exist
28 root 1.3 && CvSTART (sv)->op_type != OP_NULL) // shield against compiling an already-compiled op
29 root 1.1 {
30 root 1.3 SV *bsv = newSViv (PTR2IV (sv));
31 root 1.2
32 root 1.1 ENTER;
33     SAVETMPS;
34     PUSHMARK (SP);
35     // emulate B::CV typemap entry we don't have
36 root 1.3 XPUSHs (sv_2mortal (sv_bless (newRV_noinc (bsv), gv_stashpv ("B::CV", 1))));
37 root 1.1 PUTBACK;
38 root 1.3 call_pv ("Faster::entersub", G_VOID|G_DISCARD|G_EVAL);
39 root 1.1 SPAGAIN;
40     FREETMPS;
41     LEAVE;
42     }
43     }
44    
45     return old_entersub (aTHX);
46     }
47    
48     MODULE = Faster PACKAGE = Faster
49    
50 root 1.2 PROTOTYPES: ENABLE
51    
52     IV
53     ppaddr (int optype)
54     CODE:
55     RETVAL = optype == OP_ENTERSUB
56 root 1.6 ? (IV)old_entersub
57     : (IV)PL_ppaddr [optype];
58 root 1.2 OUTPUT:
59     RETVAL
60    
61 root 1.1 void
62     hook_entersub ()
63     CODE:
64     old_entersub = PL_ppaddr [OP_ENTERSUB];
65     PL_ppaddr [OP_ENTERSUB] = faster_entersub;
66    
67 root 1.3 void
68     patch_cv (B::CV cv, void *ptr)
69     CODE:
70     {
71     OP *op;
72    
73 root 1.7 if (!ptr)
74     croak ("NULL not allowed as code address for patch_cv");
75    
76 root 1.3 NewOp (0, op, 1, OP);
77    
78     op->op_sibling = CvSTART (cv);
79     op->op_type = OP_NULL;
80     op->op_ppaddr = ptr;
81    
82     CvSTART (cv) = op;
83     }
84    
85 root 1.1