This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
3c52e4a296860af28817c63f0851e4c7970c9c9a
[perl5.git] / ext / B / C / C.xs
1 #include <EXTERN.h>
2 #include <perl.h>
3 #include <XSUB.h>
4
5 int
6 my_runops(pTHX)
7 {
8     HV* regexp_hv = get_hv( "B::C::REGEXP", 0 );
9     SV* key = newSViv( 0 );
10
11     do {
12         PERL_ASYNC_CHECK();
13
14         if( PL_op->op_type == OP_QR ) {
15             PMOP* op;
16             REGEXP* rx = PM_GETRE( (PMOP*)PL_op );
17             SV* rv = newSViv( 0 );
18
19             New( 671, op, 1, PMOP );
20             Copy( PL_op, op, 1, PMOP );
21             /* we need just the flags */
22             op->op_next = NULL;
23             op->op_sibling = NULL;
24             op->op_first = NULL;
25             op->op_last = NULL;
26             op->op_pmreplroot = NULL;
27             op->op_pmreplstart = NULL;
28             op->op_pmnext = NULL;
29 #ifdef USE_ITHREADS
30             op->op_pmoffset = 0;
31 #else
32             op->op_pmregexp = 0;
33 #endif
34
35             sv_setiv( key, PTR2IV( rx ) );
36             sv_setref_iv( rv, "B::PMOP", PTR2IV( op ) );
37
38             hv_store_ent( regexp_hv, key, rv, 0 );
39         }
40     } while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX)));
41
42     SvREFCNT_dec( key );
43
44     TAINT_NOT;
45     return 0;
46 }
47
48 MODULE=B__C PACKAGE=B::C
49
50 PROTOTYPES: DISABLE
51
52 BOOT:
53     PL_runops = my_runops;