Skip Menu |
 

Preferred bug tracker

Please visit the preferred bug tracker to report your issue.

This queue is for tickets about the Devel-PPPort CPAN distribution.

Report information
The Basics
Id: 51851
Status: new
Priority: 0/
Queue: Devel-PPPort

People
Owner: Nobody in particular
Requestors: NUFFIN [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)

Attachments
0001-add-ptr_table-functions-badly.patch



Subject: [PATCH] add ptr_table_* functions (badly)
Download (untitled) / with headers
text/plain 199b
I don't really know how to add this stuff, it should probably have several NEED_ptr_table_* macros but I don't really know how to define those (i tried looking at other functions and got confused).
Subject: 0001-add-ptr_table-functions-badly.patch
From 805b681c28fb953b70935493de1a05e90c54a479 Mon Sep 17 00:00:00 2001 From: Yuval Kogman <nothingmuch@woobling.org> Date: Mon, 23 Nov 2009 13:56:33 +0200 Subject: [PATCH] add ptr_table functions (badly) --- PPPort.pm | 198 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 files changed, 191 insertions(+), 7 deletions(-) diff --git a/PPPort.pm b/PPPort.pm index 5d786f1..f47333b 100644 --- a/PPPort.pm +++ b/PPPort.pm @@ -3115,13 +3115,13 @@ prepend_madprops||| printbuf||| printf_nocontext|||vn process_special_blocks||| -ptr_table_clear||5.009005| -ptr_table_fetch||5.009005| -ptr_table_find|||n -ptr_table_free||5.009005| -ptr_table_new||5.009005| -ptr_table_split||5.009005| -ptr_table_store||5.009005| +ptr_table_clear|5.009005||p +ptr_table_fetch|5.009005||p +ptr_table_find|5.009005||np +ptr_table_free|5.009005||p +ptr_table_new|5.009005||p +ptr_table_split|5.009005||p +ptr_table_store|5.009005||p push_scope||| put_byte||| pv_display|5.006000||p @@ -8236,6 +8236,190 @@ DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count, #endif #endif + +#ifndef ptr_table_new + +/* FIXME NEED_ptr_table? */ + +#define ptr_table_find S_ptr_table_find +#define ptr_table_new() DPPP_(ptr_table_new)(aTHX) +#define ptr_table_fetch(a,b) DPPP_(ptr_table_fetch)(aTHX_ a,b) +#define ptr_table_store(a,b,c) DPPP_(ptr_table_store)(aTHX_ a,b,c) +#define ptr_table_split(a) DPPP_(ptr_table_split)(aTHX_ a) +#define ptr_table_clear(a) DPPP_(ptr_table_clear)(aTHX_ a) +#define ptr_table_free(a) DPPP_(ptr_table_free)(aTHX_ a) + +typedef struct ptr_tbl_ent PTR_TBL_ENT_t; +typedef struct ptr_tbl PTR_TBL_t; + +struct ptr_tbl_ent { + struct ptr_tbl_ent* next; + const void* oldval; + void* newval; +}; + +struct ptr_tbl { + struct ptr_tbl_ent** tbl_ary; + UV tbl_max; + UV tbl_items; +}; + + +static PTR_TBL_t * +DPPP_(ptr_table_new)(pTHX) +{ + PTR_TBL_t *tbl; + PERL_UNUSED_CONTEXT; + + Newx(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; +} + +#define PTR_TABLE_HASH(ptr) \ + ((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17))) + +/* + we use the PTE_SVSLOT 'reservation' made above, both here (in the + following define) and at call to new_body_inline made below in + DPPP_ptr_table_store() + */ + +#define del_pte(p) del_body_type(p, PTE_SVSLOT) + +/* map an existing pointer using a table */ + +static PTR_TBL_ENT_t * +S_ptr_table_find(PTR_TBL_t *const tbl, const void *const sv) +{ + PTR_TBL_ENT_t *tblent; + const UV hash = PTR_TABLE_HASH(sv); + + PERL_ARGS_ASSERT_PTR_TABLE_FIND; + + tblent = tbl->tbl_ary[hash & tbl->tbl_max]; + for (; tblent; tblent = tblent->next) { + if (tblent->oldval == sv) + return tblent; + } + return NULL; +} + +static void * +DPPP_(ptr_table_fetch)(pTHX_ PTR_TBL_t *const tbl, const void *const sv) +{ + PTR_TBL_ENT_t const *const tblent = ptr_table_find(tbl, sv); + + PERL_ARGS_ASSERT_PTR_TABLE_FETCH; + PERL_UNUSED_CONTEXT; + + return tblent ? tblent->newval : NULL; +} + +/* add a new entry to a pointer-mapping table */ + +static void +DPPP_(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); + + PERL_ARGS_ASSERT_PTR_TABLE_STORE; + PERL_UNUSED_CONTEXT; + + 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); + } +} + +/* double the hash bucket size of an existing ptr table */ + +static void +DPPP_(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_ARGS_ASSERT_PTR_TABLE_SPLIT; + 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; + } + } +} + +/* remove all the entries from a ptr table */ + +static void +DPPP_(ptr_table_clear)(pTHX_ PTR_TBL_t *const tbl) +{ + if (tbl && tbl->tbl_items) { + register 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; + } +} + +/* clear and free a ptr table */ + +static void +DPPP_(ptr_table_free)(pTHX_ PTR_TBL_t *const tbl) +{ + if (!tbl) { + return; + } + ptr_table_clear(tbl); + Safefree(tbl->tbl_ary); + Safefree(tbl); +} + +#endif + + + #ifndef pv_display #if defined(NEED_pv_display) static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim); -- 1.6.4.3


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.