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