/* tools.c */

#include "tools.h"

/* Enable to do old style brute force checking too */
/* #define BRUTE_FORCE */
/* #define SANITY  */

typedef struct {
    int line;
} where;

static hash *var_map   = NULL;      /* Maps SV* to location where var was created */
static list current_free;
static list current_arenas;
static int  note_init_done = 0;

static int (*runops_old)(pTHX);

#ifdef BRUTE_FORCE
static hash *brute     = NULL;
#endif

#define live_sv(sv) \
    (SvTYPE(sv) != SVTYPEMASK && SvREFCNT(sv))

#define free_sv(sv) \
    (!live_sv(sv))

#define list_hint(l) \
    (!(l) ? 100 : (list_used(l) + 10))

/* Perl opcodes which trigger a memory scan */
#define interesting_op(o) \
    ((o) == OP_NEXTSTATE || \
     (o) == OP_DBSTATE   || \
     (o) == OP_SETSTATE)
            

static void nomem(void) {
    fprintf(stderr, "Devel::LeakTrace::Fast: Out of memory\n");
    exit(1);
}

static const where *get_where(int line, const char *file) {
    static int    init_done = 0;
    static hash   *cache    = NULL;
    static buffer work;
    where *w;
    int err;
    size_t sz;

    if (!file) {
        return NULL;
    }

    if (!init_done) {
        if (err = buffer_init(&work, 256, 64), ERR_None != err) {
            nomem();
        }
        if (err = hash_new(1000, &cache), ERR_None != err) {
            nomem();
        }
        init_done = 1;
    }
    
    sz = sizeof(where) + strlen(file) + 1;
    if (err = buffer_ensure(&work, sz), ERR_None != err) {
        nomem();
    }

    w = (where *) work.buf;
    w->line = line;
    strcpy((char *) (w+1), file);
    
    /* Already got it? */
    if (w = (where *) hash_get(cache, w, sz), NULL != w) {
        return w;
    }
    
    if (w = malloc(sz), !w) {
        nomem();
    }
    
    memcpy(w, work.buf, sz);
    
    /* Add it to cache */
    if (err = hash_put(cache, w, sz, w), ERR_None != err) {
        nomem();
    }

    return w;
}

static void new_var(SV *sv, const void *p) {
    int err;
    const where *w = p;
    
/*    fprintf(stderr, "%s, line %d: New var: %p\n", (const char *) (w + 1), w->line, sv);*/
    if (!var_map) {
        fprintf(stderr, "Oops. var_map == NULL\n");
        exit(1);
    }
    
    if (err = hash_put(var_map, &sv, sizeof(sv), (void *) w), ERR_None != err) {
        nomem();
    }
}

static void free_var(SV *sv, const void *p) {
    int err;

/*    fprintf(stderr, "%s, line %d: Free var: %p\n", (const char *) (w + 1), w->line, sv);*/
    if (!var_map) {
        fprintf(stderr, "Oops. var_map == NULL\n");
        exit(1);
    }
    
    if (err = hash_delete_key(var_map, &sv, sizeof(sv)), ERR_None != err) {
        nomem();
    }
}

static void new_arena(SV *sva, const void *p) {
    const where *w = p;
    int err;
    /*fprintf(stderr, "%s, line %d: New arena: %p\n", (const char *) (w + 1), w->line, sva);*/
    SV *sv = sva + 1;
    SV *svend = &sva[SvREFCNT(sva)];

    while (sv < svend) {
        if (live_sv(sv)) {
            /* New variable */
            new_var(sv, w);
        } else {
            /* Pretend any new free SVs were already in the free list otherwise
             * when we compare the new free list with the old one it'll look as
             * if lots of variables that never existed have been freed.
             */
            if (err = list_append(&current_free, sv), ERR_None != err) {
                nomem();
            }
        }
        ++sv;
    }
    /*fprintf(stderr, "%s, line %d: End new arena: %p\n", (const char *) (w + 1), w->line, sva);*/
}

static void free_arena(SV *sva, const void *p) {
    const where *w = p;
    fprintf(stderr, "%s, line %d: Free arena: %p\n", (const char *) (w + 1), w->line, sva);
    fprintf(stderr, "Don't know what to do when an arena is freed...\n");
    exit(1);
}

#ifdef SANITY
static void in_free_only(SV *sv, const void *p) {
    fprintf(stderr, "%p is in free list but not arenas", sv);
}

static void in_comp_only(SV *sv, const void *p) {
    fprintf(stderr, "%p is in arenas but not free list", sv);
}

/* Sanity check - compare the free list with the list of free SVs in the arenas */
static void free_list_sane(void) {
    list real_free;
    list comp_free;
    int err;
    SV *sva;
    long diff;
    
    /* Get the real free list */
    if (err = list_build(&real_free, PL_sv_root, list_hint(&current_free)), ERR_None != err) {
        nomem();
    }
    
    /* Get the list of all the free SVs in all the arenas */
    if (err = list_init(&comp_free, list_hint(&real_free)), ERR_None != err) {
        nomem();
    }
    
    for (sva = PL_sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
        SV *sv = sva + 1;
        SV *svend = &sva[SvREFCNT(sva)];

        while (sv < svend) {
            if (free_sv(sv)) {
                if (err = list_append(&comp_free, sv), ERR_None != err) {
                    nomem();
                }
            }
            ++sv;
        }
    }

    diff = list_true_diff(&real_free, &comp_free, NULL, in_free_only, in_comp_only);

    if (diff != 0) {
        fprintf(stderr, "Lists have %ld differences, stopping\n", diff);
        fprintf(stderr, "%ld items in free list, %ld free items in arenas\n",
            (long) list_used(&real_free), (long) list_used(&comp_free));
        exit(1);
    }
}
#endif

static void note_new_vars(int line, const char *file) {
    list new_arenas;
    list new_free;
    int err;
    const where *w;
    
    if (!file) {
        return;
    }

#ifdef SANITY
    free_list_sane();
#endif
    
    w = get_where(line, file);

    /*fprintf(stderr, "note_new_vars(%d, \"%s\")\n", line, file);*/

    if (err = list_build(&new_arenas, PL_sv_arenaroot, list_hint(&current_arenas)), ERR_None != err) {
        nomem();
    }
    
    
    if (err = list_build(&new_free, PL_sv_root, list_hint(&current_free)), ERR_None != err) {
        nomem();
    }
    
    if (note_init_done) {
        /* Scan the lists looking for new arenas and deleted
         * free slots. A deleted free slot implies the creation of a new
         * variable.
         */

        list_true_diff(&current_arenas, &new_arenas, w, new_arena, free_arena);
        list_true_diff(&new_free, &current_free, w, new_var, free_var);
        
        list_delete(&current_arenas);
        list_delete(&current_free);
    }
    
    /* Roll round to new versions of lists */
    current_arenas = new_arenas;
    current_free   = new_free;
    note_init_done = 1;
}

#ifdef BRUTE_FORCE
static void brute_force(int line, const char *file) {
    SV *sva;
    hash *baby;
    const where *w;
    int err;

    fprintf(stderr, "brute_force(%d, \"%s\")\n", line, file);
    
    w = get_where(line, file);

    if (err = hash_new(PL_sv_count, &baby), ERR_None != err) {
        nomem();
    }

    for (sva = PL_sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
        SV *sv = sva + 1;
        SV *svend = &sva[SvREFCNT(sva)];

        while (sv < svend) {
            if (live_sv(sv)) {
                const where *nw = w;

                if (brute) {
                    const where *ow;
                    if ((ow = hash_get(brute, &sv, sizeof(sv)))) {
                        nw = hash_GETNULL(ow);
                    } else {
                        if (w) {
                            fprintf(stderr,
                                "%s, line %d: New var (bf): %p\n",
                                (const char *) (w + 1), w->line, sv);
                        }
                    }
                }

                if (err = hash_put(baby, &sv, sizeof(sv), 
                    hash_PUTNULL((void *) nw)), ERR_None != err) {
                    nomem();
                }
            }
            ++sv;
        }
    }

    hash_delete(brute);
    brute = baby;
}

#define NOTE_NEW_VARS(l, f)     \
    do {                        \
        note_new_vars(l, f);    \
        brute_force(l, f);      \
    } while (0);

#else

#define NOTE_NEW_VARS(l, f) \
    note_new_vars(l, f)

#endif

static int runops_leakcheck(pTHX) {
    char *lastfile = NULL;
    int  lastline  = 0;

    while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) {
        PERL_ASYNC_CHECK();

        if (interesting_op(PL_op->op_type)) {
            /*fprintf(stderr, "%s, line %d\n", lastfile, lastline); */
            NOTE_NEW_VARS(lastline, lastfile);
            lastfile = CopFILE(cCOP);
            lastline = CopLINE(cCOP);
        }
    }

    /*fprintf(stderr, "%s, line %d\n", lastfile, lastline); */
    NOTE_NEW_VARS(lastline, lastfile);

    TAINT_NOT;
    return 0;
}

void tools_reset_counters(void) {
    int err;
    
    hash_delete(var_map);
    var_map = NULL;
    
    /*fprintf(stderr, "\nNew var_map\n\n"); */
    
    if (err = hash_new(1000, &var_map), ERR_None != err) {
        nomem();
    }

    list_delete(&current_arenas);
    list_delete(&current_free);
    note_init_done = 0;
    
    note_new_vars(0, NULL);

#ifdef BRUTE_FORCE
    hash_delete(brute);
    brute = NULL;
    brute_force(0, NULL);
#endif  
}

void tools_hook_runops(void) {
    tools_reset_counters();
    /*note_new_vars(0, NULL); */
    /*brute_force(0, NULL); */
    if (PL_runops != runops_leakcheck) {
        runops_old = PL_runops;
        PL_runops = runops_leakcheck;
    }
}

static void print_var(SV *sv, const where *w) {
    char *type;
    
    if (!w && var_map) {
        w = hash_get(var_map, &sv, sizeof(sv));
    }

    switch (SvTYPE(sv)) {
    case SVt_PVAV:  type = "AV"; break;
    case SVt_PVCV:  type = "CV"; break;
    case SVt_PVGV:  type = "GV"; break;
    case SVt_PVHV:  type = "HV"; break;
    case SVt_RV:    type = "RV"; break;
    default:        type = "SV"; break;
    }

    fprintf(stderr, "leaked %s(0x%p) from %s line %d\n", 
            type, sv, (const char *) (w + 1), w->line);
}

void tools_show_used(void) {
/*  SV *sva; */
    hash_iter i;
    const void *k;
    size_t kl;

#ifdef BRUTE_FORCE
    fprintf(stderr, "Leaks found by free list snooping:\n");
#endif

    k = hash_get_first_key(var_map, &i, &kl);
    while (k) {
        const where *w = (const where *) hash_GETNULL(hash_get(var_map, k, kl));
        if (w) {
            print_var(* (SV **) k, w);
        }
        k = hash_get_next_key(var_map, &i, &kl);
    }

#if 0   
    for (sva = PL_sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
        SV *sv = sva + 1;
        SV *svend = &sva[SvREFCNT(sva)];

        while (sv < svend) {
            if (live_sv(sv)) {
                fprintf(stderr, "var in pool at %p\n", sv);
            }
            ++sv;
        }
    }
#endif

#ifdef BRUTE_FORCE
    if (brute) {

        fprintf(stderr, "Leaks found by brute force:\n");
        k = hash_get_first_key(brute, &i, &kl);
        while (k) {
            const where *w = (const where *) hash_GETNULL(hash_get(brute, k, kl));
            if (w) {
                print_var(* (SV **) k, w);
            }
            k = hash_get_next_key(brute, &i, &kl);
        }
    }
    
#endif
}
