My favorites | Sign in
Project Home Wiki Issues Source
Repository:
Checkout   Browse   Changes   Clones  
Changes to /C.xs
cc90753d6900 vs. 50d573862d04 Compare: vs.  Format:
Revision 50d573862d04
Go to: 
Project members, sign in to write a code review
/C.xs   cc90753d6900 /C.xs   50d573862d04
1 #include <EXTERN.h> 1 #include <EXTERN.h>
2 #include <perl.h> 2 #include <perl.h>
3 #include <XSUB.h> 3 #include <XSUB.h>
4 4
5 #ifndef PM_GETRE 5 #ifndef PM_GETRE
6 # if defined(USE_ITHREADS) && (PERL_VERSION > 8) 6 # if defined(USE_ITHREADS) && (PERL_VERSION > 8)
7 # define PM_GETRE(o) (INT2PTR(REGEXP*,SvIVX(PL_regex_pad[(o)->op_pmoffset]))) 7 # define PM_GETRE(o) (INT2PTR(REGEXP*,SvIVX(PL_regex_pad[(o)->op_pmoffset])))
8 # else 8 # else
9 # define PM_GETRE(o) ((o)->op_pmregexp) 9 # define PM_GETRE(o) ((o)->op_pmregexp)
10 # endif 10 # endif
11 #endif 11 #endif
12 #ifndef RX_EXTFLAGS 12 #ifndef RX_EXTFLAGS
13 # define RX_EXTFLAGS(prog) ((prog)->extflags) 13 # define RX_EXTFLAGS(prog) ((prog)->extflags)
14 #endif 14 #endif
15 15
16 typedef struct magic *B__MAGIC; 16 typedef struct magic *B__MAGIC;
17 #if PERL_VERSION >= 11 17 #if PERL_VERSION >= 11
18 typedef struct p5rx *B__REGEXP; 18 typedef struct p5rx *B__REGEXP;
19 #endif 19 #endif
20 typedef COP *B__COP; 20 typedef COP *B__COP;
21 21
22 STATIC U32 a_hash = 0; 22 STATIC U32 a_hash = 0;
23 23
24 typedef struct { 24 typedef struct {
25 U32 bits; 25 U32 bits;
26 IV require_tag; 26 IV require_tag;
27 } a_hint_t; 27 } a_hint_t;
28 28
29 static int 29 static int
30 my_runops(pTHX) 30 my_runops(pTHX)
31 { 31 {
32 HV* regexp_hv = get_hv( "B::C::Regexp", 0 ); 32 HV* regexp_hv = get_hv( "B::C::Regexp", 0 );
33 SV* key = newSViv( 0 ); 33 SV* key = newSViv( 0 );
34 34
35 DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level (B::C)\n")); 35 DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level (B::C)\n"));
36 do { 36 do {
37 #if (PERL_VERSION < 13) || ((PERL_VERSION == 13) && (PERL_SUBVERSION < 2)) 37 #if (PERL_VERSION < 13) || ((PERL_VERSION == 13) && (PERL_SUBVERSION < 2))
38 PERL_ASYNC_CHECK(); 38 PERL_ASYNC_CHECK();
39 #endif 39 #endif
40 40
41 if (PL_debug) { 41 if (PL_debug) {
42 if (PL_watchaddr && (*PL_watchaddr != PL_watchok)) 42 if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
43 PerlIO_printf(Perl_debug_log, 43 PerlIO_printf(Perl_debug_log,
44 "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n", 44 "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
45 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok), 45 PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
46 PTR2UV(*PL_watchaddr)); 46 PTR2UV(*PL_watchaddr));
47 #if defined(DEBUGGING) \ 47 #if defined(DEBUGGING) \
48 && !(defined(_WIN32) || (defined(__CYGWIN__) && (__GNUC__ > 3)) || defined(AIX)) 48 && !(defined(_WIN32) || (defined(__CYGWIN__) && (__GNUC__ > 3)) || defined(AIX))
49 # if (PERL_VERSION > 7) 49 # if (PERL_VERSION > 7)
50 if (DEBUG_s_TEST_) debstack(); 50 if (DEBUG_s_TEST_) debstack();
51 if (DEBUG_t_TEST_) debop(PL_op); 51 if (DEBUG_t_TEST_) debop(PL_op);
52 # else 52 # else
53 DEBUG_s(debstack()); 53 DEBUG_s(debstack());
54 DEBUG_t(debop(PL_op)); 54 DEBUG_t(debop(PL_op));
55 # endif 55 # endif
56 #endif 56 #endif
57 } 57 }
58 58
59 if( PL_op->op_type == OP_QR ) { 59 if( PL_op->op_type == OP_QR ) {
60 PMOP* op; 60 PMOP* op;
61 REGEXP* rx = PM_GETRE( (PMOP*)PL_op ); 61 REGEXP* rx = PM_GETRE( (PMOP*)PL_op );
62 SV* rv = newSViv( 0 ); 62 SV* rv = newSViv( 0 );
63 63
64 New(0, op, 1, PMOP ); 64 New(0, op, 1, PMOP );
65 Copy( PL_op, op, 1, PMOP ); 65 Copy( PL_op, op, 1, PMOP );
66 /* we need just the flags */ 66 /* we need just the flags */
67 op->op_next = NULL; 67 op->op_next = NULL;
68 op->op_sibling = NULL; 68 op->op_sibling = NULL;
69 op->op_first = NULL; 69 op->op_first = NULL;
70 op->op_last = NULL; 70 op->op_last = NULL;
71 71
72 #if PERL_VERSION < 10 72 #if PERL_VERSION < 10
73 op->op_pmreplroot = NULL; 73 op->op_pmreplroot = NULL;
74 op->op_pmreplstart = NULL; 74 op->op_pmreplstart = NULL;
75 op->op_pmnext = NULL; 75 op->op_pmnext = NULL;
76 #endif 76 #endif
77 #if defined(USE_ITHREADS) && (PERL_VERSION > 7) 77 #if defined(USE_ITHREADS) && (PERL_VERSION > 7)
78 op->op_pmoffset = 0; 78 op->op_pmoffset = 0;
79 #else 79 #else
80 op->op_pmregexp = 0; 80 op->op_pmregexp = 0;
81 #endif 81 #endif
82 82
83 sv_setiv( key, PTR2IV( rx ) ); 83 sv_setiv( key, PTR2IV( rx ) );
84 sv_setref_iv( rv, "B::PMOP", PTR2IV( op ) ); 84 sv_setref_iv( rv, "B::PMOP", PTR2IV( op ) );
85 85
86 hv_store_ent( regexp_hv, key, rv, 0 ); 86 hv_store_ent( regexp_hv, key, rv, 0 );
87 } 87 }
88 } while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))); 88 } while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX)));
89 89
90 SvREFCNT_dec( key ); 90 SvREFCNT_dec( key );
91 91
92 TAINT_NOT; 92 TAINT_NOT;
93 return 0; 93 return 0;
94 } 94 }
95 95
96 MODULE = B__MAGIC PACKAGE = B::MAGIC 96 MODULE = B__MAGIC PACKAGE = B::MAGIC
97 97
98 #if PERL_VERSION < 7 98 #if PERL_VERSION < 7
99 99
100 SV* 100 SV*
101 precomp(mg) 101 precomp(mg)
102 B::MAGIC mg 102 B::MAGIC mg
103 CODE: 103 CODE:
104 if (mg->mg_type == 'r') { 104 if (mg->mg_type == 'r') {
105 REGEXP* rx = (REGEXP*)mg->mg_obj; 105 REGEXP* rx = (REGEXP*)mg->mg_obj;
106 RETVAL = Nullsv; 106 RETVAL = Nullsv;
107 if (rx) 107 if (rx)
108 RETVAL = newSVpvn( rx->precomp, rx->prelen ); 108 RETVAL = newSVpvn( rx->precomp, rx->prelen );
109 } 109 }
110 else { 110 else {
111 croak( "precomp is only meaningful on r-magic" ); 111 croak( "precomp is only meaningful on r-magic" );
112 } 112 }
113 OUTPUT: 113 OUTPUT:
114 RETVAL 114 RETVAL
115 115
116 #endif 116 #endif
117 117
118 MODULE = B PACKAGE = B::REGEXP PREFIX = RX_ 118 MODULE = B PACKAGE = B::REGEXP PREFIX = RX_
119 119
120 #if PERL_VERSION > 10 120 #if PERL_VERSION > 10
121 121
122 U32 122 U32
123 RX_EXTFLAGS(rx) 123 RX_EXTFLAGS(rx)
124 B::REGEXP rx 124 B::REGEXP rx
125 125
126 #endif 126 #endif
127 127
128 MODULE = B PACKAGE = B::COP PREFIX = COP_ 128 MODULE = B PACKAGE = B::COP PREFIX = COP_
129 129
130 #if (PERL_VERSION >= 15) && defined(USE_ITHREADS) && defined(CopSTASH_flags) 130 #if (PERL_VERSION >= 15) && defined(USE_ITHREADS) && defined(CopSTASH_flags)
131 131
132 #define COP_stashflags(o) CopSTASH_flags(o) 132 #define COP_stashflags(o) CopSTASH_flags(o)
133 133
134 U32 134 U32
135 COP_stashflags(o) 135 COP_stashflags(o)
136 B::COP o 136 B::COP o
137 137
138 #endif 138 #endif
139 139
140 MODULE = B__CC PACKAGE = B::CC 140 MODULE = B__CC PACKAGE = B::CC
141 141
142 PROTOTYPES: DISABLE 142 PROTOTYPES: DISABLE
143 143
144 U32 144 U32
145 _autovivification(cop) 145 _autovivification(cop)
146 B::COP cop 146 B::COP cop
147 CODE: 147 CODE:
148 { 148 {
149 SV *hint; 149 SV *hint;
150 IV h; 150 IV h;
151 151
152 RETVAL = 1; 152 RETVAL = 1;
153 if (PL_check[OP_PADSV] != MEMBER_TO_FPTR(Perl_ck_null)) { 153 if (PL_check[OP_PADSV] != PL_check[0]) {
154 char *package = CopSTASHPV(cop); 154 char *package = CopSTASHPV(cop);
155 #ifdef cop_hints_fetch_pvn 155 #ifdef cop_hints_fetch_pvn
156 hint = cop_hints_fetch_pvn(cop, "autovivification", strlen("autovivification"), a_hash, 0); 156 hint = cop_hints_fetch_pvn(cop, "autovivification", strlen("autovivification"), a_hash, 0);
157 #elif PERL_VERSION > 9 157 #elif PERL_VERSION > 9
158 hint = Perl_refcounted_he_fetch(aTHX_ cop->cop_hints_hash, 158 hint = Perl_refcounted_he_fetch(aTHX_ cop->cop_hints_hash,
159 NULL, "autovivification", strlen("autovivification"), 0, a_hash); 159 NULL, "autovivification", strlen("autovivification"), 0, a_hash);
160 #else 160 #else
161 SV **val = hv_fetch(GvHV(PL_hintgv), "autovivification", strlen("autovivification"), 0); 161 SV **val = hv_fetch(GvHV(PL_hintgv), "autovivification", strlen("autovivification"), 0);
162 if (!val) 162 if (!val)
163 return; 163 return;
164 hint = *val; 164 hint = *val;
165 #endif 165 #endif
166 if (!(hint && SvIOK(hint))) 166 if (!(hint && SvIOK(hint)))
167 return; 167 return;
168 h = SvIVX(hint); 168 h = SvIVX(hint);
169 if (h & 4) /* A_HINT_FETCH 4 */ 169 if (h & 4) /* A_HINT_FETCH 4 */
170 RETVAL = 0; 170 RETVAL = 0;
171 } 171 }
172 } 172 }
173 OUTPUT: 173 OUTPUT:
174 RETVAL 174 RETVAL
175 175
176 MODULE = B__C PACKAGE = B::C 176 MODULE = B__C PACKAGE = B::C
177 177
178 PROTOTYPES: DISABLE 178 PROTOTYPES: DISABLE
179 179
180 BOOT: 180 BOOT:
181 PL_runops = my_runops; 181 PL_runops = my_runops;
Powered by Google Project Hosting