From: Ilya Zakharevich Date: Mon, 6 Jul 1998 22:24:33 +0000 (-0400) Subject: add patch for C X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=569536030df0016c037f85e8e6d3ef93f000c47a;p=p5sagit%2Fp5-mst-13.2.git add patch for C Message-Id: <199807070224.WAA10318@monk.mps.ohio-state.edu> Subject: Re: _70 and Devel::RE p4raw-id: //depot/perl@1371 --- diff --git a/MANIFEST b/MANIFEST index 5f59a7f..8211870 100644 --- a/MANIFEST +++ b/MANIFEST @@ -308,6 +308,9 @@ ext/Thread/unsync4.t Test thread implicit synchronisation ext/attrs/Makefile.PL attrs extension makefile writer ext/attrs/attrs.pm attrs extension Perl module ext/attrs/attrs.xs attrs extension external subroutines +ext/re/Makefile.PL re extension makefile writer +ext/re/re.pm re extension Perl module +ext/re/re.xs re extension external subroutines ext/util/make_ext Used by Makefile to execute extension Makefiles ext/util/mkbootstrap Turns ext/*/*_BS into bootstrap info fakethr.h Fake threads header @@ -558,7 +561,6 @@ lib/open3.pl Open a three-ended pipe (uses IPC::Open3) lib/overload.pm Module for overloading perl operators lib/perl5db.pl Perl debugging routines lib/pwd.pl Routines to keep track of PWD environment variable -lib/re.pm Pragmas for regular expressions lib/shellwords.pl Perl library to split into words with shell quoting lib/sigtrap.pm For trapping an abort and giving traceback lib/stat.pl Perl library supporting stat function diff --git a/Makefile.SH b/Makefile.SH index a664d46..06c53b3 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -381,7 +381,10 @@ lib/Config.pm: config.sh miniperl configpm lib/ExtUtils/Miniperl.pm: miniperlmain.c miniperl minimod.pl lib/Config.pm $(LDLIBPTH) ./miniperl minimod.pl > tmp && mv tmp $@ -$(plextract): miniperl lib/Config.pm +lib/re.pm: ext/re/re.pm + cat ext/re/re.pm > $@ + +$(plextract): miniperl lib/Config.pm lib/re.pm $(LDLIBPTH) ./miniperl -Ilib $@.PL install: all install.perl install.man diff --git a/ext/re/Makefile.PL b/ext/re/Makefile.PL new file mode 100644 index 0000000..c6a55a6 --- /dev/null +++ b/ext/re/Makefile.PL @@ -0,0 +1,22 @@ +use ExtUtils::MakeMaker; +WriteMakefile( + NAME => 're', + VERSION_FROM => 're.pm', + MAN3PODS => ' ', # Pods will be built by installman. + XSPROTOARG => '-noprototypes', + OBJECT => 're_exec$(OBJ_EXT) re_comp$(OBJ_EXT) re$(OBJ_EXT)', + DEFINE => '-DDEBUGGING -DIN_XSUB_RE', +); + +sub MY::postamble { + return <<'EOF'; +re_comp.c: ../../regcomp.c + -$(RM) $@ + $(CP) ../../regcomp.c $@ + +re_exec.c: ../../regexec.c + -$(RM) $@ + $(CP) ../../regexec.c $@ + +EOF +} diff --git a/lib/re.pm b/ext/re/re.pm similarity index 81% rename from lib/re.pm rename to ext/re/re.pm index b7375e3..53873fc 100644 --- a/lib/re.pm +++ b/ext/re/re.pm @@ -1,5 +1,7 @@ package re; +$VERSION = 0.02; + =head1 NAME re - Perl pragma to alter regular expression behaviour @@ -45,23 +47,36 @@ eval => 0x00200000, ); sub bits { + my $on = shift; my $bits = 0; unless(@_) { require Carp; Carp::carp("Useless use of \"re\" pragma"); } - foreach my $s (@_){ $bits |= $bitmask{$s} || 0; }; + foreach my $s (@_){ + if ($s eq 'debug') { + eval <<'EOE'; + use DynaLoader; + @ISA = ('DynaLoader'); + bootstrap re; +EOE + install() if $on; + uninstall() unless $on; + next; + } + $bits |= $bitmask{$s} || 0; + } $bits; } sub import { shift; - $^H |= bits(@_); + $^H |= bits(1,@_); } sub unimport { shift; - $^H &= ~ bits(@_); + $^H &= ~ bits(0,@_); } 1; diff --git a/ext/re/re.xs b/ext/re/re.xs new file mode 100644 index 0000000..7b9fb37 --- /dev/null +++ b/ext/re/re.xs @@ -0,0 +1,38 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +extern regexp* my_regcomp _((char* exp, char* xend, PMOP* pm)); +extern I32 my_regexec _((regexp* prog, char* stringarg, char* strend, + char* strbeg, I32 minend, SV* screamer, + void* data, U32 flags)); + +static int oldfl; + +#define R_DB 512 + +static void +deinstall(void) +{ + regexecp = ®exec_flags; + regcompp = &pregcomp; + if (!oldfl) + debug &= ~R_DB; +} + +static void +install(void) +{ + regexecp = &my_regexec; + regcompp = &my_regcomp; + oldfl = debug & R_DB; + debug |= R_DB; +} + +MODULE = re PACKAGE = re + +void +install() + +void +deinstall() diff --git a/global.sym b/global.sym index 44c8dbc..35934ac 100644 --- a/global.sym +++ b/global.sym @@ -81,7 +81,6 @@ psig_name psig_ptr rcsid reall_srchlen -regexec_flags regkind repeat_amg repeat_ass_amg @@ -884,6 +883,7 @@ q ref refkids regdump +regexec_flags regnext regprop repeatcpy diff --git a/interp.sym b/interp.sym index 2e76cc4..6270324 100644 --- a/interp.sym +++ b/interp.sym @@ -133,6 +133,8 @@ reg_start_tmpl regbol regcc regcode +regcompp +regexecp regdata regdummy regendp diff --git a/intrpvar.h b/intrpvar.h index 75fb556..9c105b2 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -240,6 +240,11 @@ PERLVAR(Iregprogram, regnode *) /* from regexec.c */ PERLVARI(Iregindent, int, 0) /* from regexec.c */ PERLVAR(Iregcc, CURCUR *) /* from regexec.c */ + +PERLVARI(Iregcompp, regcomp_t, &pregcomp) /* Pointer to RE compiler */ +PERLVARI(Iregexecp, regexec_t, ®exec_flags) /* Pointer to RE executer */ + + PERLVARI(Iin_clean_objs,bool, FALSE) /* from sv.c */ PERLVARI(Iin_clean_all, bool, FALSE) /* from sv.c */ diff --git a/op.c b/op.c index ab7a056..caa8fe1 100644 --- a/op.c +++ b/op.c @@ -2140,7 +2140,7 @@ pmruntime(OP *o, OP *expr, OP *repl) p = SvPV(pat, plen); pm->op_pmflags |= PMf_SKIPWHITE; } - pm->op_pmregexp = pregcomp(p, p + plen, pm); + pm->op_pmregexp = (*regcompp)(p, p + plen, pm); if (strEQ("\\s+", pm->op_pmregexp->precomp)) pm->op_pmflags |= PMf_WHITE; op_free(expr); diff --git a/perl.h b/perl.h index 9d982ec..69776ab 100644 --- a/perl.h +++ b/perl.h @@ -1832,6 +1832,12 @@ typedef enum { #define RsPARA(sv) (SvOK(sv) && ! SvCUR(sv)) #define RsRECORD(sv) (SvROK(sv) && (SvIV(SvRV(sv)) > 0)) +/* Enable variables which are pointers to functions */ +typedef regexp*(*regcomp_t) _((char* exp, char* xend, PMOP* pm)); +typedef I32 (*regexec_t) _((regexp* prog, char* stringarg, char* strend, char* + strbeg, I32 minend, SV* screamer, void* data, + U32 flags)); + /* Set up PERLVAR macros for populating structs */ #define PERLVAR(var,type) type var; #define PERLVARI(var,type,init) type var; diff --git a/pp.c b/pp.c index 44ddd26..c388b61 100644 --- a/pp.c +++ b/pp.c @@ -4338,7 +4338,7 @@ PP(pp_split) else { maxiters += (strend - s) * rx->nparens; while (s < strend && --limit && - regexec_flags(rx, s, strend, orig, 1, Nullsv, NULL, 0)) + (*regexecp)(rx, s, strend, orig, 1, Nullsv, NULL, 0)) { TAINT_IF(RX_MATCH_TAINTED(rx)); if (rx->subbase diff --git a/pp_ctl.c b/pp_ctl.c index b1d2f68..464e20d 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -101,7 +101,7 @@ PP(pp_regcomp) } pm->op_pmflags = pm->op_pmpermflags; /* reset case sensitivity */ - pm->op_pmregexp = pregcomp(t, t + len, pm); + pm->op_pmregexp = (*regcompp)(t, t + len, pm); } } @@ -148,7 +148,7 @@ PP(pp_substcont) sv_catsv(dstr, POPs); /* Are we done */ - if (cx->sb_once || !regexec_flags(rx, s, cx->sb_strend, orig, + if (cx->sb_once || !(*regexecp)(rx, s, cx->sb_strend, orig, s == m, Nullsv, NULL, cx->sb_safebase ? 0 : REXEC_COPY_STR)) { diff --git a/pp_hot.c b/pp_hot.c index f7183a8..c64393e 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -905,7 +905,7 @@ play_it_again: rx->float_substr = Nullsv; } } - if (regexec_flags(rx, s, strend, truebase, minmatch, + if ((*regexecp)(rx, s, strend, truebase, minmatch, screamer, NULL, safebase)) { curpm = pm; @@ -1624,7 +1624,7 @@ PP(pp_subst) /* can do inplace substitution? */ if (c && clen <= rx->minlen && (once || !(safebase & REXEC_COPY_STR)) && !(rx->reganch & ROPT_LOOKBEHIND_SEEN)) { - if (!regexec_flags(rx, s, strend, orig, 0, screamer, NULL, safebase)) { + if (!(*regexecp)(rx, s, strend, orig, 0, screamer, NULL, safebase)) { SPAGAIN; PUSHs(&sv_no); LEAVE_SCOPE(oldsave); @@ -1701,7 +1701,7 @@ PP(pp_subst) d += clen; } s = rx->endp[0]; - } while (regexec_flags(rx, s, strend, orig, s == m, + } while ((*regexecp)(rx, s, strend, orig, s == m, Nullsv, NULL, 0)); /* don't match same null twice */ if (s != d) { i = strend - s; @@ -1724,7 +1724,7 @@ PP(pp_subst) RETURN; } - if (regexec_flags(rx, s, strend, orig, 0, screamer, NULL, safebase)) { + if ((*regexecp)(rx, s, strend, orig, 0, screamer, NULL, safebase)) { if (force_on_match) { force_on_match = 0; s = SvPV_force(TARG, len); @@ -1758,7 +1758,7 @@ PP(pp_subst) sv_catpvn(dstr, c, clen); if (once) break; - } while (regexec_flags(rx, s, strend, orig, s == m, Nullsv, NULL, safebase)); + } while ((*regexecp)(rx, s, strend, orig, s == m, Nullsv, NULL, safebase)); sv_catpvn(dstr, s, strend - s); (void)SvOOK_off(TARG); diff --git a/regcomp.c b/regcomp.c index b18740c..6292466 100644 --- a/regcomp.c +++ b/regcomp.c @@ -19,6 +19,12 @@ * with the POSIX routines of the same names. */ +#ifdef IN_XSUB_RE +# define Perl_pregcomp my_regcomp +# define Perl_regdump my_regdump +# define Perl_regprop my_regprop +#endif + /*SUPPRESS 112*/ /* * pregcomp and pregexec -- regsub and regerror are not used in perl diff --git a/regexec.c b/regexec.c index 77b9f2d..505bc28 100644 --- a/regexec.c +++ b/regexec.c @@ -19,6 +19,12 @@ * with the POSIX routines of the same names. */ +#ifdef IN_XSUB_RE +# define Perl_regexec_flags my_regexec +# define Perl_regdump my_regdump +# define Perl_regprop my_regprop +#endif + /*SUPPRESS 112*/ /* * pregcomp and pregexec -- regsub and regerror are not used in perl