summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog38
-rw-r--r--generic/tclBasic.c143
-rw-r--r--generic/tclCmdIL.c55
-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.in32
-rwxr-xr-xunix/configure232
-rw-r--r--unix/configure.in36
-rw-r--r--unix/tclConfig.h.in3
-rw-r--r--win/Makefile.in6
-rw-r--r--win/makefile.vc128
-rw-r--r--win/nmakehlp.c150
-rw-r--r--win/rules.vc16
20 files changed, 1163 insertions, 131 deletions
diff --git a/ChangeLog b/ChangeLog
index ad57664..bbb29a2 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,41 @@
+2007-09-14 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclBasic.c (Tcl_CreateObjCommand): Only invalidate along the
+ namespace path once; that is enough. [Bug 1519940]
+
+2007-09-14 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 out 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
+ * win/Makefile.in: Module installed filename that should have
+ been part of the bump to tcltest 2.3b1. Thanks Larry Virden.
+
+2007-09-12 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/makefile.vc, win/rules.vc, win/nmakehlp.c: Use nmakehlp to
+ substitute values for tclConfig.sh (helps cross-compiling).
+
2007-09-11 Don Porter <dgp@users.sourceforge.net>
* library/tcltest/tcltest.tcl: Accept underscores and colons in
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 0cc7526..3d4d3e2 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.244.2.11 2007/09/06 18:20:29 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.244.2.12 2007/09/14 16:28:32 dgp 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.
*/
@@ -1967,7 +1981,6 @@ Tcl_CreateObjCommand(
*/
TclInvalidateNsCmdLookup(nsPtr);
- TclInvalidateNsPath(nsPtr);
}
cmdPtr = (Command *) ckalloc(sizeof(Command));
Tcl_SetHashValue(hPtr, cmdPtr);
@@ -2908,6 +2921,7 @@ CallCommandTraces(
* command. This insures that traces get a correct nul-terminated command
* string.
*
+ *----------------------------------------------------------------------
*/
static Tcl_Obj *
@@ -3559,6 +3573,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 +3599,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 +3663,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 +6409,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/tclCmdIL.c b/generic/tclCmdIL.c
index 17f7b27..c7455a9 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -16,7 +16,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdIL.c,v 1.115.2.6 2007/09/04 17:43:48 dgp Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.115.2.7 2007/09/14 16:28:33 dgp Exp $
*/
#include "tclInt.h"
@@ -1060,18 +1060,8 @@ InfoFrameCmd(
Tcl_Obj *CONST objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
- Tcl_Obj *lv[20]; /* Keep uptodate when more keys are added to
- * the dict. */
- int level, lc = 0;
+ int level;
CmdFrame *framePtr;
- /*
- * This array is indexed by the TCL_LOCATION_... values, except
- * for _LAST.
- */
- static CONST char *typeString[TCL_LOCATION_LAST] = {
- "eval", "eval", "eval", "precompiled", "source", "proc"
- };
- Tcl_Obj *tmpObj;
if (objc == 1) {
/*
@@ -1125,7 +1115,45 @@ InfoFrameCmd(
goto levelError;
}
+ Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInfoFrame --
+ *
+ * Core of InfoFrameCmd, returns TIP280 dict for a given frame.
+ *
+ * Results:
+ * Returns TIP280 dict.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclInfoFrame(
+ Tcl_Interp *interp, /* Current interpreter. */
+ CmdFrame *framePtr) /* Frame to get info for. */
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Obj *lv[20]; /* Keep uptodate when more keys are added to
+ * the dict. */
+ int lc = 0;
/*
+ * This array is indexed by the TCL_LOCATION_... values, except
+ * for _LAST.
+ */
+ static CONST char *typeString[TCL_LOCATION_LAST] = {
+ "eval", "eval", "eval", "precompiled", "source", "proc"
+ };
+ Tcl_Obj *tmpObj;
+
+ /*
* Pull the information and construct the dictionary to return, as list.
* Regarding use of the CmdFrame fields see tclInt.h, and its definition.
*/
@@ -1301,8 +1329,7 @@ InfoFrameCmd(
}
}
- Tcl_SetObjResult(interp, Tcl_NewListObj(lc, lv));
- return TCL_OK;
+ return Tcl_NewListObj(lc, lv);
}
/*
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 49d19d2..641963a 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.70.2.6 2007/09/09 17:26:35 dgp Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.70.2.7 2007/09/14 16:28:33 dgp 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..80946c1
--- /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.4.2 2007/09/14 16:28:33 dgp 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 e8e3114..3f18007 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.285.2.17 2007/09/11 17:58:24 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.285.2.18 2007/09/14 16:28:33 dgp 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 6101b26..2e8af5d 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.310.2.9 2007/09/10 03:06:46 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.310.2.10 2007/09/14 16:28:34 dgp 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 5a7b365..3af1fac 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.122.2.4 2007/09/10 03:06:46 dgp Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.122.2.5 2007/09/14 16:28:34 dgp 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 1513d75..2fa6764 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.115.2.11 2007/09/10 03:06:46 dgp Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.115.2.12 2007/09/14 16:28:34 dgp 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 7dc8842..7d7a8b5 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.5.2.1 2007/09/06 18:20:32 dgp Exp $
+# RCS: @(#) $Id: GNUmakefile,v 1.5.2.2 2007/09/14 16:28:35 dgp 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 c5ae852..b40d9d9 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.3.2.3 2007/09/06 18:20:32 dgp Exp $
+// RCS: @(#) $Id: Tcl-Common.xcconfig,v 1.3.2.4 2007/09/14 16:28:37 dgp 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 a411b51..af23ace 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.21.2.4 2007/09/06 18:20:33 dgp 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.21.2.5 2007/09/14 16:28:37 dgp 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 e347d05..68d3599 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.207.2.8 2007/09/06 18:20:33 dgp Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.207.2.9 2007/09/14 16:28:37 dgp 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;
@@ -781,8 +791,8 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs
done;
@echo "Installing package msgcat 1.4.2 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.2.tm;
- @echo "Installing package tcltest 2.3a1 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3a1.tm;
+ @echo "Installing package tcltest 2.3b1 as a Tcl Module";
+ @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3b1.tm;
@echo "Installing package platform 1.0.3 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.3.tm;
@@ -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 27f01e2..b7a7fa5 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 c4626d3..686404d 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.157.2.3 2007/09/04 17:44:20 dgp Exp $
+# RCS: @(#) $Id: configure.in,v 1.157.2.4 2007/09/14 16:28:39 dgp 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
diff --git a/win/Makefile.in b/win/Makefile.in
index 6caee7a..410665b 100644
--- a/win/Makefile.in
+++ b/win/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.115.2.2 2007/09/04 17:44:25 dgp Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.115.2.3 2007/09/14 16:28:39 dgp Exp $
VERSION = @TCL_VERSION@
@@ -647,8 +647,8 @@ install-libraries: libraries install-tzdata install-msgs
done;
@echo "Installing package msgcat 1.4.2 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.2.tm;
- @echo "Installing package tcltest 2.3a1 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3a1.tm;
+ @echo "Installing package tcltest 2.3b1 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3b1.tm;
@echo "Installing package platform 1.0.3 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.3.tm;
@echo "Installing package platform::shell 1.1.3 as a Tcl Module";
diff --git a/win/makefile.vc b/win/makefile.vc
index 20bebf0..d22aee1 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -12,7 +12,7 @@
# Copyright (c) 2001-2004 David Gravereaux.
#
#------------------------------------------------------------------------------
-# RCS: @(#) $Id: makefile.vc,v 1.160.2.2 2007/09/04 17:44:26 dgp Exp $
+# RCS: @(#) $Id: makefile.vc,v 1.160.2.3 2007/09/14 16:28:39 dgp Exp $
#------------------------------------------------------------------------------
# Check to see we are configured to build with MSVC (MSDEVDIR or MSVCDIR)
@@ -736,77 +736,65 @@ install-docs:
# Build tclConfig.sh for the TEA build system.
#---------------------------------------------------------------------
-tclConfig:
-!if !exist($(TCLSH))
- @echo Build tclsh first!
-!else
+tclConfig: $(OUT_DIR)\tclConfig.sh
+
+$(OUT_DIR)\tclConfig.sh: $(WINDIR)\tclConfig.sh.in
@echo Creating tclConfig.sh
- @set TCL_LIBRARY=$(ROOT)/library
- @$(TCLSH) <<
- set debug $(DEBUG)
- set thread $(TCL_THREADS)
- set static $(STATIC_BUILD)
- set config(@TCL_DLL_FILE@) {$(TCLLIBNAME)}
- set config(@TCL_VERSION@) [info tcl]
- set config(@TCL_MAJOR_VERSION@) [lindex [split [info tclversion] .] 0]
- set config(@TCL_MINOR_VERSION@) [lindex [split [info tclversion] .] 1]
- set config(@TCL_PATCH_LEVEL@) [string range [info patchlevel] [string length [info tclversion]] end]
- set config(@CC@) {$(CC)}
- set config(@DEFS@) {}
- if {$$static} {lappend config(@DEFS@) "-DSTATIC_BUILD=1"}
- if {$$thread} {lappend config(@DEFS@) "-DTHREAD=1"}
- set config(@TCL_DBGX@) {$(DBGX)}
- set config(@CFLAGS_DEBUG@) {-nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MDd}
- set config(@CFLAGS_OPTIMIZE@) {-nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MD}
- set config(@LDFLAGS_DEBUG@) {-nologo -machine:$(MACHINE) -debug:full -debugtype:cv}
- set config(@LDFLAGS_OPTIMIZE@) {-nologo -machine:$(MACHINE) -release -opt:ref -opt:icf,3}
- set config(@TCL_SHARED_BUILD@) [expr {$$static ? 0 : 1}]
- set config(@TCL_LIB_FILE@) {$(PROJECT)$(VERSION)$(SUFX).lib}
- set config(@TCL_NEEDS_EXP_FILE@) {}
- set config(@CFG_TCL_EXPORT_FILE_SUFFIX@) {$${NODOT_VERSION}$${DBGX}.lib}
- set config(@LIBS@) {$(baselibs)}
- set config(@prefix@) {$(_INSTALLDIR)}
- set config(@exec_prefix@) {$(BIN_INSTALL_DIR)}
- set config(@SHLIB_CFLAGS@) {}
- set config(@STLIB_CFLAGS@) {}
- set config(@CFLAGS_WARNING@) {-W3}
- set config(@EXTRA_CFLAGS@) {-YX}
- set config(@SHLIB_LD@) {$(link32) $(dlllflags)}
- set config(@STLIB_LD@) {$(lib32) -nologo}
- set config(@SHLIB_LD_LIBS@) {$(baselibs)}
- set config(@SHLIB_SUFFIX@) {.dll}
- set config(@DL_LIBS@) {}
- set config(@LDFLAGS@) {}
- set config(@TCL_LD_SEARCH_FLAGS@) {}
- set config(@LIBOBJS@) {}
- set config(@RANLIB@) {}
- set config(@TCL_LIB_FLAG@) {}
- set config(@TCL_BUILD_LIB_SPEC@) {}
- set config(@TCL_LIB_SPEC@) {$(LIB_INSTALL_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib}
- set config(@TCL_INCLUDE_SPEC@) {-I$(INCLUDE_INSTALL_DIR)}
- set config(@TCL_LIB_VERSIONS_OK@) {}
- set config(@CFG_TCL_SHARED_LIB_SUFFIX@) {$${NODOT_VERSION}$${DBGX}.dll}
- set config(@CFG_TCL_UNSHARED_LIB_SUFFIX@) {$${NODOT_VERSION}$${DBGX}.lib}
- set config(@TCL_SRC_DIR@) [file nativename [file normalize {$(ROOT)}]]
- set config(@TCL_PACKAGE_PATH@) {}
- set config(@TCL_STUB_LIB_FILE@) {$(TCLSTUBLIBNAME)}
- set config(@TCL_STUB_LIB_FLAG@) {$(TCLSTUBLIBNAME)}
- set config(@TCL_BUILD_STUB_LIB_SPEC@) "-L[file nativename [file normalize {$(OUT_DIR)}]] $(TCLSTUBLIBNAME)"
- set config(@TCL_STUB_LIB_SPEC@) {-L$(LIB_INSTALL_DIR) $(TCLSTUBLIBNAME)}
- set config(@TCL_BUILD_STUB_LIB_PATH@) [file nativename [file normalize {$(TCLSTUBLIB)}]]
- set config(@TCL_STUB_LIB_PATH@) [file nativename [file normalize {$(LIB_INSTALL_DIR)\\$(TCLSTUBLIBNAME)}]]
- set config(@TCL_THREADS@) {$(TCL_THREADS)}
- set f [open tclConfig.sh.in r]
- set data [read $$f]
- close $$f
- foreach {anchor subst} [array get config] {
- regsub -all $$anchor $$data $$subst data
- }
- set f [open [file join [file normalize {$(OUT_DIR)}] tclConfig.sh] w]
- puts $$f $$data
- close $$f
-<<
+ @nmakehlp -s << $** >$@
+@TCL_DLL_FILE@ $(TCLLIBNAME)
+@TCL_VERSION@ $(DOTVERSION)
+@TCL_MAJOR_VERSION@ $(TCL_MAJOR_VERSION)
+@TCL_MINOR_VERSION@ $(TCL_MINOR_VERSION)
+@TCL_PATCH_LEVEL@ $(TCL_PATCH_LEVEL)
+@CC@ $(CC)
+@DEFS@ $(TCL_CFLAGS)
+@CFLAGS_DEBUG@ -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MDd
+@CFLAGS_OPTIMIZE@ -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MD
+@LDFLAGS_DEBUG@ -nologo -machine:$(MACHINE) -debug:full -debugtype:cv
+@LDFLAGS_OPTIMIZE@ -nologo -machine:$(MACHINE) -release -opt:ref -opt:icf,3
+@TCL_DBGX@ $(SUFX)
+@TCL_LIB_FILE@ $(PROJECT)$(VERSION)$(SUFX).lib
+@TCL_NEEDS_EXP_FILE@
+@LIBS@ $(baselibs)
+@prefix@ $(_INSTALLDIR)
+@exec_prefix@ $(BIN_INSTALL_DIR)
+@SHLIB_CFLAGS@
+@STLIB_CFLAGS@
+@CFLAGS_WARNING@ -W3
+@EXTRA_CFLAGS@ -YX
+@SHLIB_LD@ $(link32) $(dlllflags)
+@STLIB_LD@ $(lib32) -nologo
+@SHLIB_LD_LIBS@ $(baselibs)
+@SHLIB_SUFFIX@ .dll
+@DL_LIBS@
+@LDFLAGS@
+@TCL_LD_SEARCH_FLAGS@
+@LIBOBJS@
+@RANLIB@
+@TCL_LIB_FLAG@
+@TCL_BUILD_LIB_SPEC@
+@TCL_LIB_SPEC@ $(LIB_INSTALL_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
+@TCL_INCLUDE_SPEC@ -I$(INCLUDE_INSTALL_DIR)
+@TCL_LIB_VERSIONS_OK@
+@TCL_SRC_DIR@ $(ROOT)
+@TCL_PACKAGE_PATH@
+@TCL_STUB_LIB_FILE@ $(TCLSTUBLIBNAME)
+@TCL_STUB_LIB_FLAG@ $(TCLSTUBLIBNAME)
+@TCL_STUB_LIB_SPEC@ -L$(LIB_INSTALL_DIR) $(TCLSTUBLIBNAME)
+@TCL_THREADS@ $(TCL_THREADS)
+@TCL_BUILD_STUB_LIB_SPEC@ -L$(OUT_DIR) $(TCLSTUBLIBNAME)
+@TCL_BUILD_STUB_LIB_PATH@ $(TCLSTUBLIB)
+@TCL_STUB_LIB_PATH@ $(LIB_INSTALL_DIR)\$(TCLSTUBLIBNAME)
+@CFG_TCL_EXPORT_FILE_SUFFIX@ $(VERSION)$(SUFX).lib
+@CFG_TCL_SHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).dll
+@CFG_TCL_UNSHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).lib
+!if $(STATIC_BUILD)
+@TCL_SHARED_BUILD@ 0
+!else
+@TCL_SHARED_BUILD@ 1
!endif
+<<
+
# The following target generates the file generic/tclDate.c
# from the yacc grammar found in generic/tclGetDate.y. This is
diff --git a/win/nmakehlp.c b/win/nmakehlp.c
index 5fb7917..7dd3aac 100644
--- a/win/nmakehlp.c
+++ b/win/nmakehlp.c
@@ -11,7 +11,7 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* ----------------------------------------------------------------------------
- * RCS: @(#) $Id: nmakehlp.c,v 1.17 2007/05/04 18:04:18 patthoyts Exp $
+ * RCS: @(#) $Id: nmakehlp.c,v 1.17.2.1 2007/09/14 16:28:39 dgp Exp $
* ----------------------------------------------------------------------------
*/
@@ -38,6 +38,7 @@ int CheckForCompilerFeature(const char *option);
int CheckForLinkerFeature(const char *option);
int IsIn(const char *string, const char *substring);
int GrepForDefine(const char *file, const char *string);
+int SubstituteFile(const char *substs, const char *filename);
const char * GetVersionFromFile(const char *filename, const char *match);
DWORD WINAPI ReadFromPipe(LPVOID args);
@@ -133,6 +134,18 @@ main(
return 2;
}
return GrepForDefine(argv[2], argv[3]);
+ case 's':
+ if (argc == 2) {
+ chars = snprintf(msg, sizeof(msg) - 1,
+ "usage: %s -s <substitutions file> <file>\n"
+ "Perform a set of string map type substutitions on a file\n"
+ "exitcodes: 0\n",
+ argv[0]);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
+ &dwWritten, NULL);
+ return 2;
+ }
+ return SubstituteFile(argv[2], argv[3]);
case 'V':
if (argc != 4) {
chars = snprintf(msg, sizeof(msg) - 1,
@@ -558,6 +571,141 @@ GetVersionFromFile(
}
return szResult;
}
+
+/*
+ * List helpers for the SubstituteFile function
+ */
+
+typedef struct list_item_t {
+ struct list_item_t *nextPtr;
+ char * key;
+ char * value;
+} list_item_t;
+
+/* insert a list item into the list (list may be null) */
+static list_item_t *
+list_insert(list_item_t **listPtrPtr, const char *key, const char *value)
+{
+ list_item_t *itemPtr = malloc(sizeof(list_item_t));
+ if (itemPtr) {
+ itemPtr->key = strdup(key);
+ itemPtr->value = strdup(value);
+ itemPtr->nextPtr = NULL;
+
+ while(*listPtrPtr) {
+ listPtrPtr = &(*listPtrPtr)->nextPtr;
+ }
+ *listPtrPtr = itemPtr;
+ }
+ return itemPtr;
+}
+
+static void
+list_free(list_item_t **listPtrPtr)
+{
+ list_item_t *tmpPtr, *listPtr = *listPtrPtr;
+ while (listPtr) {
+ tmpPtr = listPtr;
+ listPtr = listPtr->nextPtr;
+ free(tmpPtr->key);
+ free(tmpPtr->value);
+ free(tmpPtr);
+ }
+}
+
+/*
+ * SubstituteFile --
+ * As windows doesn't provide anything useful like sed and it's unreliable
+ * to use the tclsh you are building against (consider x-platform builds -
+ * eg compiling AMD64 target from IX86) we provide a simple substitution
+ * option here to handle autoconf style substitutions.
+ * The substitution file is whitespace and line delimited. The file should
+ * consist of lines matching the regular expression:
+ * \s*\S+\s+\S*$
+ *
+ * Usage is something like:
+ * nmakehlp -S << $** > $@
+ * @PACKAGE_NAME@ $(PACKAGE_NAME)
+ * @PACKAGE_VERSION@ $(PACKAGE_VERSION)
+ * <<
+ */
+
+int
+SubstituteFile(
+ const char *substitutions,
+ const char *filename)
+{
+ size_t cbBuffer = 1024;
+ static char szBuffer[1024], szCopy[1024];
+ char *szResult = NULL;
+ list_item_t *substPtr = NULL;
+ FILE *fp, *sp;
+
+ fp = fopen(filename, "rt");
+ if (fp != NULL) {
+
+ /*
+ * Build a list of substutitions from the first filename
+ */
+
+ sp = fopen(substitutions, "rt");
+ if (sp != NULL) {
+ while (fgets(szBuffer, cbBuffer, sp) != NULL) {
+ char *ks, *ke, *vs, *ve;
+ ks = szBuffer;
+ while (ks && *ks && isspace(*ks)) ++ks;
+ ke = ks;
+ while (ke && *ke && !isspace(*ke)) ++ke;
+ vs = ke;
+ while (vs && *vs && isspace(*vs)) ++vs;
+ ve = vs;
+ while (ve && *ve && !(*ve == '\r' || *ve == '\n')) ++ve;
+ *ke = 0, *ve = 0;
+ list_insert(&substPtr, ks, vs);
+ }
+ fclose(sp);
+ }
+
+ /* debug: dump the list */
+#ifdef _DEBUG
+ {
+ int n = 0;
+ list_item_t *p = NULL;
+ for (p = substPtr; p != NULL; p = p->nextPtr, ++n) {
+ fprintf(stderr, "% 3d '%s' => '%s'\n", n, p->key, p->value);
+ }
+ }
+#endif
+
+ /*
+ * Run the substitutions over each line of the input
+ */
+
+ while (fgets(szBuffer, cbBuffer, fp) != NULL) {
+ list_item_t *p = NULL;
+ for (p = substPtr; p != NULL; p = p->nextPtr) {
+ char *m = strstr(szBuffer, p->key);
+ if (m) {
+ char *cp, *op, *sp;
+ cp = szCopy;
+ op = szBuffer;
+ while (op != m) *cp++ = *op++;
+ sp = p->value;
+ while (sp && *sp) *cp++ = *sp++;
+ op += strlen(p->key);
+ while (*op) *cp++ = *op++;
+ *cp = 0;
+ memcpy(szBuffer, szCopy, sizeof(szCopy));
+ }
+ }
+ printf(szBuffer);
+ }
+
+ list_free(&substPtr);
+ }
+ fclose(fp);
+ return 0;
+}
/*
* Local variables:
diff --git a/win/rules.vc b/win/rules.vc
index 22208d2..2f1f27e 100644
--- a/win/rules.vc
+++ b/win/rules.vc
@@ -11,7 +11,7 @@
# Copyright (c) 2003-2006 Patrick Thoyts
#
#------------------------------------------------------------------------------
-# RCS: @(#) $Id: rules.vc,v 1.29 2007/02/04 00:01:54 mistachkin Exp $
+# RCS: @(#) $Id: rules.vc,v 1.29.2.1 2007/09/14 16:28:39 dgp Exp $
#------------------------------------------------------------------------------
!ifndef _RULES_VC
@@ -401,7 +401,7 @@ FULLWARNINGS = 0
# Set our defines now armed with our options.
#----------------------------------------------------------
-OPTDEFINES = -DTCL_CFGVAL_ENCODING=$(CFG_ENCODING)
+OPTDEFINES = -DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) -DSTDC_HEADERS
!if $(TCL_MEM_DEBUG)
OPTDEFINES = $(OPTDEFINES) -DTCL_MEM_DEBUG
@@ -536,9 +536,15 @@ TCLTOOLSDIR = $(_TCLDIR)\tools
!if [echo REM = This file is generated from rules.vc > versions.vc]
!endif
# Note we can do the Tcl and/or Tk version extraction
-#!if [echo TCL_DOTVERSION = \>> versions.vc] \
-# && [nmakehlp -V ..\generic\tcl.h TCL_VERSION >> versions.vc]
-#!endif
+!if [echo TCL_MAJOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V ..\generic\tcl.h TCL_MAJOR_VERSION >> versions.vc]
+!endif
+!if [echo TCL_MINOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V ..\generic\tcl.h TCL_MINOR_VERSION >> versions.vc]
+!endif
+!if [echo TCL_PATCH_LEVEL = \>> versions.vc] \
+ && [nmakehlp -V ..\generic\tcl.h TCL_PATCH_LEVEL >> versions.vc]
+!endif
!if [echo PKG_HTTP_VER = \>> versions.vc] \
&& [nmakehlp -V ..\library\http\pkgIndex.tcl http >> versions.vc]
!endif
generated by cgit v0.12 at 2024-11-25 07:15:20 (GMT)