diff options
| -rw-r--r-- | embed.fnc | 1 | ||||
| -rw-r--r-- | embed.h | 1 | ||||
| -rw-r--r-- | proto.h | 1 | ||||
| -rw-r--r-- | regcomp.c | 28 | ||||
| -rw-r--r-- | regen/regcomp.pl | 47 | ||||
| -rw-r--r-- | regnodes.h | 15 |
6 files changed, 91 insertions, 2 deletions
@@ -2047,6 +2047,7 @@ Es |void |make_trie_failtable |NN struct RExC_state_t *pRExC_state \ |NN regnode *source|NN regnode *stclass \ |U32 depth # ifdef DEBUGGING +Es |void |regdump_intflags|NULLOK const char *lead| const U32 flags Es |void |regdump_extflags|NULLOK const char *lead| const U32 flags Es |const regnode*|dumpuntil|NN const regexp *r|NN const regnode *start \ |NN const regnode *node \ @@ -878,6 +878,7 @@ #define dumpuntil(a,b,c,d,e,f,g,h) S_dumpuntil(aTHX_ a,b,c,d,e,f,g,h) #define put_byte(a,b) S_put_byte(aTHX_ a,b) #define regdump_extflags(a,b) S_regdump_extflags(aTHX_ a,b) +#define regdump_intflags(a,b) S_regdump_intflags(aTHX_ a,b) #define regtail_study(a,b,c,d) S_regtail_study(aTHX_ a,b,c,d) # endif # if defined(PERL_IN_REGEXEC_C) @@ -5188,6 +5188,7 @@ STATIC void S_put_byte(pTHX_ SV* sv, int c) assert(sv) STATIC void S_regdump_extflags(pTHX_ const char *lead, const U32 flags); +STATIC void S_regdump_intflags(pTHX_ const char *lead, const U32 flags); STATIC U8 S_regtail_study(pTHX_ struct RExC_state_t *pRExC_state, regnode *p, const regnode *val, U32 depth) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2) @@ -14446,6 +14446,29 @@ S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode *p, const regnode *val, - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form */ #ifdef DEBUGGING + +static void +S_regdump_intflags(pTHX_ const char *lead, const U32 flags) +{ + int bit; + int set=0; + regex_charset cs; + + for (bit=0; bit<32; bit++) { + if (flags & (1<<bit)) { + if (!set++ && lead) + PerlIO_printf(Perl_debug_log, "%s",lead); + PerlIO_printf(Perl_debug_log, "%s ",PL_reg_intflags_name[bit]); + } + } + if (lead) { + if (set) + PerlIO_printf(Perl_debug_log, "\n"); + else + PerlIO_printf(Perl_debug_log, "%s[none-set]\n",lead); + } +} + static void S_regdump_extflags(pTHX_ const char *lead, const U32 flags) { @@ -14578,7 +14601,10 @@ Perl_regdump(pTHX_ const regexp *r) if (r->extflags & RXf_EVAL_SEEN) PerlIO_printf(Perl_debug_log, "with eval "); PerlIO_printf(Perl_debug_log, "\n"); - DEBUG_FLAGS_r(regdump_extflags("r->extflags: ",r->extflags)); + DEBUG_FLAGS_r({ + regdump_extflags("r->extflags: ",r->extflags); + regdump_intflags("r->intflags: ",r->intflags); + }); #else PERL_ARGS_ASSERT_REGDUMP; PERL_UNUSED_CONTEXT; diff --git a/regen/regcomp.pl b/regen/regcomp.pl index 97719b00ec..4a8b9d52ab 100644 --- a/regen/regcomp.pl +++ b/regen/regcomp.pl @@ -245,6 +245,10 @@ print $out <<EOP; }; #endif /* DOINIT */ +EOP + +{ +print $out <<EOP; /* PL_reg_extflags_name[] - Opcode/state names in string form, for debugging */ #ifndef DOINIT @@ -263,7 +267,7 @@ foreach my $file ("op_reg_common.h", "regexp.h") { # optional leading '_'. Return symbol in $1, and strip it from # rest of line - if (s/ \# \s* define \s+ ( _? RXf_ \w+ ) \s+ //xi) { + if (s/^ \# \s* define \s+ ( _? RXf_ \w+ ) \s+ //xi) { chomp; my $define = $1; my $orig= $_; @@ -335,6 +339,47 @@ print $out <<EOP; #endif /* DOINIT */ EOP +} +{ +print $out <<EOP; +/* PL_reg_intflags_name[] - Opcode/state names in string form, for debugging */ + +#ifndef DOINIT +EXTCONST char * PL_reg_intflags_name[]; +#else +EXTCONST char * const PL_reg_intflags_name[] = { +EOP + +my %rxfv; +my %definitions; # Remember what the symbol definitions are +my $val = 0; +my %reverse; +foreach my $file ("regcomp.h") { + open my $fh, "<", $file or die "Can't read $file: $!"; + while (<$fh>) { + # optional leading '_'. Return symbol in $1, and strip it from + # rest of line + if (m/^ \# \s* define \s+ ( PREGf_ ( \w+ ) ) \s+ 0x([0-9a-f]+)(?:\s*\/\*(.*)\*\/)?/xi) { + chomp; + my $define = $1; + my $abbr= $2; + my $hex= $3; + my $comment= $4; + my $val= hex($hex); + $comment= $comment ? " - $comment" : ""; + + printf $out qq(\t%-30s/* 0x%08x - %s%s */\n), qq("$abbr",), $val, $define, $comment; + } + } +} + +print $out <<EOP; +}; +#endif /* DOINIT */ + +EOP +} + print $out process_flags('V', 'varies', <<'EOC'); /* The following have no fixed length. U8 so we can do strchr() on it. */ diff --git a/regnodes.h b/regnodes.h index 0caf86dd55..d6c57e0010 100644 --- a/regnodes.h +++ b/regnodes.h @@ -686,6 +686,21 @@ EXTCONST char * const PL_reg_extflags_name[] = { }; #endif /* DOINIT */ +/* PL_reg_intflags_name[] - Opcode/state names in string form, for debugging */ + +#ifndef DOINIT +EXTCONST char * PL_reg_intflags_name[]; +#else +EXTCONST char * const PL_reg_intflags_name[] = { + "SKIP", /* 0x00000001 - PREGf_SKIP */ + "IMPLICIT", /* 0x00000002 - PREGf_IMPLICIT - Converted .* to ^.* */ + "NAUGHTY", /* 0x00000004 - PREGf_NAUGHTY - how exponential is this pattern? */ + "VERBARG_SEEN", /* 0x00000008 - PREGf_VERBARG_SEEN */ + "CUTGROUP_SEEN", /* 0x00000010 - PREGf_CUTGROUP_SEEN */ + "USE_RE_EVAL", /* 0x00000020 - PREGf_USE_RE_EVAL - compiled with "use re 'eval'" */ +}; +#endif /* DOINIT */ + /* The following have no fixed length. U8 so we can do strchr() on it. */ #define REGNODE_VARIES(node) (PL_varies_bitmask[(node) >> 3] & (1 << ((node) & 7))) |