summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog22
-rw-r--r--generic/tclBasic.c142
-rw-r--r--generic/tclCompile.h91
-rw-r--r--generic/tclDTrace.d215
-rw-r--r--generic/tclExecute.c32
-rw-r--r--generic/tclInt.h33
-rw-r--r--generic/tclObj.c16
-rw-r--r--generic/tclProc.c54
-rw-r--r--macosx/GNUmakefile4
-rw-r--r--macosx/Tcl-Common.xcconfig4
-rw-r--r--macosx/Tcl.xcodeproj/project.pbxproj6
-rw-r--r--unix/Makefile.in28
-rwxr-xr-xunix/configure232
-rw-r--r--unix/configure.in36
-rw-r--r--unix/tclConfig.h.in3
15 files changed, 883 insertions, 35 deletions
diff --git a/ChangeLog b/ChangeLog
index 6d5f105..ae09d98 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,25 @@
+2007-08-07 Daniel Steffen <das@users.sourceforge.net>
+
+ * generic/tclDTrace.d (new file): add DTrace provider for Tcl; allows
+ * generic/tclCompile.h: tracing of proc and command entry &
+ * generic/tclBasic.c: return, bytecode execution, object
+ * generic/tclExecute.c: allocation and more; with essentially
+ * generic/tclInt.h: zero cost when tracing is inactive;
+ * generic/tclObj.c: enable with --enable-dtrace configure
+ * generic/tclProc.c: arg (disabled by default, will only
+ * unix/Makefile.in: enable if DTrace is present).
+ * unix/configure.in: [Patch 1793984]
+
+ * macosx/GNUmakefile: enable DTrace support.
+ * macosx/Tcl-Common.xcconfig:
+ * macosx/Tcl.xcodeproj/project.pbxproj:
+
+ * generic/tclCmdIL.c: factor our core of InfoFrameCmd() into internal
+ TclInfoFrame() for use by DTrace probes.
+
+ * unix/configure: autoconf-2.59
+ * unix/tclConfig.h.in: autoheader-2.59
+
2007-09-12 Don Porter <dgp@users.sourceforge.net>
* unix/Makefile.in: Perform missing updates of the tcltest Tcl
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 3babbf9..f2490ef 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -9,11 +9,12 @@
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
* Copyright (c) 2001, 2002 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.267 2007/09/05 21:31:01 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.268 2007/09/13 15:27:06 das Exp $
*/
#include "tclInt.h"
@@ -93,6 +94,11 @@ static int ExprWideFunc(ClientData clientData, Tcl_Interp *interp,
static void MathFuncWrongNumArgs(Tcl_Interp* interp, int expected,
int actual, Tcl_Obj *const *objv);
+#ifdef USE_DTRACE
+static int DTraceObjCmd(ClientData dummy, Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+#endif
+
extern TclStubs tclStubs;
/*
@@ -650,6 +656,14 @@ Tcl_CreateInterp(void)
Tcl_CreateObjCommand(interp, "::tcl::Bgerror",
TclDefaultBgErrorHandlerObjCmd, NULL, NULL);
+#ifdef USE_DTRACE
+ /*
+ * Register the tcl::dtrace command.
+ */
+
+ Tcl_CreateObjCommand(interp, "::tcl::dtrace", DTraceObjCmd, NULL, NULL);
+#endif /* USE_DTRACE */
+
/*
* Register the builtin math functions.
*/
@@ -2908,6 +2922,7 @@ CallCommandTraces(
* command. This insures that traces get a correct nul-terminated command
* string.
*
+ *----------------------------------------------------------------------
*/
static Tcl_Obj *
@@ -3559,6 +3574,25 @@ TclEvalObjvInternal(
}
}
+ if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
+ char *a[10];
+ int i = 0;
+
+ while (i < 10) {
+ a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++;
+ }
+ TCL_DTRACE_CMD_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
+ a[8], a[9]);
+ }
+ if (TCL_DTRACE_CMD_INFO_ENABLED() && iPtr->cmdFramePtr) {
+ Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
+ char *a[4]; int i[2];
+
+ TclDTraceInfo(info, a, i);
+ TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1]);
+ TclDecrRefCount(info);
+ }
+
/*
* Finally, invoke the command's Tcl_ObjCmdProc.
*/
@@ -3566,7 +3600,14 @@ TclEvalObjvInternal(
cmdPtr->refCount++;
iPtr->cmdCount++;
if (code == TCL_OK && traceCode == TCL_OK && !TclLimitExceeded(iPtr->limit)) {
+ if (TCL_DTRACE_CMD_ENTRY_ENABLED()) {
+ TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
+ (Tcl_Obj **)(objv + 1));
+ }
code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
+ if (TCL_DTRACE_CMD_RETURN_ENABLED()) {
+ TCL_DTRACE_CMD_RETURN(TclGetString(objv[0]), code);
+ }
}
if (Tcl_AsyncReady()) {
code = Tcl_AsyncInvoke(interp, code);
@@ -3623,6 +3664,13 @@ TclEvalObjvInternal(
(void) Tcl_GetObjResult(interp);
}
+ if (TCL_DTRACE_CMD_RESULT_ENABLED()) {
+ Tcl_Obj *r;
+
+ r = Tcl_GetObjResult(interp);
+ TCL_DTRACE_CMD_RESULT(TclGetString(objv[0]), code, TclGetString(r), r);
+ }
+
done:
if (savedVarFramePtr) {
iPtr->varFramePtr = savedVarFramePtr;
@@ -6362,6 +6410,98 @@ MathFuncWrongNumArgs(
"too %s arguments for math function \"%s\"",
(found < expected ? "few" : "many"), name));
}
+#ifdef USE_DTRACE
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DTraceObjCmd --
+ *
+ * This function is invoked to process the "::tcl::dtrace" Tcl command.
+ *
+ * Results:
+ * A standard Tcl object result.
+ *
+ * Side effects:
+ * The 'tcl-probe' DTrace probe is triggered (if it is enabled).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DTraceObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ if (TCL_DTRACE_TCL_PROBE_ENABLED()) {
+ char *a[10];
+ int i = 0;
+
+ while (i++ < 10) {
+ a[i-1] = i < objc ? TclGetString(objv[i]) : NULL;
+ }
+ TCL_DTRACE_TCL_PROBE(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
+ a[8], a[9]);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDTraceInfo --
+ *
+ * Extract information from a TIP280 dict for use by DTrace probes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclDTraceInfo(
+ Tcl_Obj *info,
+ char **args,
+ int *argsi)
+{
+ static Tcl_Obj *keys[7] = { NULL };
+ Tcl_Obj **k = keys, *val;
+ int i;
+
+ if (!*k) {
+ TclNewLiteralStringObj(keys[0], "cmd");
+ TclNewLiteralStringObj(keys[1], "type");
+ TclNewLiteralStringObj(keys[2], "proc");
+ TclNewLiteralStringObj(keys[3], "file");
+ TclNewLiteralStringObj(keys[4], "lambda");
+ TclNewLiteralStringObj(keys[5], "line");
+ TclNewLiteralStringObj(keys[6], "level");
+ }
+ for (i = 0; i < 4; i++) {
+ Tcl_DictObjGet(NULL, info, *k++, &val);
+ args[i] = val ? TclGetString(val) : NULL;
+ }
+ if (!args[2]) {
+ Tcl_DictObjGet(NULL, info, *k, &val);
+ args[2] = val ? TclGetString(val) : NULL;
+ }
+ k++;
+ for (i = 0; i < 2; i++) {
+ Tcl_DictObjGet(NULL, info, *k++, &val);
+ if (val) {
+ Tcl_GetIntFromObj(NULL, val, &(argsi[i]));
+ } else {
+ argsi[i] = 0;
+ }
+ }
+}
+#endif /* USE_DTRACE */
/*
* Local Variables:
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 50e2312..3db6da9 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -4,11 +4,12 @@
* Copyright (c) 1996-1998 Sun Microsystems, Inc.
* Copyright (c) 1998-2000 by Scriptics Corporation.
* Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompile.h,v 1.78 2007/09/09 16:51:19 dgp Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.79 2007/09/13 15:27:07 das Exp $
*/
#ifndef _TCLCOMPILATION
@@ -1203,6 +1204,94 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
#define TclMin(i, j) ((((int) i) < ((int) j))? (i) : (j))
#define TclMax(i, j) ((((int) i) > ((int) j))? (i) : (j))
+/*
+ * DTrace probe macros (NOPs if DTrace support is not enabled).
+ */
+
+#ifdef USE_DTRACE
+
+#include "tclDTrace.h"
+
+#if defined(__GNUC__ ) && __GNUC__ > 2
+/* Use gcc branch prediction hint to minimize cost of DTrace ENABLED checks. */
+#define unlikely(x) (__builtin_expect((x), 0))
+#else
+#define unlikely(x) (x)
+#endif
+
+#define TCL_DTRACE_PROC_ENTRY_ENABLED() unlikely(TCL_PROC_ENTRY_ENABLED())
+#define TCL_DTRACE_PROC_RETURN_ENABLED() unlikely(TCL_PROC_RETURN_ENABLED())
+#define TCL_DTRACE_PROC_RESULT_ENABLED() unlikely(TCL_PROC_RESULT_ENABLED())
+#define TCL_DTRACE_PROC_ARGS_ENABLED() unlikely(TCL_PROC_ARGS_ENABLED())
+#define TCL_DTRACE_PROC_INFO_ENABLED() unlikely(TCL_PROC_INFO_ENABLED())
+#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) TCL_PROC_ENTRY(a0, a1, a2)
+#define TCL_DTRACE_PROC_RETURN(a0, a1) TCL_PROC_RETURN(a0, a1)
+#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) TCL_PROC_RESULT(a0, a1, a2, a3)
+#define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
+ TCL_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
+#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5) \
+ TCL_PROC_INFO(a0, a1, a2, a3, a4, a5)
+
+#define TCL_DTRACE_CMD_ENTRY_ENABLED() unlikely(TCL_CMD_ENTRY_ENABLED())
+#define TCL_DTRACE_CMD_RETURN_ENABLED() unlikely(TCL_CMD_RETURN_ENABLED())
+#define TCL_DTRACE_CMD_RESULT_ENABLED() unlikely(TCL_CMD_RESULT_ENABLED())
+#define TCL_DTRACE_CMD_ARGS_ENABLED() unlikely(TCL_CMD_ARGS_ENABLED())
+#define TCL_DTRACE_CMD_INFO_ENABLED() unlikely(TCL_CMD_INFO_ENABLED())
+#define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) TCL_CMD_ENTRY(a0, a1, a2)
+#define TCL_DTRACE_CMD_RETURN(a0, a1) TCL_CMD_RETURN(a0, a1)
+#define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) TCL_CMD_RESULT(a0, a1, a2, a3)
+#define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
+ TCL_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
+#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5) \
+ TCL_CMD_INFO(a0, a1, a2, a3, a4, a5)
+
+#define TCL_DTRACE_INST_START_ENABLED() unlikely(TCL_INST_START_ENABLED())
+#define TCL_DTRACE_INST_DONE_ENABLED() unlikely(TCL_INST_DONE_ENABLED())
+#define TCL_DTRACE_INST_START(a0, a1, a2) TCL_INST_START(a0, a1, a2)
+#define TCL_DTRACE_INST_DONE(a0, a1, a2) TCL_INST_DONE(a0, a1, a2)
+
+#define TCL_DTRACE_TCL_PROBE_ENABLED() unlikely(TCL_TCL_PROBE_ENABLED())
+#define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
+ TCL_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
+
+MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi);
+
+#else /* USE_DTRACE */
+
+#define TCL_DTRACE_PROC_ENTRY_ENABLED() 0
+#define TCL_DTRACE_PROC_RETURN_ENABLED() 0
+#define TCL_DTRACE_PROC_RESULT_ENABLED() 0
+#define TCL_DTRACE_PROC_ARGS_ENABLED() 0
+#define TCL_DTRACE_PROC_INFO_ENABLED() 0
+#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) {}
+#define TCL_DTRACE_PROC_RETURN(a0, a1) {}
+#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) {}
+#define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
+#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5) {}
+
+#define TCL_DTRACE_CMD_ENTRY_ENABLED() 0
+#define TCL_DTRACE_CMD_RETURN_ENABLED() 0
+#define TCL_DTRACE_CMD_RESULT_ENABLED() 0
+#define TCL_DTRACE_CMD_ARGS_ENABLED() 0
+#define TCL_DTRACE_CMD_INFO_ENABLED() 0
+#define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) {}
+#define TCL_DTRACE_CMD_RETURN(a0, a1) {}
+#define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) {}
+#define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
+#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5) {}
+
+#define TCL_DTRACE_INST_START_ENABLED() 0
+#define TCL_DTRACE_INST_DONE_ENABLED() 0
+#define TCL_DTRACE_INST_START(a0, a1, a2) {}
+#define TCL_DTRACE_INST_DONE(a0, a1, a2) {}
+
+#define TCL_DTRACE_TCL_PROBE_ENABLED() 0
+#define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
+
+#define TclDTraceInfo(info, args, argsi) {*args = ""; *argsi = 0;}
+
+#endif /* USE_DTRACE */
+
#endif /* _TCLCOMPILATION */
/*
diff --git a/generic/tclDTrace.d b/generic/tclDTrace.d
new file mode 100644
index 0000000..d41be9b
--- /dev/null
+++ b/generic/tclDTrace.d
@@ -0,0 +1,215 @@
+/*
+ * tclDTrace.d --
+ *
+ * Tcl DTrace provider.
+ *
+ * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclDTrace.d,v 1.1 2007/09/13 15:27:07 das Exp $
+ */
+
+typedef struct Tcl_Obj Tcl_Obj;
+
+/*
+ * Tcl DTrace probes
+ */
+
+provider tcl {
+ /***************************** proc probes *****************************/
+ /*
+ * tcl*:::proc-entry probe
+ * triggered immediately before proc bytecode execution
+ * arg0: proc name (string)
+ * arg1: number of arguments (int)
+ * arg2: array of proc argument objects (Tcl_Obj**)
+ */
+ probe proc__entry(char* name, int objc, Tcl_Obj **objv);
+ /*
+ * tcl*:::proc-return probe
+ * triggered immediately after proc bytecode execution
+ * arg0: proc name (string)
+ * arg1: return code (int)
+ */
+ probe proc__return(char* name, int code);
+ /*
+ * tcl*:::proc-result probe
+ * triggered after proc-return probe and result processing
+ * arg0: proc name (string)
+ * arg1: return code (int)
+ * arg2: proc result (string)
+ * arg3: proc result object (Tcl_Obj*)
+ */
+ probe proc__result(char* name, int code, char* result, Tcl_Obj *resultobj);
+ /*
+ * tcl*:::proc-args probe
+ * triggered before proc-entry probe, gives access to string
+ * representation of proc arguments
+ * arg0: proc name (string)
+ * arg1-arg9: proc arguments or NULL (strings)
+ */
+ probe proc__args(char* name, char* arg1, char* arg2, char* arg3,
+ char* arg4, char* arg5, char* arg6, char* arg7, char* arg8,
+ char* arg9);
+ /*
+ * tcl*:::proc-info probe
+ * triggered before proc-entry probe, gives access to TIP 280
+ * information for the proc invocation (i.e. [info frame 0])
+ * arg0: TIP 280 cmd (string)
+ * arg1: TIP 280 type (string)
+ * arg2: TIP 280 proc (string)
+ * arg3: TIP 280 file (string)
+ * arg4: TIP 280 line (int)
+ * arg5: TIP 280 level (int)
+ */
+ probe proc__info(char* cmd, char* type, char* proc, char* file, int line,
+ int level);
+
+ /***************************** cmd probes ******************************/
+ /*
+ * tcl*:::cmd-entry probe
+ * triggered immediately before commmand execution
+ * arg0: command name (string)
+ * arg1: number of arguments (int)
+ * arg2: array of command argument objects (Tcl_Obj**)
+ */
+ probe cmd__entry(char* name, int objc, Tcl_Obj **objv);
+ /*
+ * tcl*:::cmd-return probe
+ * triggered immediately after commmand execution
+ * arg0: command name (string)
+ * arg1: return code (int)
+ */
+ probe cmd__return(char* name, int code);
+ /*
+ * tcl*:::cmd-result probe
+ * triggered after cmd-return probe and result processing
+ * arg0: command name (string)
+ * arg1: return code (int)
+ * arg2: command result (string)
+ * arg3: command result object (Tcl_Obj*)
+ */
+ probe cmd__result(char* name, int code, char* result, Tcl_Obj *resultobj);
+ /*
+ * tcl*:::cmd-args probe
+ * triggered before cmd-entry probe, gives access to string
+ * representation of command arguments
+ * arg0: command name (string)
+ * arg1-arg9: command arguments or NULL (strings)
+ */
+ probe cmd__args(char* name, char* arg1, char* arg2, char* arg3,
+ char* arg4, char* arg5, char* arg6, char* arg7, char* arg8,
+ char* arg9);
+ /*
+ * tcl*:::cmd-info probe
+ * triggered before cmd-entry probe, gives access to TIP 280
+ * information for the command invocation (i.e. [info frame 0])
+ * arg0: TIP 280 cmd (string)
+ * arg1: TIP 280 type (string)
+ * arg2: TIP 280 proc (string)
+ * arg3: TIP 280 file (string)
+ * arg4: TIP 280 line (int)
+ * arg5: TIP 280 level (int)
+ */
+ probe cmd__info(char* cmd, char* type, char* proc, char* file, int line,
+ int level);
+
+ /***************************** inst probes *****************************/
+ /*
+ * tcl*:::inst-start probe
+ * triggered immediately before execution of a bytecode
+ * arg0: bytecode name (string)
+ * arg1: depth of stack (int)
+ * arg2: top of stack (Tcl_Obj**)
+ */
+ probe inst__start(char* name, int depth, Tcl_Obj **stack);
+ /*
+ * tcl*:::inst-done probe
+ * triggered immediately after execution of a bytecode
+ * arg0: bytecode name (string)
+ * arg1: depth of stack (int)
+ * arg2: top of stack (Tcl_Obj**)
+ */
+ probe inst__done(char* name, int depth, Tcl_Obj **stack);
+
+ /***************************** obj probes ******************************/
+ /*
+ * tcl*:::obj-create probe
+ * triggered immediately after a new Tcl_Obj has been created
+ * arg0: object created (Tcl_Obj*)
+ */
+ probe obj__create(Tcl_Obj* obj);
+ /*
+ * tcl*:::obj-free probe
+ * triggered immediately before a Tcl_Obj is freed
+ * arg0: object to be freed (Tcl_Obj*)
+ */
+ probe obj__free(Tcl_Obj* obj);
+
+ /***************************** tcl probes ******************************/
+ /*
+ * tcl*:::tcl-probe probe
+ * triggered when the ::tcl::dtrace command is called
+ * arg0-arg9: command arguments (strings)
+ */
+ probe tcl__probe(char* arg0, char* arg1, char* arg2, char* arg3,
+ char* arg4, char* arg5, char* arg6, char* arg7, char* arg8,
+ char* arg9);
+};
+
+/*
+ * Tcl types and constants for use in DTrace scripts
+ */
+
+typedef struct Tcl_ObjType {
+ char *name;
+ void *freeIntRepProc;
+ void *dupIntRepProc;
+ void *updateStringProc;
+ void *setFromAnyProc;
+} Tcl_ObjType;
+
+struct Tcl_Obj {
+ int refCount;
+ char *bytes;
+ int length;
+ Tcl_ObjType *typePtr;
+ union {
+ long longValue;
+ double doubleValue;
+ void *otherValuePtr;
+ int64_t wideValue;
+ struct {
+ void *ptr1;
+ void *ptr2;
+ } twoPtrValue;
+ struct {
+ void *ptr;
+ unsigned long value;
+ } ptrAndLongRep;
+ } internalRep;
+};
+
+enum return_codes {
+ TCL_OK = 0,
+ TCL_ERROR,
+ TCL_RETURN,
+ TCL_BREAK,
+ TCL_CONTINUE
+};
+
+#pragma D attributes Evolving/Evolving/Common provider tcl provider
+#pragma D attributes Private/Private/Common provider tcl module
+#pragma D attributes Private/Private/Common provider tcl function
+#pragma D attributes Evolving/Evolving/Common provider tcl name
+#pragma D attributes Evolving/Evolving/Common provider tcl args
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index d2bec9b..584c747 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -8,11 +8,12 @@
* Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
* Copyright (c) 2002-2005 by Miguel Sofer.
* Copyright (c) 2005-2007 by Donal K. Fellows.
+ * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.335 2007/09/11 14:47:43 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.336 2007/09/13 15:27:07 das Exp $
*/
#include "tclInt.h"
@@ -318,6 +319,28 @@ VarHashCreateVar(TclVarHashTable *tablePtr, Tcl_Obj *key, int *newPtr)
#endif /* TCL_COMPILE_DEBUG */
/*
+ * DTrace instruction probe macros.
+ */
+
+#define TCL_DTRACE_INST_NEXT() \
+ if (TCL_DTRACE_INST_DONE_ENABLED()) {\
+ if (curInstName) {\
+ TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH, tosPtr);\
+ }\
+ curInstName = tclInstructionTable[*pc].name;\
+ if (TCL_DTRACE_INST_START_ENABLED()) {\
+ TCL_DTRACE_INST_START(curInstName, (int) CURR_DEPTH, tosPtr);\
+ }\
+ } else if (TCL_DTRACE_INST_START_ENABLED()) {\
+ TCL_DTRACE_INST_START(tclInstructionTable[*pc].name, (int) CURR_DEPTH,\
+ tosPtr);\
+ }
+#define TCL_DTRACE_INST_LAST() \
+ if (TCL_DTRACE_INST_DONE_ENABLED() && curInstName) {\
+ TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH, tosPtr);\
+ }
+
+/*
* Macro used in this file to save a function call for common uses of
* TclGetNumberFromObj(). The ANSI C "prototype" is:
*
@@ -1555,6 +1578,7 @@ TclExecuteByteCode(
int traceInstructions = (tclTraceExec == 3);
char cmdNameBuf[21];
#endif
+ char *curInstName = NULL;
/*
* The execution uses a unified stack: first the catch stack, immediately
@@ -1693,6 +1717,8 @@ TclExecuteByteCode(
iPtr->stats.instructionCount[*pc]++;
#endif
+ TCL_DTRACE_INST_NEXT();
+
/*
* Check for asynchronous handlers [Bug 746722]; we do the check every
* ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-1).
@@ -1818,6 +1844,7 @@ TclExecuteByteCode(
*/
if (*pc == INST_PUSH1) {
+ TCL_DTRACE_INST_NEXT();
goto instPush1Peephole;
}
#endif
@@ -1844,6 +1871,7 @@ TclExecuteByteCode(
pc++;
#if !TCL_COMPILE_DEBUG
if (*pc == INST_START_CMD) {
+ TCL_DTRACE_INST_NEXT();
goto instStartCmdPeephole;
}
#endif
@@ -6095,6 +6123,7 @@ TclExecuteByteCode(
*/
pc += 5;
+ TCL_DTRACE_INST_NEXT();
#else
NEXT_INST_F(5, 0, 0);
#endif
@@ -7008,6 +7037,7 @@ TclExecuteByteCode(
abnormalReturn:
{
+ TCL_DTRACE_INST_LAST();
while (tosPtr > initTosPtr) {
Tcl_Obj *objPtr = POP_OBJECT();
Tcl_DecrRefCount(objPtr);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 6636f1e..9ba2331 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -8,11 +8,12 @@
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
* Copyright (c) 2001, 2002 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.334 2007/09/09 19:28:31 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.335 2007/09/13 15:27:08 das Exp $
*/
#ifndef _TCLINT
@@ -2396,6 +2397,7 @@ MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr,
Tcl_Obj *incrPtr);
MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags);
+MODULE_SCOPE Tcl_Obj * TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr);
MODULE_SCOPE int TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp,
@@ -3067,6 +3069,19 @@ MODULE_SCOPE int TclObjCallVarTraces(Interp *iPtr, Var *arrayPtr,
*----------------------------------------------------------------
*/
+/*
+ * DTrace object allocation probe macros.
+ */
+
+#ifdef USE_DTRACE
+#include "tclDTrace.h"
+#define TCL_DTRACE_OBJ_CREATE(objPtr) TCL_OBJ_CREATE(objPtr)
+#define TCL_DTRACE_OBJ_FREE(objPtr) TCL_OBJ_FREE(objPtr)
+#else /* USE_DTRACE */
+#define TCL_DTRACE_OBJ_CREATE(objPtr) {}
+#define TCL_DTRACE_OBJ_FREE(objPtr) {}
+#endif /* USE_DTRACE */
+
#ifdef TCL_COMPILE_STATS
# define TclIncrObjsAllocated() \
tclObjsAlloced++
@@ -3084,7 +3099,8 @@ MODULE_SCOPE int TclObjCallVarTraces(Interp *iPtr, Var *arrayPtr,
(objPtr)->refCount = 0; \
(objPtr)->bytes = tclEmptyStringRep; \
(objPtr)->length = 0; \
- (objPtr)->typePtr = NULL
+ (objPtr)->typePtr = NULL; \
+ TCL_DTRACE_OBJ_CREATE(objPtr)
/*
* Invalidate the string rep first so we can use the bytes value for our
@@ -3096,6 +3112,7 @@ MODULE_SCOPE int TclObjCallVarTraces(Interp *iPtr, Var *arrayPtr,
# define TclDecrRefCount(objPtr) \
if (--(objPtr)->refCount > 0) ; else { \
if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \
+ TCL_DTRACE_OBJ_FREE(objPtr); \
if ((objPtr)->bytes \
&& ((objPtr)->bytes != tclEmptyStringRep)) { \
ckfree((char *) (objPtr)->bytes); \
@@ -3176,7 +3193,8 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr);
# define TclDbNewObj(objPtr, file, line) \
TclIncrObjsAllocated(); \
(objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
- TclDbInitNewObj(objPtr);
+ TclDbInitNewObj(objPtr); \
+ TCL_DTRACE_OBJ_CREATE(objPtr)
# define TclNewObj(objPtr) \
TclDbNewObj(objPtr, __FILE__, __LINE__);
@@ -3423,7 +3441,8 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum,
(objPtr)->refCount = 0; \
(objPtr)->bytes = NULL; \
(objPtr)->internalRep.longValue = (long)(i); \
- (objPtr)->typePtr = &tclIntType
+ (objPtr)->typePtr = &tclIntType; \
+ TCL_DTRACE_OBJ_CREATE(objPtr)
#define TclNewLongObj(objPtr, l) \
TclNewIntObj((objPtr), (l))
@@ -3441,14 +3460,16 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum,
(objPtr)->refCount = 0; \
(objPtr)->bytes = NULL; \
(objPtr)->internalRep.doubleValue = (double)(d); \
- (objPtr)->typePtr = &tclDoubleType
+ (objPtr)->typePtr = &tclDoubleType; \
+ TCL_DTRACE_OBJ_CREATE(objPtr)
#define TclNewStringObj(objPtr, s, len) \
TclIncrObjsAllocated(); \
TclAllocObjStorage(objPtr); \
(objPtr)->refCount = 0; \
TclInitStringRep((objPtr), (s), (len));\
- (objPtr)->typePtr = NULL
+ (objPtr)->typePtr = NULL; \
+ TCL_DTRACE_OBJ_CREATE(objPtr)
#else /* TCL_MEM_DEBUG */
#define TclNewIntObj(objPtr, i) \
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 574947b..ee9807d 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -8,11 +8,12 @@
* Copyright (c) 1999 by Scriptics Corporation.
* Copyright (c) 2001 by ActiveState Corporation.
* Copyright (c) 2005 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclObj.c,v 1.134 2007/09/09 19:28:31 dgp Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.135 2007/09/13 15:27:08 das Exp $
*/
#include "tclInt.h"
@@ -857,6 +858,7 @@ TclFreeObj(
if (ObjDeletePending(context)) {
PushObjToDelete(context, objPtr);
} else {
+ TCL_DTRACE_OBJ_FREE(objPtr);
if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
ObjDeletionLock(context);
typePtr->freeIntRepProc(objPtr);
@@ -866,22 +868,19 @@ TclFreeObj(
Tcl_MutexLock(&tclObjMutex);
ckfree((char *) objPtr);
Tcl_MutexUnlock(&tclObjMutex);
-#ifdef TCL_COMPILE_STATS
- tclObjsFreed++;
-#endif /* TCL_COMPILE_STATS */
+ TclIncrObjsFreed();
ObjDeletionLock(context);
while (ObjOnStack(context)) {
Tcl_Obj *objToFree;
PopObjToDelete(context,objToFree);
+ TCL_DTRACE_OBJ_FREE(objToFree);
TclFreeIntRep(objToFree);
Tcl_MutexLock(&tclObjMutex);
ckfree((char *) objToFree);
Tcl_MutexUnlock(&tclObjMutex);
-#ifdef TCL_COMPILE_STATS
- tclObjsFreed++;
-#endif /* TCL_COMPILE_STATS */
+ TclIncrObjsFreed();
}
ObjDeletionUnlock(context);
}
@@ -905,6 +904,7 @@ TclFreeObj(
* other objects: it will not cause recursive calls to this function.
*/
+ TCL_DTRACE_OBJ_FREE(objPtr);
TclFreeObjStorage(objPtr);
TclIncrObjsFreed();
} else {
@@ -927,6 +927,7 @@ TclFreeObj(
* satisfy this.
*/
+ TCL_DTRACE_OBJ_FREE(objPtr);
ObjDeletionLock(context);
objPtr->typePtr->freeIntRepProc(objPtr);
ObjDeletionUnlock(context);
@@ -937,6 +938,7 @@ TclFreeObj(
while (ObjOnStack(context)) {
Tcl_Obj *objToFree;
PopObjToDelete(context,objToFree);
+ TCL_DTRACE_OBJ_FREE(objToFree);
if ((objToFree->typePtr != NULL)
&& (objToFree->typePtr->freeIntRepProc != NULL)) {
objToFree->typePtr->freeIntRepProc(objToFree);
diff --git a/generic/tclProc.c b/generic/tclProc.c
index cd85e73..7008187 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -7,11 +7,12 @@
* Copyright (c) 1987-1993 The Regents of the University of California.
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
* Copyright (c) 2004-2006 Miguel Sofer
+ * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclProc.c,v 1.133 2007/09/09 19:28:31 dgp Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.134 2007/09/13 15:27:08 das Exp $
*/
#include "tclInt.h"
@@ -1645,7 +1646,8 @@ TclObjInterpProcCore(
ProcErrorProc errorProc) /* How to convert results from the script into
* results of the overall procedure. */
{
- register Proc *procPtr = ((Interp *)interp)->varFramePtr->procPtr;
+ Interp *iPtr = (Interp *) interp;
+ register Proc *procPtr = iPtr->varFramePtr->procPtr;
int result;
CallFrame *freePtr;
@@ -1656,7 +1658,7 @@ TclObjInterpProcCore(
#if defined(TCL_COMPILE_DEBUG)
if (tclTraceExec >= 1) {
- register CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
+ register CallFrame *framePtr = iPtr->varFramePtr;
register int i;
if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
@@ -1673,12 +1675,33 @@ TclObjInterpProcCore(
}
#endif /*TCL_COMPILE_DEBUG*/
+ if (TCL_DTRACE_PROC_ARGS_ENABLED()) {
+ char *a[10];
+ int i = 0;
+ int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
+
+ while (i < 10) {
+ a[i] = (l < iPtr->varFramePtr->objc ?
+ TclGetString(iPtr->varFramePtr->objv[l]) : NULL); i++; l++;
+ }
+ TCL_DTRACE_PROC_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
+ a[8], a[9]);
+ }
+ if (TCL_DTRACE_PROC_INFO_ENABLED() && iPtr->cmdFramePtr) {
+ Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
+ char *a[4]; int i[2];
+
+ TclDTraceInfo(info, a, i);
+ TCL_DTRACE_PROC_INFO(a[0], a[1], a[2], a[3], i[0], i[1]);
+ TclDecrRefCount(info);
+ }
+
/*
* Invoke the commands in the procedure's body.
*/
procPtr->refCount++;
- ((Interp *)interp)->numLevels++;
+ iPtr->numLevels++;
if (TclInterpReady(interp) == TCL_ERROR) {
result = TCL_ERROR;
@@ -1687,14 +1710,25 @@ TclObjInterpProcCore(
procPtr->bodyPtr->internalRep.otherValuePtr;
codePtr->refCount++;
+ if (TCL_DTRACE_PROC_ENTRY_ENABLED()) {
+ int l;
+
+ l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 2 : 1;
+ TCL_DTRACE_PROC_ENTRY(TclGetString(procNameObj),
+ iPtr->varFramePtr->objc - l,
+ (Tcl_Obj **)(iPtr->varFramePtr->objv + l));
+ }
result = TclExecuteByteCode(interp, codePtr);
+ if (TCL_DTRACE_PROC_RETURN_ENABLED()) {
+ TCL_DTRACE_PROC_RETURN(TclGetString(procNameObj), result);
+ }
codePtr->refCount--;
if (codePtr->refCount <= 0) {
TclCleanupByteCode(codePtr);
}
}
- ((Interp *)interp)->numLevels--;
+ iPtr->numLevels--;
procPtr->refCount--;
if (procPtr->refCount <= 0) {
TclProcCleanupProc(procPtr);
@@ -1754,6 +1788,14 @@ TclObjInterpProcCore(
(void) 0; /* do nothing */
}
+ if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
+ Tcl_Obj *r;
+
+ r = Tcl_GetObjResult(interp);
+ TCL_DTRACE_PROC_RESULT(TclGetString(procNameObj), result,
+ TclGetString(r), r);
+ }
+
procDone:
/*
* Free the stack-allocated compiled locals and CallFrame. It is important
@@ -1763,7 +1805,7 @@ TclObjInterpProcCore(
* allocated later on the stack.
*/
- freePtr = ((Interp *)interp)->framePtr;
+ freePtr = iPtr->framePtr;
Tcl_PopCallFrame(interp); /* Pop but do not free. */
TclStackFree(interp, freePtr->compiledLocals);
/* Free compiledLocals. */
diff --git a/macosx/GNUmakefile b/macosx/GNUmakefile
index d4ebe69..d7243cd 100644
--- a/macosx/GNUmakefile
+++ b/macosx/GNUmakefile
@@ -9,7 +9,7 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: GNUmakefile,v 1.6 2007/09/06 05:02:12 das Exp $
+# RCS: @(#) $Id: GNUmakefile,v 1.7 2007/09/13 15:27:09 das Exp $
#
########################################################################################################
@@ -131,7 +131,7 @@ ${OBJ_DIR}/Makefile: ${UNIX_DIR}/Makefile.in ${UNIX_DIR}/configure \
mkdir -p ${OBJ_DIR} && cd ${OBJ_DIR} && \
if [ ${UNIX_DIR}/configure -nt config.status ]; then ${UNIX_DIR}/configure -C \
--prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} \
- --mandir=${MANDIR} --enable-threads --enable-framework \
+ --mandir=${MANDIR} --enable-threads --enable-framework --enable-dtrace \
${CONFIGURE_ARGS} ${EXTRA_CONFIGURE_ARGS}; else ./config.status; fi
build-${PROJECT}: ${OBJ_DIR}/Makefile
diff --git a/macosx/Tcl-Common.xcconfig b/macosx/Tcl-Common.xcconfig
index 0758cf0..74fe411 100644
--- a/macosx/Tcl-Common.xcconfig
+++ b/macosx/Tcl-Common.xcconfig
@@ -9,7 +9,7 @@
// See the file "license.terms" for information on usage and redistribution
// of this file, and for a DISCLAIMER OF ALL WARRANTIES.
//
-// RCS: @(#) $Id: Tcl-Common.xcconfig,v 1.6 2007/09/06 08:07:18 das Exp $
+// RCS: @(#) $Id: Tcl-Common.xcconfig,v 1.7 2007/09/13 15:27:09 das Exp $
//
HEADER_SEARCH_PATHS = $(DERIVED_FILE_DIR)/tcl $(HEADER_SEARCH_PATHS)
@@ -34,7 +34,7 @@ MANDIR = $(PREFIX)/man
PER_ARCH_CFLAGS_ppc = -mcpu=G3 -mtune=G4 $(PER_ARCH_CFLAGS_ppc)
PER_ARCH_CFLAGS_ppc64 = -mcpu=G5 -mpowerpc64 $(PER_ARCH_CFLAGS_ppc64)
PREFIX = /usr/local
-TCL_CONFIGURE_ARGS = --enable-threads
+TCL_CONFIGURE_ARGS = --enable-threads --enable-dtrace
TCL_LIBRARY = $(LIBDIR)/tcl$(VERSION)
TCL_PACKAGE_PATH = "$(LIBDIR)"
TCL_DEFS = HAVE_TCL_CONFIG_H
diff --git a/macosx/Tcl.xcodeproj/project.pbxproj b/macosx/Tcl.xcodeproj/project.pbxproj
index 1d011de..2608461 100644
--- a/macosx/Tcl.xcodeproj/project.pbxproj
+++ b/macosx/Tcl.xcodeproj/project.pbxproj
@@ -160,6 +160,7 @@
F9E61D30090A48E2002B3151 /* bn_mp_to_unsigned_bin_n.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */; };
F9E61D31090A48F9002B3151 /* bn_mp_to_unsigned_bin.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */; };
F9E61D32090A48FA002B3151 /* bn_mp_unsigned_bin_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */; };
+ F9F4415E0C8BAE6F00BCCD67 /* tclDTrace.d in Sources */ = {isa = PBXBuildFile; fileRef = F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */; };
F9FC77B80AB29E9100B7077D /* tclUnixCompat.c in Sources */ = {isa = PBXBuildFile; fileRef = F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */; };
/* End PBXBuildFile section */
@@ -908,6 +909,7 @@
F9ECB1CB0B26534C00A28025 /* mathop.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = mathop.test; sourceTree = "<group>"; };
F9ECB1E10B26543C00A28025 /* platform_shell.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = platform_shell.n; sourceTree = "<group>"; };
F9ECB1E20B26543C00A28025 /* platform.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = platform.n; sourceTree = "<group>"; };
+ F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.dtrace; path = tclDTrace.d; sourceTree = "<group>"; };
F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixCompat.c; sourceTree = "<group>"; };
/* End PBXFileReference section */
@@ -930,7 +932,7 @@
F966C06F08F281DC005CB29B /* Frameworks */,
1AB674ADFE9D54B511CA2CBB /* Products */,
);
- comments = "Copyright (c) 2004-2007 Daniel A. Steffen <das@users.sourceforge.net>\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n\nRCS: @(#) $Id: project.pbxproj,v 1.26 2007/09/06 08:07:18 das Exp $\n";
+ comments = "Copyright (c) 2004-2007 Daniel A. Steffen <das@users.sourceforge.net>\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n\nRCS: @(#) $Id: project.pbxproj,v 1.27 2007/09/13 15:27:09 das Exp $\n";
name = Tcl;
path = .;
sourceTree = SOURCE_ROOT;
@@ -1225,6 +1227,7 @@
F96D3EEA08F272A7004A47F5 /* tclDate.c */,
F96D3EEB08F272A7004A47F5 /* tclDecls.h */,
F96D3EEC08F272A7004A47F5 /* tclDictObj.c */,
+ F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */,
F96D3EED08F272A7004A47F5 /* tclEncoding.c */,
F96D3EEE08F272A7004A47F5 /* tclEnv.c */,
F96D3EEF08F272A7004A47F5 /* tclEvent.c */,
@@ -2144,6 +2147,7 @@
F96D4AD308F272CA004A47F5 /* tclUnixTest.c in Sources */,
F96D4AD408F272CA004A47F5 /* tclUnixThrd.c in Sources */,
F96D4AD608F272CA004A47F5 /* tclUnixTime.c in Sources */,
+ F9F4415E0C8BAE6F00BCCD67 /* tclDTrace.d in Sources */,
);
runOnlyForDeploymentPostprocessing = 0;
};
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 7c9110b..69542c3 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -4,7 +4,7 @@
# "./configure", which is a configuration script generated by the "autoconf"
# program (constructs like "@foo@" will get replaced in the actual Makefile.
#
-# RCS: @(#) $Id: Makefile.in,v 1.219 2007/09/12 16:43:36 dgp Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.220 2007/09/13 15:27:09 das Exp $
VERSION = @TCL_VERSION@
MAJOR_VERSION = @TCL_MAJOR_VERSION@
@@ -216,6 +216,7 @@ COMPAT_OBJS = @LIBOBJS@
AC_FLAGS = @DEFS@
AR = @AR@
RANLIB = @RANLIB@
+DTRACE = @DTRACE@
SRC_DIR = @srcdir@
TOP_DIR = $(SRC_DIR)/..
BUILD_DIR = @builddir@
@@ -324,8 +325,12 @@ NOTIFY_OBJS = tclUnixNotfy.o
MAC_OSX_OBJS = tclMacOSXBundle.o tclMacOSXFCmd.o tclMacOSXNotify.o
-OBJS = ${GENERIC_OBJS} ${TOMMATH_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} \
- ${COMPAT_OBJS} @DL_OBJS@ @PLAT_OBJS@
+DTRACE_OBJ = tclDTrace.o
+
+TCL_OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} \
+ @DL_OBJS@ @PLAT_OBJS@
+
+OBJS = ${TCL_OBJS} ${TOMMATH_OBJS} @DTRACE_OBJ@
TCL_DECLS = \
$(GENERIC_DIR)/tcl.decls \
@@ -520,6 +525,10 @@ MAC_OSX_SRCS = \
$(MAC_OSX_DIR)/tclMacOSXFCmd.c \
$(MAC_OSX_DIR)/tclMacOSXNotify.c
+DTRACE_HDR = tclDTrace.h
+
+DTRACE_SRC = $(GENERIC_DIR)/tclDTrace.d
+
# Note: don't include DL_SRCS or MAC_OSX_SRCS in SRCS: most of those files
# won't compile on the current machine, and they will cause problems for
# things like "make depend".
@@ -763,7 +772,8 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs
$(INSTALL_DATA) $$i $(INCLUDE_INSTALL_DIR); \
done;
@echo "Installing library files to $(SCRIPT_INSTALL_DIR)";
- @for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex $(UNIX_DIR)/tclAppInit.c $(UNIX_DIR)/ldAix; \
+ @for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex \
+ $(UNIX_DIR)/tclAppInit.c $(UNIX_DIR)/ldAix @DTRACE_SRC@; \
do \
$(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
done;
@@ -1437,6 +1447,16 @@ tclMacOSXFCmd.o: $(MAC_OSX_DIR)/tclMacOSXFCmd.c
tclMacOSXNotify.o: $(MAC_OSX_DIR)/tclMacOSXNotify.c
$(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXNotify.c
+# DTrace support
+
+$(TCL_OBJS): @DTRACE_HDR@
+
+$(DTRACE_HDR): $(DTRACE_SRC)
+ $(DTRACE) -h $(DTRACE_SWITCHES) -o $@ -s $(DTRACE_SRC)
+
+$(DTRACE_OBJ): $(DTRACE_SRC) $(TCL_OBJS)
+ $(DTRACE) -G $(DTRACE_SWITCHES) -o $@ -s $(DTRACE_SRC) $(TCL_OBJS)
+
# The following targets are not completely general. They are provide purely
# for documentation purposes so people who are interested in the Xt based
# notifier can modify them to suit their own installation.
diff --git a/unix/configure b/unix/configure
index 2225436..59e1d3e 100755
--- a/unix/configure
+++ b/unix/configure
@@ -308,7 +308,7 @@ ac_includes_default="\
# include <unistd.h>
#endif"
-ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS RANLIB ac_ct_RANLIB AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT INSTALL_TZDATA TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_YEAR TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_SRC_DIR CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX TCL_SHARED_BUILD LD_LIBRARY_PATH_VAR TCL_BUILD_LIB_SPEC TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_SHARED_LIB_SUFFIX TCL_UNSHARED_LIB_SUFFIX TCL_HAS_LONGLONG BUILD_DLTEST TCL_PACKAGE_PATH TCL_MODULE_PATH TCL_LIBRARY PRIVATE_INCLUDE_DIR HTML_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_TCLSH_LIBS DLTEST_LD DLTEST_SUFFIX'
+ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS RANLIB ac_ct_RANLIB AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT DTRACE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_YEAR TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_SRC_DIR CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX TCL_SHARED_BUILD LD_LIBRARY_PATH_VAR TCL_BUILD_LIB_SPEC TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_SHARED_LIB_SUFFIX TCL_UNSHARED_LIB_SUFFIX TCL_HAS_LONGLONG INSTALL_TZDATA DTRACE_SRC DTRACE_HDR DTRACE_OBJ BUILD_DLTEST TCL_PACKAGE_PATH TCL_MODULE_PATH TCL_LIBRARY PRIVATE_INCLUDE_DIR HTML_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_TCLSH_LIBS DLTEST_LD DLTEST_SUFFIX'
ac_subst_files=''
# Initialize some variables set by options.
@@ -859,6 +859,7 @@ Optional Features:
--enable-langinfo use nl_langinfo if possible to determine encoding at
startup, otherwise use old heuristic (default: on)
--enable-dll-unloading enable the 'unload' command (default: on)
+ --enable-dtrace build with DTrace support (default: off)
--enable-framework package shared libraries in MacOSX frameworks
(default: off)
@@ -17623,6 +17624,7 @@ echo "${ECHO_T}$tcl_ok" >&6
# to be installed by Tcl. The default is autodetection, but can
# be overriden on the configure command line either way.
#------------------------------------------------------------------------
+
echo "$as_me:$LINENO: checking for timezone data" >&5
echo $ECHO_N "checking for timezone data... $ECHO_C" >&6
@@ -17683,6 +17685,222 @@ echo "${ECHO_T}supplied by Tcl" >&6
INSTALL_TZDATA=install-tzdata
fi
+#--------------------------------------------------------------------
+# DTrace support
+#--------------------------------------------------------------------
+
+# Check whether --enable-dtrace or --disable-dtrace was given.
+if test "${enable_dtrace+set}" = set; then
+ enableval="$enable_dtrace"
+ tcl_ok=$enableval
+else
+ tcl_ok=no
+fi;
+if test $tcl_ok = yes; then
+ if test "${ac_cv_header_sys_sdt_h+set}" = set; then
+ echo "$as_me:$LINENO: checking for sys/sdt.h" >&5
+echo $ECHO_N "checking for sys/sdt.h... $ECHO_C" >&6
+if test "${ac_cv_header_sys_sdt_h+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+fi
+echo "$as_me:$LINENO: result: $ac_cv_header_sys_sdt_h" >&5
+echo "${ECHO_T}$ac_cv_header_sys_sdt_h" >&6
+else
+ # Is the header compilable?
+echo "$as_me:$LINENO: checking sys/sdt.h usability" >&5
+echo $ECHO_N "checking sys/sdt.h usability... $ECHO_C" >&6
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_includes_default
+#include <sys/sdt.h>
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_header_compiler=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_header_compiler=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
+echo "${ECHO_T}$ac_header_compiler" >&6
+
+# Is the header present?
+echo "$as_me:$LINENO: checking sys/sdt.h presence" >&5
+echo $ECHO_N "checking sys/sdt.h presence... $ECHO_C" >&6
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <sys/sdt.h>
+_ACEOF
+if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
+ (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } >/dev/null; then
+ if test -s conftest.err; then
+ ac_cpp_err=$ac_c_preproc_warn_flag
+ ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
+ else
+ ac_cpp_err=
+ fi
+else
+ ac_cpp_err=yes
+fi
+if test -z "$ac_cpp_err"; then
+ ac_header_preproc=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ ac_header_preproc=no
+fi
+rm -f conftest.err conftest.$ac_ext
+echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
+echo "${ECHO_T}$ac_header_preproc" >&6
+
+# So? What about this header?
+case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
+ yes:no: )
+ { echo "$as_me:$LINENO: WARNING: sys/sdt.h: accepted by the compiler, rejected by the preprocessor!" >&5
+echo "$as_me: WARNING: sys/sdt.h: accepted by the compiler, rejected by the preprocessor!" >&2;}
+ { echo "$as_me:$LINENO: WARNING: sys/sdt.h: proceeding with the compiler's result" >&5
+echo "$as_me: WARNING: sys/sdt.h: proceeding with the compiler's result" >&2;}
+ ac_header_preproc=yes
+ ;;
+ no:yes:* )
+ { echo "$as_me:$LINENO: WARNING: sys/sdt.h: present but cannot be compiled" >&5
+echo "$as_me: WARNING: sys/sdt.h: present but cannot be compiled" >&2;}
+ { echo "$as_me:$LINENO: WARNING: sys/sdt.h: check for missing prerequisite headers?" >&5
+echo "$as_me: WARNING: sys/sdt.h: check for missing prerequisite headers?" >&2;}
+ { echo "$as_me:$LINENO: WARNING: sys/sdt.h: see the Autoconf documentation" >&5
+echo "$as_me: WARNING: sys/sdt.h: see the Autoconf documentation" >&2;}
+ { echo "$as_me:$LINENO: WARNING: sys/sdt.h: section \"Present But Cannot Be Compiled\"" >&5
+echo "$as_me: WARNING: sys/sdt.h: section \"Present But Cannot Be Compiled\"" >&2;}
+ { echo "$as_me:$LINENO: WARNING: sys/sdt.h: proceeding with the preprocessor's result" >&5
+echo "$as_me: WARNING: sys/sdt.h: proceeding with the preprocessor's result" >&2;}
+ { echo "$as_me:$LINENO: WARNING: sys/sdt.h: in the future, the compiler will take precedence" >&5
+echo "$as_me: WARNING: sys/sdt.h: in the future, the compiler will take precedence" >&2;}
+ (
+ cat <<\_ASBOX
+## ------------------------------ ##
+## Report this to the tcl lists. ##
+## ------------------------------ ##
+_ASBOX
+ ) |
+ sed "s/^/$as_me: WARNING: /" >&2
+ ;;
+esac
+echo "$as_me:$LINENO: checking for sys/sdt.h" >&5
+echo $ECHO_N "checking for sys/sdt.h... $ECHO_C" >&6
+if test "${ac_cv_header_sys_sdt_h+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_cv_header_sys_sdt_h=$ac_header_preproc
+fi
+echo "$as_me:$LINENO: result: $ac_cv_header_sys_sdt_h" >&5
+echo "${ECHO_T}$ac_cv_header_sys_sdt_h" >&6
+
+fi
+if test $ac_cv_header_sys_sdt_h = yes; then
+ tcl_ok=yes
+else
+ tcl_ok=no
+fi
+
+
+fi
+if test $tcl_ok = yes; then
+ # Extract the first word of "dtrace", so it can be a program name with args.
+set dummy dtrace; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_path_DTRACE+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ case $DTRACE in
+ [\\/]* | ?:[\\/]*)
+ ac_cv_path_DTRACE="$DTRACE" # Let the user override the test with a path.
+ ;;
+ *)
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+as_dummy="$PATH:/usr/sbin"
+for as_dir in $as_dummy
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_path_DTRACE="$as_dir/$ac_word$ac_exec_ext"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+ ;;
+esac
+fi
+DTRACE=$ac_cv_path_DTRACE
+
+if test -n "$DTRACE"; then
+ echo "$as_me:$LINENO: result: $DTRACE" >&5
+echo "${ECHO_T}$DTRACE" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ test -z "$ac_cv_path_DTRACE" && tcl_ok=no
+fi
+echo "$as_me:$LINENO: checking whether to enable DTrace support" >&5
+echo $ECHO_N "checking whether to enable DTrace support... $ECHO_C" >&6
+if test $tcl_ok = yes; then
+
+cat >>confdefs.h <<\_ACEOF
+#define USE_DTRACE 1
+_ACEOF
+
+ DTRACE_SRC="\${DTRACE_SRC}"
+ DTRACE_HDR="\${DTRACE_HDR}"
+ if test "`uname -s`" != "Darwin" ; then
+ DTRACE_OBJ="\${DTRACE_OBJ}"
+ fi
+fi
+echo "$as_me:$LINENO: result: $tcl_ok" >&5
+echo "${ECHO_T}$tcl_ok" >&6
#--------------------------------------------------------------------
# The statements below define a collection of symbols related to
@@ -17928,6 +18146,12 @@ TCL_SHARED_BUILD=${SHARED_BUILD}
+
+
+
+
+
+
ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in"
cat >confcache <<\_ACEOF
@@ -18607,7 +18831,7 @@ s,@INSTALL_LIB@,$INSTALL_LIB,;t t
s,@INSTALL_STUB_LIB@,$INSTALL_STUB_LIB,;t t
s,@CFLAGS_DEFAULT@,$CFLAGS_DEFAULT,;t t
s,@LDFLAGS_DEFAULT@,$LDFLAGS_DEFAULT,;t t
-s,@INSTALL_TZDATA@,$INSTALL_TZDATA,;t t
+s,@DTRACE@,$DTRACE,;t t
s,@TCL_VERSION@,$TCL_VERSION,;t t
s,@TCL_MAJOR_VERSION@,$TCL_MAJOR_VERSION,;t t
s,@TCL_MINOR_VERSION@,$TCL_MINOR_VERSION,;t t
@@ -18637,6 +18861,10 @@ s,@TCL_LIB_VERSIONS_OK@,$TCL_LIB_VERSIONS_OK,;t t
s,@TCL_SHARED_LIB_SUFFIX@,$TCL_SHARED_LIB_SUFFIX,;t t
s,@TCL_UNSHARED_LIB_SUFFIX@,$TCL_UNSHARED_LIB_SUFFIX,;t t
s,@TCL_HAS_LONGLONG@,$TCL_HAS_LONGLONG,;t t
+s,@INSTALL_TZDATA@,$INSTALL_TZDATA,;t t
+s,@DTRACE_SRC@,$DTRACE_SRC,;t t
+s,@DTRACE_HDR@,$DTRACE_HDR,;t t
+s,@DTRACE_OBJ@,$DTRACE_OBJ,;t t
s,@BUILD_DLTEST@,$BUILD_DLTEST,;t t
s,@TCL_PACKAGE_PATH@,$TCL_PACKAGE_PATH,;t t
s,@TCL_MODULE_PATH@,$TCL_MODULE_PATH,;t t
diff --git a/unix/configure.in b/unix/configure.in
index 8c38659..686c644 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -3,7 +3,7 @@ dnl This file is an input file used by the GNU "autoconf" program to
dnl generate the file "configure", which is run during Tcl installation
dnl to configure the system for the local environment.
#
-# RCS: @(#) $Id: configure.in,v 1.160 2007/08/07 05:06:20 das Exp $
+# RCS: @(#) $Id: configure.in,v 1.161 2007/09/13 15:27:11 das Exp $
AC_INIT([tcl],[8.5])
AC_PREREQ(2.59)
@@ -585,6 +585,7 @@ AC_MSG_RESULT([$tcl_ok])
# to be installed by Tcl. The default is autodetection, but can
# be overriden on the configure command line either way.
#------------------------------------------------------------------------
+
AC_MSG_CHECKING([for timezone data])
AC_ARG_WITH(tzdata,
AC_HELP_STRING([--with-tzdata],
@@ -629,7 +630,32 @@ then
AC_MSG_RESULT([supplied by Tcl])
INSTALL_TZDATA=install-tzdata
fi
-AC_SUBST(INSTALL_TZDATA)
+
+#--------------------------------------------------------------------
+# DTrace support
+#--------------------------------------------------------------------
+
+AC_ARG_ENABLE(dtrace,
+ AC_HELP_STRING([--enable-dtrace],
+ [build with DTrace support (default: off)]),
+ [tcl_ok=$enableval], [tcl_ok=no])
+if test $tcl_ok = yes; then
+ AC_CHECK_HEADER(sys/sdt.h, [tcl_ok=yes], [tcl_ok=no])
+fi
+if test $tcl_ok = yes; then
+ AC_PATH_PROG(DTRACE, dtrace,, [$PATH:/usr/sbin])
+ test -z "$ac_cv_path_DTRACE" && tcl_ok=no
+fi
+AC_MSG_CHECKING([whether to enable DTrace support])
+if test $tcl_ok = yes; then
+ AC_DEFINE(USE_DTRACE, 1, [Are we building with DTrace support?])
+ DTRACE_SRC="\${DTRACE_SRC}"
+ DTRACE_HDR="\${DTRACE_HDR}"
+ if test "`uname -s`" != "Darwin" ; then
+ DTRACE_OBJ="\${DTRACE_OBJ}"
+ fi
+fi
+AC_MSG_RESULT([$tcl_ok])
#--------------------------------------------------------------------
# The statements below define a collection of symbols related to
@@ -818,6 +844,12 @@ AC_SUBST(TCL_UNSHARED_LIB_SUFFIX)
AC_SUBST(TCL_HAS_LONGLONG)
+AC_SUBST(INSTALL_TZDATA)
+
+AC_SUBST(DTRACE_SRC)
+AC_SUBST(DTRACE_HDR)
+AC_SUBST(DTRACE_OBJ)
+
AC_SUBST(BUILD_DLTEST)
AC_SUBST(TCL_PACKAGE_PATH)
AC_SUBST(TCL_MODULE_PATH)
diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in
index 8636c5f..489b8fb 100644
--- a/unix/tclConfig.h.in
+++ b/unix/tclConfig.h.in
@@ -418,6 +418,9 @@
/* May we include <dirent2.h>? */
#undef USE_DIRENT2_H
+/* Are we building with DTrace support? */
+#undef USE_DTRACE
+
/* Should we use FIONBIO? */
#undef USE_FIONBIO