#endif
#ifdef PERL_POISON
- Poison(((char *)ptr), size, char);
+ PoisonNew(((char *)ptr), size, char);
#endif
#ifdef PERL_TRACK_MEMPOOL
if (header->size > size) {
const MEM_SIZE freed_up = header->size - size;
char *start_of_freed = ((char *)where) + size;
- Poison(start_of_freed, freed_up, char);
+ PoisonFree(start_of_freed, freed_up, char);
}
header->size = size;
# endif
if (header->size < size) {
const MEM_SIZE fresh = size - header->size;
char *start_of_fresh = ((char *)ptr) + size;
- Poison(start_of_fresh, fresh, char);
+ PoisonNew(start_of_fresh, fresh, char);
}
# endif
header->next->prev = header->prev;
header->prev->next = header->next;
# ifdef PERL_POISON
- Poison(where, header->size, char);
+ PoisonNew(where, header->size, char);
# endif
/* Trigger the duplicate free warning. */
header->next = NULL;
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's version of what C<strndup()> would be if it existed. Returns a
pointer to a newly allocated string which is a duplicate of the first
-C<len> bytes from C<pv>. The memory allocated for the new string can be
-freed with the C<Safefree()> function.
+C<len> bytes from C<pv>, plus a trailing NUL byte. The memory allocated for
+the new string can be freed with the C<Safefree()> function.
=cut
*/
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);
}
;
}
+/* Set buffer=NULL to get a new one. */
+STRLEN *
+Perl_new_warnings_bitfield(pTHX_ STRLEN *buffer, const char *const bits,
+ STRLEN size) {
+ const MEM_SIZE len_wanted = sizeof(STRLEN) + size;
+ buffer = specialWARN(buffer) ? PerlMemShared_malloc(len_wanted)
+ : PerlMemShared_realloc(buffer, len_wanted);
+ buffer[0] = size;
+ Copy(bits, (buffer + 1), size, char);
+ return buffer;
+}
/* since we've already done strlen() for both nam and val
* we can use that info to make things faster than
}
else
safesysfree(environ[i]);
- nlen = strlen(nam);
- vlen = strlen(val);
+ nlen = strlen(nam);
+ vlen = strlen(val);
- environ[i] = (char*)safesysmalloc((nlen+vlen+2) * sizeof(char));
- /* all that work just for this */
- my_setenv_format(environ[i], nam, nlen, val, vlen);
+ environ[i] = (char*)safesysmalloc((nlen+vlen+2) * sizeof(char));
+ /* all that work just for this */
+ my_setenv_format(environ[i], nam, nlen, val, vlen);
} else {
# endif
-# if defined(__CYGWIN__) || defined(EPOC) || defined(__SYMBIAN32__)
+# if defined(__CYGWIN__) || defined(EPOC) || defined(__SYMBIAN32__) || defined(__riscos__)
# if defined(HAS_UNSETENV)
if (val == NULL) {
(void)unsetenv(nam);
{
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;
const char * const func =
op == OP_READLINE ? "readline" : /* "<HANDLE>" not nice */
op == OP_LEAVEWRITE ? "write" : /* "write exit" not nice */
+ op < 0 ? "" : /* handle phoney cases */
PL_op_desc[op];
const char * const pars = OP_IS_FILETEST(op) ? "" : "()";
const char * const type = OP_IS_SOCKET(op)
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);
}
opt |= PERL_UNICODE_LOCALE_FLAG; break;
case PERL_UNICODE_ARGV:
opt |= PERL_UNICODE_ARGV_FLAG; break;
+ case PERL_UNICODE_UTF8CACHEASSERT:
+ opt |= PERL_UNICODE_UTF8CACHEASSERT_FLAG; break;
default:
if (*p != '\n' && *p != '\r')
Perl_croak(aTHX_
{
const char * const stashpv = CopSTASHPV(c);
const char * const name = HvNAME_get(hv);
+ PERL_UNUSED_CONTEXT;
if (stashpv == name)
return TRUE;
projects / p5sagit/p5-mst-13.2.git / blobdiff