1 #if defined(PERL_EXT_RE_DEBUG) && !defined(DEBUGGING) 2 # define DEBUGGING 3 # define DEBUGGING_RE_ONLY 4 #endif 5 6 #define PERL_NO_GET_CONTEXT 7 #include "EXTERN.h" 8 #include "perl.h" 9 #include "XSUB.h" 10 #include "re_comp.h" 11 12 #undef dXSBOOTARGSXSAPIVERCHK 13 /* skip API version checking due to different interp struct size but, 14 this hack is until #123007 is resolved */ 15 #define dXSBOOTARGSXSAPIVERCHK dXSBOOTARGSNOVERCHK 16 17 START_EXTERN_C 18 19 extern REGEXP* my_re_compile (pTHX_ SV * const pattern, const U32 pm_flags); 20 extern REGEXP* my_re_op_compile (pTHX_ SV ** const patternp, int pat_count, 21 OP *expr, const regexp_engine* eng, REGEXP *volatile old_re, 22 bool *is_bare_re, U32 rx_flags, U32 pm_flags); 23 24 extern I32 my_regexec (pTHX_ REGEXP * const prog, char* stringarg, char* strend, 25 char* strbeg, SSize_t minend, SV* screamer, 26 void* data, U32 flags); 27 28 extern char* my_re_intuit_start(pTHX_ 29 REGEXP * const rx, 30 SV *sv, 31 const char * const strbeg, 32 char *strpos, 33 char *strend, 34 const U32 flags, 35 re_scream_pos_data *data); 36 37 extern SV* my_re_intuit_string (pTHX_ REGEXP * const prog); 38 39 extern void my_regfree (pTHX_ REGEXP * const r); 40 41 extern void my_reg_numbered_buff_fetch(pTHX_ REGEXP * const rx, const I32 paren, 42 SV * const usesv); 43 extern void my_reg_numbered_buff_store(pTHX_ REGEXP * const rx, const I32 paren, 44 SV const * const value); 45 extern I32 my_reg_numbered_buff_length(pTHX_ REGEXP * const rx, 46 const SV * const sv, const I32 paren); 47 48 extern SV* my_reg_named_buff(pTHX_ REGEXP * const, SV * const, SV * const, 49 const U32); 50 extern SV* my_reg_named_buff_iter(pTHX_ REGEXP * const rx, 51 const SV * const lastkey, const U32 flags); 52 53 extern SV* my_reg_qr_package(pTHX_ REGEXP * const rx); 54 #if defined(USE_ITHREADS) 55 extern void* my_regdupe (pTHX_ REGEXP * const r, CLONE_PARAMS *param); 56 #endif 57 58 EXTERN_C const struct regexp_engine my_reg_engine; 59 EXTERN_C const struct regexp_engine wild_reg_engine; 60 61 END_EXTERN_C 62 63 const struct regexp_engine my_reg_engine = { 64 my_re_compile, 65 my_regexec, 66 my_re_intuit_start, 67 my_re_intuit_string, 68 my_regfree, 69 my_reg_numbered_buff_fetch, 70 my_reg_numbered_buff_store, 71 my_reg_numbered_buff_length, 72 my_reg_named_buff, 73 my_reg_named_buff_iter, 74 my_reg_qr_package, 75 #if defined(USE_ITHREADS) 76 my_regdupe, 77 #endif 78 my_re_op_compile, 79 }; 80 81 /* For use with Unicode property wildcards, when we want to see the compilation 82 * of the wildcard subpattern, but don't want to see the matching process. All 83 * but the compilation are the regcomp.c/regexec.c functions which aren't 84 * subject to 'use re' */ 85 const struct regexp_engine wild_reg_engine = { 86 my_re_compile, 87 Perl_regexec_flags, 88 Perl_re_intuit_start, 89 Perl_re_intuit_string, 90 Perl_regfree_internal, 91 Perl_reg_numbered_buff_fetch, 92 Perl_reg_numbered_buff_store, 93 Perl_reg_numbered_buff_length, 94 Perl_reg_named_buff, 95 Perl_reg_named_buff_iter, 96 Perl_reg_qr_package, 97 #if defined(USE_ITHREADS) 98 Perl_regdupe_internal, 99 #endif 100 my_re_op_compile, 101 }; 102 103 MODULE = re PACKAGE = re 104 105 void 106 install() 107 PPCODE: 108 PL_colorset = 0; /* Allow reinspection of ENV. */ 109 /* PL_debug |= DEBUG_r_FLAG; */ 110 XPUSHs(sv_2mortal(newSViv(PTR2IV(&my_reg_engine)))); 111 112 void 113 regmust(sv) 114 SV * sv 115 PROTOTYPE: $ 116 PREINIT: 117 REGEXP *re; 118 PPCODE: 119 { 120 if ((re = SvRX(sv)) /* assign deliberate */ 121 /* only for re engines we know about */ 122 && ( RX_ENGINE(re) == &my_reg_engine 123 || RX_ENGINE(re) == &wild_reg_engine 124 || RX_ENGINE(re) == &PL_core_reg_engine)) 125 { 126 SV *an = &PL_sv_no; 127 SV *fl = &PL_sv_no; 128 if (RX_ANCHORED_SUBSTR(re)) { 129 an = sv_2mortal(newSVsv(RX_ANCHORED_SUBSTR(re))); 130 } else if (RX_ANCHORED_UTF8(re)) { 131 an = sv_2mortal(newSVsv(RX_ANCHORED_UTF8(re))); 132 } 133 if (RX_FLOAT_SUBSTR(re)) { 134 fl = sv_2mortal(newSVsv(RX_FLOAT_SUBSTR(re))); 135 } else if (RX_FLOAT_UTF8(re)) { 136 fl = sv_2mortal(newSVsv(RX_FLOAT_UTF8(re))); 137 } 138 EXTEND(SP, 2); 139 PUSHs(an); 140 PUSHs(fl); 141 XSRETURN(2); 142 } 143 XSRETURN_UNDEF; 144 } 145 146