From: Vincent Pit Date: Sat, 2 May 2009 22:17:24 +0000 (+0200) Subject: Switch to a ptable-based OP map X-Git-Tag: v0.12~10 X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=commitdiff_plain;h=a21a68b2f726d4002d20fb64677a52f72c520964 Switch to a ptable-based OP map --- diff --git a/MANIFEST b/MANIFEST index 80a5874..634e126 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4,6 +4,7 @@ Makefile.PL README indirect.xs lib/indirect.pm +ptable.h samples/indirect.pl t/00-load.t t/10-good.t diff --git a/indirect.xs b/indirect.xs index 85741a8..2c1f089 100644 --- a/indirect.xs +++ b/indirect.xs @@ -84,17 +84,26 @@ STATIC IV indirect_hint(pTHX) { /* ... op -> source position ............................................... */ -STATIC HV *indirect_map = NULL; -STATIC const char *indirect_linestr = NULL; +#define PTABLE_NAME ptable_map +#define PTABLE_VAL_FREE(V) SvREFCNT_dec(V) + +#define pPTBL pTHX +#define pPTBL_ pTHX_ +#define aPTBL aTHX +#define aPTBL_ aTHX_ + +#include "ptable.h" + +#define ptable_map_store(T, K, V) ptable_map_store(aTHX_ (T), (K), (V)) +#define ptable_map_clear(T) ptable_map_clear(aTHX_ (T)) +#define ptable_map_free(T) ptable_map_free(aTHX_ (T)) + +STATIC ptable *indirect_map = NULL; -/* We need (CHAR_BIT * sizeof(UV)) / 4 + 1 chars, but it's just better to take - * a power of two */ -#define OP2STR_BUF char buf[(CHAR_BIT * sizeof(UV)) / 2] -#define OP2STR(O) (sprintf(buf, "%"UVxf, PTR2UV(O))) +STATIC const char *indirect_linestr = NULL; STATIC void indirect_map_store(pTHX_ const OP *o, const char *src, SV *sv) { #define indirect_map_store(O, S, N) indirect_map_store(aTHX_ (O), (S), (N)) - OP2STR_BUF; SV *val; /* When lex_inwhat is set, we're in a quotelike environment (qq, qr, but not q) @@ -104,7 +113,7 @@ STATIC void indirect_map_store(pTHX_ const OP *o, const char *src, SV *sv) { if (!PL_lex_inwhat) { const char *pl_linestr = SvPVX_const(PL_linestr); if (indirect_linestr != pl_linestr) { - hv_clear(indirect_map); + ptable_map_clear(indirect_map); indirect_linestr = pl_linestr; } } @@ -114,49 +123,25 @@ STATIC void indirect_map_store(pTHX_ const OP *o, const char *src, SV *sv) { SvUVX(val) = PTR2UV(src); SvIOK_on(val); SvIsUV_on(val); - if (!hv_store(indirect_map, buf, OP2STR(o), val, 0)) SvREFCNT_dec(val); + + ptable_map_store(indirect_map, o, val); } STATIC const char *indirect_map_fetch(pTHX_ const OP *o, SV ** const name) { #define indirect_map_fetch(O, S) indirect_map_fetch(aTHX_ (O), (S)) - OP2STR_BUF; - SV **val; + SV *val; if (indirect_linestr != SvPVX_const(PL_linestr)) return NULL; - val = hv_fetch(indirect_map, buf, OP2STR(o), 0); + val = ptable_fetch(indirect_map, o); if (!val) { *name = NULL; return NULL; } - *name = *val; - return INT2PTR(const char *, SvUVX(*val)); -} - -STATIC void indirect_map_delete(pTHX_ const OP *o) { -#define indirect_map_delete(O) indirect_map_delete(aTHX_ (O)) - OP2STR_BUF; - - (void)hv_delete(indirect_map, buf, OP2STR(o), G_DISCARD); -} - -STATIC void indirect_map_clean_kids(pTHX_ const OP *o) { -#define indirect_map_clean_kids(O) indirect_map_clean_kids(aTHX_ (O)) - if (o->op_flags & OPf_KIDS) { - const OP *kid = ((const UNOP *) o)->op_first; - for (; kid; kid = kid->op_sibling) { - indirect_map_clean_kids(kid); - indirect_map_delete(kid); - } - } -} - -STATIC void indirect_map_clean(pTHX_ const OP *o) { -#define indirect_map_clean(O) indirect_map_clean(aTHX_ (O)) - indirect_map_clean_kids(o); - indirect_map_delete(o); + *name = val; + return INT2PTR(const char *, SvUVX(val)); } STATIC const char *indirect_find(pTHX_ SV *sv, const char *s) { @@ -361,11 +346,9 @@ STATIC OP *indirect_ck_entersub(pTHX_ OP *o) { else warn(indirect_msg, mname, oname); } - -done: - indirect_map_clean(o); } +done: return o; } @@ -381,7 +364,7 @@ BOOT: { if (!indirect_initialized++) { PERL_HASH(indirect_hash, "indirect", 8); - indirect_map = newHV(); + indirect_map = ptable_new(); indirect_old_ck_const = PL_check[OP_CONST]; PL_check[OP_CONST] = MEMBER_TO_FPTR(indirect_ck_const); indirect_old_ck_rv2sv = PL_check[OP_RV2SV]; diff --git a/ptable.h b/ptable.h new file mode 100644 index 0000000..72be11d --- /dev/null +++ b/ptable.h @@ -0,0 +1,221 @@ +/* This file is part of the indirect Perl module. + * See http://search.cpan.org/dist/indirect/ */ + +/* This is a pointer table implementation essentially copied from the ptr_table + * implementation in perl's sv.c, except that it has been modified to use memory + * shared across threads. + * Copyright goes to the original authors, bug reports to me. */ + +/* This header is designed to be included several times with different + * definitions for PTABLE_NAME and PTABLE_VAL_FREE(). */ + +#undef pPTBLMS +#undef pPTBLMS_ +#undef aPTBLMS +#undef aPTBLMS_ + +/* Context for PerlMemShared_* functions */ + +#ifdef PERL_IMPLICIT_SYS +# define pPTBLMS pTHX +# define pPTBLMS_ pTHX_ +# define aPTBLMS aTHX +# define aPTBLMS_ aTHX_ +#else +# define pPTBLMS +# define pPTBLMS_ +# define aPTBLMS +# define aPTBLMS_ +#endif + +#ifndef pPTBL +# define pPTBL pPTBLMS +#endif +#ifndef pPTBL_ +# define pPTBL_ pPTBLMS_ +#endif +#ifndef aPTBL +# define aPTBL aPTBLMS +#endif +#ifndef aPTBL_ +# define aPTBL_ aPTBLMS_ +#endif + +#ifndef PTABLE_NAME +# define PTABLE_NAME ptable +#endif + +#ifndef PTABLE_VAL_FREE +# define PTABLE_VAL_FREE(V) +#endif + +#ifndef PTABLE_JOIN +# define PTABLE_PASTE(A, B) A ## B +# define PTABLE_JOIN(A, B) PTABLE_PASTE(A, B) +#endif + +#ifndef PTABLE_PREFIX +# define PTABLE_PREFIX(X) PTABLE_JOIN(PTABLE_NAME, X) +#endif + +#ifndef ptable_ent +typedef struct ptable_ent { + struct ptable_ent *next; + const void * key; + void * val; +} ptable_ent; +#define ptable_ent ptable_ent +#endif /* !ptable_ent */ + +#ifndef ptable +typedef struct ptable { + ptable_ent **ary; + UV max; + UV items; +} ptable; +#define ptable ptable +#endif /* !ptable */ + +#ifndef ptable_new +STATIC ptable *ptable_new(pPTBLMS) { +#define ptable_new() ptable_new(aPTBLMS) + ptable *t = PerlMemShared_malloc(sizeof *t); + t->max = 127; + t->items = 0; + t->ary = PerlMemShared_calloc(t->max + 1, sizeof *t->ary); + return t; +} +#endif /* !ptable_new */ + +#ifndef PTABLE_HASH +# define PTABLE_HASH(ptr) \ + ((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17))) +#endif + +#ifndef ptable_find +STATIC ptable_ent *ptable_find(const ptable * const t, const void * const key) { +#define ptable_find ptable_find + ptable_ent *ent; + const UV hash = PTABLE_HASH(key); + + ent = t->ary[hash & t->max]; + for (; ent; ent = ent->next) { + if (ent->key == key) + return ent; + } + + return NULL; +} +#endif /* !ptable_find */ + +#ifndef ptable_fetch +STATIC void *ptable_fetch(const ptable * const t, const void * const key) { +#define ptable_fetch ptable_fetch + const ptable_ent *const ent = ptable_find(t, key); + + return ent ? ent->val : NULL; +} +#endif /* !ptable_fetch */ + +#ifndef ptable_split +STATIC void ptable_split(pPTBLMS_ ptable * const t) { +#define ptable_split(T) ptable_split(aPTBLMS_ (T)) + ptable_ent **ary = t->ary; + const UV oldsize = t->max + 1; + UV newsize = oldsize * 2; + UV i; + + ary = PerlMemShared_realloc(ary, newsize * sizeof(*ary)); + Zero(&ary[oldsize], newsize - oldsize, sizeof(*ary)); + t->max = --newsize; + t->ary = ary; + + for (i = 0; i < oldsize; i++, ary++) { + ptable_ent **curentp, **entp, *ent; + if (!*ary) + continue; + curentp = ary + oldsize; + for (entp = ary, ent = *ary; ent; ent = *entp) { + if ((newsize & PTABLE_HASH(ent->key)) != i) { + *entp = ent->next; + ent->next = *curentp; + *curentp = ent; + continue; + } else + entp = &ent->next; + } + } +} +#endif /* !ptable_split */ + +STATIC void PTABLE_PREFIX(_store)(pPTBL_ ptable * const t, const void * const key, void * const val) { + ptable_ent *ent = ptable_find(t, key); + + if (ent) { + void *oldval = ent->val; + PTABLE_VAL_FREE(oldval); + ent->val = val; + } else { + const UV i = PTABLE_HASH(key) & t->max; + ent = PerlMemShared_malloc(sizeof *ent); + ent->key = key; + ent->val = val; + ent->next = t->ary[i]; + t->ary[i] = ent; + t->items++; + if (ent->next && t->items > t->max) + ptable_split(t); + } +} + +#ifndef ptable_walk +STATIC void ptable_walk(pTHX_ ptable * const t, void (*cb)(pTHX_ ptable_ent *ent, void *userdata), void *userdata) { +#define ptable_walk(T, CB, UD) ptable_walk(aTHX_ (T), (CB), (UD)) + if (t && t->items) { + register ptable_ent ** const array = t->ary; + UV i = t->max; + do { + ptable_ent *entry; + for (entry = array[i]; entry; entry = entry->next) + cb(aTHX_ entry, userdata); + } while (i--); + } +} +#endif /* !ptable_walk */ + +STATIC void PTABLE_PREFIX(_clear)(pPTBL_ ptable * const t) { + if (t && t->items) { + register ptable_ent ** const array = t->ary; + UV i = t->max; + + do { + ptable_ent *entry = array[i]; + while (entry) { + ptable_ent * const oentry = entry; + void *val = oentry->val; + entry = entry->next; + PTABLE_VAL_FREE(val); + PerlMemShared_free(oentry); + } + array[i] = NULL; + } while (i--); + + t->items = 0; + } +} + +STATIC void PTABLE_PREFIX(_free)(pPTBL_ ptable * const t) { + if (!t) + return; + PTABLE_PREFIX(_clear)(aPTBL_ t); + PerlMemShared_free(t->ary); + PerlMemShared_free(t); +} + +#undef pPTBL +#undef pPTBL_ +#undef aPTBL +#undef aPTBL_ + +#undef PTABLE_NAME +#undef PTABLE_VAL_FREE