summaryrefslogtreecommitdiffstats
path: root/tools/tsdPerf.c
diff options
context:
space:
mode:
authorgeorgeps <georgeps>2008-05-09 05:07:37 (GMT)
committergeorgeps <georgeps>2008-05-09 05:07:37 (GMT)
commit8c6b0215a7ccebe49708b68c096c93ae84113fb6 (patch)
tree91be3b2c8782dc2cb72fc73b7d113d37aac28884 /tools/tsdPerf.c
parente782414ad0af468115d69e437d0d70c5895287ff (diff)
downloadtcl-8c6b0215a7ccebe49708b68c096c93ae84113fb6.zip
tcl-8c6b0215a7ccebe49708b68c096c93ae84113fb6.tar.gz
tcl-8c6b0215a7ccebe49708b68c096c93ae84113fb6.tar.bz2
* 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.
Diffstat (limited to 'tools/tsdPerf.c')
-rw-r--r--tools/tsdPerf.c61
1 files changed, 61 insertions, 0 deletions
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:
+ */