/*
 * 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, int line)
{
    char *tptr = crt_malloc_dbg((size * newcount) + sizeof(inuse_t), line);
    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);
}

##</code><code>##

#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

##</code><code>##

    'OBJECT' => '$(BASEEXT)$(OBJ_EXT) crt_memmgt$(OBJ_EXT)',