1#@!#!123s

32759 1#@!#!123s
: / proc / self / root / home / .cpan / build / Test-LeakTrace-0.17-0 /
Filename : ptr_table.h
back
/*
	ptr_table.h - ptr_table compatible functions for older perls

	This file is originated from sv.c of 5.10.0.
*/

/*
 * LISENCE AND COPYRIGHT in sv.c:
 *
 *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
 *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
 *
 *    You may distribute under the terms of either the GNU General Public
 *    License or the Artistic License, as specified in the README file.
 *
*/

#ifdef TESTING_PTR_TABLE_COMPAT
#undef ptr_table_new
#undef ptr_table_find
#undef ptr_table_fetch
#undef ptr_table_store
#undef ptr_table_split
#undef ptr_table_clear
#undef ptr_table_free
#endif

#ifndef ptr_table_new

/*
    PTR_TBL_t and PTR_TBL_ENT_t are defined in perl.h
*/

#define PTE_SVSLOT
#define new_body_inline(pte, type) Newx(pte, 1, PTR_TBL_ENT_t)
#define del_pte(pte)               Safefree(pte)

#define ptr_table_new()                my_ptr_table_new(aTHX)
#define ptr_table_find(tbl, sv)        my_ptr_table_find(aTHX_ tbl, sv)
#define ptr_table_fetch(tbl, key)      my_ptr_table_fetch(aTHX_ tbl, key)
#define ptr_table_store(tbl, key, val) my_ptr_table_store(aTHX_ tbl, key, val)
#define ptr_table_split(tbl)           my_ptr_table_split(aTHX_ tbl)
#define ptr_table_clear(tbl)           my_ptr_table_clear(aTHX_ tbl)
#define ptr_table_free(tbl)            my_ptr_table_free(aTHX_ tbl)


#define PTR_TABLE_HASH(ptr) \
  ((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17)))


static PTR_TBL_t *
my_ptr_table_new(pTHX)
{
    PTR_TBL_t *tbl;
    PERL_UNUSED_CONTEXT;

    Newxz(tbl, 1, PTR_TBL_t);
    tbl->tbl_max	= 511;
    tbl->tbl_items	= 0;
    Newxz(tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t*);
    return tbl;
}

static void
my_ptr_table_split(pTHX_ PTR_TBL_t * const tbl)
{
    PTR_TBL_ENT_t **ary = tbl->tbl_ary;
    const UV oldsize = tbl->tbl_max + 1;
    UV newsize = oldsize * 2;
    UV i;
    PERL_UNUSED_CONTEXT;

    Renew(ary, newsize, PTR_TBL_ENT_t*);
    Zero(&ary[oldsize], newsize-oldsize, PTR_TBL_ENT_t*);
    tbl->tbl_max = --newsize;
    tbl->tbl_ary = ary;
    for (i=0; i < oldsize; i++, ary++) {
	PTR_TBL_ENT_t **curentp, **entp, *ent;
	if (!*ary)
	    continue;
	curentp = ary + oldsize;
	for (entp = ary, ent = *ary; ent; ent = *entp) {
	    if ((newsize & PTR_TABLE_HASH(ent->oldval)) != i) {
		*entp = ent->next;
		ent->next = *curentp;
		*curentp = ent;
		continue;
	    }
	    else
		entp = &ent->next;
	}
    }
}

static PTR_TBL_ENT_t *
my_ptr_table_find(pTHX_ PTR_TBL_t const * const tbl, const void * const sv) {
    PTR_TBL_ENT_t *tblent;
    PERL_UNUSED_CONTEXT;

    assert(tbl);
    tblent = tbl->tbl_ary[PTR_TABLE_HASH(sv) & tbl->tbl_max];
    for (; tblent; tblent = tblent->next) {
	if (tblent->oldval == sv)
	    return tblent;
    }
    return NULL;
}

static void *
my_ptr_table_fetch(pTHX_ const PTR_TBL_t * const tbl, const void * const sv)
{
    PTR_TBL_ENT_t const *const tblent = ptr_table_find(tbl, sv);
    PERL_UNUSED_CONTEXT;
    return tblent ? tblent->newval : NULL;
}

static void
my_ptr_table_store(pTHX_ PTR_TBL_t * const tbl, const void * const oldsv, void * const newsv)
{
    PTR_TBL_ENT_t *tblent = ptr_table_find(tbl, oldsv);

    if (tblent) {
	tblent->newval = newsv;
    } else {
	const UV entry = PTR_TABLE_HASH(oldsv) & tbl->tbl_max;

	new_body_inline(tblent, PTE_SVSLOT);

	tblent->oldval = oldsv;
	tblent->newval = newsv;
	tblent->next = tbl->tbl_ary[entry];
	tbl->tbl_ary[entry] = tblent;
	tbl->tbl_items++;
	if (tblent->next && tbl->tbl_items > tbl->tbl_max)
	    ptr_table_split(tbl);
    }
}


static void
my_ptr_table_clear(pTHX_ PTR_TBL_t * const tbl)
{
    assert(tbl);
    if (tbl->tbl_items) {
	PTR_TBL_ENT_t * const * const array = tbl->tbl_ary;
	UV riter = tbl->tbl_max;

	do {
	    PTR_TBL_ENT_t *entry = array[riter];

	    while (entry) {
		PTR_TBL_ENT_t * const oentry = entry;
		entry = entry->next;
		del_pte(oentry);
	    }
	} while (riter--);

	tbl->tbl_items = 0;
    }
}

static void
my_ptr_table_free(pTHX_ PTR_TBL_t * const tbl)
{
    assert(tbl);
    ptr_table_clear(tbl);
    Safefree(tbl->tbl_ary);
    Safefree(tbl);
}

#endif /* !ptr_table_new */