#ifdef PERL_TRACK_MEMPOOL
struct perl_memory_debug_header *const header
= (struct perl_memory_debug_header *)ptr;
+#endif
+
+#ifdef PERL_POISON
+ Poison(((char *)ptr), size, char);
+#endif
+#ifdef PERL_TRACK_MEMPOOL
header->interpreter = aTHX;
/* Link us into the list. */
header->prev = &PL_memory_debug_header;
struct perl_memory_debug_header *const header
= (struct perl_memory_debug_header *)ptr;
+# ifdef PERL_POISON
+ if (header->size < size) {
+ const MEM_SIZE fresh = size - header->size;
+ char *start_of_fresh = ((char *)ptr) + size;
+ Poison(start_of_fresh, fresh, char);
+ }
+# endif
+
header->next->prev = header;
header->prev->next = header;
Perl_delimcpy(pTHX_ register char *to, register const char *toend, register const char *from, register const char *fromend, register int delim, I32 *retlen)
{
register I32 tolen;
+ PERL_UNUSED_CONTEXT;
for (tolen = 0; from < fromend; from++, tolen++) {
if (*from == '\\') {
if (from[1] == delim)
Perl_instr(pTHX_ register const char *big, register const char *little)
{
register I32 first;
+ PERL_UNUSED_CONTEXT;
if (!little)
return (char*)big;
char *
Perl_ninstr(pTHX_ const char *big, const char *bigend, const char *little, const char *lend)
{
+ PERL_UNUSED_CONTEXT;
if (little >= lend)
return (char*)big;
{
register const char *bigbeg;
register const I32 first = *little;
register const char * const littleend = lend;
+ PERL_UNUSED_CONTEXT;
if (little >= littleend)
return (char*)bigend;
{
register const U8 *a = (const U8 *)s1;
register const U8 *b = (const U8 *)s2;
+ PERL_UNUSED_CONTEXT;
+
while (len--) {
if (*a != *b && *a != PL_fold[*b])
return 1;
dVAR;
register const U8 *a = (const U8 *)s1;
register const U8 *b = (const U8 *)s2;
+ PERL_UNUSED_CONTEXT;
+
while (len--) {
if (*a != *b && *a != PL_fold_locale[*b])
return 1;
char *
Perl_savepv(pTHX_ const char *pv)
{
+ PERL_UNUSED_CONTEXT;
if (!pv)
return NULL;
else {
Newx(newaddr,pvlen,char);
return memcpy(newaddr,pv,pvlen);
}
-
}
/* same thing but with a known length */
Perl_savepvn(pTHX_ const char *pv, register I32 len)
{
register char *newaddr;
+ PERL_UNUSED_CONTEXT;
Newx(newaddr,len+1,char);
/* Give a meaning to NULL pointer mainly for the use in sv_magic() */
Perl_vform(pTHX_ const char *pat, va_list *args)
{
SV * const sv = mess_alloc();
- sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
+ sv_vsetpvfn(sv, pat, strlen(pat), args, NULL, 0, NULL);
return SvPVX(sv);
}
return retval;
}
-STATIC COP*
-S_closest_cop(pTHX_ COP *cop, const OP *o)
+STATIC const COP*
+S_closest_cop(pTHX_ const COP *cop, const OP *o)
{
dVAR;
/* Look for PL_op starting from o. cop is the last COP we've seen. */
return cop;
if (o->op_flags & OPf_KIDS) {
- OP *kid;
+ const OP *kid;
for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
- COP *new_cop;
+ const COP *new_cop;
/* If the OP_NEXTSTATE has been optimised away we can still use it
* the get the file and line number. */
if (kid->op_type == OP_NULL && kid->op_targ == OP_NEXTSTATE)
- cop = (COP *)kid;
+ cop = (const COP *)kid;
/* Keep searching, and return when we've found something. */
/* Nothing found. */
- return Null(COP *);
+ return NULL;
}
SV *
{
dVAR;
SV * const sv = mess_alloc();
- static const char dgd[] = " during global destruction.\n";
- sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
+ sv_vsetpvfn(sv, pat, strlen(pat), args, NULL, 0, NULL);
if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
-
/*
* Try and find the file and line for PL_op. This will usually be
* PL_curcop, but it might be a cop that has been optimised away. We
*/
const COP *cop = closest_cop(PL_curcop, PL_curcop->op_sibling);
- if (!cop) cop = PL_curcop;
+ if (!cop)
+ cop = PL_curcop;
if (CopLINE(cop))
Perl_sv_catpvf(aTHX_ sv, " at %s line %"IVdf,
const bool line_mode = (RsSIMPLE(PL_rs) &&
SvCUR(PL_rs) == 1 && *SvPVX_const(PL_rs) == '\n');
Perl_sv_catpvf(aTHX_ sv, ", <%s> %s %"IVdf,
- PL_last_in_gv == PL_argvgv ?
- "" : GvNAME(PL_last_in_gv),
+ PL_last_in_gv == PL_argvgv ? "" : GvNAME(PL_last_in_gv),
line_mode ? "line" : "chunk",
(IV)IoLINES(GvIOp(PL_last_in_gv)));
}
- sv_catpv(sv, PL_dirty ? dgd : ".\n");
+ if (PL_dirty)
+ sv_catpvs(sv, " during global destruction");
+ sv_catpvs(sv, ".\n");
}
return sv;
}
{
register I32 i;
register const I32 len = strlen(nam);
+ PERL_UNUSED_CONTEXT;
for (i = 0; environ[i]; i++) {
if (
taint_proper("Insecure %s%s", "EXEC");
}
if (PerlProc_pipe(p) < 0)
- return Nullfp;
+ return NULL;
/* Try for another pipe pair for error return */
if (PerlProc_pipe(pp) >= 0)
did_pipes = 1;
PerlLIO_close(pp[0]);
PerlLIO_close(pp[1]);
}
- return Nullfp;
+ return NULL;
}
sleep(5);
}
pid2 = wait4pid(pid, &status, 0);
} while (pid2 == -1 && errno == EINTR);
errno = errkid; /* Propagate errno from kid */
- return Nullfp;
+ return NULL;
}
}
if (did_pipes)
taint_proper("Insecure %s%s", "EXEC");
}
if (PerlProc_pipe(p) < 0)
- return Nullfp;
+ return NULL;
if (doexec && PerlProc_pipe(pp) >= 0)
did_pipes = 1;
while ((pid = PerlProc_fork()) < 0) {
}
if (!doexec)
Perl_croak(aTHX_ "Can't fork");
- return Nullfp;
+ return NULL;
}
sleep(5);
}
#ifdef PERL_USES_PL_PIDSTATUS
hv_clear(PL_pidstatus); /* we have no children */
#endif
- return Nullfp;
+ return NULL;
#undef THIS
#undef THAT
}
pid2 = wait4pid(pid, &status, 0);
} while (pid2 == -1 && errno == EINTR);
errno = errkid; /* Propagate errno from kid */
- return Nullfp;
+ return NULL;
}
}
if (did_pipes)
Perl_rsignal_state(pTHX_ int signo)
{
struct sigaction oact;
+ PERL_UNUSED_CONTEXT;
if (sigaction(signo, (struct sigaction *)NULL, &oact) == -1)
return (Sighandler_t) SIG_ERR;
goto finish;
#endif
#if !defined(HAS_WAITPID) && defined(HAS_WAIT4)
- result = wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
+ result = wait4((pid==-1)?0:pid,statusp,flags,NULL);
goto finish;
#endif
#ifdef PERL_USES_PL_PIDSTATUS
{
register I32 todo;
register const char * const frombase = from;
+ PERL_UNUSED_CONTEXT;
if (len == 1) {
register const char c = *from;
char **
Perl_get_op_names(pTHX)
{
- return (char **)PL_op_name;
+ PERL_UNUSED_CONTEXT;
+ return (char **)PL_op_name;
}
char **
Perl_get_op_descs(pTHX)
{
- return (char **)PL_op_desc;
+ PERL_UNUSED_CONTEXT;
+ return (char **)PL_op_desc;
}
const char *
Perl_get_no_modify(pTHX)
{
- return PL_no_modify;
+ PERL_UNUSED_CONTEXT;
+ return PL_no_modify;
}
U32 *
Perl_get_opargs(pTHX)
{
- return (U32 *)PL_opargs;
+ PERL_UNUSED_CONTEXT;
+ return (U32 *)PL_opargs;
}
PPADDR_t*
Perl_get_ppaddr(pTHX)
{
- dVAR;
- return (PPADDR_t*)PL_ppaddr;
+ dVAR;
+ PERL_UNUSED_CONTEXT;
+ return (PPADDR_t*)PL_ppaddr;
}
#ifndef HAS_GETENV_LEN
Perl_getenv_len(pTHX_ const char *env_elem, unsigned long *len)
{
char * const env_trans = PerlEnv_getenv(env_elem);
+ PERL_UNUSED_CONTEXT;
if (env_trans)
*len = strlen(env_trans);
return env_trans;
Perl_get_vtbl(pTHX_ int vtbl_id)
{
const MGVTBL* result;
+ PERL_UNUSED_CONTEXT;
switch(vtbl_id) {
case want_vtbl_sv:
case want_vtbl_arylen:
result = &PL_vtbl_arylen;
break;
- case want_vtbl_glob:
- result = &PL_vtbl_glob;
- break;
case want_vtbl_mglob:
result = &PL_vtbl_mglob;
break;
result = &PL_vtbl_utf8;
break;
default:
- result = Null(MGVTBL*);
+ result = NULL;
break;
}
return (MGVTBL*)result;
int secs;
int month, mday, year, jday;
int odd_cent, odd_year;
+ PERL_UNUSED_CONTEXT;
#define DAYS_PER_YEAR 365
#define DAYS_PER_QYEAR (4*DAYS_PER_YEAR+1)
void
Perl_sv_nosharing(pTHX_ SV *sv)
{
+ PERL_UNUSED_CONTEXT;
PERL_UNUSED_ARG(sv);
}
{
const char * const stashpv = CopSTASHPV(c);
const char * const name = HvNAME_get(hv);
+ PERL_UNUSED_CONTEXT;
if (stashpv == name)
return TRUE;