Are you using Perl's mem. mgmt. functions ? (Newz, Safefree, etc.)
Or is this something external to the Perl environment (e.g.,
a shared library). If the latter, you might want to build an external
stub and test/debug outside XS.
As to using any debug heap mgrs, you probably already know that XS/Perl obsconds
with the std. malloc/free symbols, so you need to create your own version in
an externally compiled object. I've been using the following (you'll need to
reference your own set of heap mgr libs/methods):
crt_memmgt.c:
/*
* crt_memmgt.c - provides wrappers for malloc, free, and strdup, cuz
* Perl core has hijacked the symbols
* also provides debug versions of malloc/free
*/
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
typedef struct inuse_t inuse_t;
typedef struct inuse_t {
inuse_t *prev;
inuse_t *next;
int line;
} inuse_t;
static inuse_t *inuse = NULL;
/*
* seem to be writing past the end of somethign somewhere...but where
+?
*/
void *crt_malloc(int size) { return malloc(size + sizeof(inuse_t)); }
void *crt_free(void *ptr) { if (ptr) free(ptr); return NULL; }
void *crt_strdup(char *str) { return strdup(str); }
void *crt_realloc(void *ptr, int count, int size, int newcount)
{
char *tptr = malloc((size * newcount) + sizeof(inuse_t));
if (tptr == NULL)
return NULL;
if (ptr && count) {
memcpy(tptr, ptr, (count * size));
crt_free(ptr);
}
memset(&tptr[(count * size)], 0, (newcount - count) * size);
return tptr;
}
void *crt_malloc_dbg(int size, int line) {
inuse_t *p = (inuse_t *)malloc(size + sizeof(inuse_t));
void *t = (char *)p + sizeof(inuse_t);
p->prev = NULL;
p->next = inuse;
p->line = line;
if (inuse)
inuse->prev = p;
inuse = p;
return t;
}
void *crt_free_dbg(void *ptr, int line) {
inuse_t *tp = (inuse_t *)((char *)ptr - sizeof(inuse_t));
inuse_t *s = inuse;
while (s && (s != tp))
s = s->next;
if (!s) {
printf("\n**** BOGUS FREED POINTER %p at %d\n", ptr, line);
}
else {
if (tp->next)
tp->next->prev = tp->prev;
if (tp->prev)
tp->prev->next = tp->next;
if (inuse == tp)
inuse = tp->next;
printf("\n*** FREEING %p ALLOC'd at %d FREED AT %d\n", tp, tp-
+>line, line);
}
free(tp);
return NULL;
}
void *crt_strdup_dbg(char *str, int line) {
char *p = crt_malloc_dbg(strlen(str) + 1, line);
strcpy(p, str);
return p;
}
void *crt_realloc_dbg(void *ptr, int count, int size, int newcount, in
+t line)
{
char *tptr = crt_malloc_dbg((size * newcount) + sizeof(inuse_t), l
+ine);
if (tptr == NULL)
return NULL;
if (ptr && count) {
memcpy(tptr, ptr, (count * size));
crt_free_dbg(ptr, line);
}
memset(&tptr[(count * size)], 0, (newcount - count) * size);
return tptr;
}
void crt_check() {
inuse_t *p = inuse;
for (; p; p = p->next)
printf("\n*** LEFTOVER %p FROM %d\n", p, p->line);
}
crt_memmgt.h:
#ifndef CRT_MEMMGT_H
/*
* Because Perl CORE, in its infinite wisdom, has hijacked
* CRT's malloc() and free() symbols, without providing
* any replacement symbols for them, we have
* to create a separate object to link into our XS code
*/
#define CRT_Newz(v,n,t) \
if ((v = (t *)crt_malloc((n) * sizeof(t))) == NULL) \
Perl_croak_nocontext("Out of CRT memory!"); \
memzero((char*)(v), (n)*sizeof(t))
#define CRT_Dup(v,n,t,s,l) \
if ((v = (t *)crt_malloc((n) * sizeof(t))) == NULL) \
Perl_croak_nocontext("Out of CRT memory!"); \
memcpy((char*)(v), (char*)(s), (l) * sizeof(t)); \
if ((l) < (n)) \
memzero((char*)(&v[(n)]), ((n) - (l)) * sizeof(t))
#define CRT_Realloc(v,n,t,l) \
if ((v = crt_realloc(v, n, sizeof(t), l)) == NULL) \
Perl_croak_nocontext("Out of CRT memory!");
// #define CRT_DEBUG 1
#ifdef CRT_DEBUG
#define crt_malloc(v) crt_malloc_dbg(v, __LINE__)
#define crt_free(v) crt_free_dbg(v, __LINE__)
#define crt_strdup(v) crt_strdup_dbg(v, __LINE__)
#define crt_realloc(v,n,t,l) crt_realloc_dbg(v,n,t,l, __LINE__)
void *crt_malloc_dbg(int size, int line);
void *crt_free_dbg(void *, int);
void *crt_strdup_dbg(void *, int);
void *crt_realloc_dbg(void *, int, int, int, int);
#else
void *crt_malloc(int size);
void *crt_free(void *);
char *crt_strdup(char *str);
void *crt_realloc(void *, int, int, int);
#endif
void crt_check();
#endif
Then, in your Makefile.PL (assuming EU::MM), add the following to your
WriteMakefile() arguments:
'OBJECT' => '$(BASEEXT)$(OBJ_EXT) crt_memmgt$(OBJ_EXT)',