diff options
-rw-r--r-- | embed.fnc | 45 | ||||
-rw-r--r-- | embed.h | 16 | ||||
-rw-r--r-- | pp_ctl.c | 54 | ||||
-rw-r--r-- | pp_sort.c | 151 | ||||
-rw-r--r-- | proto.h | 77 | ||||
-rw-r--r-- | scope.c | 14 |
6 files changed, 180 insertions, 177 deletions
@@ -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 @@ -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 @@ -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 */ @@ -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); } @@ -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) @@ -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 */ |