[svn:ponie] r370 - trunk/perl

Author: nicholas
Date: Thu Dec  8 05:07:12 2005
New Revision: 370

Modified:
   trunk/perl/embed.fnc
   trunk/perl/embed.h
   trunk/perl/global.sym
   trunk/perl/proto.h
   trunk/perl/sv.c
Log:
New public functions ptr_table_inc, ptr_table_dec, ptr_table_val to manipulate
the counts stored in the pointer table union.


Modified: trunk/perl/embed.fnc
==============================================================================
--- trunk/perl/embed.fnc	(original)
+++ trunk/perl/embed.fnc	Thu Dec  8 05:07:12 2005
@@ -957,6 +957,9 @@ Ap	|PTR_TBL_t*|ptr_table_new
 Ap	|void*	|ptr_table_delete|PTR_TBL_t *tbl|void *sv
 Ap	|void*	|ptr_table_fetch|PTR_TBL_t *tbl|void *sv
 Ap	|void	|ptr_table_store|PTR_TBL_t *tbl|void *oldsv|void *newsv
+Ap	|void	|ptr_table_inc|PTR_TBL_t *tbl|void *oldv
+Ap	|void	|ptr_table_dec|PTR_TBL_t *tbl|void *oldv
+Ap	|U32	|ptr_table_val|PTR_TBL_t *tbl|void *sv
 Ap	|void	|ptr_table_split|PTR_TBL_t *tbl
 Ap	|void	|ptr_table_clear|PTR_TBL_t *tbl
 Ap	|void	|ptr_table_free|PTR_TBL_t *tbl

Modified: trunk/perl/embed.h
==============================================================================
--- trunk/perl/embed.h	(original)
+++ trunk/perl/embed.h	Thu Dec  8 05:07:12 2005
@@ -1231,6 +1231,9 @@
 #define ptr_table_delete	Perl_ptr_table_delete
 #define ptr_table_fetch		Perl_ptr_table_fetch
 #define ptr_table_store		Perl_ptr_table_store
+#define ptr_table_inc		Perl_ptr_table_inc
+#define ptr_table_dec		Perl_ptr_table_dec
+#define ptr_table_val		Perl_ptr_table_val
 #define ptr_table_split		Perl_ptr_table_split
 #define ptr_table_clear		Perl_ptr_table_clear
 #define ptr_table_free		Perl_ptr_table_free
@@ -3734,6 +3737,9 @@
 #define ptr_table_delete(a,b)	Perl_ptr_table_delete(aTHX_ a,b)
 #define ptr_table_fetch(a,b)	Perl_ptr_table_fetch(aTHX_ a,b)
 #define ptr_table_store(a,b,c)	Perl_ptr_table_store(aTHX_ a,b,c)
+#define ptr_table_inc(a,b)	Perl_ptr_table_inc(aTHX_ a,b)
+#define ptr_table_dec(a,b)	Perl_ptr_table_dec(aTHX_ a,b)
+#define ptr_table_val(a,b)	Perl_ptr_table_val(aTHX_ a,b)
 #define ptr_table_split(a)	Perl_ptr_table_split(aTHX_ a)
 #define ptr_table_clear(a)	Perl_ptr_table_clear(aTHX_ a)
 #define ptr_table_free(a)	Perl_ptr_table_free(aTHX_ a)

Modified: trunk/perl/global.sym
==============================================================================
--- trunk/perl/global.sym	(original)
+++ trunk/perl/global.sym	Thu Dec  8 05:07:12 2005
@@ -624,6 +624,9 @@ Perl_ptr_table_new
 Perl_ptr_table_delete
 Perl_ptr_table_fetch
 Perl_ptr_table_store
+Perl_ptr_table_inc
+Perl_ptr_table_dec
+Perl_ptr_table_val
 Perl_ptr_table_split
 Perl_ptr_table_clear
 Perl_ptr_table_free

Modified: trunk/perl/proto.h
==============================================================================
--- trunk/perl/proto.h	(original)
+++ trunk/perl/proto.h	Thu Dec  8 05:07:12 2005
@@ -917,6 +917,9 @@ PERL_CALLCONV PTR_TBL_t*	Perl_ptr_table_
 PERL_CALLCONV void*	Perl_ptr_table_delete(pTHX_ PTR_TBL_t *tbl, void *sv);
 PERL_CALLCONV void*	Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, void *sv);
 PERL_CALLCONV void	Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, void *oldsv, void *newsv);
+PERL_CALLCONV void	Perl_ptr_table_inc(pTHX_ PTR_TBL_t *tbl, void *oldv);
+PERL_CALLCONV void	Perl_ptr_table_dec(pTHX_ PTR_TBL_t *tbl, void *oldv);
+PERL_CALLCONV U32	Perl_ptr_table_val(pTHX_ PTR_TBL_t *tbl, void *sv);
 PERL_CALLCONV void	Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl);
 PERL_CALLCONV void	Perl_ptr_table_clear(pTHX_ PTR_TBL_t *tbl);
 PERL_CALLCONV void	Perl_ptr_table_free(pTHX_ PTR_TBL_t *tbl);

Modified: trunk/perl/sv.c
==============================================================================
--- trunk/perl/sv.c	(original)
+++ trunk/perl/sv.c	Thu Dec  8 05:07:12 2005
@@ -9412,7 +9412,6 @@ S_ptr_table_find(pTHX_ PTR_TBL_t *tbl, v
     return tblent;
 }
 
-
 void
 Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, void *oldv, void *newv)
 {
@@ -9421,6 +9420,41 @@ Perl_ptr_table_store(pTHX_ PTR_TBL_t *tb
     entry->val_u.newval = newv;
 }
 
+void
+Perl_ptr_table_inc(pTHX_ PTR_TBL_t *tbl, void *oldv)
+{
+    PTR_TBL_ENT_t *const entry = S_ptr_table_find(aTHX_ tbl, oldv);
+    assert(entry);
+    ++entry->val_u.count;
+}
+
+void
+Perl_ptr_table_dec(pTHX_ PTR_TBL_t *tbl, void *oldv)
+{
+    PTR_TBL_ENT_t *const entry = S_ptr_table_find(aTHX_ tbl, oldv);
+    assert(entry);
+    assert(entry->val_u.count);
+    --entry->val_u.count;
+}
+
+/* FIXME. This is cut and paste.
+   It also implies that ptr_table_fetch and store share code, and in turn
+   that some of their callers in the dup code might benefit from an LVALUE
+   fetch.  */
+U32
+Perl_ptr_table_val(pTHX_ PTR_TBL_t *tbl, void *sv)
+{
+    PTR_TBL_ENT_t *tblent;
+    UV hash = PTR_TABLE_HASH(sv);
+    assert(tbl);
+    tblent = tbl->tbl_ary[hash & tbl->tbl_max];
+    for (; tblent; tblent = tblent->next) {
+	if (tblent->oldval == sv)
+	    return tblent->val_u.count;
+    }
+    return 0;
+}
+
 /* double the hash bucket size of an existing ptr table */
 
 void