* tools/tsdPerf.c A loadable Tcl extension for testing TSD

        performance.
        * tools/tsdPerf.tcl     A simplistic tool that uses the thread
        extension and tsdPerf.so to get some performance metrics by,
        simulating, simple TSD contention.

3 files changed, 93 insertions, 0 deletions

diff --git a/ChangeLog b/ChangeLog
index df677d6..8233bda 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,12 @@
 2008-05-09  George Peter Staplin  <georgeps@xmission.com>
+	* tools/tsdPerf.c 	A loadable Tcl extension for testing TSD
+	performance.
+	* tools/tsdPerf.tcl	A simplistic tool that uses the thread
+	extension and tsdPerf.so to get some performance metrics by,
+	simulating, simple TSD contention.
+
+
+2008-05-09  George Peter Staplin  <georgeps@xmission.com>
 
 	* generic/tcl.h: 	Make Tcl_ThreadDataKey a void *.
 	* generic/tclInt.h:	Change around some function names and
diff --git a/tools/tsdPerf.c b/tools/tsdPerf.c
new file mode 100644
index 0000000..a6a84df
--- /dev/null
+++ b/tools/tsdPerf.c
@@ -0,0 +1,61 @@
+#include <tcl.h>
+
+static Tcl_ThreadDataKey key;
+
+typedef struct {
+    int value;  
+} TsdPerf;
+
+
+int
+tsdPerfSetObjCmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) {
+    TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf));
+    int i;
+
+    if (2 != objc) {
+	Tcl_WrongNumArgs(interp, 1, objv, "value");
+	return TCL_ERROR;
+    }
+
+    if (TCL_OK != Tcl_GetIntFromObj(interp, objv[1], &i)) {
+	return TCL_ERROR;
+    }
+    
+    perf->value = i;
+       
+    return TCL_OK;
+}
+
+int tsdPerfGetObjCmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) {
+    TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf));
+
+    
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(perf->value));
+
+    return TCL_OK;
+}
+
+
+int
+Tsdperf_Init (Tcl_Interp *interp) {
+    if (NULL == Tcl_InitStubs(interp, TCL_VERSION, 0)) {
+	return TCL_ERROR;
+    }
+    
+
+    Tcl_CreateObjCommand(interp, "tsdPerfSet", tsdPerfSetObjCmd, (ClientData)NULL,
+			 (Tcl_CmdDeleteProc *)NULL);
+    Tcl_CreateObjCommand(interp, "tsdPerfGet", tsdPerfGetObjCmd, (ClientData)NULL,
+			 (Tcl_CmdDeleteProc *)NULL);
+
+
+    return TCL_OK;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/tools/tsdPerf.tcl b/tools/tsdPerf.tcl
new file mode 100644
index 0000000..c2d74c9
--- /dev/null
+++ b/tools/tsdPerf.tcl
@@ -0,0 +1,24 @@
+
+package require Thread
+
+set ::tids [list]
+for {set i 0} {$i < 4} {incr i} {
+    lappend ::tids [thread::create [string map [list IVALUE $i] {
+	set curdir [file dirname [info script]]
+	load [file join $curdir tsdPerf.so]
+	
+	while 1 {
+	    tsdPerfSet IVALUE
+	}
+    }]]
+}
+
+puts TIDS:$::tids
+
+set curdir [file dirname [info script]]
+load [file join $curdir tsdPerf.so]
+
+tsdPerfSet 1234
+while 1 {
+    puts "TIME:[time {set value [tsdPerfGet]} 1000] VALUE:$value"
+}