diff options
| -rw-r--r-- | Makefile.SH | 18 | ||||
| -rw-r--r-- | README.aix | 4 | ||||
| -rw-r--r-- | embed.fnc | 65 | ||||
| -rw-r--r-- | hv.c | 2 | ||||
| -rw-r--r-- | numeric.c | 2 | ||||
| -rw-r--r-- | op.c | 38 | ||||
| -rw-r--r-- | pad.c | 4 | ||||
| -rw-r--r-- | pod/perldebug.pod | 4 | ||||
| -rw-r--r-- | pp_ctl.c | 4 | ||||
| -rw-r--r-- | proto.h | 100 | ||||
| -rw-r--r-- | sv.c | 24 | ||||
| -rw-r--r-- | toke.c | 2 | ||||
| -rw-r--r-- | util.c | 47 |
13 files changed, 172 insertions, 142 deletions
diff --git a/Makefile.SH b/Makefile.SH index 9b25126d34..a6034ab4e2 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -355,12 +355,12 @@ obj3 = doop$(OBJ_EXT) doio$(OBJ_EXT) regexec$(OBJ_EXT) utf8$(OBJ_EXT) taint$(OBJ obj = $(obj1) $(obj2) $(obj3) $(ARCHOBJS) lintflags = \ - -bh \ + -bhn \ -p \ -s \ -Ncheck=%all \ -Nlevel=4 \ - -errfmt=simple \ + -errfmt=src \ -errtags \ -erroff=E_BAD_PTR_CAST \ -erroff=E_BLOCK_DECL_UNUSED \ @@ -370,7 +370,15 @@ lintflags = \ -erroff=E_EXPR_NULL_EFFECT \ -erroff=E_BAD_PTR_INT_COMBINATION \ -erroff=E_LOOP_EMPTY \ - *.c + -erroff=E_TRUE_LOGICAL_EXPR \ + -erroff=E_FALSE_LOGICAL_EXPR \ + -erroff=E_INDISTING_FROM_TRUNC \ + -erroff=E_POINTER_TO_OBJECT \ + -erroff=E_ASSIGN_NARROW_CONV \ + -erroff=E_BAD_SIGN_EXTEND \ + -erroff=E_INCL_NUSD \ + -erroff=E_MAIN_PARAM \ + -Wfoo.flow .c$(OBJ_EXT): $(CCCMD) $(PLDLFLAGS) $*.c @@ -1052,7 +1060,7 @@ _verycleaner: .PHONY: lint lint: $(c) rm -f *.ln - lint $(lintflags) -DPERL_CORE -D_REENTRANT -DDEBUGGING -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 $(c) perly.c + lint $(lintflags) -DPERL_CORE -D_REENTRANT -DDEBUGGING -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 $(c) # Need to unset during recursion to go out of loop. # The README below ensures that the dependency list is never empty and @@ -1294,7 +1302,7 @@ tags: TAGS perl emacs/e2ctags.pl TAGS > tags ctags: - ctags -f Tags --totals --languages=c --langmap=c:+.h *.c *.h + ctags -f Tags -N --totals --languages=c --langmap=c:+.h *.c *.h # AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE # If this runs make out of memory, delete /usr/include lines. diff --git a/README.aix b/README.aix index 39ff260d8f..fa65933822 100644 --- a/README.aix +++ b/README.aix @@ -31,7 +31,7 @@ you will find xlC.C for AIX-5.0 as package xlC.aix50.rte 5.0.2.0 or 6.0.0.3 -subversions are not the same `latest' on all OS versions. For example, +subversions are not the same "latest" on all OS versions. For example, the latest xlC-5 on aix41 is 5.0.2.9, while on aix43, it is 5.0.2.7. Perl can be compiled with either IBM's ANSI C compiler or with gcc. @@ -106,7 +106,7 @@ level. Of course this is subject to changes. You can only upgrade versions from ftp-available updates if the first three digit groups are the same (in where you can skip intermediate unlike the patches in the developer snapshots of perl), or to one version up where the -`base' is available. In other words, the AIX compiler patches are +"base" is available. In other words, the AIX compiler patches are cumulative. vac.C.4.4.0.1 => vac.C.4.4.0.3 is OK (vac.C.4.4.0.2 not needed) @@ -524,7 +524,7 @@ Apa |OP* |newLISTOP |I32 type|I32 flags|OP* first|OP* last Apa |OP* |newPADOP |I32 type|I32 flags|SV* sv Apa |OP* |newPMOP |I32 type|I32 flags Apa |OP* |newPVOP |I32 type|I32 flags|char* pv -Apa |SV* |newRV |SV* pref +Apa |SV* |newRV |NN SV* pref Apda |SV* |newRV_noinc |NN SV *sv Apda |SV* |newSV |STRLEN len Apa |OP* |newSVREF |NN OP* o @@ -1000,7 +1000,7 @@ s |void |hv_magic_check |NN HV *hv|NN bool *needs_copy|NN bool *needs_store s |void |unshare_hek_or_pvn|HEK* hek|const char* str|I32 len|U32 hash sR |HE* |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 -asR |struct xpvhv_aux*|hv_auxinit|HV *hv +s |struct xpvhv_aux*|hv_auxinit|HV *hv #endif #if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT) @@ -1364,26 +1364,26 @@ pMXE |SV* |sv_setsv_cow |SV* dsv|SV* ssv #endif #if defined(USE_PERLIO) && !defined(USE_SFIO) -Ap |int |PerlIO_close |PerlIO * -Ap |int |PerlIO_fill |PerlIO * -Ap |int |PerlIO_fileno |PerlIO * -Ap |int |PerlIO_eof |PerlIO * -Ap |int |PerlIO_error |PerlIO * -Ap |int |PerlIO_flush |PerlIO * -Ap |void |PerlIO_clearerr |PerlIO * -Ap |void |PerlIO_set_cnt |PerlIO *|int -Ap |void |PerlIO_set_ptrcnt |PerlIO *|STDCHAR *|int -Ap |void |PerlIO_setlinebuf |PerlIO * -Ap |SSize_t|PerlIO_read |PerlIO *|void *|Size_t -Ap |SSize_t|PerlIO_write |PerlIO *|const void *|Size_t -Ap |SSize_t|PerlIO_unread |PerlIO *|const void *|Size_t -Ap |Off_t |PerlIO_tell |PerlIO * -Ap |int |PerlIO_seek |PerlIO *|Off_t|int +Ap |int |PerlIO_close |PerlIO *f +Ap |int |PerlIO_fill |PerlIO *f +Ap |int |PerlIO_fileno |PerlIO *f +Ap |int |PerlIO_eof |PerlIO *f +Ap |int |PerlIO_error |PerlIO *f +Ap |int |PerlIO_flush |PerlIO *f +Ap |void |PerlIO_clearerr |PerlIO *f +Ap |void |PerlIO_set_cnt |PerlIO *f|int cnt +Ap |void |PerlIO_set_ptrcnt |PerlIO *f|NN STDCHAR *ptr|int cnt +Ap |void |PerlIO_setlinebuf |PerlIO *f +Ap |SSize_t|PerlIO_read |PerlIO *f|NN void *buf|Size_t count +Ap |SSize_t|PerlIO_write |PerlIO *f|NN const void *buf|Size_t count +Ap |SSize_t|PerlIO_unread |PerlIO *f|NN const void *buf|Size_t count +Ap |Off_t |PerlIO_tell |PerlIO *f +Ap |int |PerlIO_seek |PerlIO *f|Off_t offset|int whence -Ap |STDCHAR *|PerlIO_get_base |PerlIO * -Ap |STDCHAR *|PerlIO_get_ptr |PerlIO * -Ap |int |PerlIO_get_bufsiz |PerlIO * -Ap |int |PerlIO_get_cnt |PerlIO * +Ap |STDCHAR *|PerlIO_get_base |PerlIO *f +Ap |STDCHAR *|PerlIO_get_ptr |PerlIO *f +Ap |int |PerlIO_get_bufsiz |PerlIO *f +Ap |int |PerlIO_get_cnt |PerlIO *f Ap |PerlIO *|PerlIO_stdin Ap |PerlIO *|PerlIO_stdout @@ -1396,23 +1396,22 @@ s |void |deb_stack_n |SV** stack_base|I32 stack_min \ |I32 stack_max|I32 mark_min|I32 mark_max #endif -pd |PADLIST*|pad_new |int flags +pda |PADLIST*|pad_new |int flags pd |void |pad_undef |CV* cv pd |PADOFFSET|pad_add_name |NN const char *name\ |HV* typestash|HV* ourstash \ |bool clone pd |PADOFFSET|pad_add_anon |SV* sv|OPCODE op_type -pd |void |pad_check_dup |const char* name|bool is_our|const HV* ourstash +pd |void |pad_check_dup |NN const char* name|bool is_our|NN const HV* ourstash #ifdef DEBUGGING -pd |void |pad_setsv |PADOFFSET po|SV* sv +pd |void |pad_setsv |PADOFFSET po|NN SV* sv #endif pd |void |pad_block_start|int full pd |void |pad_tidy |padtidy_type type -pd |void |do_dump_pad |I32 level|PerlIO *file \ - |PADLIST *padlist|int full -pd |void |pad_fixup_inner_anons|PADLIST *padlist|CV *old_cv|CV *new_cv +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 |PADLIST *padlist|int depth +pd |void |pad_push |NN PADLIST *padlist|int depth p |HV* |pad_compname_type|const PADOFFSET po #if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT) @@ -1420,7 +1419,7 @@ sd |PADOFFSET|pad_findlex |const char *name|const CV* cv|U32 seq|int warn \ |SV** out_capture|SV** out_name_sv \ |int *out_flags # if defined(DEBUGGING) -sd |void |cv_dump |const CV *cv|const char *title +sd |void |cv_dump |NN const CV *cv|NN const char *title # endif #endif pdR |CV* |find_runcv |U32 *db_seqp @@ -1429,7 +1428,7 @@ p |void |free_tied_hv_pool p |int |get_debug_opts |const char **s|bool givehelp #endif Ap |void |save_set_svflags|SV* sv|U32 mask|U32 val -Apod |void |hv_assert |HV* tb +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 @@ -1440,14 +1439,14 @@ ApdR |SV* |hv_scalar |NN HV* hv ApoR |I32* |hv_riter_p |NN HV* hv ApoR |HE** |hv_eiter_p |NN HV* hv Apo |void |hv_riter_set |NN HV* hv|I32 riter -Apo |void |hv_eiter_set |NN HV* hv|NN HE* eiter +Apo |void |hv_eiter_set |NN HV* hv|HE* eiter Apo |void |hv_name_set |NN HV* hv|const char *name|I32 len|int flags Apd |void |hv_clear_placeholders |NN HV* hb ApoR |I32* |hv_placeholders_p |NN HV* hv ApoR |I32 |hv_placeholders_get |NN HV* hv -ApoR |void |hv_placeholders_set |NN HV* hv|I32 ph +Apo |void |hv_placeholders_set |NN HV* hv|I32 ph -p |SV* |magic_scalarpack|HV* hv|MAGIC* mg +p |SV* |magic_scalarpack|NN HV* hv|NN MAGIC* mg #ifdef PERL_IN_SV_C sMd |SV* |find_uninit_var|OP* obase|SV* uninit_sv|bool top #endif @@ -1767,12 +1767,10 @@ value, you can get it through the macro C<HvFILL(tb)>. I32 Perl_hv_iterinit(pTHX_ HV *hv) { - register XPVHV* xhv; HE *entry; if (!hv) Perl_croak(aTHX_ "Bad hash"); - xhv = (XPVHV*)SvANY(hv); if (SvOOK(hv)) { struct xpvhv_aux *iter = HvAUX(hv); @@ -757,7 +757,7 @@ S_mulexp10(NV value, I32 exponent) if (exponent == 0) return value; if (value == 0) - return 0; + return (NV)0; /* On OpenVMS VAX we by default use the D_FLOAT double format, * and that format does not have *easy* capabilities [1] for @@ -3913,7 +3913,7 @@ whileline, OP *expr, OP *block, OP *cont, I32 has_my) } OP * -Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont) +Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP *block, OP *cont) { dVAR; LOOP *loop; @@ -3968,8 +3968,8 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo */ UNOP* flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first; LOGOP* range = (LOGOP*) flip->op_first; - OP* left = range->op_first; - OP* right = left->op_sibling; + OP* const left = range->op_first; + OP* const right = left->op_sibling; LISTOP* listop; range->op_flags &= ~OPf_KIDS; @@ -4660,24 +4660,32 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename) if (GvCVGEN(gv)) { /* just a cached method */ SvREFCNT_dec(cv); - cv = 0; + cv = Nullcv; } else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) { /* already defined (or promised) */ /* XXX It's possible for this HvNAME_get to return null, and get passed into strEQ */ - if (ckWARN(WARN_REDEFINE) && !(CvGV(cv) && GvSTASH(CvGV(cv)) - && strEQ(HvNAME_get(GvSTASH(CvGV(cv))), "autouse"))) { - const line_t oldline = CopLINE(PL_curcop); - if (PL_copline != NOLINE) - CopLINE_set(PL_curcop, PL_copline); - Perl_warner(aTHX_ packWARN(WARN_REDEFINE), - CvCONST(cv) ? "Constant subroutine %s redefined" - : "Subroutine %s redefined" - ,name); - CopLINE_set(PL_curcop, oldline); + if (ckWARN(WARN_REDEFINE)) { + GV * const gvcv = CvGV(cv); + if (gvcv) { + HV * const stash = GvSTASH(gvcv); + if (stash) { + const char *name = HvNAME_get(stash); + if ( strEQ(name,"autouse") ) { + const line_t oldline = CopLINE(PL_curcop); + if (PL_copline != NOLINE) + CopLINE_set(PL_curcop, PL_copline); + Perl_warner(aTHX_ packWARN(WARN_REDEFINE), + CvCONST(cv) ? "Constant subroutine %s redefined" + : "Subroutine %s redefined" + ,name); + CopLINE_set(PL_curcop, oldline); + } + } + } } SvREFCNT_dec(cv); - cv = 0; + cv = Nullcv; } } @@ -1524,8 +1524,8 @@ void Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv) { I32 ix; - AV *comppad_name = (AV*)AvARRAY(padlist)[0]; - AV *comppad = (AV*)AvARRAY(padlist)[1]; + AV * const comppad_name = (AV*)AvARRAY(padlist)[0]; + AV * const comppad = (AV*)AvARRAY(padlist)[1]; SV **namepad = AvARRAY(comppad_name); SV **curpad = AvARRAY(comppad); for (ix = AvFILLp(comppad_name); ix > 0; ix--) { diff --git a/pod/perldebug.pod b/pod/perldebug.pod index 9a8d02fa26..9eb0a9e343 100644 --- a/pod/perldebug.pod +++ b/pod/perldebug.pod @@ -669,7 +669,7 @@ include lexicals in a module's file scope, or lost in closures. =back After the rc file is read, the debugger reads the C<$ENV{PERLDB_OPTS}> -environment variable and parses this as the remainder of a `O ...' +environment variable and parses this as the remainder of a "O ..." line as one might enter at the debugger prompt. You may place the initialization options C<TTY>, C<noTTY>, C<ReadLine>, and C<NonStop> there. @@ -1016,7 +1016,7 @@ L<perlrun>. When debugging a script that uses #! and is thus normally found in $PATH, the -S option causes perl to search $PATH for it, so you don't -have to type the path or `which $scriptname`. +have to type the path or C<which $scriptname>. $ perl -Sd foo.pl @@ -1653,8 +1653,8 @@ PP(pp_caller) if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs && CopSTASH_eq(PL_curcop, PL_debstash)) { - AV *ary = cx->blk_sub.argarray; - const int off = AvARRAY(ary) - AvALLOC(ary); + AV * const ary = cx->blk_sub.argarray; + const int off = AvARRAY(ary) - AvALLOC(ary); if (!PL_dbargs) { GV* tmpgv; @@ -994,7 +994,8 @@ PERL_CALLCONV OP* Perl_newPVOP(pTHX_ I32 type, I32 flags, char* pv) PERL_CALLCONV SV* Perl_newRV(pTHX_ SV* pref) __attribute__malloc__ - __attribute__warn_unused_result__; + __attribute__warn_unused_result__ + __attribute__nonnull__(pTHX_1); PERL_CALLCONV SV* Perl_newRV_noinc(pTHX_ SV *sv) __attribute__malloc__ @@ -1879,10 +1880,7 @@ STATIC void S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen, const ch __attribute__nonnull__(pTHX_2) __attribute__nonnull__(pTHX_4); -STATIC struct xpvhv_aux* S_hv_auxinit(pTHX_ HV *hv) - __attribute__malloc__ - __attribute__warn_unused_result__; - +STATIC struct xpvhv_aux* S_hv_auxinit(pTHX_ HV *hv); #endif #if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT) @@ -2532,26 +2530,34 @@ PERL_CALLCONV SV* Perl_sv_setsv_cow(pTHX_ SV* dsv, SV* ssv); #endif #if defined(USE_PERLIO) && !defined(USE_SFIO) -PERL_CALLCONV int Perl_PerlIO_close(pTHX_ PerlIO *); -PERL_CALLCONV int Perl_PerlIO_fill(pTHX_ PerlIO *); -PERL_CALLCONV int Perl_PerlIO_fileno(pTHX_ PerlIO *); -PERL_CALLCONV int Perl_PerlIO_eof(pTHX_ PerlIO *); -PERL_CALLCONV int Perl_PerlIO_error(pTHX_ PerlIO *); -PERL_CALLCONV int Perl_PerlIO_flush(pTHX_ PerlIO *); -PERL_CALLCONV void Perl_PerlIO_clearerr(pTHX_ PerlIO *); -PERL_CALLCONV void Perl_PerlIO_set_cnt(pTHX_ PerlIO *, int); -PERL_CALLCONV void Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *, STDCHAR *, int); -PERL_CALLCONV void Perl_PerlIO_setlinebuf(pTHX_ PerlIO *); -PERL_CALLCONV SSize_t Perl_PerlIO_read(pTHX_ PerlIO *, void *, Size_t); -PERL_CALLCONV SSize_t Perl_PerlIO_write(pTHX_ PerlIO *, const void *, Size_t); -PERL_CALLCONV SSize_t Perl_PerlIO_unread(pTHX_ PerlIO *, const void *, Size_t); -PERL_CALLCONV Off_t Perl_PerlIO_tell(pTHX_ PerlIO *); -PERL_CALLCONV int Perl_PerlIO_seek(pTHX_ PerlIO *, Off_t, int); - -PERL_CALLCONV STDCHAR * Perl_PerlIO_get_base(pTHX_ PerlIO *); -PERL_CALLCONV STDCHAR * Perl_PerlIO_get_ptr(pTHX_ PerlIO *); -PERL_CALLCONV int Perl_PerlIO_get_bufsiz(pTHX_ PerlIO *); -PERL_CALLCONV int Perl_PerlIO_get_cnt(pTHX_ PerlIO *); +PERL_CALLCONV int Perl_PerlIO_close(pTHX_ PerlIO *f); +PERL_CALLCONV int Perl_PerlIO_fill(pTHX_ PerlIO *f); +PERL_CALLCONV int Perl_PerlIO_fileno(pTHX_ PerlIO *f); +PERL_CALLCONV int Perl_PerlIO_eof(pTHX_ PerlIO *f); +PERL_CALLCONV int Perl_PerlIO_error(pTHX_ PerlIO *f); +PERL_CALLCONV int Perl_PerlIO_flush(pTHX_ PerlIO *f); +PERL_CALLCONV void Perl_PerlIO_clearerr(pTHX_ PerlIO *f); +PERL_CALLCONV void Perl_PerlIO_set_cnt(pTHX_ PerlIO *f, int cnt); +PERL_CALLCONV void Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR *ptr, int cnt) + __attribute__nonnull__(pTHX_2); + +PERL_CALLCONV void Perl_PerlIO_setlinebuf(pTHX_ PerlIO *f); +PERL_CALLCONV SSize_t Perl_PerlIO_read(pTHX_ PerlIO *f, void *buf, Size_t count) + __attribute__nonnull__(pTHX_2); + +PERL_CALLCONV SSize_t Perl_PerlIO_write(pTHX_ PerlIO *f, const void *buf, Size_t count) + __attribute__nonnull__(pTHX_2); + +PERL_CALLCONV SSize_t Perl_PerlIO_unread(pTHX_ PerlIO *f, const void *buf, Size_t count) + __attribute__nonnull__(pTHX_2); + +PERL_CALLCONV Off_t Perl_PerlIO_tell(pTHX_ PerlIO *f); +PERL_CALLCONV int Perl_PerlIO_seek(pTHX_ PerlIO *f, Off_t offset, int whence); + +PERL_CALLCONV STDCHAR * Perl_PerlIO_get_base(pTHX_ PerlIO *f); +PERL_CALLCONV STDCHAR * Perl_PerlIO_get_ptr(pTHX_ PerlIO *f); +PERL_CALLCONV int Perl_PerlIO_get_bufsiz(pTHX_ PerlIO *f); +PERL_CALLCONV int Perl_PerlIO_get_cnt(pTHX_ PerlIO *f); PERL_CALLCONV PerlIO * Perl_PerlIO_stdin(pTHX); PERL_CALLCONV PerlIO * Perl_PerlIO_stdout(pTHX); @@ -2563,28 +2569,45 @@ PERL_CALLCONV void Perl_deb_stack_all(pTHX); STATIC void S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max, I32 mark_min, I32 mark_max); #endif -PERL_CALLCONV PADLIST* Perl_pad_new(pTHX_ int flags); +PERL_CALLCONV PADLIST* Perl_pad_new(pTHX_ int flags) + __attribute__malloc__ + __attribute__warn_unused_result__; + PERL_CALLCONV void Perl_pad_undef(pTHX_ CV* cv); PERL_CALLCONV PADOFFSET Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool clone) __attribute__nonnull__(pTHX_1); PERL_CALLCONV PADOFFSET Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type); -PERL_CALLCONV void Perl_pad_check_dup(pTHX_ const char* name, bool is_our, const HV* ourstash); +PERL_CALLCONV void Perl_pad_check_dup(pTHX_ const char* name, bool is_our, const HV* ourstash) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_3); + #ifdef DEBUGGING -PERL_CALLCONV void Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv); +PERL_CALLCONV void Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv) + __attribute__nonnull__(pTHX_2); + #endif PERL_CALLCONV void Perl_pad_block_start(pTHX_ int full); PERL_CALLCONV void Perl_pad_tidy(pTHX_ padtidy_type type); -PERL_CALLCONV void Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full); -PERL_CALLCONV void Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv); +PERL_CALLCONV void Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full) + __attribute__nonnull__(pTHX_2); + +PERL_CALLCONV void Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv) + __attribute__nonnull__(pTHX_1); + + +PERL_CALLCONV void Perl_pad_push(pTHX_ PADLIST *padlist, int depth) + __attribute__nonnull__(pTHX_1); -PERL_CALLCONV void Perl_pad_push(pTHX_ PADLIST *padlist, int depth); PERL_CALLCONV HV* Perl_pad_compname_type(pTHX_ const PADOFFSET po); #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); # if defined(DEBUGGING) -STATIC void S_cv_dump(pTHX_ const CV *cv, const char *title); +STATIC void S_cv_dump(pTHX_ const CV *cv, const char *title) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); + # endif #endif PERL_CALLCONV CV* Perl_find_runcv(pTHX_ U32 *db_seqp) @@ -2595,7 +2618,9 @@ PERL_CALLCONV void Perl_free_tied_hv_pool(pTHX); PERL_CALLCONV int Perl_get_debug_opts(pTHX_ const char **s, bool givehelp); #endif PERL_CALLCONV void Perl_save_set_svflags(pTHX_ SV* sv, U32 mask, U32 val); -PERL_CALLCONV void Perl_hv_assert(pTHX_ HV* tb); +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); @@ -2618,8 +2643,7 @@ PERL_CALLCONV void Perl_hv_riter_set(pTHX_ HV* hv, I32 riter) __attribute__nonnull__(pTHX_1); PERL_CALLCONV void Perl_hv_eiter_set(pTHX_ HV* hv, HE* eiter) - __attribute__nonnull__(pTHX_1) - __attribute__nonnull__(pTHX_2); + __attribute__nonnull__(pTHX_1); PERL_CALLCONV void Perl_hv_name_set(pTHX_ HV* hv, const char *name, I32 len, int flags) __attribute__nonnull__(pTHX_1); @@ -2636,11 +2660,13 @@ PERL_CALLCONV I32 Perl_hv_placeholders_get(pTHX_ HV* hv) __attribute__nonnull__(pTHX_1); PERL_CALLCONV void Perl_hv_placeholders_set(pTHX_ HV* hv, I32 ph) - __attribute__warn_unused_result__ __attribute__nonnull__(pTHX_1); -PERL_CALLCONV SV* Perl_magic_scalarpack(pTHX_ HV* hv, MAGIC* mg); +PERL_CALLCONV SV* Perl_magic_scalarpack(pTHX_ HV* hv, MAGIC* mg) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); + #ifdef PERL_IN_SV_C STATIC SV* S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool top); #endif @@ -3095,7 +3095,7 @@ Perl_sv_2nv(pTHX_ register SV *sv) if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing) report_uninit(sv); } - return 0; + return (NV)0; } } if (SvTHINKFIRST(sv)) { @@ -3209,7 +3209,7 @@ Perl_sv_2nv(pTHX_ register SV *sv) flags. NWC, 2000/11/25 */ /* Both already have p flags, so do nothing */ } else { - NV nv = SvNVX(sv); + const NV nv = SvNVX(sv); if (SvNVX(sv) < (NV)IV_MAX + 0.5) { if (SvIVX(sv) == I_V(nv)) { SvNOK_on(sv); @@ -3225,7 +3225,7 @@ Perl_sv_2nv(pTHX_ register SV *sv) if (numtype & IS_NUMBER_NOT_INT) { /* UV and NV both imprecise. */ } else { - UV nv_as_uv = U_V(nv); + const UV nv_as_uv = U_V(nv); if (value == nv_as_uv && SvUVX(sv) != UV_MAX) { SvNOK_on(sv); @@ -3275,7 +3275,7 @@ STATIC IV S_asIV(pTHX_ SV *sv) { UV value; - int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value); + const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value); if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT)) == IS_NUMBER_IN_UV) { @@ -4934,10 +4934,10 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags) /* At this point I believe I should acquire a global SV mutex. */ if (SvFAKE(sv)) { const char *pvx = SvPVX_const(sv); - STRLEN len = SvLEN(sv); - STRLEN cur = SvCUR(sv); - U32 hash = SvSHARED_HASH(sv); - SV *next = SV_COW_NEXT_SV(sv); /* next COW sv in the loop. */ + 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", @@ -4972,12 +4972,12 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags) if (SvFAKE(sv)) { const char *pvx = SvPVX_const(sv); const int is_utf8 = SvUTF8(sv); - STRLEN len = SvCUR(sv); - U32 hash = SvSHARED_HASH(sv); + const STRLEN len = SvCUR(sv); + const U32 hash = SvSHARED_HASH(sv); SvFAKE_off(sv); SvREADONLY_off(sv); - SvPV_set(sv, (char*)0); - SvLEN_set(sv, 0); + SvPV_set(sv, Nullch); + SvLEN_set(sv, 0); SvGROW(sv, len + 1); Move(pvx,SvPVX_const(sv),len,char); *SvEND(sv) = '\0'; @@ -9908,7 +9908,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) while (cont) { int offset = s - SvPVX_const(PL_linestr); - bool found = sv_cat_decode(sv, PL_encoding, PL_linestr, + const bool found = sv_cat_decode(sv, PL_encoding, PL_linestr, &offset, (char*)termstr, termlen); const char *ns = SvPVX_const(PL_linestr) + offset; char *svlast = SvEND(sv) - 1; @@ -261,7 +261,6 @@ Perl_delimcpy(pTHX_ register char *to, register const char *toend, register cons char * Perl_instr(pTHX_ register const char *big, register const char *little) { - register const char *s, *x; register I32 first; if (!little) @@ -270,6 +269,7 @@ Perl_instr(pTHX_ register const char *big, register const char *little) if (!first) return (char*)big; while (*big) { + register const char *s, *x; if (*big++ != first) continue; for (x=big,s=little; *s; /**/ ) { @@ -291,7 +291,6 @@ Perl_instr(pTHX_ register const char *big, register const char *little) char * Perl_ninstr(pTHX_ register const char *big, register const char *bigend, const char *little, const char *lend) { - register const char *s, *x; register const I32 first = *little; register const char *littleend = lend; @@ -301,6 +300,7 @@ Perl_ninstr(pTHX_ register const char *big, register const char *bigend, const c return Nullch; bigend -= littleend - little++; while (big <= bigend) { + register const char *s, *x; if (*big++ != first) continue; for (x=big,s=little; s < littleend; /**/ ) { @@ -321,7 +321,6 @@ char * Perl_rninstr(pTHX_ register const char *big, const char *bigend, const char *little, const char *lend) { register const char *bigbeg; - register const char *s, *x; register const I32 first = *little; register const char *littleend = lend; @@ -330,6 +329,7 @@ Perl_rninstr(pTHX_ register const char *big, const char *bigend, const char *lit bigbeg = big; big = bigend - (littleend - little++); while (big >= bigbeg) { + register const char *s, *x; if (*big-- != first) continue; for (x=big+2,s=little; s < littleend; /**/ ) { @@ -384,13 +384,9 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags) if (len == 0) /* TAIL might be on a zero-length string. */ return; if (len > 2) { - U8 mlen; const unsigned char *sb; + const U8 mlen = (len>255) ? 255 : (U8)len; - if (len > 255) - mlen = 255; - else - mlen = (U8)len; Sv_Grow(sv, len + 256 + FBM_TABLE_OFFSET); table = (unsigned char*)(SvPVX_mutable(sv) + len + FBM_TABLE_OFFSET); s = table - 1 - FBM_TABLE_OFFSET; /* last char */ @@ -492,8 +488,8 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit /* This should be better than FBM if c1 == c2, and almost as good otherwise: maybe better since we do less indirection. And we save a lot of memory by caching no table. */ - register unsigned char c1 = little[0]; - register unsigned char c2 = little[1]; + const unsigned char c1 = little[0]; + const unsigned char c2 = little[1]; s = big + 1; bigend--; @@ -595,7 +591,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit goto check_end; } else { /* less expensive than calling strncmp() */ - register unsigned char *olds = s; + register unsigned char * const olds = s; tmp = littlelen; @@ -638,7 +634,6 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit char * Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift, I32 *old_posp, I32 last) { - register unsigned char *s, *x; register unsigned char *big; register I32 pos; register I32 previous; @@ -687,6 +682,7 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift } big -= previous; do { + register unsigned char *s, *x; if (pos >= stop_pos) break; if (big[pos] != first) continue; @@ -765,20 +761,15 @@ be freed with the C<Safefree()> function. char * Perl_savepv(pTHX_ const char *pv) { - register char *newaddr; -#ifdef PERL_MALLOC_WRAP - STRLEN pvlen; -#endif if (!pv) return Nullch; + else { + char *newaddr; + const STRLEN pvlen = strlen(pv)+1; + New(902,newaddr,pvlen,char); + return strcpy(newaddr,pv); + } -#ifdef PERL_MALLOC_WRAP - pvlen = strlen(pv)+1; - New(902,newaddr,pvlen,char); -#else - New(902,newaddr,strlen(pv)+1,char); -#endif - return strcpy(newaddr,pv); } /* same thing but with a known length */ @@ -4058,7 +4049,7 @@ Perl_vnumify(pTHX_ SV *vs) len = av_len((AV *)vs); if ( len == -1 ) { - Perl_sv_catpv(aTHX_ sv,"0"); + sv_catpvn(sv,"0",1); return sv; } digit = SvIVX(*av_fetch((AV *)vs, 0, 0)); @@ -4075,14 +4066,14 @@ Perl_vnumify(pTHX_ SV *vs) if ( (int)PERL_ABS(digit) != 0 || len == 1 ) { if ( digit < 0 ) /* alpha version */ - Perl_sv_catpv(aTHX_ sv,"_"); + sv_catpvn(sv,"_",1); /* Don't display additional trailing zeros */ Perl_sv_catpvf(aTHX_ sv,"%03d", (int)PERL_ABS(digit)); } } else /* len == 0 */ { - Perl_sv_catpv(aTHX_ sv,"000"); + sv_catpvn(sv,"000",3); } return sv; } @@ -4111,7 +4102,7 @@ Perl_vnormal(pTHX_ SV *vs) len = av_len((AV *)vs); if ( len == -1 ) { - Perl_sv_catpv(aTHX_ sv,""); + sv_catpvn(sv,"",0); return sv; } digit = SvIVX(*av_fetch((AV *)vs, 0, 0)); @@ -4127,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-- ) - Perl_sv_catpv(aTHX_ sv,".0"); + sv_catpvn(sv,".0",2); } return sv; |