ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Faster/Faster.xs
Revision: 1.9
Committed: Sun Mar 12 21:36:00 2006 UTC (18 years, 3 months ago) by root
Branch: MAIN
Changes since 1.8: +26 -1 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.9 #include <fcntl.h>
6     #include <unistd.h>
7    
8 root 1.3 typedef CV *B__CV;
9    
10 root 1.1 static OP *(*old_entersub)(pTHX);
11    
12     // this is, of course, a slower entersub
13     static OP *
14     faster_entersub (pTHX)
15     {
16 root 1.9 static int in_perl;
17    
18     if (!PL_compcv || in_perl) // only when not compiling, reduces recompiling due to op-address-shift
19 root 1.8 {
20     dSP;
21     dTOPss;
22 root 1.1
23 root 1.9 ++in_perl;
24    
25 root 1.8 if (SvTYPE (sv) == SVt_PVGV)
26     sv = (SV *)GvCV (sv);
27 root 1.1
28 root 1.8 if (sv)
29 root 1.1 {
30 root 1.8 // only once for now
31     PL_op->op_ppaddr = old_entersub;
32 root 1.2
33 root 1.8 // only simple cv calls for now
34     if (!PL_perldb && !PL_tainting
35     && SvTYPE (sv) == SVt_PVCV && !CvXSUB (sv)
36     && CvSTART (sv) // must exist
37     && CvSTART (sv)->op_type != OP_NULL) // shield against compiling an already-compiled op
38     {
39     SV *bsv = newSViv (PTR2IV (sv));
40    
41     ENTER;
42     SAVETMPS;
43     PUSHMARK (SP);
44     // emulate B::CV typemap entry we don't have
45     XPUSHs (sv_2mortal (sv_bless (newRV_noinc (bsv), gv_stashpv ("B::CV", 1))));
46     PUTBACK;
47     call_pv ("Faster::entersub", G_VOID|G_DISCARD|G_EVAL);
48     SPAGAIN;
49     FREETMPS;
50     LEAVE;
51     }
52 root 1.1 }
53 root 1.9
54     --in_perl;
55 root 1.1 }
56    
57     return old_entersub (aTHX);
58     }
59    
60     MODULE = Faster PACKAGE = Faster
61    
62 root 1.2 PROTOTYPES: ENABLE
63    
64     IV
65     ppaddr (int optype)
66     CODE:
67     RETVAL = optype == OP_ENTERSUB
68 root 1.6 ? (IV)old_entersub
69     : (IV)PL_ppaddr [optype];
70 root 1.2 OUTPUT:
71     RETVAL
72    
73 root 1.1 void
74     hook_entersub ()
75     CODE:
76     old_entersub = PL_ppaddr [OP_ENTERSUB];
77     PL_ppaddr [OP_ENTERSUB] = faster_entersub;
78    
79 root 1.3 void
80     patch_cv (B::CV cv, void *ptr)
81     CODE:
82     {
83     OP *op;
84    
85 root 1.7 if (!ptr)
86     croak ("NULL not allowed as code address for patch_cv");
87    
88 root 1.3 NewOp (0, op, 1, OP);
89    
90     op->op_sibling = CvSTART (cv);
91     op->op_type = OP_NULL;
92     op->op_ppaddr = ptr;
93    
94     CvSTART (cv) = op;
95     }
96    
97 root 1.9 bool
98     fcntl_lock (int fd)
99     CODE:
100     {
101     struct flock lck;
102     lck.l_type = F_WRLCK;
103     lck.l_whence = SEEK_SET;
104     lck.l_start = 0;
105     lck.l_len = 0;
106    
107     RETVAL = fcntl (fd, F_SETLKW, &lck) == 0;
108     }
109     OUTPUT:
110     RETVAL
111    
112    
113 root 1.1