/*
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 */