ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Faster/Faster.xs
Revision: 1.10
Committed: Sat Feb 21 05:55:52 2009 UTC (15 years, 4 months ago) by root
Branch: MAIN
CVS Tags: rel-0_1, HEAD
Changes since 1.9: +1 -1 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 #include <fcntl.h>
6 #include <unistd.h>
7
8 typedef CV *B__CV;
9
10 static OP *(*old_entersub)(pTHX);
11
12 // this is, of course, a slower entersub
13 static OP *
14 faster_entersub (pTHX)
15 {
16 static int in_perl;
17
18 if (!PL_compcv || in_perl) // only when not compiling, reduces recompiling due to op-address-shift
19 {
20 dSP;
21 dTOPss;
22
23 ++in_perl;
24
25 if (SvTYPE (sv) == SVt_PVGV)
26 sv = (SV *)GvCV (sv);
27
28 if (sv)
29 {
30 // only once for now
31 PL_op->op_ppaddr = old_entersub;
32
33 // only simple cv calls for now
34 if (!PL_perldb && !PL_tainting
35 && SvTYPE (sv) == SVt_PVCV && !CvISXSUB (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 }
53
54 --in_perl;
55 }
56
57 return old_entersub (aTHX);
58 }
59
60 MODULE = Faster PACKAGE = Faster
61
62 PROTOTYPES: ENABLE
63
64 IV
65 ppaddr (int optype)
66 CODE:
67 RETVAL = optype == OP_ENTERSUB
68 ? (IV)old_entersub
69 : (IV)PL_ppaddr [optype];
70 OUTPUT:
71 RETVAL
72
73 void
74 hook_entersub ()
75 CODE:
76 old_entersub = PL_ppaddr [OP_ENTERSUB];
77 PL_ppaddr [OP_ENTERSUB] = faster_entersub;
78
79 void
80 patch_cv (B::CV cv, void *ptr)
81 CODE:
82 {
83 OP *op;
84
85 if (!ptr)
86 croak ("NULL not allowed as code address for patch_cv");
87
88 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 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