diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | tools/tsdPerf.c | 61 | ||||
| -rw-r--r-- | tools/tsdPerf.tcl | 24 |
3 files changed, 93 insertions, 0 deletions
@@ -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" +} |