ptr = (Malloc_t)PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */
PERL_ALLOC_CHECK(ptr);
DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) malloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size));
- if (ptr != Nullch) {
+ if (ptr != NULL) {
#ifdef PERL_TRACK_MEMPOOL
- ((struct perl_memory_debug_header *)ptr)->interpreter = aTHX;
+ struct perl_memory_debug_header *const header
+ = (struct perl_memory_debug_header *)ptr;
+
+ header->interpreter = aTHX;
+ /* Link us into the list. */
+ header->prev = &PL_memory_debug_header;
+ header->next = PL_memory_debug_header.next;
+ PL_memory_debug_header.next = header;
+ header->next->prev = header;
# ifdef PERL_POISON
- ((struct perl_memory_debug_header *)ptr)->size = size;
- ((struct perl_memory_debug_header *)ptr)->in_use = PERL_POISON_INUSE;
+ header->size = size;
# endif
ptr = (Malloc_t)((char*)ptr+sTHX);
#endif
return ptr;
}
else if (PL_nomemok)
- return Nullch;
+ return NULL;
else {
return write_no_mem();
}
#ifdef PERL_TRACK_MEMPOOL
where = (Malloc_t)((char*)where-sTHX);
size += sTHX;
- if (((struct perl_memory_debug_header *)where)->interpreter != aTHX) {
- Perl_croak_nocontext("panic: realloc from wrong pool");
- }
+ {
+ struct perl_memory_debug_header *const header
+ = (struct perl_memory_debug_header *)where;
+
+ if (header->interpreter != aTHX) {
+ Perl_croak_nocontext("panic: realloc from wrong pool");
+ }
+ assert(header->next->prev == header);
+ assert(header->prev->next == header);
# ifdef PERL_POISON
- if (((struct perl_memory_debug_header *)where)->size > size) {
- const MEM_SIZE freed_up =
- ((struct perl_memory_debug_header *)where)->size - size;
- char *start_of_freed = ((char *)where) + size;
- Poison(start_of_freed, freed_up, char);
- }
- ((struct perl_memory_debug_header *)where)->size = size;
+ 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);
+ }
+ header->size = size;
# endif
+ }
#endif
#ifdef DEBUGGING
if ((long)size < 0)
DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) rfree\n",PTR2UV(where),(long)PL_an++));
DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) realloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size));
- if (ptr != Nullch) {
+ if (ptr != NULL) {
#ifdef PERL_TRACK_MEMPOOL
+ struct perl_memory_debug_header *const header
+ = (struct perl_memory_debug_header *)ptr;
+
+ header->next->prev = header;
+ header->prev->next = header;
+
ptr = (Malloc_t)((char*)ptr+sTHX);
#endif
return ptr;
}
else if (PL_nomemok)
- return Nullch;
+ return NULL;
else {
return write_no_mem();
}
if (where) {
#ifdef PERL_TRACK_MEMPOOL
where = (Malloc_t)((char*)where-sTHX);
- if (((struct perl_memory_debug_header *)where)->interpreter != aTHX) {
- Perl_croak_nocontext("panic: free from wrong pool");
- }
-# ifdef PERL_POISON
{
- if (((struct perl_memory_debug_header *)where)->in_use
- == PERL_POISON_FREE) {
+ struct perl_memory_debug_header *const header
+ = (struct perl_memory_debug_header *)where;
+
+ if (header->interpreter != aTHX) {
+ Perl_croak_nocontext("panic: free from wrong pool");
+ }
+ if (!header->prev) {
Perl_croak_nocontext("panic: duplicate free");
}
- if (((struct perl_memory_debug_header *)where)->in_use
- != PERL_POISON_INUSE) {
- Perl_croak_nocontext("panic: bad free ");
+ if (!(header->next) || header->next->prev != header
+ || header->prev->next != header) {
+ Perl_croak_nocontext("panic: bad free");
}
- ((struct perl_memory_debug_header *)where)->in_use
- = PERL_POISON_FREE;
- }
- Poison(where, ((struct perl_memory_debug_header *)where)->size, char);
+ /* Unlink us from the chain. */
+ header->next->prev = header->prev;
+ header->prev->next = header->next;
+# ifdef PERL_POISON
+ Poison(where, header->size, char);
# endif
+ /* Trigger the duplicate free warning. */
+ header->next = NULL;
+ }
#endif
PerlMem_free(where);
}
ptr = (Malloc_t)PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */
PERL_ALLOC_CHECK(ptr);
DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) calloc %ld x %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)count,(long)size));
- if (ptr != Nullch) {
+ if (ptr != NULL) {
memset((void*)ptr, 0, size);
#ifdef PERL_TRACK_MEMPOOL
- ((struct perl_memory_debug_header *)ptr)->interpreter = aTHX;
+ {
+ struct perl_memory_debug_header *const header
+ = (struct perl_memory_debug_header *)ptr;
+
+ header->interpreter = aTHX;
+ /* Link us into the list. */
+ header->prev = &PL_memory_debug_header;
+ header->next = PL_memory_debug_header.next;
+ PL_memory_debug_header.next = header;
+ header->next->prev = header;
# ifdef PERL_POISON
- ((struct perl_memory_debug_header *)ptr)->size = size;
- ((struct perl_memory_debug_header *)ptr)->in_use = PERL_POISON_INUSE;
+ header->size = size;
# endif
- ptr = (Malloc_t)((char*)ptr+sTHX);
+ ptr = (Malloc_t)((char*)ptr+sTHX);
+ }
#endif
return ptr;
}
else if (PL_nomemok)
- return Nullch;
+ return NULL;
return write_no_mem();
}
continue;
for (x=big,s=little; *s; /**/ ) {
if (!*x)
- return Nullch;
+ return NULL;
if (*s != *x)
break;
else {
if (!*s)
return (char*)(big-1);
}
- return Nullch;
+ return NULL;
}
/* same as instr but allow embedded nulls */
return (char*)(big-1);
}
}
- return Nullch;
+ return NULL;
}
/* reverse of the above--find last substring */
if (s >= littleend)
return (char*)(big+1);
}
- return Nullch;
+ return NULL;
}
#define FBM_TABLE_OFFSET 2 /* Number of bytes between EOS and table*/
s--, i++;
}
}
- sv_magic(sv, Nullsv, PERL_MAGIC_bm, Nullch, 0); /* deep magic */
+ sv_magic(sv, NULL, PERL_MAGIC_bm, NULL, 0); /* deep magic */
SvVALID_on(sv);
s = (const unsigned char*)(SvPVX_const(sv)); /* deeper magic */
=for apidoc fbm_instr
Returns the location of the SV in the string delimited by C<str> and
-C<strend>. It returns C<Nullch> if the string can't be found. The C<sv>
+C<strend>. It returns C<NULL> if the string can't be found. The C<sv>
does not have to be fbm_compiled, but the search will not be as fast
then.
|| (*big == *little &&
memEQ((char *)big, (char *)little, littlelen - 1))))
return (char*)big;
- return Nullch;
+ return NULL;
}
if (littlelen <= 2) { /* Special-cased */
}
if (SvTAIL(littlestr))
return (char *) bigend;
- return Nullch;
+ return NULL;
}
if (!littlelen)
return (char*)big; /* Cannot be SvTAIL! */
return (char*)bigend - 2;
if (bigend[-1] == *little)
return (char*)bigend - 1;
- return Nullch;
+ return NULL;
}
{
/* This should be better than FBM if c1 == c2, and almost
check_1char_anchor: /* One char and anchor! */
if (SvTAIL(littlestr) && (*bigend == *little))
return (char *)bigend; /* bigend is already decremented. */
- return Nullch;
+ return NULL;
}
if (SvTAIL(littlestr) && !multiline) { /* tail anchored? */
s = bigend - littlelen;
{
return (char*)s + 1; /* how sweet it is */
}
- return Nullch;
+ return NULL;
}
if (SvTYPE(littlestr) != SVt_PVBM || !SvVALID(littlestr)) {
char * const b = ninstr((char*)big,(char*)bigend,
{
return (char*)s;
}
- return Nullch;
+ return NULL;
}
return b;
}
register const unsigned char *oldlittle;
if (littlelen > (STRLEN)(bigend - big))
- return Nullch;
+ return NULL;
--littlelen; /* Last char found by table lookup */
s = big + littlelen;
&& memEQ((char *)(bigend - littlelen),
(char *)(oldlittle - littlelen), littlelen) )
return (char*)bigend - littlelen;
- return Nullch;
+ return NULL;
}
}
first = *little++;
goto check_tail;
}
- return Nullch;
+ return NULL;
}
little = (const unsigned char *)(SvPVX_const(littlestr));
if (previous + start_shift == stop_pos + 1) /* A fake '\n'? */
goto check_tail;
#endif
- return Nullch;
+ return NULL;
}
while (pos < previous + start_shift) {
if (!(pos += PL_screamnext[pos]))
return (char *)(big+(*old_posp));
check_tail:
if (!SvTAIL(littlestr) || (end_shift > 0))
- return Nullch;
+ return NULL;
/* Ignore the trailing "\n". This code is not microoptimized */
big = (const unsigned char *)(SvPVX_const(bigstr) + SvCUR(bigstr));
stop_pos = littleend - little; /* Actual littlestr len */
&& ((stop_pos == 1) ||
memEQ((char *)(big + 1), (char *)little, stop_pos - 1)))
return (char*)big;
- return Nullch;
+ return NULL;
}
I32
Perl_savepv(pTHX_ const char *pv)
{
if (!pv)
- return Nullch;
+ return NULL;
else {
char *newaddr;
const STRLEN pvlen = strlen(pv)+1;
register char *newaddr;
STRLEN pvlen;
if (!pv)
- return Nullch;
+ return NULL;
pvlen = strlen(pv)+1;
newaddr = (char*)PerlMemShared_malloc(pvlen);
save_re_context();
SAVESPTR(PL_stderrgv);
- PL_stderrgv = Nullgv;
+ PL_stderrgv = NULL;
PUSHSTACKi(PERLSI_MAGIC);
*utf8 = SvUTF8(msv);
}
else {
- message = Nullch;
+ message = NULL;
}
DEBUG_S(PerlIO_printf(Perl_debug_log,
sidestepping the normal C order of execution. See C<warn>.
If you want to throw an exception object, assign the object to
-C<$@> and then pass C<Nullch> to croak():
+C<$@> and then pass C<NULL> to croak():
errsv = get_sv("@", TRUE);
sv_setsv(errsv, exception_object);
- croak(Nullch);
+ croak(NULL);
=cut
*/
tmpenv[j] = (char*)safesysmalloc((len+1)*sizeof(char));
Copy(environ[j], tmpenv[j], len+1, char);
}
- tmpenv[max] = Nullch;
+ tmpenv[max] = NULL;
environ = tmpenv; /* tell exec where it is now */
}
if (!val) {
}
if (!environ[i]) { /* does not exist yet */
environ = (char**)safesysrealloc(environ, (i+2) * sizeof(char*));
- environ[i+1] = Nullch; /* make sure it's null terminated */
+ environ[i+1] = NULL; /* make sure it's null terminated */
}
else
safesysfree(environ[i]);
}
}
#endif
- do_aexec5(Nullsv, args-1, args-1+n, pp[1], did_pipes);
+ do_aexec5(NULL, args-1, args-1+n, pp[1], did_pipes);
PerlProc__exit(1);
#undef THIS
#undef THAT
PerlProc__exit(1);
}
#endif /* defined OS2 */
- if ((tmpgv = gv_fetchpvs("$",TRUE, SVt_PV))) {
+ if ((tmpgv = gv_fetchpvs("$", GV_ADD|GV_NOTQUAL, SVt_PV))) {
SvREADONLY_off(GvSV(tmpgv));
sv_setiv(GvSV(tmpgv), PerlProc_getpid());
SvREADONLY_on(GvSV(tmpgv));
const char *const *const search_ext, I32 flags)
{
dVAR;
- const char *xfound = Nullch;
- char *xfailed = Nullch;
+ const char *xfound = NULL;
+ char *xfailed = NULL;
char tmpbuf[MAXPATHLEN];
register char *s;
I32 len = 0;
static const char *const exts[] = { SEARCH_EXTS };
const char *const *const ext = search_ext ? search_ext : exts;
int extidx = 0, i = 0;
- const char *curext = Nullch;
+ const char *curext = NULL;
#else
PERL_UNUSED_ARG(search_ext);
# define MAX_EXT_LEN 0
int idx = 0, deftypes = 1;
bool seen_dot = 1;
- const int hasdir = !dosearch || (strpbrk(scriptname,":[</") != Nullch);
+ const int hasdir = !dosearch || (strpbrk(scriptname,":[</") != NULL);
# else
if (dosearch) {
int idx = 0, deftypes = 1;
bool seen_dot = 1;
- const int hasdir = (strpbrk(scriptname,":[</") != Nullch);
+ const int hasdir = (strpbrk(scriptname,":[</") != NULL);
# endif
/* The first time through, just add SEARCH_EXTS to whatever we
* already have, so we can check for default file types. */
(xfailed ? "" : " on PATH"),
(xfailed || seen_dot) ? "" : ", '.' not in PATH");
}
- scriptname = Nullch;
+ scriptname = NULL;
}
Safefree(xfailed);
scriptname = xfound;
}
- return (scriptname ? savepv(scriptname) : Nullch);
+ return (scriptname ? savepv(scriptname) : NULL);
}
#ifndef PERL_GET_CONTEXT_DEFINED