Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Re: Debugging XS with duma/efence?

by renodino (Curate)
on Nov 14, 2007 at 17:15 UTC ( #650803=note: print w/ replies, xml ) Need Help??


in reply to Debugging XS with duma/efence?

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)',

Perl Contrarian & SQL fanboy


Comment on Re: Debugging XS with duma/efence?
Select or Download Code
Re^2: Debugging XS with duma/efence?
by suaveant (Parson) on Nov 14, 2007 at 17:36 UTC
    I basically wrote my own char by char ringbuffer parser for a product we connect to. I use a couple of linked lists.

    I am segfaulting on malloc, but when I clear out on of my free commands for the linked list everything runs smooth. I assume I am using freed memory somewhere and am trying to find out where. Duma does that but hooking it in seems problematic, at best.

    I can't easily compile the code outside of my module since it reads and writes Perl structures. All in all a nightmare :)

                    - Ant
                    - Some of my best work - (1 2 3)

Re^2: Debugging XS with duma/efence?
by suaveant (Parson) on Nov 14, 2007 at 19:57 UTC
    Oh.. and I knew nothing of newz and safefree... I am looking into those now.

    Are you supposed to use them vs normal calloc free etc when writing C under Perl? (This is my first serious foray into XS)

                    - Ant
                    - Some of my best work - (1 2 3)

      Are you supposed to use them vs normal calloc free etc when writing C under Perl?

      Probably. See Memory Mgmt API in the perldocs.


      Perl Contrarian & SQL fanboy

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://650803]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (12)
As of 2014-12-22 21:41 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (131 votes), past polls