summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--embed.fnc45
-rw-r--r--embed.h16
-rw-r--r--pp_ctl.c54
-rw-r--r--pp_sort.c151
-rw-r--r--proto.h77
-rw-r--r--scope.c14
6 files changed, 180 insertions, 177 deletions
diff --git a/embed.fnc b/embed.fnc
index fb7740d0fc..828e6ec32d 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -274,8 +274,8 @@ Apd |void |hv_clear |HV* tb
Ap |void |hv_delayfree_ent|HV* hv|HE* entry
Apd |SV* |hv_delete |HV* tb|const char* key|I32 klen|I32 flags
Apd |SV* |hv_delete_ent |HV* tb|SV* key|I32 flags|U32 hash
-Apd |bool |hv_exists |HV* tb|const char* key|I32 klen
-Apd |bool |hv_exists_ent |HV* tb|SV* key|U32 hash
+ApdR |bool |hv_exists |HV* tb|const char* key|I32 klen
+ApdR |bool |hv_exists_ent |HV* tb|SV* key|U32 hash
Apd |SV** |hv_fetch |HV* tb|const char* key|I32 klen|I32 lval
Apd |HE* |hv_fetch_ent |HV* tb|SV* key|I32 lval|U32 hash
Ap |void |hv_free_ent |NN HV* hv|HE* entry
@@ -382,7 +382,7 @@ ApdR |I32 |looks_like_number|NN SV* sv
Apd |UV |grok_bin |NN const char* start|NN STRLEN* len_p|NN I32* flags|NV *result
Apd |UV |grok_hex |NN const char* start|NN STRLEN* len_p|NN I32* flags|NV *result
Apd |int |grok_number |NN const char *pv|STRLEN len|UV *valuep
-Apd |bool |grok_numeric_radix|const char **sp|const char *send
+ApdR |bool |grok_numeric_radix|const char **sp|const char *send
Apd |UV |grok_oct |const char* start|STRLEN* len_p|I32* flags|NV *result
p |int |magic_clearenv |SV* sv|MAGIC* mg
p |int |magic_clear_all_env|SV* sv|MAGIC* mg
@@ -1001,6 +1001,8 @@ s |void |unshare_hek_or_pvn|const HEK* hek|const char* str|I32 len|U32 hash
sR |HEK* |share_hek_flags|const char* sv|I32 len|U32 hash|int flags
rs |void |hv_notallowed |int flags|NN const char *key|I32 klen|NN const char *msg
s |struct xpvhv_aux*|hv_auxinit|HV *hv
+sM |SV* |hv_delete_common|HV* tb|SV* key_sv|const char* key|STRLEN klen|int k_flags|I32 d_flags|U32 hash
+sM |HE* |hv_fetch_common|HV* tb|SV* key_sv|const char* key|STRLEN klen|int flags|int action|SV* val|U32 hash
#endif
#if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT)
@@ -1103,7 +1105,7 @@ s |void* |call_list_body |CV *cv
#endif
#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
-s |SV* |refto |SV* sv
+sR |SV* |refto |SV* sv
#endif
#if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT)
@@ -1119,20 +1121,20 @@ s |const char *|get_num |NN const char *ppat|NN I32 *lenptr
#endif
#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
-s |OP* |docatch |OP *o
-s |void* |docatch_body
-s |OP* |dofindlabel |OP *o|const char *label|OP **opstack|OP **oplimit
-s |OP* |doparseform |SV *sv
-sn |bool |num_overflow |NV value|I32 fldsize|I32 frcsize
-s |I32 |dopoptoeval |I32 startingblock
-s |I32 |dopoptolabel |NN const char *label
-s |I32 |dopoptoloop |I32 startingblock
-s |I32 |dopoptosub |I32 startingblock
-s |I32 |dopoptosub_at |PERL_CONTEXT* cxstk|I32 startingblock
+sR |OP* |docatch |OP *o
+s |void |docatch_body
+sR |OP* |dofindlabel |OP *o|const char *label|OP **opstack|OP **oplimit
+sR |OP* |doparseform |SV *sv
+snR |bool |num_overflow |NV value|I32 fldsize|I32 frcsize
+sR |I32 |dopoptoeval |I32 startingblock
+sR |I32 |dopoptolabel |NN const char *label
+sR |I32 |dopoptoloop |I32 startingblock
+sR |I32 |dopoptosub |I32 startingblock
+sR |I32 |dopoptosub_at |const PERL_CONTEXT* cxstk|I32 startingblock
s |void |save_lines |AV *array|SV *sv
-s |OP* |doeval |int gimme|OP** startop|CV* outside|U32 seq
-s |PerlIO *|doopen_pm |const char *name|const char *mode
-s |bool |path_is_absolute|NN const char *name
+sR |OP* |doeval |int gimme|OP** startop|CV* outside|U32 seq
+sR |PerlIO *|doopen_pm |const char *name|const char *mode
+sR |bool |path_is_absolute|NN const char *name
#endif
#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
@@ -1391,7 +1393,7 @@ pd |void |do_dump_pad |I32 level|NN PerlIO *file|PADLIST *padlist|int full
pd |void |pad_fixup_inner_anons|NN PADLIST *padlist|CV *old_cv|CV *new_cv
pd |void |pad_push |NN PADLIST *padlist|int depth
-p |HV* |pad_compname_type|const PADOFFSET po
+pR |HV* |pad_compname_type|const PADOFFSET po
#if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
sd |PADOFFSET|pad_findlex |const char *name|const CV* cv|U32 seq|int warn \
@@ -1409,11 +1411,6 @@ p |int |get_debug_opts |const char **s|bool givehelp
Ap |void |save_set_svflags|SV* sv|U32 mask|U32 val
Apod |void |hv_assert |NN HV* tb
-#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT)
-sM |SV* |hv_delete_common|HV* tb|SV* key_sv|const char* key|STRLEN klen|int k_flags|I32 d_flags|U32 hash
-sM |HE* |hv_fetch_common|HV* tb|SV* key_sv|const char* key|STRLEN klen|int flags|int action|SV* val|U32 hash
-#endif
-
ApdR |SV* |hv_scalar |NN HV* hv
ApoR |I32* |hv_riter_p |NN HV* hv
ApoR |HE** |hv_eiter_p |NN HV* hv
@@ -1510,7 +1507,7 @@ Ap |GV* |gv_fetchpvn_flags|const char* name|STRLEN len|I32 flags|I32 sv_type
Ap |GV* |gv_fetchsv|SV *name|I32 flags|I32 sv_type
dpR |bool |is_gv_magical_sv|SV *name|U32 flags
-Apd |char* |savesvpv |SV* sv
+Apda |char* |savesvpv |NN SV* sv
ApR |bool |stashpv_hvname_match|NN const COP *cop|NN const HV *hv
END_EXTERN_C
diff --git a/embed.h b/embed.h
index 4eff6b18f5..6b811bea56 100644
--- a/embed.h
+++ b/embed.h
@@ -1040,6 +1040,8 @@
#define share_hek_flags S_share_hek_flags
#define hv_notallowed S_hv_notallowed
#define hv_auxinit S_hv_auxinit
+#define hv_delete_common S_hv_delete_common
+#define hv_fetch_common S_hv_fetch_common
#endif
#endif
#if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT)
@@ -1489,12 +1491,6 @@
#endif
#endif
#define save_set_svflags Perl_save_set_svflags
-#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT)
-#ifdef PERL_CORE
-#define hv_delete_common S_hv_delete_common
-#define hv_fetch_common S_hv_fetch_common
-#endif
-#endif
#define hv_scalar Perl_hv_scalar
#define hv_clear_placeholders Perl_hv_clear_placeholders
#ifdef PERL_CORE
@@ -3009,6 +3005,8 @@
#define share_hek_flags(a,b,c,d) S_share_hek_flags(aTHX_ a,b,c,d)
#define hv_notallowed(a,b,c,d) S_hv_notallowed(aTHX_ a,b,c,d)
#define hv_auxinit(a) S_hv_auxinit(aTHX_ a)
+#define hv_delete_common(a,b,c,d,e,f,g) S_hv_delete_common(aTHX_ a,b,c,d,e,f,g)
+#define hv_fetch_common(a,b,c,d,e,f,g,h) S_hv_fetch_common(aTHX_ a,b,c,d,e,f,g,h)
#endif
#endif
#if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT)
@@ -3457,12 +3455,6 @@
#endif
#endif
#define save_set_svflags(a,b,c) Perl_save_set_svflags(aTHX_ a,b,c)
-#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT)
-#ifdef PERL_CORE
-#define hv_delete_common(a,b,c,d,e,f,g) S_hv_delete_common(aTHX_ a,b,c,d,e,f,g)
-#define hv_fetch_common(a,b,c,d,e,f,g,h) S_hv_fetch_common(aTHX_ a,b,c,d,e,f,g,h)
-#endif
-#endif
#define hv_scalar(a) Perl_hv_scalar(aTHX_ a)
#define hv_clear_placeholders(a) Perl_hv_clear_placeholders(aTHX_ a)
#ifdef PERL_CORE
diff --git a/pp_ctl.c b/pp_ctl.c
index 69bc3fe6d5..6fd1add267 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -188,13 +188,13 @@ PP(pp_regcomp)
PP(pp_substcont)
{
dSP;
- register PMOP *pm = (PMOP*) cLOGOP->op_other;
register PERL_CONTEXT *cx = &cxstack[cxstack_ix];
- register SV *dstr = cx->sb_dstr;
+ register PMOP * const pm = (PMOP*) cLOGOP->op_other;
+ register SV * const dstr = cx->sb_dstr;
register char *s = cx->sb_s;
register char *m = cx->sb_m;
char *orig = cx->sb_orig;
- register REGEXP *rx = cx->sb_rx;
+ register REGEXP * const rx = cx->sb_rx;
SV *nsv = Nullsv;
REGEXP *old = PM_GETRE(pm);
if(old != rx) {
@@ -699,7 +699,7 @@ PP(pp_formline)
sv_catpvn_utf8_upgrade(PL_formtarget, s, arg, nsv);
for (; t < SvEND(PL_formtarget); t++) {
#ifdef EBCDIC
- int ch = *t;
+ const int ch = *t;
if (iscntrl(ch))
#else
if (!(*t & ~31))
@@ -710,7 +710,7 @@ PP(pp_formline)
}
while (arg--) {
#ifdef EBCDIC
- int ch = *t++ = *s++;
+ const int ch = *t++ = *s++;
if (iscntrl(ch))
#else
if ( !((*t++ = *s++) & ~31) )
@@ -1118,9 +1118,6 @@ PP(pp_flop)
if (GIMME == G_ARRAY) {
dPOPPOPssrl;
- register IV i, j;
- register SV *sv;
- IV max;
if (SvGMAGICAL(left))
mg_get(left);
@@ -1128,6 +1125,8 @@ PP(pp_flop)
mg_get(right);
if (RANGE_IS_NUMERIC(left,right)) {
+ register IV i, j;
+ IV max;
if ((SvOK(left) && SvNV(left) < IV_MIN) ||
(SvOK(right) && SvNV(right) > IV_MAX))
DIE(aTHX_ "Range iterator outside integer range");
@@ -1141,7 +1140,7 @@ PP(pp_flop)
else
j = 0;
while (j--) {
- sv = sv_2mortal(newSViv(i++));
+ SV * const sv = sv_2mortal(newSViv(i++));
PUSHs(sv);
}
}
@@ -1150,7 +1149,7 @@ PP(pp_flop)
STRLEN len;
const char *tmps = SvPV_const(final, len);
- sv = sv_mortalcopy(left);
+ SV *sv = sv_mortalcopy(left);
SvPV_force_nolen(sv);
while (!SvNIOKp(sv) && SvCUR(sv) <= len) {
XPUSHs(sv);
@@ -1163,7 +1162,7 @@ PP(pp_flop)
}
else {
dTOPss;
- SV *targ = PAD_SV(cUNOP->op_first->op_targ);
+ SV * const targ = PAD_SV(cUNOP->op_first->op_targ);
int flop = 0;
sv_inc(targ);
@@ -1172,7 +1171,7 @@ PP(pp_flop)
flop = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv));
}
else {
- GV *gv = gv_fetchpv(".", TRUE, SVt_PV);
+ GV * const gv = gv_fetchpv(".", TRUE, SVt_PV);
if (gv && GvSV(gv)) flop = SvIV(sv) == SvIV(GvSV(gv));
}
}
@@ -1182,7 +1181,7 @@ PP(pp_flop)
if (flop) {
sv_setiv(PAD_SV(((UNOP*)cUNOP->op_first)->op_first->op_targ), 0);
- sv_catpv(targ, "E0");
+ sv_catpvn(targ, "E0", 2);
}
SETs(targ);
}
@@ -1208,7 +1207,7 @@ S_dopoptolabel(pTHX_ const char *label)
register I32 i;
for (i = cxstack_ix; i >= 0; i--) {
- register const PERL_CONTEXT *cx = &cxstack[i];
+ register const PERL_CONTEXT * const cx = &cxstack[i];
switch (CxTYPE(cx)) {
case CXt_SUBST:
case CXt_SUB:
@@ -1222,8 +1221,7 @@ S_dopoptolabel(pTHX_ const char *label)
return -1;
break;
case CXt_LOOP:
- if (!cx->blk_loop.label ||
- strNE(label, cx->blk_loop.label) ) {
+ if ( !cx->blk_loop.label || strNE(label, cx->blk_loop.label) ) {
DEBUG_l(Perl_deb(aTHX_ "(Skipping label #%ld %s)\n",
(long)i, cx->blk_loop.label));
continue;
@@ -1282,11 +1280,11 @@ S_dopoptosub(pTHX_ I32 startingblock)
}
STATIC I32
-S_dopoptosub_at(pTHX_ PERL_CONTEXT *cxstk, I32 startingblock)
+S_dopoptosub_at(pTHX_ const PERL_CONTEXT *cxstk, I32 startingblock)
{
I32 i;
for (i = startingblock; i >= 0; i--) {
- register const PERL_CONTEXT *cx = &cxstk[i];
+ register const PERL_CONTEXT * const cx = &cxstk[i];
switch (CxTYPE(cx)) {
default:
continue;
@@ -1322,7 +1320,7 @@ S_dopoptoloop(pTHX_ I32 startingblock)
{
I32 i;
for (i = startingblock; i >= 0; i--) {
- register const PERL_CONTEXT *cx = &cxstack[i];
+ register const PERL_CONTEXT * const cx = &cxstack[i];
switch (CxTYPE(cx)) {
case CXt_SUBST:
case CXt_SUB:
@@ -1398,7 +1396,6 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
if (PL_in_eval) {
I32 cxix;
I32 gimme;
- SV **newsp;
if (message) {
if (PL_in_eval & EVAL_KEEPERR) {
@@ -1439,6 +1436,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
if (cxix >= 0) {
I32 optype;
register PERL_CONTEXT *cx;
+ SV **newsp;
if (cxix < cxstack_ix)
dounwind(cxix);
@@ -1467,7 +1465,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
if (optype == OP_REQUIRE) {
const char* msg = SvPVx_nolen_const(ERRSV);
- SV *nsv = cx->blk_eval.old_namesv;
+ SV * const nsv = cx->blk_eval.old_namesv;
(void)hv_store(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv),
&PL_sv_undef, 0);
DIE(aTHX_ "%sCompilation failed in require",
@@ -1550,9 +1548,9 @@ PP(pp_caller)
{
dSP;
register I32 cxix = dopoptosub(cxstack_ix);
- register PERL_CONTEXT *cx;
- register PERL_CONTEXT *ccstack = cxstack;
- PERL_SI *top_si = PL_curstackinfo;
+ register const PERL_CONTEXT *cx;
+ register const PERL_CONTEXT *ccstack = cxstack;
+ const PERL_SI *top_si = PL_curstackinfo;
I32 gimme;
const char *stashname;
I32 count = 0;
@@ -1978,7 +1976,7 @@ PP(pp_return)
(MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) )
{
/* Unassume the success we assumed earlier. */
- SV *nsv = cx->blk_eval.old_namesv;
+ SV * const nsv = cx->blk_eval.old_namesv;
(void)hv_delete(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), G_DISCARD);
DIE(aTHX_ "%"SVf" did not return a true value", nsv);
}
@@ -2690,11 +2688,11 @@ S_save_lines(pTHX_ AV *array, SV *sv)
}
}
-STATIC void *
+STATIC void
S_docatch_body(pTHX)
{
CALLRUNOPS(aTHX);
- return NULL;
+ return;
}
STATIC OP *
@@ -3533,7 +3531,7 @@ PP(pp_leaveeval)
!(gimme == G_SCALAR ? SvTRUE(*SP) : SP > newsp))
{
/* Unassume the success we assumed earlier. */
- SV *nsv = cx->blk_eval.old_namesv;
+ SV * const nsv = cx->blk_eval.old_namesv;
(void)hv_delete(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), G_DISCARD);
retop = Perl_die(aTHX_ "%"SVf" did not return a true value", nsv);
/* die_where() did LEAVE, or we won't be here */
diff --git a/pp_sort.c b/pp_sort.c
index 4b3f56ce73..8863e9f2d5 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -784,10 +784,10 @@ S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare)
/* Innoculate large partitions against quadratic behavior */
if (num_elts > QSORT_PLAY_SAFE) {
- register size_t n, j;
- register SV **q;
- for (n = num_elts, q = array; n > 1; ) {
- j = (size_t)(n-- * Drand01());
+ register size_t n;
+ register SV ** const q = array;
+ for (n = num_elts; n > 1; ) {
+ register const size_t j = (size_t)(n-- * Drand01());
temp = q[j];
q[j] = q[n];
q[n] = temp;
@@ -1143,7 +1143,7 @@ S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare)
qsort_break_even *= 2;
#endif
#if QSORT_ORDER_GUESS == 3
- int prev_break = qsort_break_even;
+ const int prev_break = qsort_break_even;
qsort_break_even *= qsort_break_even;
if (qsort_break_even < prev_break) {
qsort_break_even = (part_right - part_left) + 1;
@@ -1321,8 +1321,8 @@ static I32
cmpindir(pTHX_ gptr a, gptr b)
{
I32 sense;
- gptr *ap = (gptr *)a;
- gptr *bp = (gptr *)b;
+ gptr * const ap = (gptr *)a;
+ gptr * const bp = (gptr *)b;
if ((sense = PL_sort_RealCmp(aTHX_ *ap, *bp)) == 0)
sense = (ap > bp) ? 1 : ((ap < bp) ? -1 : 0);
@@ -1333,8 +1333,8 @@ static I32
cmpindir_desc(pTHX_ gptr a, gptr b)
{
I32 sense;
- gptr *ap = (gptr *)a;
- gptr *bp = (gptr *)b;
+ gptr * const ap = (gptr *)a;
+ gptr * const bp = (gptr *)b;
/* Reverse the default */
if ((sense = PL_sort_RealCmp(aTHX_ *ap, *bp)))
@@ -1443,14 +1443,13 @@ Perl_sortsv(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp)
void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
= S_mergesortsv;
SV *hintsv;
- I32 hints;
/* Sun's Compiler (cc: WorkShop Compilers 4.2 30 Oct 1996 C 4.2) used
to miscompile this function under optimization -O. If you get test
errors related to picking the correct sort() function, try recompiling
this file without optimiziation. -- A.D. 4/2002.
*/
- hints = SORTHINTS(hintsv);
+ const I32 hints = SORTHINTS(hintsv);
if (hints & HINT_SORT_QUICKSORT) {
sortsvp = S_qsortsv;
}
@@ -1469,14 +1468,13 @@ S_sortsv_desc(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp)
void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
= S_mergesortsv;
SV *hintsv;
- I32 hints;
/* Sun's Compiler (cc: WorkShop Compilers 4.2 30 Oct 1996 C 4.2) used
to miscompile this function under optimization -O. If you get test
errors related to picking the correct sort() function, try recompiling
this file without optimiziation. -- A.D. 4/2002.
*/
- hints = SORTHINTS(hintsv);
+ const I32 hints = SORTHINTS(hintsv);
if (hints & HINT_SORT_QUICKSORT) {
sortsvp = S_qsortsv;
}
@@ -1507,8 +1505,8 @@ PP(pp_sort)
bool hasargs = FALSE;
I32 is_xsub = 0;
I32 sorting_av = 0;
- U8 priv = PL_op->op_private;
- U8 flags = PL_op->op_flags;
+ const U8 priv = PL_op->op_private;
+ const U8 flags = PL_op->op_flags;
void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp)
= Perl_sortsv;
I32 all_SIVs = 1;
@@ -1647,7 +1645,7 @@ PP(pp_sort)
if (PL_sortcop) {
PERL_CONTEXT *cx;
SV** newsp;
- bool oldcatch = CATCH_GET;
+ const bool oldcatch = CATCH_GET;
SAVETMPS;
SAVEOP();
@@ -1718,17 +1716,15 @@ PP(pp_sort)
}
if (av && !sorting_av) {
/* simulate pp_aassign of tied AV */
- SV *sv;
- SV** base, **didstore;
- for (base = ORIGMARK+1, i=0; i < max; i++) {
- sv = newSVsv(base[i]);
- base[i] = sv;
+ SV** const base = ORIGMARK+1;
+ for (i=0; i < max; i++) {
+ base[i] = newSVsv(base[i]);
}
av_clear(av);
av_extend(av, max);
for (i=0; i < max; i++) {
- sv = base[i];
- didstore = av_store(av, i, sv);
+ SV * const sv = base[i];
+ SV **didstore = av_store(av, i, sv);
if (SvSMAGICAL(sv))
mg_set(sv);
if (!didstore)
@@ -1744,8 +1740,8 @@ static I32
sortcv(pTHX_ SV *a, SV *b)
{
dVAR;
- I32 oldsaveix = PL_savestack_ix;
- I32 oldscopeix = PL_scopestack_ix;
+ const I32 oldsaveix = PL_savestack_ix;
+ const I32 oldscopeix = PL_scopestack_ix;
I32 result;
GvSV(PL_firstgv) = a;
GvSV(PL_secondgv) = b;
@@ -1768,12 +1764,10 @@ static I32
sortcv_stacked(pTHX_ SV *a, SV *b)
{
dVAR;
- I32 oldsaveix = PL_savestack_ix;
- I32 oldscopeix = PL_scopestack_ix;
+ const I32 oldsaveix = PL_savestack_ix;
+ const I32 oldscopeix = PL_scopestack_ix;
I32 result;
- AV *av;
-
- av = GvAV(PL_defgv);
+ AV * const av = GvAV(PL_defgv);
if (AvMAX(av) < 1) {
SV** ary = AvALLOC(av);
@@ -1810,10 +1804,10 @@ static I32
sortcv_xsub(pTHX_ SV *a, SV *b)
{
dVAR; dSP;
- I32 oldsaveix = PL_savestack_ix;
- I32 oldscopeix = PL_scopestack_ix;
+ const I32 oldsaveix = PL_savestack_ix;
+ const I32 oldscopeix = PL_scopestack_ix;
+ CV * const cv=(CV*)PL_sortcop;
I32 result;
- CV *cv=(CV*)PL_sortcop;
SP = PL_stack_base;
PUSHMARK(SP);
@@ -1838,47 +1832,41 @@ sortcv_xsub(pTHX_ SV *a, SV *b)
static I32
sv_ncmp(pTHX_ SV *a, SV *b)
{
- NV nv1 = SvNSIV(a);
- NV nv2 = SvNSIV(b);
+ const NV nv1 = SvNSIV(a);
+ const NV nv2 = SvNSIV(b);
return nv1 < nv2 ? -1 : nv1 > nv2 ? 1 : 0;
}
static I32
sv_i_ncmp(pTHX_ SV *a, SV *b)
{
- IV iv1 = SvIV(a);
- IV iv2 = SvIV(b);
+ const IV iv1 = SvIV(a);
+ const IV iv2 = SvIV(b);
return iv1 < iv2 ? -1 : iv1 > iv2 ? 1 : 0;
}
-#define tryCALL_AMAGICbin(left,right,meth,svp) STMT_START { \
- *svp = Nullsv; \
- if (PL_amagic_generation) { \
- if (SvAMAGIC(left)||SvAMAGIC(right))\
- *svp = amagic_call(left, \
- right, \
- CAT2(meth,_amg), \
- 0); \
- } \
- } STMT_END
+
+#define tryCALL_AMAGICbin(left,right,meth) \
+ (PL_amagic_generation && (SvAMAGIC(left)||SvAMAGIC(right))) \
+ ? amagic_call(left, right, CAT2(meth,_amg), 0) \
+ : Nullsv;
static I32
amagic_ncmp(pTHX_ register SV *a, register SV *b)
{
- SV *tmpsv;
- tryCALL_AMAGICbin(a,b,ncmp,&tmpsv);
+ SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp);
if (tmpsv) {
- NV d;
-
if (SvIOK(tmpsv)) {
- I32 i = SvIVX(tmpsv);
+ const I32 i = SvIVX(tmpsv);
if (i > 0)
return 1;
return i? -1 : 0;
}
- d = SvNV(tmpsv);
- if (d > 0)
- return 1;
- return d? -1 : 0;
+ else {
+ const NV d = SvNV(tmpsv);
+ if (d > 0)
+ return 1;
+ return d ? -1 : 0;
+ }
}
return sv_ncmp(aTHX_ a, b);
}
@@ -1886,21 +1874,20 @@ amagic_ncmp(pTHX_ register SV *a, register SV *b)
static I32
amagic_i_ncmp(pTHX_ register SV *a, register SV *b)
{
- SV *tmpsv;
- tryCALL_AMAGICbin(a,b,ncmp,&tmpsv);
+ SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp);
if (tmpsv) {
- NV d;
-
if (SvIOK(tmpsv)) {
- I32 i = SvIVX(tmpsv);
+ const I32 i = SvIVX(tmpsv);
if (i > 0)
return 1;
return i? -1 : 0;
}
- d = SvNV(tmpsv);
- if (d > 0)
- return 1;
- return d? -1 : 0;
+ else {
+ const NV d = SvNV(tmpsv);
+ if (d > 0)
+ return 1;
+ return d ? -1 : 0;
+ }
}
return sv_i_ncmp(aTHX_ a, b);
}
@@ -1908,21 +1895,20 @@ amagic_i_ncmp(pTHX_ register SV *a, register SV *b)
static I32
amagic_cmp(pTHX_ register SV *str1, register SV *str2)
{
- SV *tmpsv;
- tryCALL_AMAGICbin(str1,str2,scmp,&tmpsv);
+ SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp);
if (tmpsv) {
- NV d;
-
if (SvIOK(tmpsv)) {
- I32 i = SvIVX(tmpsv);
+ const I32 i = SvIVX(tmpsv);
if (i > 0)
return 1;
return i? -1 : 0;
}
- d = SvNV(tmpsv);
- if (d > 0)
- return 1;
- return d? -1 : 0;
+ else {
+ const NV d = SvNV(tmpsv);
+ if (d > 0)
+ return 1;
+ return d? -1 : 0;
+ }
}
return sv_cmp(str1, str2);
}
@@ -1930,21 +1916,20 @@ amagic_cmp(pTHX_ register SV *str1, register SV *str2)
static I32
amagic_cmp_locale(pTHX_ register SV *str1, register SV *str2)
{
- SV *tmpsv;
- tryCALL_AMAGICbin(str1,str2,scmp,&tmpsv);
+ SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp);
if (tmpsv) {
- NV d;
-
if (SvIOK(tmpsv)) {
- I32 i = SvIVX(tmpsv);
+ const I32 i = SvIVX(tmpsv);
if (i > 0)
return 1;
return i? -1 : 0;
}
- d = SvNV(tmpsv);
- if (d > 0)
- return 1;
- return d? -1 : 0;
+ else {
+ const NV d = SvNV(tmpsv);
+ if (d > 0)
+ return 1;
+ return d? -1 : 0;
+ }
}
return sv_cmp_locale(str1, str2);
}
diff --git a/proto.h b/proto.h
index c7c5975149..0064341245 100644
--- a/proto.h
+++ b/proto.h
@@ -389,8 +389,12 @@ PERL_CALLCONV void Perl_hv_clear(pTHX_ HV* tb);
PERL_CALLCONV void Perl_hv_delayfree_ent(pTHX_ HV* hv, HE* entry);
PERL_CALLCONV SV* Perl_hv_delete(pTHX_ HV* tb, const char* key, I32 klen, I32 flags);
PERL_CALLCONV SV* Perl_hv_delete_ent(pTHX_ HV* tb, SV* key, I32 flags, U32 hash);
-PERL_CALLCONV bool Perl_hv_exists(pTHX_ HV* tb, const char* key, I32 klen);
-PERL_CALLCONV bool Perl_hv_exists_ent(pTHX_ HV* tb, SV* key, U32 hash);
+PERL_CALLCONV bool Perl_hv_exists(pTHX_ HV* tb, const char* key, I32 klen)
+ __attribute__warn_unused_result__;
+
+PERL_CALLCONV bool Perl_hv_exists_ent(pTHX_ HV* tb, SV* key, U32 hash)
+ __attribute__warn_unused_result__;
+
PERL_CALLCONV SV** Perl_hv_fetch(pTHX_ HV* tb, const char* key, I32 klen, I32 lval);
PERL_CALLCONV HE* Perl_hv_fetch_ent(pTHX_ HV* tb, SV* key, I32 lval, U32 hash);
PERL_CALLCONV void Perl_hv_free_ent(pTHX_ HV* hv, HE* entry)
@@ -731,7 +735,9 @@ PERL_CALLCONV UV Perl_grok_hex(pTHX_ const char* start, STRLEN* len_p, I32* flag
PERL_CALLCONV int Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep)
__attribute__nonnull__(pTHX_1);
-PERL_CALLCONV bool Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send);
+PERL_CALLCONV bool Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
+ __attribute__warn_unused_result__;
+
PERL_CALLCONV UV Perl_grok_oct(pTHX_ const char* start, STRLEN* len_p, I32* flags, NV *result);
PERL_CALLCONV int Perl_magic_clearenv(pTHX_ SV* sv, MAGIC* mg);
PERL_CALLCONV int Perl_magic_clear_all_env(pTHX_ SV* sv, MAGIC* mg);
@@ -1884,6 +1890,8 @@ STATIC void S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen, const ch
__attribute__nonnull__(pTHX_4);
STATIC struct xpvhv_aux* S_hv_auxinit(pTHX_ HV *hv);
+STATIC SV* S_hv_delete_common(pTHX_ HV* tb, SV* key_sv, const char* key, STRLEN klen, int k_flags, I32 d_flags, U32 hash);
+STATIC HE* S_hv_fetch_common(pTHX_ HV* tb, SV* key_sv, const char* key, STRLEN klen, int flags, int action, SV* val, U32 hash);
#endif
#if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT)
@@ -2158,7 +2166,9 @@ STATIC void* S_call_list_body(pTHX_ CV *cv);
#endif
#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
-STATIC SV* S_refto(pTHX_ SV* sv);
+STATIC SV* S_refto(pTHX_ SV* sv)
+ __attribute__warn_unused_result__;
+
#endif
#if defined(PERL_IN_PP_PACK_C) || defined(PERL_DECL_PROT)
@@ -2192,22 +2202,44 @@ STATIC const char * S_get_num(pTHX_ const char *ppat, I32 *lenptr)
#endif
#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
-STATIC OP* S_docatch(pTHX_ OP *o);
-STATIC void* S_docatch_body(pTHX);
-STATIC OP* S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit);
-STATIC OP* S_doparseform(pTHX_ SV *sv);
-STATIC bool S_num_overflow(NV value, I32 fldsize, I32 frcsize);
-STATIC I32 S_dopoptoeval(pTHX_ I32 startingblock);
+STATIC OP* S_docatch(pTHX_ OP *o)
+ __attribute__warn_unused_result__;
+
+STATIC void S_docatch_body(pTHX);
+STATIC OP* S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit)
+ __attribute__warn_unused_result__;
+
+STATIC OP* S_doparseform(pTHX_ SV *sv)
+ __attribute__warn_unused_result__;
+
+STATIC bool S_num_overflow(NV value, I32 fldsize, I32 frcsize)
+ __attribute__warn_unused_result__;
+
+STATIC I32 S_dopoptoeval(pTHX_ I32 startingblock)
+ __attribute__warn_unused_result__;
+
STATIC I32 S_dopoptolabel(pTHX_ const char *label)
+ __attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1);
-STATIC I32 S_dopoptoloop(pTHX_ I32 startingblock);
-STATIC I32 S_dopoptosub(pTHX_ I32 startingblock);
-STATIC I32 S_dopoptosub_at(pTHX_ PERL_CONTEXT* cxstk, I32 startingblock);
+STATIC I32 S_dopoptoloop(pTHX_ I32 startingblock)
+ __attribute__warn_unused_result__;
+
+STATIC I32 S_dopoptosub(pTHX_ I32 startingblock)
+ __attribute__warn_unused_result__;
+
+STATIC I32 S_dopoptosub_at(pTHX_ const PERL_CONTEXT* cxstk, I32 startingblock)
+ __attribute__warn_unused_result__;
+
STATIC void S_save_lines(pTHX_ AV *array, SV *sv);
-STATIC OP* S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq);
-STATIC PerlIO * S_doopen_pm(pTHX_ const char *name, const char *mode);
+STATIC OP* S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
+ __attribute__warn_unused_result__;
+
+STATIC PerlIO * S_doopen_pm(pTHX_ const char *name, const char *mode)
+ __attribute__warn_unused_result__;
+
STATIC bool S_path_is_absolute(pTHX_ const char *name)
+ __attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1);
#endif
@@ -2643,7 +2675,9 @@ PERL_CALLCONV void Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv
PERL_CALLCONV void Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
__attribute__nonnull__(pTHX_1);
-PERL_CALLCONV HV* Perl_pad_compname_type(pTHX_ const PADOFFSET po);
+PERL_CALLCONV HV* Perl_pad_compname_type(pTHX_ const PADOFFSET po)
+ __attribute__warn_unused_result__;
+
#if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
STATIC PADOFFSET S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, SV** out_capture, SV** out_name_sv, int *out_flags);
@@ -2666,11 +2700,6 @@ PERL_CALLCONV void Perl_hv_assert(pTHX_ HV* tb)
__attribute__nonnull__(pTHX_1);
-#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT)
-STATIC SV* S_hv_delete_common(pTHX_ HV* tb, SV* key_sv, const char* key, STRLEN klen, int k_flags, I32 d_flags, U32 hash);
-STATIC HE* S_hv_fetch_common(pTHX_ HV* tb, SV* key_sv, const char* key, STRLEN klen, int flags, int action, SV* val, U32 hash);
-#endif
-
PERL_CALLCONV SV* Perl_hv_scalar(pTHX_ HV* hv)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1);
@@ -2797,7 +2826,11 @@ PERL_CALLCONV bool Perl_is_gv_magical_sv(pTHX_ SV *name, U32 flags)
__attribute__warn_unused_result__;
-PERL_CALLCONV char* Perl_savesvpv(pTHX_ SV* sv);
+PERL_CALLCONV char* Perl_savesvpv(pTHX_ SV* sv)
+ __attribute__malloc__
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1);
+
PERL_CALLCONV bool Perl_stashpv_hvname_match(pTHX_ const COP *cop, const HV *hv)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1)
diff --git a/scope.c b/scope.c
index 31a3ebc44b..1602af6312 100644
--- a/scope.c
+++ b/scope.c
@@ -139,7 +139,7 @@ Perl_free_tmps(pTHX)
/* XXX should tmps_floor live in cxstack? */
const I32 myfloor = PL_tmps_floor;
while (PL_tmps_ix > myfloor) { /* clean up after last statement */
- SV* sv = PL_tmps_stack[PL_tmps_ix];
+ SV* const sv = PL_tmps_stack[PL_tmps_ix];
PL_tmps_stack[PL_tmps_ix--] = Nullsv;
if (sv && sv != &PL_sv_undef) {
SvTEMP_off(sv);
@@ -151,10 +151,9 @@ Perl_free_tmps(pTHX)
STATIC SV *
S_save_scalar_at(pTHX_ SV **sptr)
{
- register SV *sv;
- SV *osv = *sptr;
+ SV * const osv = *sptr;
+ register SV * const sv = *sptr = NEWSV(0,0);
- sv = *sptr = NEWSV(0,0);
if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
MAGIC *mg;
sv_upgrade(sv, SvTYPE(osv));
@@ -301,7 +300,7 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty)
AV *
Perl_save_ary(pTHX_ GV *gv)
{
- AV *oav = GvAVn(gv);
+ AV * const oav = GvAVn(gv);
AV *av;
if (!AvREAL(oav) && AvREIFY(oav))
@@ -352,7 +351,7 @@ Perl_save_hash(pTHX_ GV *gv)
void
Perl_save_item(pTHX_ register SV *item)
{
- register SV *sv = newSVsv(item);
+ register SV * const sv = newSVsv(item);
SSCHECK(3);
SSPUSHPTR(item); /* remember the pointer */
@@ -553,11 +552,10 @@ Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen)
void
Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg)
{
- register SV *sv;
register I32 i;
for (i = 1; i <= maxsarg; i++) {
- sv = NEWSV(0,0);
+ register SV * const sv = NEWSV(0,0);
sv_setsv(sv,sarg[i]);
SSCHECK(3);
SSPUSHPTR(sarg[i]); /* remember the pointer */