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