From: Andy Lester Date: Thu, 9 Jun 2005 10:05:56 +0000 (-0500) Subject: regcomp.c and more X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a28509cc00517ad2ad1f6e022f1be6ab8f1ad18e;p=p5sagit%2Fp5-mst-13.2.git regcomp.c and more Message-ID: <20050609150556.GA30554@petdance.com> p4raw-id: //depot/perl@24780 --- diff --git a/embed.fnc b/embed.fnc index 75b9031..408e44f 100644 --- a/embed.fnc +++ b/embed.fnc @@ -53,7 +53,7 @@ Anod |void |perl_free |NN PerlInterpreter* interp Anod |int |perl_run |NN PerlInterpreter* interp Anod |int |perl_parse |PerlInterpreter* interp|XSINIT_t xsinit \ |int argc|char** argv|char** env -Anp |bool |doing_taint |int argc|char** argv|char** env +AnpR |bool |doing_taint |int argc|char** argv|char** env #if defined(USE_ITHREADS) Anod |PerlInterpreter*|perl_clone|PerlInterpreter* interp|UV flags # if defined(PERL_IMPLICIT_SYS) @@ -248,8 +248,7 @@ Ap |GP* |gp_ref |GP* gp Ap |GV* |gv_AVadd |GV* gv Ap |GV* |gv_HVadd |GV* gv Ap |GV* |gv_IOadd |GV* gv -Ap |GV* |gv_autoload4 |HV* stash|const char* name|STRLEN len \ - |I32 method +ApR |GV* |gv_autoload4 |HV* stash|NN const char* name|STRLEN len|I32 method Ap |void |gv_check |HV* stash Ap |void |gv_efullname |SV* sv|const GV* gv Apmb |void |gv_efullname3 |SV* sv|const GV* gv|const char* prefix @@ -797,7 +796,7 @@ Apd |void |sv_setpv |SV* sv|const char* ptr Apd |void |sv_setpvn |NN SV* sv|const char* ptr|STRLEN len Amdb |void |sv_setsv |SV* dsv|SV* ssv Apd |void |sv_taint |SV* sv -Apd |bool |sv_tainted |SV* sv +ApdR |bool |sv_tainted |SV* sv Apd |int |sv_unmagic |NN SV* sv|int type Apd |void |sv_unref |NN SV* sv Apd |void |sv_unref_flags |NN SV* sv|U32 flags @@ -1136,9 +1135,9 @@ s |bool |path_is_absolute|NN const char *name #endif #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT) -s |void |do_oddball |HV *hash|SV **relem|SV **firstrelem -s |CV* |get_db_sub |SV **svp|CV *cv -s |SV* |method_common |SV* meth|U32* hashp +s |void |do_oddball |NN HV *hash|NN SV **relem|NN SV **firstrelem +sR |CV* |get_db_sub |NN SV **svp|NN CV *cv +sR |SV* |method_common |NN SV* meth|U32* hashp #endif #if defined(PERL_IN_PP_SYS_C) || defined(PERL_DECL_PROT) @@ -1150,34 +1149,34 @@ sR |int |dooneliner |NN const char *cmd|NN const char *filename #endif #if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT) -Es |regnode*|reg |struct RExC_state_t*|I32|I32 * -Es |regnode*|reganode |struct RExC_state_t*|U8|U32 -Es |regnode*|regatom |struct RExC_state_t*|I32 * -Es |regnode*|regbranch |struct RExC_state_t*|I32 *|I32 -Es |void |reguni |struct RExC_state_t*|UV|char *|STRLEN* -Es |regnode*|regclass |struct RExC_state_t* +Es |regnode*|reg |NN struct RExC_state_t *state|I32 paren|NN I32 *flagp +Es |regnode*|reganode |NN struct RExC_state_t *state|U8 op|U32 arg +Es |regnode*|regatom |NN struct RExC_state_t *state|NN I32 *flagp +Es |regnode*|regbranch |NN struct RExC_state_t *state|NN I32 *flagp|I32 first +Es |void |reguni |NN const struct RExC_state_t *state|UV uv|NN char *s|NN STRLEN *lenp +Es |regnode*|regclass |NN struct RExC_state_t *state ERs |I32 |regcurly |NN const char * -Es |regnode*|reg_node |struct RExC_state_t*|U8 -Es |regnode*|regpiece |struct RExC_state_t*|I32 * -Es |void |reginsert |struct RExC_state_t*|U8|regnode * -Es |void |regoptail |struct RExC_state_t*|regnode *|regnode * -Es |void |regtail |struct RExC_state_t*|regnode *|regnode * -Es |char* |regwhite |char *p|const char *e -Es |char* |nextchar |struct RExC_state_t* +Es |regnode*|reg_node |NN struct RExC_state_t *state|U8 op +Es |regnode*|regpiece |NN struct RExC_state_t *state|NN I32 *flagp +Es |void |reginsert |NN struct RExC_state_t *state|U8 op|NN regnode *opnd +Es |void |regoptail |NN struct RExC_state_t *state|NN regnode *p|NN regnode *val +Es |void |regtail |NN struct RExC_state_t *state|NN regnode *p|NN regnode *val +Es |char* |regwhite |NN char *p|NN const char *e +Es |char* |nextchar |NN struct RExC_state_t* # ifdef DEBUGGING Es |regnode*|dumpuntil |regnode *start|regnode *node \ |regnode *last|SV* sv|I32 l Es |void |put_byte |NN SV* sv|int c # endif Es |void |scan_commit |struct RExC_state_t*|struct scan_data_t *data -Es |void |cl_anything |struct RExC_state_t*|struct regnode_charclass_class *cl -Es |int |cl_is_anything |struct regnode_charclass_class *cl -Es |void |cl_init |struct RExC_state_t*|struct regnode_charclass_class *cl -Es |void |cl_init_zero |struct RExC_state_t*|struct regnode_charclass_class *cl -Es |void |cl_and |struct regnode_charclass_class *cl \ - |struct regnode_charclass_class *and_with -Es |void |cl_or |struct RExC_state_t*|struct regnode_charclass_class *cl \ - |struct regnode_charclass_class *or_with +Es |void |cl_anything |NN struct RExC_state_t*|NN struct regnode_charclass_class *cl +Es |int |cl_is_anything |NN const struct regnode_charclass_class *cl +Es |void |cl_init |NN struct RExC_state_t*|NN struct regnode_charclass_class *cl +Es |void |cl_init_zero |NN struct RExC_state_t*|NN struct regnode_charclass_class *cl +Es |void |cl_and |NN struct regnode_charclass_class *cl \ + |const struct regnode_charclass_class *and_with +Es |void |cl_or |NN struct RExC_state_t*|NN struct regnode_charclass_class *cl \ + |NN const struct regnode_charclass_class *or_with Es |I32 |study_chunk |struct RExC_state_t*|regnode **scanp|I32 *deltap \ |regnode *last|struct scan_data_t *data \ |U32 flags|U32 depth diff --git a/mg.c b/mg.c index e49b26e..4b31e4b 100644 --- a/mg.c +++ b/mg.c @@ -493,7 +493,7 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg) i = t1 - s1; getlen: if (i > 0 && RX_MATCH_UTF8(rx)) { - char *s = rx->subbeg + s1; + const char * const s = rx->subbeg + s1; const U8 *ep; STRLEN el; diff --git a/perly.c b/perly.c index b71f95a..6e92e27 100644 --- a/perly.c +++ b/perly.c @@ -322,6 +322,7 @@ Perl_yyparse (pTHX) #ifdef DEBUGGING yyns_sv = NEWSV(73, YYINITDEPTH * sizeof(char *)); SAVEFREESV(yyns_sv); + /* XXX This seems strange to cast char * to char ** */ yyns = (const char **) SvPVX(yyns_sv); yynsp = yyns; #endif @@ -366,6 +367,7 @@ Perl_yyparse (pTHX) yyvs = (YYSTYPE *) SvPVX(yyvs_sv); #ifdef DEBUGGING SvGROW(yyns_sv, yystacksize * sizeof(char *)); + /* XXX This seems strange to cast char * to char ** */ yyns = (const char **) SvPVX(yyns_sv); if (! yyns) goto yyoverflowlab; diff --git a/proto.h b/proto.h index 6d23f92..6ac3d69 100644 --- a/proto.h +++ b/proto.h @@ -35,7 +35,9 @@ PERL_CALLCONV int perl_run(PerlInterpreter* interp) __attribute__nonnull__(1); PERL_CALLCONV int perl_parse(PerlInterpreter* interp, XSINIT_t xsinit, int argc, char** argv, char** env); -PERL_CALLCONV bool Perl_doing_taint(int argc, char** argv, char** env); +PERL_CALLCONV bool Perl_doing_taint(int argc, char** argv, char** env) + __attribute__warn_unused_result__; + #if defined(USE_ITHREADS) PERL_CALLCONV PerlInterpreter* perl_clone(PerlInterpreter* interp, UV flags); # if defined(PERL_IMPLICIT_SYS) @@ -362,7 +364,10 @@ PERL_CALLCONV GP* Perl_gp_ref(pTHX_ GP* gp); PERL_CALLCONV GV* Perl_gv_AVadd(pTHX_ GV* gv); PERL_CALLCONV GV* Perl_gv_HVadd(pTHX_ GV* gv); PERL_CALLCONV GV* Perl_gv_IOadd(pTHX_ GV* gv); -PERL_CALLCONV GV* Perl_gv_autoload4(pTHX_ HV* stash, const char* name, STRLEN len, I32 method); +PERL_CALLCONV GV* Perl_gv_autoload4(pTHX_ HV* stash, const char* name, STRLEN len, I32 method) + __attribute__warn_unused_result__ + __attribute__nonnull__(pTHX_2); + PERL_CALLCONV void Perl_gv_check(pTHX_ HV* stash); PERL_CALLCONV void Perl_gv_efullname(pTHX_ SV* sv, const GV* gv); /* PERL_CALLCONV void Perl_gv_efullname3(pTHX_ SV* sv, const GV* gv, const char* prefix); */ @@ -1551,7 +1556,9 @@ PERL_CALLCONV void Perl_sv_setpvn(pTHX_ SV* sv, const char* ptr, STRLEN len) /* PERL_CALLCONV void sv_setsv(pTHX_ SV* dsv, SV* ssv); */ PERL_CALLCONV void Perl_sv_taint(pTHX_ SV* sv); -PERL_CALLCONV bool Perl_sv_tainted(pTHX_ SV* sv); +PERL_CALLCONV bool Perl_sv_tainted(pTHX_ SV* sv) + __attribute__warn_unused_result__; + PERL_CALLCONV int Perl_sv_unmagic(pTHX_ SV* sv, int type) __attribute__nonnull__(pTHX_1); @@ -2205,9 +2212,20 @@ STATIC bool S_path_is_absolute(pTHX_ const char *name) #endif #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT) -STATIC void S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem); -STATIC CV* S_get_db_sub(pTHX_ SV **svp, CV *cv); -STATIC SV* S_method_common(pTHX_ SV* meth, U32* hashp); +STATIC void S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2) + __attribute__nonnull__(pTHX_3); + +STATIC CV* S_get_db_sub(pTHX_ SV **svp, CV *cv) + __attribute__warn_unused_result__ + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); + +STATIC SV* S_method_common(pTHX_ SV* meth, U32* hashp) + __attribute__warn_unused_result__ + __attribute__nonnull__(pTHX_1); + #endif #if defined(PERL_IN_PP_SYS_C) || defined(PERL_DECL_PROT) @@ -2230,23 +2248,61 @@ STATIC int S_dooneliner(pTHX_ const char *cmd, const char *filename) #endif #if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT) -STATIC regnode* S_reg(pTHX_ struct RExC_state_t*, I32, I32 *); -STATIC regnode* S_reganode(pTHX_ struct RExC_state_t*, U8, U32); -STATIC regnode* S_regatom(pTHX_ struct RExC_state_t*, I32 *); -STATIC regnode* S_regbranch(pTHX_ struct RExC_state_t*, I32 *, I32); -STATIC void S_reguni(pTHX_ struct RExC_state_t*, UV, char *, STRLEN*); -STATIC regnode* S_regclass(pTHX_ struct RExC_state_t*); +STATIC regnode* S_reg(pTHX_ struct RExC_state_t *state, I32 paren, I32 *flagp) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_3); + +STATIC regnode* S_reganode(pTHX_ struct RExC_state_t *state, U8 op, U32 arg) + __attribute__nonnull__(pTHX_1); + +STATIC regnode* S_regatom(pTHX_ struct RExC_state_t *state, I32 *flagp) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); + +STATIC regnode* S_regbranch(pTHX_ struct RExC_state_t *state, I32 *flagp, I32 first) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); + +STATIC void S_reguni(pTHX_ const struct RExC_state_t *state, UV uv, char *s, STRLEN *lenp) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_3) + __attribute__nonnull__(pTHX_4); + +STATIC regnode* S_regclass(pTHX_ struct RExC_state_t *state) + __attribute__nonnull__(pTHX_1); + STATIC I32 S_regcurly(pTHX_ const char *) __attribute__warn_unused_result__ __attribute__nonnull__(pTHX_1); -STATIC regnode* S_reg_node(pTHX_ struct RExC_state_t*, U8); -STATIC regnode* S_regpiece(pTHX_ struct RExC_state_t*, I32 *); -STATIC void S_reginsert(pTHX_ struct RExC_state_t*, U8, regnode *); -STATIC void S_regoptail(pTHX_ struct RExC_state_t*, regnode *, regnode *); -STATIC void S_regtail(pTHX_ struct RExC_state_t*, regnode *, regnode *); -STATIC char* S_regwhite(pTHX_ char *p, const char *e); -STATIC char* S_nextchar(pTHX_ struct RExC_state_t*); +STATIC regnode* S_reg_node(pTHX_ struct RExC_state_t *state, U8 op) + __attribute__nonnull__(pTHX_1); + +STATIC regnode* S_regpiece(pTHX_ struct RExC_state_t *state, I32 *flagp) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); + +STATIC void S_reginsert(pTHX_ struct RExC_state_t *state, U8 op, regnode *opnd) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_3); + +STATIC void S_regoptail(pTHX_ struct RExC_state_t *state, regnode *p, regnode *val) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2) + __attribute__nonnull__(pTHX_3); + +STATIC void S_regtail(pTHX_ struct RExC_state_t *state, regnode *p, regnode *val) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2) + __attribute__nonnull__(pTHX_3); + +STATIC char* S_regwhite(pTHX_ char *p, const char *e) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); + +STATIC char* S_nextchar(pTHX_ struct RExC_state_t*) + __attribute__nonnull__(pTHX_1); + # ifdef DEBUGGING STATIC regnode* S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l); STATIC void S_put_byte(pTHX_ SV* sv, int c) @@ -2254,12 +2310,29 @@ STATIC void S_put_byte(pTHX_ SV* sv, int c) # endif STATIC void S_scan_commit(pTHX_ struct RExC_state_t*, struct scan_data_t *data); -STATIC void S_cl_anything(pTHX_ struct RExC_state_t*, struct regnode_charclass_class *cl); -STATIC int S_cl_is_anything(pTHX_ struct regnode_charclass_class *cl); -STATIC void S_cl_init(pTHX_ struct RExC_state_t*, struct regnode_charclass_class *cl); -STATIC void S_cl_init_zero(pTHX_ struct RExC_state_t*, struct regnode_charclass_class *cl); -STATIC void S_cl_and(pTHX_ struct regnode_charclass_class *cl, struct regnode_charclass_class *and_with); -STATIC void S_cl_or(pTHX_ struct RExC_state_t*, struct regnode_charclass_class *cl, struct regnode_charclass_class *or_with); +STATIC void S_cl_anything(pTHX_ struct RExC_state_t*, struct regnode_charclass_class *cl) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); + +STATIC int S_cl_is_anything(pTHX_ const struct regnode_charclass_class *cl) + __attribute__nonnull__(pTHX_1); + +STATIC void S_cl_init(pTHX_ struct RExC_state_t*, struct regnode_charclass_class *cl) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); + +STATIC void S_cl_init_zero(pTHX_ struct RExC_state_t*, struct regnode_charclass_class *cl) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); + +STATIC void S_cl_and(pTHX_ struct regnode_charclass_class *cl, const struct regnode_charclass_class *and_with) + __attribute__nonnull__(pTHX_1); + +STATIC void S_cl_or(pTHX_ struct RExC_state_t*, struct regnode_charclass_class *cl, const struct regnode_charclass_class *or_with) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2) + __attribute__nonnull__(pTHX_3); + STATIC I32 S_study_chunk(pTHX_ struct RExC_state_t*, regnode **scanp, I32 *deltap, regnode *last, struct scan_data_t *data, U32 flags, U32 depth); STATIC I32 S_add_data(pTHX_ struct RExC_state_t*, I32 n, const char *s); STATIC void S_re_croak2(pTHX_ const char* pat1, const char* pat2, ...) diff --git a/regcomp.c b/regcomp.c index affd94a..6f28be4 100644 --- a/regcomp.c +++ b/regcomp.c @@ -307,7 +307,7 @@ static const scan_data_t zero_scan_data = * Simple_vFAIL -- like FAIL, but marks the current location in the scan */ #define Simple_vFAIL(m) STMT_START { \ - IV offset = RExC_parse - RExC_precomp; \ + const IV offset = RExC_parse - RExC_precomp; \ Perl_croak(aTHX_ "%s" REPORT_LOCATION, \ m, (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END @@ -325,7 +325,7 @@ static const scan_data_t zero_scan_data = * Like Simple_vFAIL(), but accepts two arguments. */ #define Simple_vFAIL2(m,a1) STMT_START { \ - IV offset = RExC_parse - RExC_precomp; \ + const IV offset = RExC_parse - RExC_precomp; \ S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, \ (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END @@ -344,7 +344,7 @@ static const scan_data_t zero_scan_data = * Like Simple_vFAIL(), but accepts three arguments. */ #define Simple_vFAIL3(m, a1, a2) STMT_START { \ - IV offset = RExC_parse - RExC_precomp; \ + const IV offset = RExC_parse - RExC_precomp; \ S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, \ (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END @@ -362,29 +362,19 @@ static const scan_data_t zero_scan_data = * Like Simple_vFAIL(), but accepts four arguments. */ #define Simple_vFAIL4(m, a1, a2, a3) STMT_START { \ - IV offset = RExC_parse - RExC_precomp; \ + const IV offset = RExC_parse - RExC_precomp; \ S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, a3, \ (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END -/* - * Like Simple_vFAIL(), but accepts five arguments. - */ -#define Simple_vFAIL5(m, a1, a2, a3, a4) STMT_START { \ - IV offset = RExC_parse - RExC_precomp; \ - S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, a3, a4, \ - (int)offset, RExC_precomp, RExC_precomp + offset); \ -} STMT_END - - #define vWARN(loc,m) STMT_START { \ - IV offset = loc - RExC_precomp; \ + const IV offset = loc - RExC_precomp; \ Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s" REPORT_LOCATION, \ m, (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END #define vWARNdep(loc,m) STMT_START { \ - IV offset = loc - RExC_precomp; \ + const IV offset = loc - RExC_precomp; \ Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_REGEXP), \ "%s" REPORT_LOCATION, \ m, (int)offset, RExC_precomp, RExC_precomp + offset); \ @@ -392,25 +382,25 @@ static const scan_data_t zero_scan_data = #define vWARN2(loc, m, a1) STMT_START { \ - IV offset = loc - RExC_precomp; \ + const IV offset = loc - RExC_precomp; \ Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \ a1, (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END #define vWARN3(loc, m, a1, a2) STMT_START { \ - IV offset = loc - RExC_precomp; \ + const IV offset = loc - RExC_precomp; \ Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \ a1, a2, (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END #define vWARN4(loc, m, a1, a2, a3) STMT_START { \ - IV offset = loc - RExC_precomp; \ + const IV offset = loc - RExC_precomp; \ Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \ a1, a2, a3, (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END #define vWARN5(loc, m, a1, a2, a3, a4) STMT_START { \ - IV offset = loc - RExC_precomp; \ + const IV offset = loc - RExC_precomp; \ Perl_warner(aTHX_ packWARN(WARN_REGEXP), m REPORT_LOCATION, \ a1, a2, a3, a4, (int)offset, RExC_precomp, RExC_precomp + offset); \ } STMT_END @@ -507,8 +497,8 @@ S_scan_commit(pTHX_ RExC_state_t *pRExC_state, scan_data_t *data) } SvCUR_set(data->last_found, 0); { - SV * sv = data->last_found; - MAGIC *mg = + SV * const sv = data->last_found; + MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : NULL; if (mg && mg->mg_len > 0) mg->mg_len = 0; @@ -530,7 +520,7 @@ S_cl_anything(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *c /* Can match anything (initialization) */ STATIC int -S_cl_is_anything(pTHX_ struct regnode_charclass_class *cl) +S_cl_is_anything(pTHX_ const struct regnode_charclass_class *cl) { int value; @@ -567,7 +557,7 @@ S_cl_init_zero(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class * /* We assume that cl is not inverted */ STATIC void S_cl_and(pTHX_ struct regnode_charclass_class *cl, - struct regnode_charclass_class *and_with) + const struct regnode_charclass_class *and_with) { if (!(and_with->flags & ANYOF_CLASS) && !(cl->flags & ANYOF_CLASS) @@ -603,7 +593,7 @@ S_cl_and(pTHX_ struct regnode_charclass_class *cl, /* 'OR' a given class with another one. Can create false positives */ /* We assume that cl is not inverted */ STATIC void -S_cl_or(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, struct regnode_charclass_class *or_with) +S_cl_or(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, const struct regnode_charclass_class *or_with) { if (or_with->flags & ANYOF_INVERT) { /* We do not use @@ -899,7 +889,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs for ( cur = first ; cur < last ; cur = regnext( cur ) ) { regnode *noper = NEXTOPER( cur ); const U8 *uc = (U8*)STRING( noper ); - const U8 *e = uc + STR_LEN( noper ); + const U8 * const e = uc + STR_LEN( noper ); STRLEN foldlen = 0; U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ]; const U8 *scan = (U8*)NULL; @@ -987,7 +977,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs regnode *noper = NEXTOPER( cur ); U8 *uc = (U8*)STRING( noper ); - U8 *e = uc + STR_LEN( noper ); + const U8 * const e = uc + STR_LEN( noper ); U32 state = 1; /* required init */ U16 charid = 0; /* sanity init */ U8 *scan = (U8*)NULL; /* sanity init */ @@ -1024,14 +1014,13 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs newstate = TRIE_LIST_ITEM( state, check ).newstate; break; } - } - if ( ! newstate ) { - newstate = next_alloc++; - TRIE_LIST_PUSH( state, charid, newstate ); - transcount++; - } - state = newstate; - + } + if ( ! newstate ) { + newstate = next_alloc++; + TRIE_LIST_PUSH( state, charid, newstate ); + transcount++; + } + state = newstate; } else { Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc ); } @@ -1060,16 +1049,14 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs DEBUG_TRIE_COMPILE_MORE_r({ U32 state; - U16 charid; - /* - print out the table precompression. - */ + /* print out the table precompression. */ PerlIO_printf( Perl_debug_log, "\nState :Word | Transition Data\n" ); PerlIO_printf( Perl_debug_log, "------:-----+-----------------" ); for( state=1 ; state < next_alloc ; state ++ ) { + U16 charid; PerlIO_printf( Perl_debug_log, "\n %04"UVXf" :", (UV)state ); if ( ! trie->states[ state ].wordnum ) { @@ -1095,7 +1082,6 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs Newz( 848203, trie->trans, transcount ,reg_trie_trans ); { U32 state; - U16 idx; U32 tp = 0; U32 zp = 0; @@ -1112,7 +1098,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs if (trie->states[state].trans.list) { U16 minid=TRIE_LIST_ITEM( state, 1).forid; U16 maxid=minid; - + U16 idx; for( idx = 2 ; idx <= TRIE_LIST_USED( state ) ; idx++ ) { if ( TRIE_LIST_ITEM( state, idx).forid < minid ) { @@ -1208,8 +1194,8 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs for ( cur = first ; cur < last ; cur = regnext( cur ) ) { regnode *noper = NEXTOPER( cur ); - U8 *uc = (U8*)STRING( noper ); - U8 *e = uc + STR_LEN( noper ); + const U8 *uc = (U8*)STRING( noper ); + const U8 * const e = uc + STR_LEN( noper ); U32 state = 1; /* required init */ @@ -1371,15 +1357,15 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs demq */ const U32 laststate = TRIE_NODENUM( next_alloc ); - U32 used , state, charid; + U32 state, charid; U32 pos = 0, zp=0; trie->laststate = laststate; for ( state = 1 ; state < laststate ; state++ ) { U8 flag = 0; - U32 stateidx = TRIE_NODEIDX( state ); - U32 o_used=trie->trans[ stateidx ].check; - used = trie->trans[ stateidx ].check; + const U32 stateidx = TRIE_NODEIDX( state ); + const U32 o_used = trie->trans[ stateidx ].check; + U32 used = trie->trans[ stateidx ].check; trie->trans[ stateidx ].check = 0; for ( charid = 0 ; used && charid < trie->uniquecharcount ; charid++ ) { @@ -1447,7 +1433,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs PerlIO_printf( Perl_debug_log, "\n"); for( state = 1 ; state < trie->laststate ; state++ ) { - U32 base = trie->states[ state ].trans.base; + const U32 base = trie->states[ state ].trans.base; PerlIO_printf( Perl_debug_log, "#%04"UVXf" ", (UV)state); @@ -1656,8 +1642,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg */ char *s0 = STRING(scan), *s, *t; char *s1 = s0 + STR_LEN(scan) - 1, *s2 = s1 - 4; - const char *t0 = "\xcc\x88\xcc\x81"; - const char *t1 = t0 + 3; + const char * const t0 = "\xcc\x88\xcc\x81"; + const char * const t1 = t0 + 3; for (s = s0 + 2; s < s2 && (t = ninstr(s, s1, t0, t1)); @@ -2017,7 +2003,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg sv_catpvn(data->last_found, STRING(scan), STR_LEN(scan)); { SV * sv = data->last_found; - MAGIC *mg = SvUTF8(sv) && SvMAGICAL(sv) ? + MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : NULL; if (mg && mg->mg_len >= 0) mg->mg_len += utf8_length((U8*)STRING(scan), @@ -2703,7 +2689,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg if (data) data->whilem_c = data_fake.whilem_c; if (f & SCF_DO_STCLASS_AND) { - int was = (data->start_class->flags & ANYOF_EOS); + const int was = (data->start_class->flags & ANYOF_EOS); cl_and(data->start_class, &intrnl); if (was) @@ -3246,7 +3232,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) wasted_c = 0x04; char * parse_start = RExC_parse; /* MJD */ - char *oregcomp_parse = RExC_parse; + char * const oregcomp_parse = RExC_parse; char c; *flagp = 0; /* Tentatively. */ @@ -3258,7 +3244,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp) U32 posflags = 0, negflags = 0; U32 *flagsp = &posflags; int logical = 0; - char *seqstart = RExC_parse; + const char * const seqstart = RExC_parse; RExC_parse++; paren = *RExC_parse++; @@ -4474,7 +4460,6 @@ S_regwhite(pTHX_ char *p, const char *e) STATIC I32 S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value) { - char *posixcc = 0; I32 namedclass = OOB_NAMEDCLASS; if (value == '[' && RExC_parse + 1 < RExC_end && @@ -4490,6 +4475,7 @@ S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value) RExC_parse = s; else { const char* t = RExC_parse++; /* skip over the c */ + const char *posixcc; assert(*t == c); @@ -5539,7 +5525,7 @@ S_reganode(pTHX_ RExC_state_t *pRExC_state, U8 op, U32 arg) - reguni - emit (if appropriate) a Unicode character */ STATIC void -S_reguni(pTHX_ RExC_state_t *pRExC_state, UV uv, char* s, STRLEN* lenp) +S_reguni(pTHX_ const RExC_state_t *pRExC_state, UV uv, char* s, STRLEN* lenp) { *lenp = SIZE_ONLY ? UNISKIP(uv) : (uvchr_to_utf8((U8*)s, uv) - (U8*)s); } @@ -5673,119 +5659,6 @@ S_regcurly(pTHX_ register const char *s) } -#ifdef DEBUGGING - -STATIC regnode * -S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l) -{ - register U8 op = EXACT; /* Arbitrary non-END op. */ - register regnode *next; - - while (op != END && (!last || node < last)) { - /* While that wasn't END last time... */ - - NODE_ALIGN(node); - op = OP(node); - if (op == CLOSE) - l--; - next = regnext(node); - /* Where, what. */ - if (OP(node) == OPTIMIZED) - goto after_print; - regprop(sv, node); - PerlIO_printf(Perl_debug_log, "%4"IVdf":%*s%s", (IV)(node - start), - (int)(2*l + 1), "", SvPVX_const(sv)); - if (next == NULL) /* Next ptr. */ - PerlIO_printf(Perl_debug_log, "(0)"); - else - PerlIO_printf(Perl_debug_log, "(%"IVdf")", (IV)(next - start)); - (void)PerlIO_putc(Perl_debug_log, '\n'); - after_print: - if (PL_regkind[(U8)op] == BRANCHJ) { - register regnode *nnode = (OP(next) == LONGJMP - ? regnext(next) - : next); - if (last && nnode > last) - nnode = last; - node = dumpuntil(start, NEXTOPER(NEXTOPER(node)), nnode, sv, l + 1); - } - else if (PL_regkind[(U8)op] == BRANCH) { - node = dumpuntil(start, NEXTOPER(node), next, sv, l + 1); - } - else if ( PL_regkind[(U8)op] == TRIE ) { - const I32 n = ARG(node); - const reg_trie_data *trie = (reg_trie_data*)PL_regdata->data[n]; - const I32 arry_len = av_len(trie->words)+1; - I32 word_idx; - PerlIO_printf(Perl_debug_log, - "%*s[Words:%d Chars Stored:%d Unique Chars:%d States:%"IVdf"%s]\n", - (int)(2*(l+3)), - "", - trie->wordcount, - (int)trie->charcount, - trie->uniquecharcount, - (IV)trie->laststate-1, - node->flags ? " EVAL mode" : ""); - - for (word_idx=0; word_idx < arry_len; word_idx++) { - SV **elem_ptr=av_fetch(trie->words,word_idx,0); - if (elem_ptr) { - PerlIO_printf(Perl_debug_log, "%*s<%s%s%s>\n", - (int)(2*(l+4)), "", - PL_colors[0], - SvPV_nolen(*elem_ptr), - PL_colors[1] - ); - /* - if (next == NULL) - PerlIO_printf(Perl_debug_log, "(0)\n"); - else - PerlIO_printf(Perl_debug_log, "(%"IVdf")\n", (IV)(next - start)); - */ - } - - } - - node = NEXTOPER(node); - node += regarglen[(U8)op]; - - } - else if ( op == CURLY) { /* "next" might be very big: optimizer */ - node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS, - NEXTOPER(node) + EXTRA_STEP_2ARGS + 1, sv, l + 1); - } - else if (PL_regkind[(U8)op] == CURLY && op != CURLYX) { - node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS, - next, sv, l + 1); - } - else if ( op == PLUS || op == STAR) { - node = dumpuntil(start, NEXTOPER(node), NEXTOPER(node) + 1, sv, l + 1); - } - else if (op == ANYOF) { - /* arglen 1 + class block */ - node += 1 + ((ANYOF_FLAGS(node) & ANYOF_LARGE) - ? ANYOF_CLASS_SKIP : ANYOF_SKIP); - node = NEXTOPER(node); - } - else if (PL_regkind[(U8)op] == EXACT) { - /* Literal string, where present. */ - node += NODE_SZ_STR(node) - 1; - node = NEXTOPER(node); - } - else { - node = NEXTOPER(node); - node += regarglen[(U8)op]; - } - if (op == CURLYX || op == OPEN) - l++; - else if (op == WHILEM) - l--; - } - return node; -} - -#endif /* DEBUGGING */ - /* - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form */ @@ -5887,22 +5760,6 @@ Perl_regdump(pTHX_ regexp *r) #endif /* DEBUGGING */ } -#ifdef DEBUGGING - -STATIC void -S_put_byte(pTHX_ SV *sv, int c) -{ - if (isCNTRL(c) || c == 255 || !isPRINT(c)) - Perl_sv_catpvf(aTHX_ sv, "\\%o", c); - else if (c == '-' || c == ']' || c == '\\' || c == '^') - Perl_sv_catpvf(aTHX_ sv, "\\%c", c); - else - Perl_sv_catpvf(aTHX_ sv, "%c", c); -} - -#endif /* DEBUGGING */ - - /* - regprop - printable representation of opcode */ @@ -6106,9 +5963,9 @@ Perl_re_intuit_string(pTHX_ regexp *prog) { /* Assume that RE_INTUIT is set */ GET_RE_DEBUG_FLAGS_DECL; DEBUG_COMPILE_r( - { - const char *s = SvPV_nolen_const(prog->check_substr - ? prog->check_substr : prog->check_utf8); + { STRLEN n_a; + const char *s = SvPV(prog->check_substr + ? prog->check_substr : prog->check_utf8, n_a); if (!PL_colorset) reginitcolors(); PerlIO_printf(Perl_debug_log, @@ -6381,6 +6238,131 @@ clear_re(pTHX_ void *r) ReREFCNT_dec((regexp *)r); } +#ifdef DEBUGGING + +STATIC void +S_put_byte(pTHX_ SV *sv, int c) +{ + if (isCNTRL(c) || c == 255 || !isPRINT(c)) + Perl_sv_catpvf(aTHX_ sv, "\\%o", c); + else if (c == '-' || c == ']' || c == '\\' || c == '^') + Perl_sv_catpvf(aTHX_ sv, "\\%c", c); + else + Perl_sv_catpvf(aTHX_ sv, "%c", c); +} + + +STATIC regnode * +S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l) +{ + register U8 op = EXACT; /* Arbitrary non-END op. */ + register regnode *next; + + while (op != END && (!last || node < last)) { + /* While that wasn't END last time... */ + + NODE_ALIGN(node); + op = OP(node); + if (op == CLOSE) + l--; + next = regnext(node); + /* Where, what. */ + if (OP(node) == OPTIMIZED) + goto after_print; + regprop(sv, node); + PerlIO_printf(Perl_debug_log, "%4"IVdf":%*s%s", (IV)(node - start), + (int)(2*l + 1), "", SvPVX_const(sv)); + if (next == NULL) /* Next ptr. */ + PerlIO_printf(Perl_debug_log, "(0)"); + else + PerlIO_printf(Perl_debug_log, "(%"IVdf")", (IV)(next - start)); + (void)PerlIO_putc(Perl_debug_log, '\n'); + after_print: + if (PL_regkind[(U8)op] == BRANCHJ) { + register regnode *nnode = (OP(next) == LONGJMP + ? regnext(next) + : next); + if (last && nnode > last) + nnode = last; + node = dumpuntil(start, NEXTOPER(NEXTOPER(node)), nnode, sv, l + 1); + } + else if (PL_regkind[(U8)op] == BRANCH) { + node = dumpuntil(start, NEXTOPER(node), next, sv, l + 1); + } + else if ( PL_regkind[(U8)op] == TRIE ) { + const I32 n = ARG(node); + const reg_trie_data * const trie = (reg_trie_data*)PL_regdata->data[n]; + const I32 arry_len = av_len(trie->words)+1; + I32 word_idx; + PerlIO_printf(Perl_debug_log, + "%*s[Words:%d Chars Stored:%d Unique Chars:%d States:%"IVdf"%s]\n", + (int)(2*(l+3)), + "", + trie->wordcount, + (int)trie->charcount, + trie->uniquecharcount, + (IV)trie->laststate-1, + node->flags ? " EVAL mode" : ""); + + for (word_idx=0; word_idx < arry_len; word_idx++) { + SV **elem_ptr=av_fetch(trie->words,word_idx,0); + if (elem_ptr) { + PerlIO_printf(Perl_debug_log, "%*s<%s%s%s>\n", + (int)(2*(l+4)), "", + PL_colors[0], + SvPV_nolen(*elem_ptr), + PL_colors[1] + ); + /* + if (next == NULL) + PerlIO_printf(Perl_debug_log, "(0)\n"); + else + PerlIO_printf(Perl_debug_log, "(%"IVdf")\n", (IV)(next - start)); + */ + } + + } + + node = NEXTOPER(node); + node += regarglen[(U8)op]; + + } + else if ( op == CURLY) { /* "next" might be very big: optimizer */ + node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS, + NEXTOPER(node) + EXTRA_STEP_2ARGS + 1, sv, l + 1); + } + else if (PL_regkind[(U8)op] == CURLY && op != CURLYX) { + node = dumpuntil(start, NEXTOPER(node) + EXTRA_STEP_2ARGS, + next, sv, l + 1); + } + else if ( op == PLUS || op == STAR) { + node = dumpuntil(start, NEXTOPER(node), NEXTOPER(node) + 1, sv, l + 1); + } + else if (op == ANYOF) { + /* arglen 1 + class block */ + node += 1 + ((ANYOF_FLAGS(node) & ANYOF_LARGE) + ? ANYOF_CLASS_SKIP : ANYOF_SKIP); + node = NEXTOPER(node); + } + else if (PL_regkind[(U8)op] == EXACT) { + /* Literal string, where present. */ + node += NODE_SZ_STR(node) - 1; + node = NEXTOPER(node); + } + else { + node = NEXTOPER(node); + node += regarglen[(U8)op]; + } + if (op == CURLYX || op == OPEN) + l++; + else if (op == WHILEM) + l--; + } + return node; +} + +#endif /* DEBUGGING */ + /* * Local variables: * c-indentation-style: bsd diff --git a/sv.c b/sv.c index b5b5522..fb3e7dc 100644 --- a/sv.c +++ b/sv.c @@ -4945,11 +4945,11 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags) if (SvREADONLY(sv)) { /* At this point I believe I should acquire a global SV mutex. */ if (SvFAKE(sv)) { - const char *pvx = SvPVX_const(sv); - const STRLEN len = SvLEN(sv); - const STRLEN cur = SvCUR(sv); - const U32 hash = SvSHARED_HASH(sv); - SV *const next = SV_COW_NEXT_SV(sv); /* next COW sv in the loop. */ + const char *pvx = SvPVX_const(sv); + const STRLEN len = SvLEN(sv); + const STRLEN cur = SvCUR(sv); + const U32 hash = SvSHARED_HASH(sv); + SV * const next = SV_COW_NEXT_SV(sv); /* next COW sv in the loop. */ if (DEBUG_C_TEST) { PerlIO_printf(Perl_debug_log, "Copy on write: Force normal %ld\n", @@ -4985,7 +4985,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags) const char *pvx = SvPVX_const(sv); const int is_utf8 = SvUTF8(sv); const STRLEN len = SvCUR(sv); - const U32 hash = SvSHARED_HASH(sv); + const U32 hash = SvSHARED_HASH(sv); SvFAKE_off(sv); SvREADONLY_off(sv); SvPV_set(sv, Nullch); @@ -5048,7 +5048,7 @@ Perl_sv_chop(pTHX_ register SV *sv, register const char *ptr) if (!SvOOK(sv)) { if (!SvLEN(sv)) { /* make copy of shared string */ const char *pvx = SvPVX_const(sv); - STRLEN len = SvCUR(sv); + const STRLEN len = SvCUR(sv); SvGROW(sv, len + 1); Move(pvx,SvPVX_const(sv),len,char); *SvEND(sv) = '\0'; @@ -8870,7 +8870,7 @@ bool Perl_sv_tainted(pTHX_ SV *sv) { if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { - MAGIC *mg = mg_find(sv, PERL_MAGIC_taint); + MAGIC * const mg = mg_find(sv, PERL_MAGIC_taint); if (mg && ((mg->mg_len & 1) || ((mg->mg_len & 2) && mg->mg_obj == sv))) return TRUE; } diff --git a/util.c b/util.c index ae831e4..9468e6b 100644 --- a/util.c +++ b/util.c @@ -4049,7 +4049,7 @@ Perl_vnumify(pTHX_ SV *vs) len = av_len((AV *)vs); if ( len == -1 ) { - sv_catpvn(sv,"0",1); + Perl_sv_catpv(aTHX_ sv,"0"); return sv; } digit = SvIVX(*av_fetch((AV *)vs, 0, 0)); @@ -4066,14 +4066,14 @@ Perl_vnumify(pTHX_ SV *vs) if ( (int)PERL_ABS(digit) != 0 || len == 1 ) { if ( digit < 0 ) /* alpha version */ - sv_catpvn(sv,"_",1); + Perl_sv_catpv(aTHX_ sv,"_"); /* Don't display additional trailing zeros */ Perl_sv_catpvf(aTHX_ sv,"%03d", (int)PERL_ABS(digit)); } } else /* len == 0 */ { - sv_catpvn(sv,"000",3); + Perl_sv_catpv(aTHX_ sv,"000"); } return sv; } @@ -4102,7 +4102,7 @@ Perl_vnormal(pTHX_ SV *vs) len = av_len((AV *)vs); if ( len == -1 ) { - sv_catpvn(sv,"",0); + Perl_sv_catpv(aTHX_ sv,""); return sv; } digit = SvIVX(*av_fetch((AV *)vs, 0, 0)); @@ -4118,7 +4118,7 @@ Perl_vnormal(pTHX_ SV *vs) if ( len <= 2 ) { /* short version, must be at least three */ for ( len = 2 - len; len != 0; len-- ) - sv_catpvn(sv,".0",2); + Perl_sv_catpv(aTHX_ sv,".0"); } return sv;