#ifdef DEBUGGING
-static const char * si_names[] = {
+static const char * const si_names[] = {
"UNKNOWN",
"UNDEF",
"MAIN",
Perl_deb_stack_all(pTHX)
{
#ifdef DEBUGGING
- I32 ix, si_ix;
+ I32 si_ix;
const PERL_SI *si;
/* rewind to start of chain */
{
const int si_name_ix = si->si_type+1; /* -1 is a valid index */
const char * const si_name = (si_name_ix>= sizeof(si_names)) ? "????" : si_names[si_name_ix];
+ I32 ix;
PerlIO_printf(Perl_debug_log, "STACK %"IVdf": %s\n",
(IV)si_ix, si_name);
}
}
-static const char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat";
I32
Perl_my_lstat(pTHX)
{
+ static const char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat";
dSP;
SV *sv;
if (PL_op->op_flags & OPf_REF) {
#define PERL_IN_DUMP_C
#include "perl.h"
#include "regcomp.h"
+#include "proto.h"
+
#define Sequence PL_op_sequence
/* An op sequencer. We visit the ops in the order they're to execute. */
STATIC void
-sequence(pTHX_ register const OP *o)
+S_sequence(pTHX_ register const OP *o)
{
dVAR;
SV *op;
hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
for (l = cLOGOPo->op_other; l && l->op_type == OP_NULL; l = l->op_next)
;
- sequence(aTHX_ l);
+ sequence(l);
break;
case OP_ENTERLOOP:
hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
for (l = cLOOPo->op_redoop; l && l->op_type == OP_NULL; l = l->op_next)
;
- sequence(aTHX_ l);
+ sequence(l);
for (l = cLOOPo->op_nextop; l && l->op_type == OP_NULL; l = l->op_next)
;
- sequence(aTHX_ l);
+ sequence(l);
for (l = cLOOPo->op_lastop; l && l->op_type == OP_NULL; l = l->op_next)
;
- sequence(aTHX_ l);
+ sequence(l);
break;
case OP_QR:
hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
for (l = cPMOPo->op_pmreplstart; l && l->op_type == OP_NULL; l = l->op_next)
;
- sequence(aTHX_ l);
+ sequence(l);
break;
case OP_HELEM:
}
STATIC UV
-sequence_num(pTHX_ const OP *o)
+S_sequence_num(pTHX_ const OP *o)
{
dVAR;
SV *op,
{
dVAR;
UV seq;
- sequence(aTHX_ o);
+ sequence(o);
Perl_dump_indent(aTHX_ level, file, "{\n");
level++;
- seq = sequence_num(aTHX_ o);
+ seq = sequence_num(o);
if (seq)
PerlIO_printf(file, "%-4"UVf, seq);
else
(int)(PL_dumpindent*level-4), "", OP_NAME(o));
if (o->op_next)
PerlIO_printf(file, seq ? "%"UVf"\n" : "(%"UVf")\n",
- sequence_num(aTHX_ o->op_next));
+ sequence_num(o->op_next));
else
PerlIO_printf(file, "DONE\n");
if (o->op_targ) {
case OP_ENTERLOOP:
Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
if (cLOOPo->op_redoop)
- PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOOPo->op_redoop));
+ PerlIO_printf(file, "%"UVf"\n", sequence_num(cLOOPo->op_redoop));
else
PerlIO_printf(file, "DONE\n");
Perl_dump_indent(aTHX_ level, file, "NEXT ===> ");
if (cLOOPo->op_nextop)
- PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOOPo->op_nextop));
+ PerlIO_printf(file, "%"UVf"\n", sequence_num(cLOOPo->op_nextop));
else
PerlIO_printf(file, "DONE\n");
Perl_dump_indent(aTHX_ level, file, "LAST ===> ");
if (cLOOPo->op_lastop)
- PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOOPo->op_lastop));
+ PerlIO_printf(file, "%"UVf"\n", sequence_num(cLOOPo->op_lastop));
else
PerlIO_printf(file, "DONE\n");
break;
case OP_AND:
Perl_dump_indent(aTHX_ level, file, "OTHER ===> ");
if (cLOGOPo->op_other)
- PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOGOPo->op_other));
+ PerlIO_printf(file, "%"UVf"\n", sequence_num(cLOGOPo->op_other));
else
PerlIO_printf(file, "DONE\n");
break;
case SVt_PVFM:
do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
if (CvSTART(sv))
- Perl_dump_indent(aTHX_ level, file, " START = 0x%"UVxf" ===> %"IVdf"\n", PTR2UV(CvSTART(sv)), (IV)sequence_num(aTHX_ CvSTART(sv)));
+ Perl_dump_indent(aTHX_ level, file, " START = 0x%"UVxf" ===> %"IVdf"\n", PTR2UV(CvSTART(sv)), (IV)sequence_num(CvSTART(sv)));
Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n", PTR2UV(CvROOT(sv)));
if (CvROOT(sv) && dumpops)
do_op_dump(level+1, file, CvROOT(sv));
rs |void |run_body |I32 oldscope
s |void |call_body |NN const OP *myop|bool is_eval
s |void* |call_list_body |NN CV *cv
+s |SV * |incpush_if_exists|NN SV *dir
#endif
#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
sR |const char *|get_num |NN const char *ppat|NN I32 *lenptr
ns |bool |need_utf8 |NN const char *pat|NN const char *patend
ns |char |first_symbol |NN const char *pat|NN const char *patend
+sR |char * |sv_exp_grow |NN SV *sv|STRLEN needed
#endif
#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
sR |OP* |doeval |int gimme|NULLOK OP** startop|NULLOK CV* outside|U32 seq
sR |PerlIO *|doopen_pm |NN const char *name|NN const char *mode
sR |bool |path_is_absolute|NN const char *name
+sR |I32 |run_user_filter|int idx|NN SV *buf_sv|int maxlen
#endif
#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
#if defined(PERL_IN_DUMP_C) || defined(PERL_DECL_PROT)
s |CV* |deb_curcv |I32 ix
s |void |debprof |NN const OP *o
+s |void |sequence |NULLOK const OP *o
+s |UV |sequence_num |NULLOK const OP *o
#endif
#if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
sR |I32 |sublex_start
sR |char * |filter_gets |NN SV *sv|NN PerlIO *fp|STRLEN append
sR |HV * |find_in_my_stash|NN const char *pkgname|I32 len
-sR |char * |tokenize_use |int|NN char*
+sR |char * |tokenize_use |int is_use|NN char*
s |SV* |new_constant |NULLOK const char *s|STRLEN len|NN const char *key|NN SV *sv \
|NULLOK SV *pv|NULLOK const char *type
# if defined(DEBUGGING)
s |const char*|incl_perldb
# if defined(PERL_CR_FILTER)
s |I32 |cr_textfilter |int idx|NULLOK SV *sv|int maxlen
+s |void |strip_return |NN SV *sv
# endif
#endif
s |const char *|vdie_croak_common|NULLOK const char *pat|NULLOK va_list *args \
|NULLOK STRLEN *msglen|NULLOK I32* utf8
s |void |vdie_common |NULLOK const char *message|STRLEN msglen|I32 utf8
+sr |char * |write_no_mem
#endif
#if defined(PERL_IN_NUMERIC_C) || defined(PERL_DECL_PROT)
#define run_body S_run_body
#define call_body S_call_body
#define call_list_body S_call_list_body
+#define incpush_if_exists S_incpush_if_exists
#endif
#endif
#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
#define get_num S_get_num
#define need_utf8 S_need_utf8
#define first_symbol S_first_symbol
+#define sv_exp_grow S_sv_exp_grow
#endif
#endif
#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
#define doeval S_doeval
#define doopen_pm S_doopen_pm
#define path_is_absolute S_path_is_absolute
+#define run_user_filter S_run_user_filter
#endif
#endif
#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define deb_curcv S_deb_curcv
#define debprof S_debprof
+#define sequence S_sequence
+#define sequence_num S_sequence_num
#endif
#endif
#if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
# if defined(PERL_CR_FILTER)
#ifdef PERL_CORE
#define cr_textfilter S_cr_textfilter
+#define strip_return S_strip_return
#endif
# endif
#endif
#define mess_alloc S_mess_alloc
#define vdie_croak_common S_vdie_croak_common
#define vdie_common S_vdie_common
+#define write_no_mem S_write_no_mem
#endif
#endif
#if defined(PERL_IN_NUMERIC_C) || defined(PERL_DECL_PROT)
#define run_body(a) S_run_body(aTHX_ a)
#define call_body(a,b) S_call_body(aTHX_ a,b)
#define call_list_body(a) S_call_list_body(aTHX_ a)
+#define incpush_if_exists(a) S_incpush_if_exists(aTHX_ a)
#endif
#endif
#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
#define get_num(a,b) S_get_num(aTHX_ a,b)
#define need_utf8 S_need_utf8
#define first_symbol S_first_symbol
+#define sv_exp_grow(a,b) S_sv_exp_grow(aTHX_ a,b)
#endif
#endif
#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
#define doeval(a,b,c,d) S_doeval(aTHX_ a,b,c,d)
#define doopen_pm(a,b) S_doopen_pm(aTHX_ a,b)
#define path_is_absolute(a) S_path_is_absolute(aTHX_ a)
+#define run_user_filter(a,b,c) S_run_user_filter(aTHX_ a,b,c)
#endif
#endif
#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define deb_curcv(a) S_deb_curcv(aTHX_ a)
#define debprof(a) S_debprof(aTHX_ a)
+#define sequence(a) S_sequence(aTHX_ a)
+#define sequence_num(a) S_sequence_num(aTHX_ a)
#endif
#endif
#if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
# if defined(PERL_CR_FILTER)
#ifdef PERL_CORE
#define cr_textfilter(a,b,c) S_cr_textfilter(aTHX_ a,b,c)
+#define strip_return(a) S_strip_return(aTHX_ a)
#endif
# endif
#endif
#define mess_alloc() S_mess_alloc(aTHX)
#define vdie_croak_common(a,b,c,d) S_vdie_croak_common(aTHX_ a,b,c,d)
#define vdie_common(a,b,c) S_vdie_common(aTHX_ a,b,c)
+#define write_no_mem() S_write_no_mem(aTHX)
#endif
#endif
#if defined(PERL_IN_NUMERIC_C) || defined(PERL_DECL_PROT)
S_new_he(pTHX)
{
HE* he;
- void **root = &PL_body_roots[HE_SVSLOT];
+ void ** const root = &PL_body_roots[HE_SVSLOT];
LOCK_SV_MUTEX;
if (!*root)
if (isLOWER(key[i])) {
/* Would be nice if we had a routine to do the
copy and upercase in a single pass through. */
- const char *nkey = strupr(savepvn(key,klen));
+ const char * const nkey = strupr(savepvn(key,klen));
/* Note that this fetch is for nkey (the uppercased
key) whereas the store is for key (the original) */
entry = hv_fetch_common(hv, Nullsv, nkey, klen,
I32
Perl_hv_iterinit(pTHX_ HV *hv)
{
- HE *entry;
-
if (!hv)
Perl_croak(aTHX_ "Bad hash");
if (SvOOK(hv)) {
struct xpvhv_aux *iter = HvAUX(hv);
- entry = iter->xhv_eiter; /* HvEITER(hv) */
+ HE * const entry = iter->xhv_eiter; /* HvEITER(hv) */
if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
HvLAZYDEL_off(hv);
hv_free_ent(hv, entry);
{
if (HeKLEN(entry) == HEf_SVKEY) {
STRLEN len;
- char *p = SvPV(HeKEY_sv(entry), len);
+ char * const p = SvPV(HeKEY_sv(entry), len);
*retlen = len;
return p;
}
SV *
Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen)
{
- HE *he;
- if ( (he = hv_iternext_flags(hv, 0)) == NULL)
+ HE * const he = hv_iternext_flags(hv, 0);
+
+ if (!he)
return NULL;
*key = hv_iterkey(he, retlen);
return hv_iterval(hv, he);
#endif
#define PERL_HASH(hash,str,len) \
STMT_START { \
- register const char *s_PeRlHaSh_tmp = str; \
+ register const char * const s_PeRlHaSh_tmp = str; \
register const unsigned char *s_PeRlHaSh = (const unsigned char *)s_PeRlHaSh_tmp; \
register I32 i_PeRlHaSh = len; \
register U32 hash_PeRlHaSh = PERL_HASH_SEED; \
#ifdef PERL_HASH_INTERNAL_ACCESS
#define PERL_HASH_INTERNAL(hash,str,len) \
STMT_START { \
- register const char *s_PeRlHaSh_tmp = str; \
+ register const char * const s_PeRlHaSh_tmp = str; \
register const unsigned char *s_PeRlHaSh = (const unsigned char *)s_PeRlHaSh_tmp; \
register I32 i_PeRlHaSh = len; \
register U32 hash_PeRlHaSh = PL_rehash_seed; \
if (setlocale_failure) {
char *p;
- bool locwarn = (printwarn > 1 ||
+ const bool locwarn = (printwarn > 1 ||
(printwarn &&
(!(p = PerlEnv_getenv("PERL_BADLANG")) || atoi(p))));
U32
Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
{
- register const REGEXP *rx;
PERL_UNUSED_ARG(sv);
- if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
- if (mg->mg_obj) /* @+ */
- return rx->nparens;
- else /* @- */
- return rx->lastparen;
+ if (PL_curpm) {
+ register const REGEXP * const rx = PM_GETRE(PL_curpm);
+ if (rx) {
+ return mg->mg_obj
+ ? rx->nparens /* @+ */
+ : rx->lastparen; /* @- */
+ }
}
return (U32)-1;
int
Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
{
- register REGEXP *rx;
-
- if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
- register const I32 paren = mg->mg_len;
- register I32 s;
- register I32 t;
- if (paren < 0)
- return 0;
- if (paren <= (I32)rx->nparens &&
- (s = rx->startp[paren]) != -1 &&
- (t = rx->endp[paren]) != -1)
- {
- register I32 i;
- if (mg->mg_obj) /* @+ */
- i = t;
- else /* @- */
- i = s;
+ if (PL_curpm) {
+ register const REGEXP * const rx = PM_GETRE(PL_curpm);
+ if (rx) {
+ register const I32 paren = mg->mg_len;
+ register I32 s;
+ register I32 t;
+ if (paren < 0)
+ return 0;
+ if (paren <= (I32)rx->nparens &&
+ (s = rx->startp[paren]) != -1 &&
+ (t = rx->endp[paren]) != -1)
+ {
+ register I32 i;
+ if (mg->mg_obj) /* @+ */
+ i = t;
+ else /* @- */
+ i = s;
+
+ if (i > 0 && RX_MATCH_UTF8(rx)) {
+ const char * const b = rx->subbeg;
+ if (b)
+ i = Perl_utf8_length(aTHX_ (U8*)b, (U8*)(b+i));
+ }
- if (i > 0 && RX_MATCH_UTF8(rx)) {
- const char * const b = rx->subbeg;
- if (b)
- i = Perl_utf8_length(aTHX_ (U8*)b, (U8*)(b+i));
+ sv_setiv(sv, i);
}
-
- sv_setiv(sv, i);
- }
+ }
}
return 0;
}
static void
restore_sigmask(pTHX_ SV *save_sv)
{
- const sigset_t *ossetp = (const sigset_t *) SvPV_nolen_const( save_sv );
+ const sigset_t * const ossetp = (const sigset_t *) SvPV_nolen_const( save_sv );
(void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
}
#endif
STATIC OP *
S_dup_attrlist(pTHX_ OP *o)
{
- OP *rop = Nullop;
+ OP *rop;
/* An attrlist is either a simple OP_CONST or an OP_LIST with kids,
* where the first kid is OP_PUSHMARK and the remaining ones
rop = newSVOP(OP_CONST, o->op_flags, SvREFCNT_inc(cSVOPo->op_sv));
else {
assert((o->op_type == OP_LIST) && (o->op_flags & OPf_KIDS));
+ rop = Nullop;
for (o = cLISTOPo->op_first; o; o=o->op_sibling) {
if (o->op_type == OP_CONST)
rop = append_elem(OP_LIST, rop,
OP *
Perl_my_attrs(pTHX_ OP *o, OP *attrs)
{
- OP *rops = Nullop;
+ OP *rops;
int maybe_scalar = 0;
/* [perl #17376]: this appears to be premature, and results in code such as
#endif
if (attrs)
SAVEFREEOP(attrs);
+ rops = Nullop;
o = my_kid(o, attrs, &rops);
if (rops) {
if (maybe_scalar && o->op_type == OP_PADSV) {
cLISTOPx(expr)->op_first->op_sibling == cLISTOPx(expr)->op_last)
{
/* convert single element list to element */
- OP* oe = expr;
+ OP* const oe = expr;
expr = cLISTOPx(oe)->op_first->op_sibling;
cLISTOPx(oe)->op_first->op_sibling = Nullop;
cLISTOPx(oe)->op_last = Nullop;
if (name || aname) {
const char *s;
- const char *tname = (name ? name : aname);
+ const char * const tname = (name ? name : aname);
if (PERLDB_SUBLINE && PL_curstash != PL_debstash) {
SV * const sv = NEWSV(0,0);
Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
{
register CV *cv;
- GV *gv;
- if (o)
- gv = gv_fetchsv(cSVOPo->op_sv, TRUE, SVt_PVFM);
- else
- gv = gv_fetchpv("STDOUT", TRUE, SVt_PVFM);
-
+ GV * const gv = o
+ ? gv_fetchsv(cSVOPo->op_sv, TRUE, SVt_PVFM)
+ : gv_fetchpv("STDOUT", TRUE, SVt_PVFM);
+
#ifdef GV_UNIQUE_CHECK
if (GvUNIQUE(gv)) {
Perl_croak(aTHX_ "Bad symbol for form (GV is unique)");
OP *
Perl_ck_concat(pTHX_ OP *o)
{
- const OP *kid = cUNOPo->op_first;
+ const OP * const kid = cUNOPo->op_first;
if (kid->op_type == OP_CONCAT && !(kid->op_private & OPpTARGET_MY) &&
!(kUNOP->op_first->op_flags & OPf_MOD))
o->op_flags |= OPf_STACKED;
Perl_ck_rvconst(pTHX_ register OP *o)
{
dVAR;
- SVOP *kid = (SVOP*)cUNOPo->op_first;
+ SVOP * const kid = (SVOP*)cUNOPo->op_first;
o->op_private |= (PL_hints & HINT_STRICT_REFS);
if (kid->op_type == OP_CONST) {
/* Is it a constant from cv_const_sv()? */
if (SvROK(kidsv) && SvREADONLY(kidsv)) {
- SV *rsv = SvRV(kidsv);
+ SV * const rsv = SvRV(kidsv);
const int svtype = SvTYPE(rsv);
const char *badtype = Nullch;
if (kid->op_type == OP_CONST &&
(kid->op_private & OPpCONST_BARE))
{
- OP *newop = newGVOP(OP_GV, 0,
+ OP * const newop = newGVOP(OP_GV, 0,
gv_fetchsv(((SVOP*)kid)->op_sv, TRUE, SVt_PVIO) );
if (!(o->op_private & 1) && /* if not unop */
kid == cLISTOPo->op_last)
else if (kid->op_type == OP_RV2SV
&& kUNOP->op_first->op_type == OP_GV)
{
- GV *gv = cGVOPx_gv(kUNOP->op_first);
+ GV * const gv = cGVOPx_gv(kUNOP->op_first);
name = GvNAME(gv);
len = GvNAMELEN(gv);
}
break;
case ']':
if (contextclass) {
+ /* XXX We shouldn't be modifying proto, so we can const proto */
char *p = proto;
const char s = *p;
contextclass = 0;
case OP_PADAV:
case OP_GV:
if (o->op_type == OP_PADAV || o->op_next->op_type == OP_RV2AV) {
- OP* pop = (o->op_type == OP_PADAV) ?
+ OP* const pop = (o->op_type == OP_PADAV) ?
o->op_next : o->op_next->op_next;
IV i;
if (pop && pop->op_type == OP_CONST &&
#ifdef USE_ITHREADS
#define PM_GETRE(o) (INT2PTR(REGEXP*,SvIVX(PL_regex_pad[(o)->op_pmoffset])))
-#define PM_SETRE(o,r) STMT_START { SV* sv = PL_regex_pad[(o)->op_pmoffset]; sv_setiv(sv, PTR2IV(r)); } STMT_END
+#define PM_SETRE(o,r) STMT_START { \
+ SV* const sv = PL_regex_pad[(o)->op_pmoffset]; \
+ sv_setiv(sv, PTR2IV(r)); \
+ } STMT_END
#define PM_GETRE_SAFE(o) (PL_regex_pad ? PM_GETRE(o) : (REGEXP*)0)
#define PM_SETRE_SAFE(o,r) if (PL_regex_pad) PM_SETRE(o,r)
#else
if (SvMAGICAL(TARG)) {
U32 i;
for (i=0; i < (U32)maxarg; i++) {
- SV ** const svp = av_fetch((AV*)TARG, i, FALSE);
+ SV * const * const svp = av_fetch((AV*)TARG, i, FALSE);
SP[i+1] = (svp) ? *svp : &PL_sv_undef;
}
}
GV *gv;
if (cUNOP->op_targ) {
STRLEN len;
- SV *namesv = PAD_SV(cUNOP->op_targ);
- const char *name = SvPV(namesv, len);
+ SV * const namesv = PAD_SV(cUNOP->op_targ);
+ const char * const name = SvPV(namesv, len);
gv = (GV*)NEWSV(0,0);
gv_init(gv, CopSTASH(PL_curcop), name, len, 0);
}
else {
- const char *name = CopSTASHPV(PL_curcop);
+ const char * const name = CopSTASHPV(PL_curcop);
gv = newGVgen(name);
}
if (SvTYPE(sv) < SVt_RV)
ret = &PL_sv_undef;
if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
- const char *s = SvPVX_const(TOPs);
+ const char * const s = SvPVX_const(TOPs);
if (strnEQ(s, "CORE::", 6)) {
const int code = keyword(s + 6, SvCUR(TOPs) - 6);
if (code < 0) { /* Overridable. */
case SVt_PVFM:
{
/* let user-undef'd sub keep its identity */
- GV* gv = CvGV((CV*)sv);
+ GV* const gv = CvGV((CV*)sv);
cv_undef((CV*)sv);
CvGV((CV*)sv) = gv;
}
if (!left_neg) {
left = SvUVX(POPs);
} else {
- IV aiv = SvIVX(POPs);
+ const IV aiv = SvIVX(POPs);
if (aiv >= 0) {
left = aiv;
left_neg = FALSE; /* effectively it's a UV now */
else
count = uv;
} else {
- IV iv = SvIV(sv);
+ const IV iv = SvIV(sv);
if (iv < 0)
count = 0;
else
count = SvIVx(sv);
if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
dMARK;
- I32 items = SP - MARK;
- I32 max;
- static const char oom_list_extend[] =
- "Out of memory during list extend";
+ static const char oom_list_extend[] = "Out of memory during list extend";
+ const I32 items = SP - MARK;
+ const I32 max = items * count;
- max = items * count;
MEM_WRAP_CHECK_1(max, SV*, oom_list_extend);
/* Did the max computation overflow? */
if (items > 0 && max > 0 && (max < items || max < count))
SP -= items;
}
else { /* Note: mark already snarfed by pp_list */
- SV *tmpstr = POPs;
+ SV * const tmpstr = POPs;
STRLEN len;
bool isutf;
static const char oom_string_extend[] =
{
const IV shift = POPi;
if (PL_op->op_private & HINT_INTEGER) {
- IV i = TOPi;
+ const IV i = TOPi;
SETi(i >> shift);
}
else {
- UV u = TOPu;
+ const UV u = TOPu;
SETu(u >> shift);
}
RETURN;
if (SvIOK(TOPs)) {
SvIV_please(TOPm1s);
if (SvIOK(TOPm1s)) {
- bool auvok = SvUOK(TOPm1s);
- bool buvok = SvUOK(TOPs);
+ const bool auvok = SvUOK(TOPm1s);
+ const bool buvok = SvUOK(TOPs);
if (auvok == buvok) { /* ## IV == IV or UV == UV ## */
/* Casting IV to UV before comparison isn't going to matter
dSP; dTARGET; tryAMAGICbin(ncmp,0);
#ifndef NV_PRESERVES_UV
if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
- UV right = PTR2UV(SvRV(POPs));
- UV left = PTR2UV(SvRV(TOPs));
+ const UV right = PTR2UV(SvRV(POPs));
+ const UV left = PTR2UV(SvRV(TOPs));
SETi((left > right) - (left < right));
RETURN;
}
PP(pp_srand)
{
dSP;
- UV anum;
- if (MAXARG < 1)
- anum = seed();
- else
- anum = POPu;
+ const UV anum = (MAXARG < 1) ? seed() : POPu;
(void)seedDrand01((Rand_seed_t)anum);
PL_srand_called = TRUE;
EXTEND(SP, 1);
PP(pp_length)
{
dSP; dTARGET;
- SV *sv = TOPs;
+ SV * const sv = TOPs;
if (DO_UTF8(sv))
SETi(sv_len_utf8(sv));
if (ulen > u && (SvLEN(TARG) < (min += ulen - u))) {
/* If the eventually required minimum size outgrows
* the available space, we need to grow. */
- UV o = d - (U8*)SvPVX_const(TARG);
+ const UV o = d - (U8*)SvPVX_const(TARG);
/* If someone uppercases one million U+03B0s we
* SvGROW() one million times. Or we could try
if (ulen > u && (SvLEN(TARG) < (min += ulen - u))) {
/* If the eventually required minimum size outgrows
* the available space, we need to grow. */
- UV o = d - (U8*)SvPVX_const(TARG);
+ const UV o = d - (U8*)SvPVX_const(TARG);
/* If someone lowercases one million U+0130s we
* SvGROW() one million times. Or we could try
if (PL_op->op_private & OPpEXISTS_SUB) {
GV *gv;
- SV *sv = POPs;
+ SV * const sv = POPs;
CV * const cv = sv_2cv(sv, &hv, &gv, FALSE);
if (cv)
RETPUSHYES;
#define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o))
-static I32 run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen);
-
PP(pp_wantarray)
{
dSP;
if (!MAXARG)
RETURN;
if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
- GV *cvgv = CvGV(ccstack[cxix].blk_sub.cv);
+ GV * const cvgv = CvGV(ccstack[cxix].blk_sub.cv);
/* So is ccstack[dbcxix]. */
if (isGV(cvgv)) {
SV * const sv = NEWSV(49, 0);
const int off = AvARRAY(ary) - AvALLOC(ary);
if (!PL_dbargs) {
- GV* tmpgv;
- PL_dbargs = GvAV(gv_AVadd(tmpgv = gv_fetchpv("DB::args", TRUE,
- SVt_PVAV)));
+ GV* const tmpgv = gv_fetchpv("DB::args", TRUE, SVt_PVAV);
+ PL_dbargs = GvAV(gv_AVadd(tmpgv));
GvMULTI_on(tmpgv);
AvREAL_off(PL_dbargs); /* XXX should be REIFY (see av.h) */
}
HINT_PRIVATE_MASK)));
{
SV * mask ;
- SV * old_warnings = cx->blk_oldcop->cop_warnings ;
+ SV * const old_warnings = cx->blk_oldcop->cop_warnings ;
if (old_warnings == pWARN_NONE ||
(old_warnings == pWARN_STD && (PL_dowarn & G_WARN_ON) == 0))
/* Get the bit mask for $warnings::Bits{all}, because
* it could have been extended by warnings::register */
SV **bits_all;
- HV *bits = get_hv("warnings::Bits", FALSE);
+ HV * const bits = get_hv("warnings::Bits", FALSE);
if (bits && (bits_all=hv_fetch(bits, "all", 3, FALSE))) {
mask = newSVsv(*bits_all);
}
PP(pp_reset)
{
dSP;
- const char *tmps;
-
- if (MAXARG < 1)
- tmps = "";
- else
- tmps = POPpconstx;
+ const char * const tmps = (MAXARG < 1) ? "" : POPpconstx;
sv_reset(tmps, CopSTASH(PL_curcop));
PUSHs(&PL_sv_yes);
RETURN;
|| SvIV(PL_DBsingle) || SvIV(PL_DBsignal) || SvIV(PL_DBtrace))
{
dSP;
- register CV *cv;
register PERL_CONTEXT *cx;
const I32 gimme = G_ARRAY;
U8 hasargs;
- GV *gv;
+ GV * const gv = PL_DBgv;
+ register CV * const cv = GvCV(gv);
- gv = PL_DBgv;
- cv = GvCV(gv);
if (!cv)
DIE(aTHX_ "No DB::DB routine defined");
#endif
}
else {
- GV *gv = (GV*)POPs;
+ GV * const gv = (GV*)POPs;
svp = &GvSV(gv); /* symbol table variable */
SAVEGENERICSV(*svp);
*svp = NEWSV(0,0);
cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs);
if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) {
dPOPss;
- SV *right = (SV*)cx->blk_loop.iterary;
+ SV * const right = (SV*)cx->blk_loop.iterary;
SvGETMAGIC(sv);
SvGETMAGIC(right);
if (RANGE_IS_NUMERIC(sv,right)) {
PP(pp_return)
{
dVAR; dSP; dMARK;
- I32 cxix;
register PERL_CONTEXT *cx;
bool popsub2 = FALSE;
bool clear_errsv = FALSE;
SV *sv;
OP *retop;
- cxix = dopoptosub(cxstack_ix);
+ const I32 cxix = dopoptosub(cxstack_ix);
+
if (cxix < 0) {
if (CxMULTICALL(cxstack)) { /* In this case we must be in a
* sort block, which is a CXt_NULL
/* push wanted frames */
if (*enterops && enterops[1]) {
- OP *oldop = PL_op;
+ OP * const oldop = PL_op;
ix = enterops[1]->op_type == OP_ENTER && in_block ? 2 : 1;
for (; enterops[ix]; ix++) {
PL_op = enterops[ix];
DIE(aTHX_ "Null filename used");
TAINT_PROPER("require");
if (PL_op->op_type == OP_REQUIRE) {
- SV ** const svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
+ SV * const * const svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
if ( svp ) {
if (*svp != &PL_sv_undef)
RETPUSHYES;
PL_compiling.cop_io = Nullsv;
if (filter_sub || filter_child_proc) {
- SV * const datasv = filter_add(run_user_filter, Nullsv);
+ SV * const datasv = filter_add(S_run_user_filter, Nullsv);
IoLINES(datasv) = filter_has_file;
IoFMT_GV(datasv) = (GV *)filter_child_proc;
IoTOP_GV(datasv) = (GV *)filter_state;
}
static I32
-run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
+S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
{
dVAR;
- SV *datasv = FILTER_DATA(idx);
+ SV * const datasv = FILTER_DATA(idx);
const int filter_has_file = IoLINES(datasv);
- GV *filter_child_proc = (GV *)IoFMT_GV(datasv);
- SV *filter_state = (SV *)IoTOP_GV(datasv);
- SV *filter_sub = (SV *)IoBOTTOM_GV(datasv);
+ GV * const filter_child_proc = (GV *)IoFMT_GV(datasv);
+ SV * const filter_state = (SV *)IoTOP_GV(datasv);
+ SV * const filter_sub = (SV *)IoBOTTOM_GV(datasv);
int len = 0;
/* I was having segfault trouble under Linux 2.2.5 after a
SvREFCNT_dec(filter_sub);
IoBOTTOM_GV(datasv) = Nullgv;
}
- filter_del(run_user_filter);
+ filter_del(S_run_user_filter);
}
return len;
{
if (PERL_FILE_IS_ABSOLUTE(name)
#ifdef MACOS_TRADITIONAL
- || (*name == ':'))
+ || (*name == ':')
#else
|| (*name == '.' && (name[1] == '/' ||
- (name[1] == '.' && name[2] == '/'))))
+ (name[1] == '.' && name[2] == '/')))
#endif
+ )
{
return TRUE;
}
dSP; dPOPTOPssrl;
if (PL_op->op_private & OPpASSIGN_BACKWARDS) {
- SV *temp;
- temp = left; left = right; right = temp;
+ SV * const temp = left;
+ left = right; right = temp;
}
if (PL_tainting && PL_tainted && !SvTAINTED(left))
TAINT_NOT;
right argument if we know the left is integer. */
SvIV_please(TOPm1s);
if (SvIOK(TOPm1s)) {
- bool auvok = SvUOK(TOPm1s);
- bool buvok = SvUOK(TOPs);
+ const bool auvok = SvUOK(TOPm1s);
+ const bool buvok = SvUOK(TOPs);
if (auvok == buvok) { /* ## IV == IV or UV == UV ## */
/* Casting IV to UV before comparison isn't going to matter
differ from normal zero. As I understand it. (Need to
check - is negative zero implementation defined behaviour
anyway?). NWC */
- UV buv = SvUVX(POPs);
- UV auv = SvUVX(TOPs);
+ const UV buv = SvUVX(POPs);
+ const UV auv = SvUVX(TOPs);
SETs(boolSV(auv == buv));
RETURN;
AV *av = PL_op->op_flags & OPf_SPECIAL ?
(AV*)PAD_SV(PL_op->op_targ) : GvAV(cGVOP_gv);
const U32 lval = PL_op->op_flags & OPf_MOD;
- SV** svp = av_fetch(av, PL_op->op_private, lval);
+ SV** const svp = av_fetch(av, PL_op->op_private, lval);
SV *sv = (svp ? *svp : &PL_sv_undef);
EXTEND(SP, 1);
if (!lval && SvGMAGICAL(sv)) /* see note in pp_helem() */
PP(pp_print)
{
dVAR; dSP; dMARK; dORIGMARK;
- GV *gv;
IO *io;
register PerlIO *fp;
MAGIC *mg;
-
- if (PL_op->op_flags & OPf_STACKED)
- gv = (GV*)*++MARK;
- else
- gv = PL_defoutgv;
+ GV * const gv = (PL_op->op_flags & OPf_STACKED) ? (GV*)*++MARK : PL_defoutgv;
if (gv && (io = GvIO(gv))
&& (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
STRLEN glen = (in_len); \
if (utf8) glen *= UTF8_EXPAND; \
if ((cur) + glen >= (start) + SvLEN(cat)) { \
- (start) = sv_exp_grow(aTHX_ cat, glen); \
+ (start) = sv_exp_grow(cat, glen); \
(cur) = (start) + SvCUR(cat); \
} \
} STMT_END
if ((cur) + gl >= (start) + SvLEN(cat)) { \
*cur = '\0'; \
SvCUR_set((cat), (cur) - (start)); \
- (start) = sv_exp_grow(aTHX_ cat, gl); \
+ (start) = sv_exp_grow(cat, gl); \
(cur) = (start) + SvCUR(cat); \
} \
PUSH_BYTES(utf8, cur, buf, glen); \
Only grows the string if there is an actual lack of space
*/
STATIC char *
-sv_exp_grow(pTHX_ SV *sv, STRLEN needed) {
+S_sv_exp_grow(pTHX_ SV *sv, STRLEN needed) {
const STRLEN cur = SvCUR(sv);
const STRLEN len = SvLEN(sv);
STRLEN extend;
else {
cv = sv_2cv(*++MARK, &stash, &gv, 0);
if (cv && SvPOK(cv)) {
- const char *proto = SvPV_nolen_const((SV*)cv);
+ const char * const proto = SvPV_nolen_const((SV*)cv);
if (proto && strEQ(proto, "$$")) {
hasargs = TRUE;
}
if ((mg = SvTIED_mg(sv, how))) {
SV * const obj = SvRV(SvTIED_obj(sv, mg));
- CV *cv = NULL;
if (obj) {
GV * const gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE);
+ CV *cv;
if (gv && isGV(gv) && (cv = GvCV(gv))) {
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)gv, mg));
STATIC void* S_call_list_body(pTHX_ CV *cv)
__attribute__nonnull__(pTHX_1);
+STATIC SV * S_incpush_if_exists(pTHX_ SV *dir)
+ __attribute__nonnull__(pTHX_1);
+
#endif
#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
__attribute__nonnull__(1)
__attribute__nonnull__(2);
+STATIC char * S_sv_exp_grow(pTHX_ SV *sv, STRLEN needed)
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1);
+
#endif
#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1);
+STATIC I32 S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_2);
+
#endif
#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
STATIC void S_debprof(pTHX_ const OP *o)
__attribute__nonnull__(pTHX_1);
+STATIC void S_sequence(pTHX_ const OP *o);
+STATIC UV S_sequence_num(pTHX_ const OP *o);
#endif
#if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1);
-STATIC char * S_tokenize_use(pTHX_ int, char*)
+STATIC char * S_tokenize_use(pTHX_ int is_use, char*)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_2);
STATIC const char* S_incl_perldb(pTHX);
# if defined(PERL_CR_FILTER)
STATIC I32 S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen);
+STATIC void S_strip_return(pTHX_ SV *sv)
+ __attribute__nonnull__(pTHX_1);
+
# endif
#endif
STATIC SV* S_mess_alloc(pTHX);
STATIC const char * S_vdie_croak_common(pTHX_ const char *pat, va_list *args, STRLEN *msglen, I32* utf8);
STATIC void S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8);
+STATIC char * S_write_no_mem(pTHX)
+ __attribute__noreturn__;
+
#endif
#if defined(PERL_IN_NUMERIC_C) || defined(PERL_DECL_PROT)
else if (k == ANYOF) {
int i, rangestart = -1;
const U8 flags = ANYOF_FLAGS(o);
- const char * const anyofs[] = { /* Should be synchronized with
- * ANYOF_ #xdefines in regcomp.h */
+
+ /* Should be synchronized with * ANYOF_ #xdefines in regcomp.h */
+ static const char * const anyofs[] = {
"\\w",
"\\W",
"\\s",
void
Perl_sv_add_arena(pTHX_ char *ptr, U32 size, U32 flags)
{
- SV* sva = (SV*)ptr;
+ SV* const sva = (SV*)ptr;
register SV* sv;
register SV* svend;
#endif /* !VMS */
for (e = misc_env; *e; e++) {
- SV ** const svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE);
+ SV * const * const svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE);
if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) {
TAINT;
taint_proper("Insecure $ENV{%s}%s", *e);
#define yychar (*PL_yycharp)
#define yylval (*PL_yylvalp)
-static const char ident_too_long[] =
- "Identifier too long";
-static const char c_without_g[] =
- "Use of /c modifier is meaningless without /g";
-static const char c_in_subst[] =
- "Use of /c modifier is meaningless in s///";
+static const char ident_too_long[] = "Identifier too long";
static void restore_rsfp(pTHX_ void *f);
#ifndef PERL_NO_UTF16_FILTER
PL_last_uni = 0;
PL_last_lop = 0;
if (PL_lex_brackets) {
- if (PL_lex_formbrack)
- yyerror("Format not terminated");
- else
- yyerror("Missing right curly or square bracket");
+ yyerror(PL_lex_formbrack
+ ? "Format not terminated"
+ : "Missing right curly or square bracket");
}
DEBUG_T( { PerlIO_printf(Perl_debug_log,
"### Tokener got EOF\n");
context messages from yyerror().
*/
PL_bufptr = s;
- if (!*s)
- yyerror("Unterminated attribute list");
- else
- yyerror(Perl_form(aTHX_ "Invalid separator character %c%c%c in attribute list",
- q, *s, q));
+ yyerror( *s
+ ? Perl_form(aTHX_ "Invalid separator character %c%c%c in attribute list", q, *s, q)
+ : "Unterminated attribute list" );
if (attrs)
op_free(attrs);
OPERATOR(':');
if ((pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL)
&& ckWARN(WARN_REGEXP))
{
- Perl_warner(aTHX_ packWARN(WARN_REGEXP), c_without_g);
+ Perl_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless without /g" );
}
pm->op_pmpermflags = pm->op_pmflags;
break;
}
- /* /c is not meaningful with s/// */
- if ((pm->op_pmflags & PMf_CONTINUE) && ckWARN(WARN_REGEXP))
- {
- Perl_warner(aTHX_ packWARN(WARN_REGEXP), c_in_subst);
+ if ((pm->op_pmflags & PMf_CONTINUE) && ckWARN(WARN_REGEXP)) {
+ Perl_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless in s///" );
}
if (es) {
static void
restore_rsfp(pTHX_ void *f)
{
- PerlIO *fp = (PerlIO*)f;
+ PerlIO * const fp = (PerlIO*)f;
if (PL_rsfp == PerlIO_stdin())
PerlIO_clearerr(PL_rsfp);
}
if (!isALPHA(*pos)) {
- UV rev;
U8 tmpbuf[UTF8_MAXBYTES+1];
- U8 *tmpend;
if (*s == 'v') s++; /* get past 'v' */
sv_setpvn(sv, "", 0);
for (;;) {
- rev = 0;
+ U8 *tmpend;
+ UV rev = 0;
{
/* this is atoi() that tolerates underscores */
const char *end = pos;
STRLEN lcur, xcur, scur;
HV* const hv = (HV*)SvRV(swash);
- SV** listsvp = hv_fetch(hv, "LIST", 4, FALSE);
- SV** typesvp = hv_fetch(hv, "TYPE", 4, FALSE);
- SV** bitssvp = hv_fetch(hv, "BITS", 4, FALSE);
- SV** nonesvp = hv_fetch(hv, "NONE", 4, FALSE);
- SV** extssvp = hv_fetch(hv, "EXTRAS", 6, FALSE);
- U8* typestr = (U8*)SvPV_nolen(*typesvp);
- int typeto = typestr[0] == 'T' && typestr[1] == 'o';
- STRLEN bits = SvUV(*bitssvp);
- STRLEN octets = bits >> 3; /* if bits == 1, then octets == 0 */
- UV none = SvUV(*nonesvp);
- UV end = start + span;
+ SV** const listsvp = hv_fetch(hv, "LIST", 4, FALSE);
+ SV** const typesvp = hv_fetch(hv, "TYPE", 4, FALSE);
+ SV** const bitssvp = hv_fetch(hv, "BITS", 4, FALSE);
+ SV** const nonesvp = hv_fetch(hv, "NONE", 4, FALSE);
+ SV** const extssvp = hv_fetch(hv, "EXTRAS", 6, FALSE);
+ const U8* const typestr = (U8*)SvPV_nolen(*typesvp);
+ const int typeto = typestr[0] == 'T' && typestr[1] == 'o';
+ const STRLEN bits = SvUV(*bitssvp);
+ const STRLEN octets = bits >> 3; /* if bits == 1, then octets == 0 */
+ const UV none = SvUV(*nonesvp);
+ const UV end = start + span;
if (bits != 1 && bits != 8 && bits != 16 && bits != 32) {
Perl_croak(aTHX_ "panic: swash_get doesn't expect bits %"UVuf,
SvGROW(swatch, scur + 1);
s = (U8*)SvPVX(swatch);
if (octets && none) {
- const U8* e = s + scur;
+ const U8* const e = s + scur;
while (s < e) {
if (bits == 8)
*s++ = (U8)(none & 0xff);
STRLEN numlen;
I32 flags = PERL_SCAN_SILENT_ILLDIGIT | PERL_SCAN_DISALLOW_PREFIX;
- U8* nl = (U8*)memchr(l, '\n', lend - l);
+ U8* const nl = (U8*)memchr(l, '\n', lend - l);
numlen = lend - l;
min = grok_hex((char *)l, &numlen, &flags, NULL);
if (min < start)
min = start;
for (key = min; key <= max; key++) {
- STRLEN offset = (STRLEN)(key - start);
+ const STRLEN offset = (STRLEN)(key - start);
if (key >= end)
goto go_out_list;
s[offset >> 3] |= 1 << (offset & 7);
u = utf8_to_uvchr((U8*)s, 0);
if (u < 256) {
const unsigned char c = (unsigned char)u & 0xFF;
- if (!ok && (flags & UNI_DISPLAY_BACKSLASH)) {
+ if (flags & UNI_DISPLAY_BACKSLASH) {
switch (c) {
case '\n':
ok = 'n'; break;
PerlLIO_write(PerlIO_fileno(Perl_error_log),
PL_no_mem, strlen(PL_no_mem));
my_exit(1);
- return Nullch;
+ NORETURN_FUNCTION_END
}
/* paranoid version of system's malloc() */
else if (PL_nomemok)
return Nullch;
else {
- return S_write_no_mem(aTHX);
+ return write_no_mem();
}
/*NOTREACHED*/
}
else if (PL_nomemok)
return Nullch;
else {
- return S_write_no_mem(aTHX);
+ return write_no_mem();
}
/*NOTREACHED*/
}
}
else if (PL_nomemok)
return Nullch;
- else {
- return S_write_no_mem(aTHX);
- }
- /*NOTREACHED*/
+ return write_no_mem();
}
/* These must be defined when not using Perl's malloc for binary
pvlen = strlen(pv)+1;
newaddr = (char*)PerlMemShared_malloc(pvlen);
if (!newaddr) {
- return S_write_no_mem(aTHX);
+ return write_no_mem();
}
return memcpy(newaddr,pv,pvlen);
}
projects / p5sagit/p5-mst-13.2.git / commitdiff