tsv - Part of the Tcl threading extension allowing script level manipulation of data shared between threads.
Index: doc/html/ttrace.html
==================================================================
--- doc/html/ttrace.html
+++ doc/html/ttrace.html
@@ -1,7 +1,7 @@
-
+
A word upfront: the package already includes callbacks for tracing
following Tcl commands: proc, namespace, variable,
-load, and rename. Additionally, a set of callbacks for
-tracing resources (object, classes) for the XOTcl v1.3.8+, an
+load, and rename. Additionaly, a set of callbacks for
+tracing resources (object, clasess) for the XOTcl v1.3.8+, an
OO-extension to Tcl, is also provided.
This gives a solid base for solving most of the real-life needs and
serves as an example for people wanting to customize the package
to cover their specific needs.
Below, you can find commands for registering callbacks in the
@@ -291,11 +291,11 @@
thread and replicate that interpreter state (or part of it) to other
threads/interpreters in the process.
Immediate benefit of such approach is the much smaller memory footprint
of the application and much faster thread creation. By not actually
loading all necessary procedures (and other resources) in every thread
-at the thread initialization time, but by deferring this to the time the
+at the thread initialization time, but by deffering this to the time the
resource is actually referenced, significant improvements in both
memory consumption and thread initialization time can be achieved. Some
tests have shown that memory footprint of an multithreading Tcl application
went down more than three times and thread startup time was reduced for
about 50 times. Note that your mileage may vary.
Index: doc/man/tpool.n
==================================================================
--- doc/man/tpool.n
+++ doc/man/tpool.n
@@ -320,11 +320,11 @@
Minimum number of worker threads needed for this threadpool instance\&.
During threadpool creation, the implementation will create somany
worker threads upfront and will keep at least number of them alive
during the lifetime of the threadpool instance\&.
Default value of this parameter is 0 (zero)\&. which means that a newly
-threadpool will have no worker threads initially\&. All worker threads
+threadpool will have no worker threads initialy\&. All worker threads
will be started on demand by callers running \fBtpool::post\fR command
and posting jobs to the job queue\&.
.TP
\fB-maxworkers\fR \fInumber\fR
Maximum number of worker threads allowed for this threadpool instance\&.
@@ -365,11 +365,11 @@
\fBtpool::create\fR or \fBtpool::post\fR) will throw error\&.
Default value for this option is unspecified, hence, the Tcl interpreter of
the worker thread will contain just the initial set of Tcl commands\&.
.TP
\fB-exitcmd\fR \fIscript\fR
-Sets a Tcl script run when the idle worker thread exits\&. This is normally
+Sets a Tcl script run when the idle worker thread exits\&. This is normaly
used to cleanup the state of the worker thread, release reserved resources,
cleanup memory and such\&.
Default value for this option is unspecified, thus no Tcl script will run
on the worker thread exit\&.
.RE
Index: doc/man/tsv.n
==================================================================
--- doc/man/tsv.n
+++ doc/man/tsv.n
@@ -349,11 +349,11 @@
.SH DESCRIPTION
This section describes commands implementing thread shared variables\&.
A thread shared variable is very similar to a Tcl array but in
contrast to a Tcl array it is created in shared memory and can
be accessed from many threads at the same time\&. Important feature of
-thread shared variable is that each access to the variable is internally
+thread shared variable is that each access to the variable is internaly
protected by a mutex so script programmer does not have to take care
about locking the variable himself\&.
.PP
Thread shared variables are not bound to any thread explicitly\&. That
means that when a thread which created any of thread shared variables
@@ -362,11 +362,11 @@
consumed by the variable\&.
.SH "ELEMENT COMMANDS"
.TP
\fBtsv::names\fR ?pattern?
Returns names of shared variables matching optional ?pattern?
-or all known variables if pattern is omitted\&.
+or all known variables if pattern is ommited\&.
.TP
\fBtsv::object\fR \fIvarname\fR \fIelement\fR
Creates object accessor command for the \fIelement\fR in the
shared variable \fIvarname\fR\&. Using this command, one can apply most
of the other shared variable commands as method functions of
@@ -383,29 +383,29 @@
.CE
.TP
\fBtsv::set\fR \fIvarname\fR \fIelement\fR ?value?
Sets the value of the \fIelement\fR in the shared variable \fIvarname\fR
to \fIvalue\fR and returns the value to caller\&. The \fIvalue\fR
-may be omitted, in which case the command will return the current
+may be ommited, in which case the command will return the current
value of the element\&. If the element cannot be found, error is triggered\&.
.TP
\fBtsv::get\fR \fIvarname\fR \fIelement\fR ?namedvar?
Retrieves the value of the \fIelement\fR from the shared variable \fIvarname\fR\&.
If the optional argument \fInamedvar\fR is given, the value is
stored in the named variable\&. Return value of the command depends
of the existence of the optional argument \fInamedvar\fR\&.
-If the argument is omitted and the requested element cannot be found
+If the argument is ommited and the requested element cannot be found
in the shared array, the command triggers error\&. If, however, the
optional argument is given on the command line, the command returns
true (1) if the element is found or false (0) if the element is not found\&.
.TP
\fBtsv::unset\fR \fIvarname\fR ?element?
Unsets the \fIelement\fR from the shared variable \fIvarname\fR\&.
If the optional element is not given, it deletes the variable\&.
.TP
\fBtsv::exists\fR \fIvarname\fR \fIelement\fR
-Checks whether the \fIelement\fR exists in the shared variable \fIvarname\fR
+Checks wether the \fIelement\fR exists in the shared variable \fIvarname\fR
and returns true (1) if it does or false (0) if it doesn't\&.
.TP
\fBtsv::pop\fR \fIvarname\fR \fIelement\fR
Returns value of the \fIelement\fR in the shared variable \fIvarname\fR
and unsets the element, all in one atomic operation\&.
@@ -415,11 +415,11 @@
shared variable \fIvarname\fR\&. This effectively performs an get/unset/set
sequence of operations but all in one atomic step\&.
.TP
\fBtsv::incr\fR \fIvarname\fR \fIelement\fR ?count?
Similar to standard Tcl \fBincr\fR command but increments the value
-of the \fIelement\fR in shared variable \fIvarname\fR instead of
+of the \fIelement\fR in shared variaboe \fIvarname\fR instead of
the Tcl variable\&.
.TP
\fBtsv::append\fR \fIvarname\fR \fIelement\fR \fIvalue\fR ?value \&.\&.\&.?
Similar to standard Tcl \fBappend\fR command but appends one or more
values to the \fIelement\fR in shared variable \fIvarname\fR instead of the
@@ -498,17 +498,17 @@
from the shared variable \fIvarname\fR in one atomic operation\&.
In contrast to the Tcl \fBlindex\fR command, this command returns
no value to the caller\&.
.TP
\fBtsv::lpush\fR \fIvarname\fR \fIelement\fR ?index?
-This command performs the opposite of the \fBtsv::lpop\fR command\&.
+This command performes the opposite of the \fBtsv::lpop\fR command\&.
As its counterpart, it returns no value to the caller\&.
.PP
.SH "ARRAY COMMANDS"
This command supports most of the options of the standard Tcl
\fBarray\fR command\&. In addition to those, it allows binding
-a shared variable to some persistent storage databases\&. Currently the persistent
+a shared variable to some persisten storage databases\&. Currently the persistent
options supported are the famous GNU Gdbm and LMDB\&. These options have to be
selected during the package compilation time\&.
The implementation provides hooks for defining other persistency layers, if
needed\&.
.TP
@@ -594,11 +594,11 @@
setting a variable as a side-effect\&.
.TP
\fBtsv::keylkeys\fR \fIvarname\fR \fIkeylist\fR ?key?
Return the a list of the keys in the keyed list \fIkeylist\fR in the
shared variable \fIvarname\fR\&. If \fIkey\fR is specified, then it is
-the name of a key field whose subfield keys are to be retrieved\&.
+the name of a key field who's subfield keys are to be retrieved\&.
.TP
\fBtsv::keylset\fR \fIvarname\fR \fIkeylist\fR \fIkey\fR \fIvalue\fR ?key value\&.\&.?
Set the value associated with \fIkey\fR, in the keyed list \fIkeylist\fR
to \fIvalue\fR\&. If the \fIkeylist\fR does not exists, it is created\&.
If \fIkey\fR is not currently in the list, it will be added\&. If it already
@@ -616,13 +616,13 @@
.PP
Due to the internal design of the Tcl core, there is no provision of full
integration of shared variables within the Tcl syntax, unfortunately\&. All
access to shared data must be performed with the supplied package commands\&.
Also, variable traces are not supported\&. But even so, benefits of easy,
-simple and safe shared data manipulation outweighs imposed limitations\&.
+simple and safe shared data manipulation outweights imposed limitations\&.
.SH CREDITS
Thread shared variables are inspired by the nsv interface found in
AOLserver, a highly scalable Web server from America Online\&.
.SH "SEE ALSO"
thread, tpool, ttrace
.SH KEYWORDS
locking, synchronization, thread shared data, threads
Index: doc/man/ttrace.n
==================================================================
--- doc/man/ttrace.n
+++ doc/man/ttrace.n
@@ -312,11 +312,11 @@
\fBttrace::preload\fR \fIcmd\fR
.sp
.BE
.SH DESCRIPTION
This package creates a framework for on-demand replication of the
-interpreter state across threads in an multithreading application\&.
+interpreter state accross threads in an multithreading application\&.
It relies on the mechanics of Tcl command tracing and the Tcl
\fBunknown\fR command and mechanism\&.
.PP
The package requires Tcl threading extension but can be alternatively
used stand-alone within the AOLserver, a scalable webserver from
@@ -327,11 +327,11 @@
.CS
% package require Ttrace
- 2\&.8\&.2
+ 2\&.8\&.0
% set t1 [thread::create {package require Ttrace; thread::wait}]
tid0x1802800
% ttrace::eval {proc test args {return test-[thread::id]}}
@@ -368,11 +368,11 @@
.sp
This is the most important user-level command of the package as
it wraps most of the commands described below\&. This greatly
simplifies things, because user need to learn just this (one)
command in order to effectively use the package\&. Other commands,
-as described below, are included mostly for the sake of completeness\&.
+as desribed below, are included mostly for the sake of completeness\&.
.TP
\fBttrace::enable\fR
Activates all registered callbacks in the framework
and starts a new trace epoch\&. The trace epoch encapsulates all
changes done to the interpreter during the time traces are activated\&.
@@ -389,21 +389,21 @@
Used to refresh the state of the interpreter to match the optional
trace ?epoch?\&. If the optional ?epoch? is not given, it takes
the most recent trace epoch\&.
.TP
\fBttrace::getscript\fR
-Returns a synthesized Tcl script which may be sourced in any interpreter\&.
+Returns a synthetized Tcl script which may be sourced in any interpreter\&.
This script sets the stage for the Tcl \fBunknown\fR command so it can
load traced resources from the in-memory database\&. Normally, this command
is automatically invoked by other higher-level commands like
\fBttrace::eval\fR and \fBttrace::update\fR\&.
.PP
.SH "CALLBACK COMMANDS"
A word upfront: the package already includes callbacks for tracing
following Tcl commands: \fBproc\fR, \fBnamespace\fR, \fBvariable\fR,
-\fBload\fR, and \fBrename\fR\&. Additionally, a set of callbacks for
-tracing resources (object, classes) for the XOTcl v1\&.3\&.8+, an
+\fBload\fR, and \fBrename\fR\&. Additionaly, a set of callbacks for
+tracing resources (object, clasess) for the XOTcl v1\&.3\&.8+, an
OO-extension to Tcl, is also provided\&.
This gives a solid base for solving most of the real-life needs and
serves as an example for people wanting to customize the package
to cover their specific needs\&.
.PP
@@ -490,11 +490,11 @@
threads/interpreters in the process\&.
.PP
Immediate benefit of such approach is the much smaller memory footprint
of the application and much faster thread creation\&. By not actually
loading all necessary procedures (and other resources) in every thread
-at the thread initialization time, but by deferring this to the time the
+at the thread initialization time, but by deffering this to the time the
resource is actually referenced, significant improvements in both
memory consumption and thread initialization time can be achieved\&. Some
tests have shown that memory footprint of an multithreading Tcl application
went down more than three times and thread startup time was reduced for
about 50 times\&. Note that your mileage may vary\&.
Index: doc/thread.man
==================================================================
--- doc/thread.man
+++ doc/thread.man
@@ -281,10 +281,21 @@
This command passes a [arg script] to all threads created by the
package for execution. It does not wait for response from any of
the threads.
+[para]
+
+The sending thread (the one executing the thread::broadcast command) does
+not send the script to itself.
+
+[para]
+
+Each receiving thread is directed to place evaluation of the send script
+at the head of its event queue, stepping in front of any other events
+awaiting processing.
+
[call [cmd thread::wait]]
This enters the event loop so a thread can receive messages from
the [cmd thread::send] command. This command should only be used
within the script passed to the [cmd thread::create]. It should
@@ -326,20 +337,25 @@
[cmd fconfigure] configures some Tcl channel options. Options currently
supported are: [option -eventmark] and [option -unwindonerror].
[para]
-When [option -eventmark] is provided with a value greater than 0 (zero), that
-value is the maximum number of asynchronously posted scripts that may be
-pending for the thread. [cmd {thread::send -async}] blocks until the number of
-pending scripts in the event loop drops below the [option -eventmark] value.
+The [option -eventmark] option, when set, limits the number of
+asynchronously posted scripts to the thread event loop.
+The [cmd {thread::send -async}] command will block until the number
+of pending scripts in the event loop does not drop below the value
+configured with [option -eventmark]. Default value for the
+[option -eventmark] is 0 (zero) which effectively disables the checking,
+i.e. allows for unlimited number of posted scripts.
[para]
-When [option -unwindonerror] is provided with a value of true, an error result
-in a script causes the thread to unwind, making it unavailable to evaluate
-additional scripts.
+The [option -unwindonerror] option, when set, causes the
+target thread to unwind if the result of the script processing
+resulted in error. Default value for the [option -unwindonerror]
+is 0 (false), i.e. thread continues to process scripts after one
+of the posted scripts fails.
[call [cmd thread::transfer] [arg id] [arg channel]]
This moves the specified [arg channel] from the current thread
Index: generic/psGdbm.c
==================================================================
--- generic/psGdbm.c
+++ generic/psGdbm.c
@@ -372,21 +372,22 @@
*/
static const char*
ps_gdbm_geterr(
ClientData handle)
{
- /*
- * The problem with gdbm interface is that it uses the global
- * gdbm_errno variable which is not per-thread nor mutex
- * protected. This variable is used to reference array of gdbm
- * error text strings. It is very dangeours to use this in the
- * MT-program without proper locking. For this kind of app
- * we should not be concerned with that, since all ps_gdbm_xxx
- * operations are performed under shared variable lock anyway.
- */
-
- return gdbm_strerror(gdbm_errno);
+ (void)handle;
+ /*
+ * The problem with gdbm interface is that it uses the global
+ * gdbm_errno variable which is not per-thread nor mutex
+ * protected. This variable is used to reference array of gdbm
+ * error text strings. It is very dangerous to use this in the
+ * MT-program without proper locking. For this kind of app
+ * we should not be concerned with that, since all ps_gdbm_xxx
+ * operations are performed under shared variable lock anyway.
+ */
+
+ return gdbm_strerror(gdbm_errno);
}
#endif /* HAVE_GDBM */
/* EOF $RCSfile*/
Index: generic/psLmdb.c
==================================================================
--- generic/psLmdb.c
+++ generic/psLmdb.c
@@ -157,11 +157,11 @@
LmdbCtx ctx;
char *ext;
Tcl_DString toext;
- ctx = ckalloc(sizeof(*ctx));
+ ctx = (LmdbCtx)ckalloc(sizeof(*ctx));
if (ctx == NULL)
{
return NULL;
}
@@ -266,11 +266,11 @@
{
mdb_txn_reset(ctx->txn);
return 1;
}
- *dataptrptr = data.mv_data;
+ *dataptrptr = (char *)data.mv_data;
*lenptr = data.mv_size;
/*
* Transaction is left open at this point, so that the caller can get ahold
* of the data and make a copy of it. Afterwards, it will call ps_lmdb_free
@@ -326,13 +326,13 @@
mdb_cursor_close(ctx->cur);
ctx->cur = NULL;
return 1;
}
- *dataptrptr = data.mv_data;
+ *dataptrptr = (char *)data.mv_data;
*lenptr = data.mv_size;
- *keyptrptr = key.mv_data;
+ *keyptrptr = (char *)key.mv_data;
return 0;
}
/*
@@ -367,13 +367,13 @@
mdb_cursor_close(ctx->cur);
ctx->cur = NULL;
return 1;
}
- *dataptrptr = data.mv_data;
+ *dataptrptr = (char *)data.mv_data;
*lenptr = data.mv_size;
- *keyptrptr = key.mv_data;
+ *keyptrptr = (char *)key.mv_data;
return 0;
}
/*
Index: generic/tclThreadInt.h
==================================================================
--- generic/tclThreadInt.h
+++ generic/tclThreadInt.h
@@ -23,10 +23,12 @@
* MSVC 8.0 started to mark many standard C library functions depreciated
* including the *printf family and others. Tell it to shut up.
* (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0)
*/
#if defined(_MSC_VER)
+# pragma warning(disable:4090) /* see: https://developercommunity.visualstudio.com/t/c-compiler-incorrect-propagation-of-const-qualifie/390711 */
+# pragma warning(disable:4146)
# pragma warning(disable:4244)
# if _MSC_VER >= 1400
# pragma warning(disable:4267)
# pragma warning(disable:4996)
# endif
@@ -43,10 +45,14 @@
# else
# define MODULE_SCOPE extern
# endif
#endif
+#if defined(_WIN32) && defined(_MSC_VER) && _MSC_VER < 1900
+# define snprintf _snprintf
+#endif
+
/*
* For linking against NaviServer/AOLserver require V4 at least
*/
#ifdef NS_AOLSERVER
@@ -54,14 +60,10 @@
# if !defined(NS_MAJOR_VERSION) || NS_MAJOR_VERSION < 4
# error "unsupported NaviServer/AOLserver version"
# endif
#endif
-#ifndef TCL_INDEX_NONE
-# define TCL_INDEX_NONE (-1)
-#endif
-
/*
* Allow for some command names customization.
* Only thread:: and tpool:: are handled here.
* Shared variable commands are more complicated.
* Look into the threadSvCmd.h for more info.
@@ -72,23 +74,23 @@
/*
* Exported from threadSvCmd.c file.
*/
-MODULE_SCOPE int Sv_Init(Tcl_Interp *interp);
+MODULE_SCOPE const char *SvInit(Tcl_Interp *interp);
/*
* Exported from threadSpCmd.c file.
*/
-MODULE_SCOPE int Sp_Init(Tcl_Interp *interp);
+MODULE_SCOPE const char *SpInit(Tcl_Interp *interp);
/*
* Exported from threadPoolCmd.c file.
*/
-MODULE_SCOPE int Tpool_Init(Tcl_Interp *interp);
+MODULE_SCOPE const char *TpoolInit(Tcl_Interp *interp);
/*
* Macros for splicing in/out of linked lists
*/
@@ -118,14 +120,14 @@
* Utility macros
*/
#define TCL_CMD(a,b,c) \
if (Tcl_CreateObjCommand((a),(b),(c),NULL, NULL) == NULL) \
- return TCL_ERROR
+ return NULL;
#define OPT_CMP(a,b) \
- ((a) && (b) && (*(a)==*(b)) && (*(a+1)==*(b+1)) && (!strcmp((a),(b))))
+ ((a) && (b) && ((a)[0]==(b)[0]) && ((a)[1]==(b)[1]) && (!strcmp((a),(b))))
#ifndef TCL_TSD_INIT
#define TCL_TSD_INIT(keyPtr) \
(ThreadSpecificData*)Tcl_GetThreadData((keyPtr),sizeof(ThreadSpecificData))
#endif
@@ -155,22 +157,22 @@
} tclInterpType;
#if defined(TCL_TIP285) && defined(USE_TCL_STUBS)
# undef Tcl_GetErrorLine
# define Tcl_GetErrorLine(interp) ((threadTclVersion>85)? \
- ((int (*)(Tcl_Interp *))((&(tclStubsPtr->tcl_PkgProvideEx))[605]))(interp): \
+ ((int (*)(Tcl_Interp *))(void *)((&(tclStubsPtr->tcl_PkgProvideEx))[605]))(interp): \
(((tclInterpType *)(interp))->errorLine))
/* TIP #270 */
# undef Tcl_AddErrorInfo
# define Tcl_AddErrorInfo(interp, msg) ((threadTclVersion>85)? \
- ((void (*)(Tcl_Interp *, Tcl_Obj *))((&(tclStubsPtr->tcl_PkgProvideEx))[574]))(interp, Tcl_NewStringObj(msg, -1)): \
- ((void (*)(Tcl_Interp *, const char *))((&(tclStubsPtr->tcl_PkgProvideEx))[66]))(interp, msg))
+ ((void (*)(Tcl_Interp *, Tcl_Obj *))(void *)((&(tclStubsPtr->tcl_PkgProvideEx))[574]))(interp, Tcl_NewStringObj(msg, -1)): \
+ ((void (*)(Tcl_Interp *, const char *))(void *)((&(tclStubsPtr->tcl_PkgProvideEx))[66]))(interp, msg))
/* TIP #337 */
# undef Tcl_BackgroundException
# define Tcl_BackgroundException(interp, result) ((threadTclVersion>85)? \
- ((void (*)(Tcl_Interp *, int))((&(tclStubsPtr->tcl_PkgProvideEx))[609]))(interp, result): \
- ((void (*)(Tcl_Interp *))((&(tclStubsPtr->tcl_PkgProvideEx))[76]))(interp))
+ ((void (*)(Tcl_Interp *, int))(void *)((&(tclStubsPtr->tcl_PkgProvideEx))[609]))(interp, result): \
+ ((void (*)(Tcl_Interp *))(void *)((&(tclStubsPtr->tcl_PkgProvideEx))[76]))(interp))
#elif !TCL_MINIMUM_VERSION(8,6)
/* 8.5, 8.4, or less - Emulate access to the error-line information */
# define Tcl_GetErrorLine(interp) (((tclInterpType *)(interp))->errorLine)
#endif
@@ -181,17 +183,17 @@
* get an actual "wideInt".
*/
#if defined(USE_TCL_STUBS)
# undef Tcl_SetIntObj
# define Tcl_SetIntObj(objPtr, value) ((threadTclVersion>86)? \
- ((void (*)(Tcl_Obj *, Tcl_WideInt))((&(tclStubsPtr->tcl_PkgProvideEx))[489]))(objPtr, (int)(value)): \
- ((void (*)(Tcl_Obj *, int))((&(tclStubsPtr->tcl_PkgProvideEx))[61]))(objPtr, value))
+ ((void (*)(Tcl_Obj *, Tcl_WideInt))(void *)((&(tclStubsPtr->tcl_PkgProvideEx))[489]))(objPtr, (int)(value)): \
+ ((void (*)(Tcl_Obj *, int))(void *)((&(tclStubsPtr->tcl_PkgProvideEx))[61]))(objPtr, value))
# undef Tcl_NewIntObj
# define Tcl_NewIntObj(value) ((threadTclVersion>86)? \
- ((Tcl_Obj * (*)(Tcl_WideInt))((&(tclStubsPtr->tcl_PkgProvideEx))[488]))((int)(value)): \
- ((Tcl_Obj * (*)(int))((&(tclStubsPtr->tcl_PkgProvideEx))[52]))(value))
+ ((Tcl_Obj * (*)(Tcl_WideInt))(void *)((&(tclStubsPtr->tcl_PkgProvideEx))[488]))((int)(value)): \
+ ((Tcl_Obj * (*)(int))(void *)((&(tclStubsPtr->tcl_PkgProvideEx))[52]))(value))
# undef Tcl_GetUnicodeFromObj
# define Tcl_GetUnicodeFromObj ((((&(tclStubsPtr->tcl_PkgProvideEx))[378]) != ((&(tclStubsPtr->tcl_PkgProvideEx))[434])) ? \
- ((void (*)(Tcl_Obj *, int *))((&(tclStubsPtr->tcl_PkgProvideEx))[434])) : ((void (*)(Tcl_Obj *, int *)) NULL))
+ ((void (*)(Tcl_Obj *, int *))(void *)((&(tclStubsPtr->tcl_PkgProvideEx))[434])) : ((void (*)(Tcl_Obj *, int *)) NULL))
#endif
#endif /* _TCL_THREAD_INT_H_ */
Index: generic/tclXkeylist.c
==================================================================
--- generic/tclXkeylist.c
+++ generic/tclXkeylist.c
@@ -28,37 +28,10 @@
#include "tclThreadInt.h"
#include "threadSvCmd.h"
#include "tclXkeylist.h"
#include
-#ifdef STATIC_BUILD
-#if TCL_MAJOR_VERSION >= 9
-/*
- * Static build, Tcl >= 9, compile-time decision to disable T_ROT calls.
- */
-#undef Tcl_RegisterObjType
-#define Tcl_RegisterObjType(typePtr) (typePtr)->setFromAnyProc = NULL
-#else
-/*
- * Static build, Tcl <= 9 --> T_ROT is directly linked, no stubs
- * Nothing needs to be done
- */
-#endif
-#else /* !STATIC_BUILD */
-/*
- * Dynamic build. Assume building with stubs (xx) and make a run-time
- * decision regarding T_ROT.
- * (Ad xx): Should be checked. Without stubs we have to go like static.
- */
-#undef Tcl_RegisterObjType
-#define Tcl_RegisterObjType(typePtr) if (threadTclVersion<90) { \
- ((void (*)(const Tcl_ObjType *))((&(tclStubsPtr->tcl_PkgProvideEx))[211]))(typePtr); \
-} else { \
- (typePtr)->setFromAnyProc = NULL; \
-}
-#endif /* eof STATIC_BUILD */
-
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
/* Stuff copied verbatim from the rest of TclX to avoid dependencies */
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
@@ -553,15 +526,15 @@
keylIntObj_t *keylIntPtr,
const char *key,
size_t *keyLenPtr,
const char **nextSubKeyPtr
) {
- char *keySeparPtr;
+ const char *keySeparPtr;
size_t keyLen;
int findIdx;
- keySeparPtr = strchr (key, '.');
+ keySeparPtr = strchr(key, '.');
if (keySeparPtr != NULL) {
keyLen = keySeparPtr - key;
} else {
keyLen = strlen (key);
}
@@ -1260,18 +1233,19 @@
* keylset listvar key value ?key value...?
*-----------------------------------------------------------------------------
*/
static int
Tcl_KeylsetObjCmd(
- void *clientData,
+ void *dummy,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[]
) {
Tcl_Obj *keylVarPtr, *newVarObj;
const char *key;
int idx;
+ (void)dummy;
if ((objc < 4) || ((objc % 2) != 0)) {
return TclX_WrongArgs (interp, objv [0],
"listvar key value ?key value...?");
}
@@ -1323,18 +1297,19 @@
* keyldel listvar key ?key ...?
*----------------------------------------------------------------------------
*/
static int
Tcl_KeyldelObjCmd(
- void *clientData,
+ void *dummy,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[]
) {
Tcl_Obj *keylVarPtr, *keylPtr;
const char *key;
int idx, status;
+ (void)dummy;
if (objc < 3) {
return TclX_WrongArgs (interp, objv [0], "listvar key ?key ...?");
}
@@ -1385,18 +1360,19 @@
* keylkeys listvar ?key?
*-----------------------------------------------------------------------------
*/
static int
Tcl_KeylkeysObjCmd(
- void *clientData,
+ void *dummy,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[]
) {
Tcl_Obj *keylPtr, *listObjPtr;
const char *key;
int status;
+ (void)dummy;
if ((objc < 2) || (objc > 3)) {
return TclX_WrongArgs(interp, objv [0], "listvar ?key?");
}
Index: generic/threadCmd.c
==================================================================
--- generic/threadCmd.c
+++ generic/threadCmd.c
@@ -18,19 +18,19 @@
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
* ----------------------------------------------------------------------------
*/
#include "tclThreadInt.h"
-#include "threadSvCmd.h"
+#include "threadUuid.h"
/*
* Provide package version in build contexts which do not provide
* -DPACKAGE_VERSION, like building a shell with the Thread object
* files built as part of that shell. Example: basekits.
*/
#ifndef PACKAGE_VERSION
-#define PACKAGE_VERSION "2.9a1"
+#define PACKAGE_VERSION "2.8.9"
#endif
/*
* Check if this is Tcl 8.5 or higher. In that case, we will have the TIP
* #143 APIs (i.e. interpreter resource limiting) available.
@@ -171,11 +171,11 @@
*/
typedef struct ThreadEventResult {
Tcl_Condition done; /* Set when the script completes */
int code; /* Return value of the function */
- Tcl_Obj *result; /* Result from the function */
+ char *result; /* Result from the function */
char *errorInfo; /* Copy of errorInfo variable */
char *errorCode; /* Copy of errorCode variable */
Tcl_ThreadId srcThreadId; /* Id of sender, if it dies */
Tcl_ThreadId dstThreadId; /* Id of target, if it dies */
struct ThreadEvent *eventPtr; /* Back pointer */
@@ -202,40 +202,38 @@
struct ThreadEventResult *resultPtr; /* To communicate the result back.
* NULL if we don't care about it */
} ThreadEvent;
typedef int (ThreadSendProc) (Tcl_Interp*, ClientData);
-typedef void (ThreadSendFree) (void *);
static ThreadSendProc ThreadSendEval; /* Does a regular Tcl_Eval */
static ThreadSendProc ThreadClbkSetVar; /* Sets the named variable */
-static ThreadSendProc ThreadClbkCommand; /* Sets the named variable */
/*
* These structures are used to communicate commands between source and target
* threads. The ThreadSendData is used for source->target command passing,
* while the ThreadClbkData is used for doing asynchronous callbacks.
*
- * Important: structures below must have first three elements identical!
+ * Important: structures below must have first two elements identical!
*/
typedef struct ThreadSendData {
ThreadSendProc *execProc; /* Func to exec in remote thread */
ClientData clientData; /* Ptr to pass to send function */
- ThreadSendFree *freeProc; /* Function to free client data */
- /* ---- */
+ /* ---- */
Tcl_Interp *interp; /* Interp to run the command */
+ char script[1]; /* Script to be executed */
} ThreadSendData;
typedef struct ThreadClbkData {
ThreadSendProc *execProc; /* The callback function */
ClientData clientData; /* Ptr to pass to clbk function */
- ThreadSendFree *freeProc; /* Function to free client data */
/* ---- */
Tcl_Interp *interp; /* Interp to run the command */
Tcl_ThreadId threadId; /* Thread where to post callback */
ThreadEventResult result; /* Returns result asynchronously */
+ char var[1]; /* Variable name to be set */
} ThreadClbkData;
/*
* Event used to transfer a channel between threads.
*/
@@ -291,17 +289,16 @@
NewThread(ClientData clientData);
static ThreadSpecificData*
ThreadExistsInner(Tcl_ThreadId id);
-static int
+static const char *
ThreadInit(Tcl_Interp *interp);
static int
ThreadCreate(Tcl_Interp *interp,
const char *script,
- int stacksize,
int flags,
int preserve);
static int
ThreadSend(Tcl_Interp *interp,
Tcl_ThreadId id,
@@ -427,26 +424,21 @@
#ifdef TCL_TIP285
static Tcl_ObjCmdProc ThreadCancelObjCmd;
#endif
-static int
+#ifndef STRINGIFY
+# define STRINGIFY(x) STRINGIFY1(x)
+# define STRINGIFY1(x) #x
+#endif
+
+static const char *
ThreadInit(
Tcl_Interp *interp /* The current Tcl interpreter */
) {
if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
- if ((sizeof(size_t) != sizeof(int))
-#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 7 && defined(TCL_NO_DEPRECATED)
- /* As long as Tcl 8.7 is not final, this allows the Thread extension */
- /* to be loadable on Tcl 9.0, provided it is compiled against Tcl 8.7+ headers */
- || !(Tcl_InitStubs)(interp, "8.4-",
- (TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), TCL_STUB_MAGIC)
-#endif
- ) {
- return TCL_ERROR;
- }
- Tcl_ResetResult(interp);
+ return NULL;
}
if (!threadTclVersion) {
/*
@@ -461,11 +453,11 @@
if (threadMutex == NULL){
/* If threadMutex==NULL here, it means that Tcl_MutexLock() is
* a dummy function, which is the case in unthreaded Tcl */
const char *msg = "Tcl core wasn't compiled for threading";
Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
- return TCL_ERROR;
+ return NULL;
}
Tcl_GetVersion(&major, &minor, NULL, NULL);
threadTclVersion = 10 * major + minor;
Tcl_MutexUnlock(&threadMutex);
}
@@ -493,26 +485,84 @@
/*
* Add shared variable commands
*/
- Sv_Init(interp);
+ SvInit(interp);
/*
* Add commands to access thread
* synchronization primitives.
*/
- Sp_Init(interp);
+ SpInit(interp);
/*
* Add threadpool commands.
*/
- Tpool_Init(interp);
+ TpoolInit(interp);
- return TCL_OK;
+ return PACKAGE_VERSION
+ "+" STRINGIFY(THREAD_VERSION_UUID)
+#if defined(__clang__) && defined(__clang_major__)
+ ".clang-" STRINGIFY(__clang_major__)
+#if __clang_minor__ < 10
+ "0"
+#endif
+ STRINGIFY(__clang_minor__)
+#endif
+#if defined(__cplusplus) && !defined(__OBJC__)
+ ".cplusplus"
+#endif
+#ifndef NDEBUG
+ ".debug"
+#endif
+#if !defined(__clang__) && !defined(__INTEL_COMPILER) && defined(__GNUC__)
+ ".gcc-" STRINGIFY(__GNUC__)
+#if __GNUC_MINOR__ < 10
+ "0"
+#endif
+ STRINGIFY(__GNUC_MINOR__)
+#endif
+#ifdef __INTEL_COMPILER
+ ".icc-" STRINGIFY(__INTEL_COMPILER)
+#endif
+#ifdef HAVE_GDBM
+ ".gdbm"
+#endif
+#ifdef HAVE_LMDB
+ ".lmdb"
+#endif
+#ifdef TCL_MEM_DEBUG
+ ".memdebug"
+#endif
+#if defined(_MSC_VER)
+ ".msvc-" STRINGIFY(_MSC_VER)
+#endif
+#ifdef USE_NMAKE
+ ".nmake"
+#endif
+#ifndef TCL_CFG_OPTIMIZED
+ ".no-optimize"
+#endif
+#ifdef __OBJC__
+ ".objective-c"
+#if defined(__cplusplus)
+ "plusplus"
+#endif
+#endif
+#ifdef TCL_CFG_PROFILED
+ ".profile"
+#endif
+#ifdef PURIFY
+ ".purify"
+#endif
+#ifdef STATIC_BUILD
+ ".static"
+#endif
+ ;
}
/*
*----------------------------------------------------------------------
@@ -532,16 +582,21 @@
DLLEXPORT int
Thread_Init(
Tcl_Interp *interp /* The current Tcl interpreter */
) {
- int status = ThreadInit(interp);
+ const char *version = ThreadInit(interp);
+ Tcl_CmdInfo info;
- if (status != TCL_OK) {
- return status;
+ if (version == NULL) {
+ return TCL_ERROR;
}
+ if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
+ Tcl_CreateObjCommand(interp, "::thread::build-info",
+ info.objProc, (void *)version, NULL);
+ }
return Tcl_PkgProvideEx(interp, "Thread", PACKAGE_VERSION, NULL);
}
/*
*----------------------------------------------------------------------
@@ -599,10 +654,11 @@
Tcl_Obj *const objv[] /* Argument objects. */
) {
int argc, rsrv = 0;
const char *arg, *script;
int flags = TCL_THREAD_NOFLAGS;
+ (void)dummy;
Init(interp);
/*
* Syntax: thread::create ?-joinable? ?-preserved? ?script?
@@ -629,11 +685,11 @@
} else {
goto usage;
}
}
- return ThreadCreate(interp, script, TCL_THREAD_STACK_DEFAULT, flags, rsrv);
+ return ThreadCreate(interp, script, flags, rsrv);
usage:
Tcl_WrongNumArgs(interp, 1, objv, "?-joinable? ?script?");
return TCL_ERROR;
}
@@ -663,10 +719,11 @@
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[] /* Argument objects. */
) {
Tcl_ThreadId thrId = NULL;
+ (void)dummy;
Init(interp);
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?threadId?");
@@ -706,10 +763,11 @@
int objc, /* Number of arguments. */
Tcl_Obj *const objv[] /* Argument objects. */
) {
int wait = 0;
Tcl_ThreadId thrId = NULL;
+ (void)dummy;
Init(interp);
if (objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "?-wait? ?threadId?");
@@ -753,10 +811,12 @@
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[] /* Argument objects. */
) {
+ (void)dummy;
+
Init(interp);
if (objc > 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
@@ -789,10 +849,11 @@
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[] /* Argument objects. */
) {
int status = 666;
+ (void)dummy;
Init(interp);
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?status?");
@@ -835,10 +896,11 @@
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[] /* Argument objects. */
) {
char thrHandle[THREAD_HNDLMAXLEN];
+ (void)dummy;
Init(interp);
if (objc > 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
@@ -879,10 +941,11 @@
) {
int ii, length;
char *result, thrHandle[THREAD_HNDLMAXLEN];
Tcl_ThreadId *thrIdArray;
Tcl_DString threadNames;
+ (void)dummy;
Init(interp);
if (objc > 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
@@ -928,37 +991,25 @@
* None.
*
*----------------------------------------------------------------------
*/
-static void
-threadSendFree(void *ptr)
-{
- ckfree((char *)ptr);
-}
-
-static void
-threadSendObjFree(void *ptr)
-{
- Tcl_DecrRefCount((Tcl_Obj *)ptr);
-}
-
static int
ThreadSendObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[] /* Argument objects. */
) {
size_t size;
- int cmd = 0, ret, ii = 0, flags = 0;
+ int ret, ii = 0, flags = 0;
Tcl_ThreadId thrId;
const char *script, *arg;
Tcl_Obj *var = NULL;
-
ThreadClbkData *clbkPtr = NULL;
ThreadSendData *sendPtr = NULL;
+ (void)dummy;
Init(interp);
/*
* Syntax: thread::send ?-async? ?-head? threadId script ?varName?
@@ -974,13 +1025,10 @@
arg = Tcl_GetString(objv[ii]);
if (OPT_CMP(arg, "-async")) {
flags &= ~THREAD_SEND_WAIT;
} else if (OPT_CMP(arg, "-head")) {
flags |= THREAD_SEND_HEAD;
- } else if (OPT_CMP(arg, "-command")) {
- flags &= ~THREAD_SEND_WAIT;
- cmd = 1;
} else {
break;
}
}
if (ii >= objc) {
@@ -997,10 +1045,12 @@
size = objv[ii]->length+1;
if (++ii < objc) {
var = objv[ii];
}
if (var && (flags & THREAD_SEND_WAIT) == 0) {
+ const char *varName = Tcl_GetString(var);
+ size_t vsize = var->length + 1;
if (thrId == Tcl_GetCurrentThread()) {
/*
* FIXME: Do something for callbacks to self
*/
@@ -1012,32 +1062,27 @@
* Prepare record for the callback. This is asynchronously
* posted back to us when the target thread finishes processing.
* We should do a vwait on the "var" to get notified.
*/
- clbkPtr = (ThreadClbkData*)ckalloc(sizeof(ThreadClbkData));
- if (cmd) {
- clbkPtr->execProc = ThreadClbkCommand;
- } else {
- clbkPtr->execProc = ThreadClbkSetVar;
- }
- clbkPtr->freeProc = threadSendObjFree;
+ clbkPtr = (ThreadClbkData*)ckalloc(sizeof(ThreadClbkData) + vsize);
+ clbkPtr->execProc = ThreadClbkSetVar;
clbkPtr->interp = interp;
clbkPtr->threadId = Tcl_GetCurrentThread();
- clbkPtr->clientData = Sv_DuplicateObj(var);
- Tcl_IncrRefCount((Tcl_Obj *)clbkPtr->clientData);
+ memcpy(clbkPtr->var, varName, vsize);
+ clbkPtr->clientData = NULL;
}
/*
* Prepare job record for the target thread
*/
- sendPtr = (ThreadSendData*)ckalloc(sizeof(ThreadSendData));
+ sendPtr = (ThreadSendData*)ckalloc(sizeof(ThreadSendData) + size);
sendPtr->interp = NULL; /* Signal to use thread main interp */
sendPtr->execProc = ThreadSendEval;
- sendPtr->freeProc = threadSendFree;
- sendPtr->clientData = memcpy(ckalloc(size), script, size);
+ memcpy(sendPtr->script, script, size);
+ sendPtr->clientData = NULL;
ret = ThreadSend(interp, thrId, sendPtr, clbkPtr, flags);
if (var && (flags & THREAD_SEND_WAIT)) {
@@ -1088,10 +1133,11 @@
int ii, nthreads;
size_t size;
const char *script;
Tcl_ThreadId *thrIdArray;
ThreadSendData *sendPtr, job;
+ (void)dummy;
Init(interp);
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "script");
@@ -1120,11 +1166,10 @@
* to be sent asynchronously to each known thread.
*/
job.interp = NULL; /* Signal to use thread's main interp */
job.execProc = ThreadSendEval;
- job.freeProc = threadSendFree;
job.clientData = NULL;
/*
* Now, circle this list and send each thread the script.
* This is sent asynchronously, since we do not care what
@@ -1134,13 +1179,14 @@
for (ii = 0; ii < nthreads; ii++) {
if (thrIdArray[ii] == Tcl_GetCurrentThread()) {
continue; /* Do not broadcast self */
}
- sendPtr = (ThreadSendData*)ckalloc(sizeof(ThreadSendData));
+ sendPtr = (ThreadSendData*)ckalloc(sizeof(ThreadSendData) + size);
*sendPtr = job;
- sendPtr->clientData = memcpy(ckalloc(size), script, size);
+ memcpy(sendPtr->script, script, size);
+ sendPtr->clientData = NULL;
ThreadSend(interp, thrIdArray[ii], sendPtr, NULL, THREAD_SEND_HEAD);
}
ckfree((char*)thrIdArray);
Tcl_ResetResult(interp);
@@ -1170,10 +1216,12 @@
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[] /* Argument objects. */
) {
+ (void)dummy;
+
Init(interp);
if (objc > 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
@@ -1208,10 +1256,11 @@
int objc, /* Number of arguments. */
Tcl_Obj *const objv[] /* Argument objects. */
) {
size_t len;
char *proc;
+ (void)dummy;
Init(interp);
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?proc?");
@@ -1244,12 +1293,14 @@
return TCL_OK;
}
static void
ThreadFreeError(
- ClientData clientData
+ ClientData dummy
) {
+ (void)dummy;
+
Tcl_MutexLock(&threadMutex);
if (errorThreadId != Tcl_GetCurrentThread()) {
Tcl_MutexUnlock(&threadMutex);
return;
}
@@ -1282,10 +1333,11 @@
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[] /* Argument objects. */
) {
Tcl_ThreadId thrId;
+ (void)dummy;
Init(interp);
/*
* Syntax of 'join': id
@@ -1325,13 +1377,13 @@
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[] /* Argument objects. */
) {
-
Tcl_ThreadId thrId;
Tcl_Channel chan;
+ (void)dummy;
Init(interp);
/*
* Syntax of 'transfer': id channel
@@ -1376,10 +1428,11 @@
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[] /* Argument objects. */
) {
Tcl_Channel chan;
+ (void)dummy;
Init(interp);
/*
* Syntax: thread::detach channel
@@ -1421,10 +1474,11 @@
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[] /* Argument objects. */
) {
char *chanName;
+ (void)dummy;
Init(interp);
/*
* Syntax: thread::attach channel
@@ -1466,10 +1520,11 @@
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[] /* Argument objects. */
) {
Tcl_ThreadId thrId;
+ (void)dummy;
Init(interp);
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "id");
@@ -1510,10 +1565,11 @@
char *option, *value;
Tcl_ThreadId thrId; /* Id of the thread to configure */
int i; /* Iterate over arg-value pairs. */
Tcl_DString ds; /* DString to hold result of
* calling GetThreadOption. */
+ (void)dummy;
if (objc < 2 || (objc % 2 == 1 && objc != 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "threadlId ?optionName? "
"?value? ?optionName value?...");
return TCL_ERROR;
@@ -1580,10 +1636,11 @@
Tcl_Obj *const objv[] /* Argument objects. */
) {
Tcl_ThreadId thrId;
int ii, flags;
const char *result;
+ (void)dummy;
if ((objc < 2) || (objc > 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "?-unwind? id ?result?");
return TCL_ERROR;
}
@@ -1631,12 +1688,13 @@
ThreadSendEval(
Tcl_Interp *interp,
ClientData clientData
) {
ThreadSendData *sendPtr = (ThreadSendData*)clientData;
- char *script = (char*)sendPtr->clientData;
+ char *script = (char *)sendPtr->clientData;
+ if (!script) script = sendPtr->script;
return Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL);
}
/*
*----------------------------------------------------------------------
@@ -1659,27 +1717,32 @@
ThreadClbkSetVar(
Tcl_Interp *interp,
ClientData clientData
) {
ThreadClbkData *clbkPtr = (ThreadClbkData*)clientData;
- Tcl_Obj *var = (Tcl_Obj *)clbkPtr->clientData;
+ const char *var = clbkPtr->var;
Tcl_Obj *valObj;
ThreadEventResult *resultPtr = &clbkPtr->result;
int rc = TCL_OK;
/*
* Get the result of the posted command.
* We will use it to fill-in the result variable.
*/
- valObj = resultPtr->result;
+ valObj = Tcl_NewStringObj(resultPtr->result, -1);
+ Tcl_IncrRefCount(valObj);
+
+ if (resultPtr->result != threadEmptyResult) {
+ ckfree(resultPtr->result);
+ }
/*
* Set the result variable
*/
- if (Tcl_ObjSetVar2(interp, var, NULL, valObj,
+ if (Tcl_SetVar2Ex(interp, var, NULL, valObj,
TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG) == NULL) {
rc = TCL_ERROR;
goto cleanup;
}
@@ -1687,53 +1750,27 @@
* In case of error, trigger the bgerror mechansim
*/
if (resultPtr->code == TCL_ERROR) {
if (resultPtr->errorCode) {
- Tcl_SetVar2Ex(interp, "errorCode", NULL,
- Tcl_NewStringObj(resultPtr->errorCode, -1), TCL_GLOBAL_ONLY);
+ var = "errorCode";
+ Tcl_SetVar2Ex(interp, var, NULL, Tcl_NewStringObj(resultPtr->errorCode, -1), TCL_GLOBAL_ONLY);
ckfree((char*)resultPtr->errorCode);
}
if (resultPtr->errorInfo) {
- Tcl_SetVar2Ex(interp, "errorInfo", NULL,
- Tcl_NewStringObj(resultPtr->errorInfo, -1), TCL_GLOBAL_ONLY);
+ var = "errorInfo";
+ Tcl_SetVar2Ex(interp, var, NULL, Tcl_NewStringObj(resultPtr->errorInfo, -1), TCL_GLOBAL_ONLY);
ckfree((char*)resultPtr->errorInfo);
}
Tcl_SetObjResult(interp, valObj);
Tcl_BackgroundException(interp, TCL_ERROR);
- return TCL_ERROR;
}
- return TCL_OK;
cleanup:
Tcl_DecrRefCount(valObj);
return rc;
}
-
-static int ThreadClbkCommand(Tcl_Interp *interp, ClientData clientData)
-{
- int status = TCL_OK;
- ThreadClbkData *clbkPtr = (ThreadClbkData*)clientData;
- Tcl_Obj *script = (Tcl_Obj *)clbkPtr->clientData;
- ThreadEventResult *resultPtr = &clbkPtr->result;
-
- if (resultPtr->code == TCL_ERROR) {
- Tcl_SetObjResult(interp, resultPtr->result);
- Tcl_BackgroundError(interp);
- goto cleanup;
- }
-
- if ((status = Tcl_ListObjAppendElement(
- interp, script, resultPtr->result)) != TCL_OK) {
- goto cleanup;
- }
- status = Tcl_GlobalEvalObj(interp, script);
-
-cleanup:
- Tcl_DecrRefCount(resultPtr->result);
- return status;
-}
/*
*----------------------------------------------------------------------
*
* ThreadCreate --
@@ -1753,11 +1790,10 @@
static int
ThreadCreate(
Tcl_Interp *interp, /* Current interpreter. */
const char *script, /* Script to evaluate */
- int stacksize, /* Zero for default size */
int flags, /* Zero for no flags */
int preserve /* If true, reserve the thread */
) {
char thrHandle[THREAD_HNDLMAXLEN];
ThreadCtrl ctrl;
@@ -1768,11 +1804,11 @@
ctrl.condWait = NULL;
ctrl.flags = 0;
Tcl_MutexLock(&threadMutex);
if (Tcl_CreateThread(&thrId, NewThread, &ctrl,
- stacksize, flags) != TCL_OK) {
+ TCL_THREAD_STACK_DEFAULT, flags) != TCL_OK) {
Tcl_MutexUnlock(&threadMutex);
Tcl_SetObjResult(interp, Tcl_NewStringObj("can't create a new thread", -1));
return TCL_ERROR;
}
@@ -1993,11 +2029,10 @@
argv[1] = buf;
argv[2] = errorInfo;
sendPtr = (ThreadSendData*)ckalloc(sizeof(ThreadSendData));
sendPtr->execProc = ThreadSendEval;
- sendPtr->freeProc = threadSendFree;
sendPtr->clientData = Tcl_Merge(3, argv);
sendPtr->interp = NULL;
ThreadSend(interp, errorThreadId, sendPtr, NULL, 0);
}
@@ -2147,15 +2182,16 @@
*----------------------------------------------------------------------
*/
static int
ThreadList(
- Tcl_Interp *interp,
+ Tcl_Interp *dummy,
Tcl_ThreadId **thrIdArray
) {
int ii, count = 0;
ThreadSpecificData *tsdPtr;
+ (void)dummy;
Tcl_MutexLock(&threadMutex);
/*
* First walk; find out how many threads are registered.
@@ -2743,18 +2779,18 @@
if (thrId == Tcl_GetCurrentThread() && (flags & THREAD_SEND_WAIT)) {
Tcl_MutexUnlock(&threadMutex);
if (!(flags & THREAD_SEND_HEAD)) {
- /*
+ /*
* Be sure all already queued events are processed before this event
*/
while ( Tcl_DoOneEvent((TCL_ALL_EVENTS & ~TCL_IDLE_EVENTS)|TCL_DONT_WAIT) ) {};
}
/* call it synchronously right now */
- int code = (*send->execProc)(interp, send);
- ThreadFreeProc(send);
+ code = (*send->execProc)(interp, (ClientData)send);
+ ThreadFreeProc((ClientData)send);
return code;
}
/*
* Create the event for target thread event queue.
@@ -2854,18 +2890,20 @@
ckfree(resultPtr->errorInfo);
}
}
code = resultPtr->code;
- Tcl_SetObjResult(interp, resultPtr->result);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(resultPtr->result, -1));
/*
* Cleanup
*/
Tcl_ConditionFinalize(&resultPtr->done);
- Tcl_DecrRefCount(resultPtr->result);
+ if (resultPtr->result != threadEmptyResult) {
+ ckfree(resultPtr->result);
+ }
ckfree((char*)resultPtr);
return code;
}
@@ -3099,11 +3137,13 @@
while (resultPtr->result == NULL) {
Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL);
}
SpliceOut(resultPtr, resultList);
Tcl_ConditionFinalize(&resultPtr->done);
- Tcl_DecrRefCount(resultPtr->result);
+ if (resultPtr->result != threadEmptyResult) {
+ ckfree(resultPtr->result); /* Will be ignored anyway */
+ }
ckfree((char*)resultPtr);
}
}
}
@@ -3141,10 +3181,11 @@
ThreadSendData *sendPtr = eventPtr->sendData;
ThreadClbkData *clbkPtr = eventPtr->clbkData;
ThreadEventResult* resultPtr = eventPtr->resultPtr;
int code = TCL_ERROR; /* Pessimistic assumption */
+ (void)mask;
/*
* See whether user has any preferences about which interpreter
* to use for running this job. The job structure might identify
* one. If not, just use the thread's main interpreter which is
@@ -3295,29 +3336,34 @@
ThreadSetResult(
Tcl_Interp *interp,
int code,
ThreadEventResult *resultPtr
) {
- const char *errorCode, *errorInfo;
size_t size;
+ const char *errorCode, *errorInfo, *result;
if (interp == NULL) {
code = TCL_ERROR;
errorInfo = "";
errorCode = "THREAD";
- resultPtr->result = Tcl_NewStringObj("no target interp", -1);
+ result = "no target interp!";
+ size = strlen(result);
+ resultPtr->result = (size) ?
+ (char *)memcpy(ckalloc(1+size), result, 1+size) : threadEmptyResult;
} else {
- resultPtr->result = Sv_DuplicateObj(Tcl_GetObjResult(interp));
+ result = Tcl_GetString(Tcl_GetObjResult(interp));
+ size = Tcl_GetObjResult(interp)->length;
+ resultPtr->result = (size) ?
+ (char *)memcpy(ckalloc(1+size), result, 1+size) : threadEmptyResult;
if (code == TCL_ERROR) {
errorCode = Tcl_GetVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY);
errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
} else {
errorCode = NULL;
errorInfo = NULL;
}
}
- Tcl_IncrRefCount(resultPtr->result);
resultPtr->code = code;
if (errorCode != NULL) {
size = strlen(errorCode) + 1;
@@ -3376,11 +3422,11 @@
&& !strncmp(option,"-eventmark", len))) {
char buf[16];
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-eventmark");
}
- sprintf(buf, "%d", tsdPtr->maxEventsCount);
+ snprintf(buf, sizeof(buf), "%d", tsdPtr->maxEventsCount);
Tcl_DStringAppendElement(dsPtr, buf);
if (len != 0) {
Tcl_MutexUnlock(&threadMutex);
return TCL_OK;
}
@@ -3520,10 +3566,11 @@
TransferEvent *eventPtr = (TransferEvent *)evPtr;
TransferResult *resultPtr = eventPtr->resultPtr;
Tcl_Interp *interp = tsdPtr->interp;
int code;
const char* msg = NULL;
+ (void)mask;
if (interp == NULL) {
/*
* Reject transfer in case of a missing target.
*/
@@ -3586,14 +3633,14 @@
*/
ThreadSendData *anyPtr = (ThreadSendData*)clientData;
if (anyPtr) {
- if (anyPtr->clientData) {
- (*anyPtr->freeProc)(anyPtr->clientData);
- }
- ckfree((char*)anyPtr);
+ if (anyPtr->clientData) {
+ ckfree((char *)anyPtr->clientData);
+ }
+ ckfree((char*)anyPtr);
}
}
/*
*----------------------------------------------------------------------
@@ -3612,12 +3659,14 @@
*----------------------------------------------------------------------
*/
static int
ThreadDeleteEvent(
Tcl_Event *eventPtr, /* Really ThreadEvent */
- ClientData clientData /* dummy */
+ ClientData dummy /* dummy */
) {
+ (void)dummy;
+
if (eventPtr->proc == ThreadEventProc) {
/*
* Regular script event. Just dispose memory
*/
ThreadEvent *evPtr = (ThreadEvent*)eventPtr;
@@ -3742,12 +3791,11 @@
* Dang. The target is going away. Unblock the caller.
* The result string must be dynamically allocated
* because the main thread is going to call free on it.
*/
- resultPtr->result = Tcl_NewStringObj(diemsg, -1);
- Tcl_IncrRefCount(resultPtr->result);
+ resultPtr->result = strcpy((char *)ckalloc(1+strlen(diemsg)), diemsg);
resultPtr->code = TCL_ERROR;
resultPtr->errorCode = resultPtr->errorInfo = NULL;
Tcl_ConditionNotify(&resultPtr->done);
}
}
@@ -3801,11 +3849,11 @@
static void
ThreadGetHandle(
Tcl_ThreadId thrId,
char *handlePtr
) {
- sprintf(handlePtr, THREAD_HNDLPREFIX "%p", thrId);
+ snprintf(handlePtr, THREAD_HNDLMAXLEN, THREAD_HNDLPREFIX "%p", thrId);
}
/*
*----------------------------------------------------------------------
*
Index: generic/threadPoolCmd.c
==================================================================
--- generic/threadPoolCmd.c
+++ generic/threadPoolCmd.c
@@ -200,10 +200,11 @@
Tcl_Obj *const objv[] /* Argument objects. */
) {
int ii, minw, maxw, idle;
char buf[64], *exs = NULL, *cmd = NULL;
ThreadPool *tpoolPtr;
+ (void)dummy;
/*
* Syntax: tpool::create ?-minworkers count?
* ?-maxworkers count?
* ?-initcmd script?
@@ -296,11 +297,11 @@
return TCL_ERROR;
}
}
Tcl_MutexUnlock(&tpoolPtr->mutex);
- sprintf(buf, "%s%p", TPOOL_HNDLPREFIX, tpoolPtr);
+ snprintf(buf, sizeof(buf), "%s%p", TPOOL_HNDLPREFIX, tpoolPtr);
Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
return TCL_OK;
usage:
@@ -341,10 +342,11 @@
const char *tpoolName, *script;
TpoolResult *rPtr;
ThreadPool *tpoolPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ (void)dummy;
/*
* Syntax: tpool::post ?-detached? ?-nowait? tpoolId script
*/
@@ -515,10 +517,11 @@
ThreadPool *tpoolPtr;
TpoolResult *rPtr;
Tcl_HashEntry *hPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ (void)dummy;
/*
* Syntax: tpool::wait tpoolId jobIdList ?listVar?
*/
@@ -627,10 +630,11 @@
char *tpoolName;
Tcl_Obj *listVar = NULL;
Tcl_Obj *doneList, *waitList, **wObjv;
ThreadPool *tpoolPtr;
TpoolResult *rPtr;
+ (void)dummy;
/*
* Syntax: tpool::cancel tpoolId jobIdList ?listVar?
*/
@@ -723,10 +727,11 @@
char *tpoolName;
Tcl_Obj *resVar = NULL;
ThreadPool *tpoolPtr;
TpoolResult *rPtr;
Tcl_HashEntry *hPtr;
+ (void)dummy;
/*
* Syntax: tpool::get tpoolId jobId ?result?
*/
@@ -814,10 +819,11 @@
Tcl_Obj *const objv[] /* Argument objects. */
) {
int ret;
char *tpoolName;
ThreadPool *tpoolPtr;
+ (void)dummy;
/*
* Syntax: tpool::preserve tpoolId
*/
@@ -869,10 +875,11 @@
Tcl_Obj *const objv[] /* Argument objects. */
) {
size_t ret;
char *tpoolName;
ThreadPool *tpoolPtr;
+ (void)dummy;
/*
* Syntax: tpool::release tpoolId
*/
@@ -923,10 +930,11 @@
int objc, /* Number of arguments. */
Tcl_Obj *const objv[] /* Argument objects. */
) {
char *tpoolName;
ThreadPool *tpoolPtr;
+ (void)dummy;
/*
* Syntax: tpool::suspend tpoolId
*/
@@ -973,10 +981,11 @@
int objc, /* Number of arguments. */
Tcl_Obj *const objv[] /* Argument objects. */
) {
char *tpoolName;
ThreadPool *tpoolPtr;
+ (void)dummy;
/*
* Syntax: tpool::resume tpoolId
*/
@@ -1023,15 +1032,18 @@
int objc, /* Number of arguments. */
Tcl_Obj *const objv[] /* Argument objects. */
) {
ThreadPool *tpoolPtr;
Tcl_Obj *listObj = Tcl_NewListObj(0, NULL);
+ (void)dummy;
+ (void)objc;
+ (void)objv;
Tcl_MutexLock(&listMutex);
for (tpoolPtr = tpoolList; tpoolPtr; tpoolPtr = tpoolPtr->nextPtr) {
char buf[32];
- sprintf(buf, "%s%p", TPOOL_HNDLPREFIX, tpoolPtr);
+ snprintf(buf, sizeof(buf), "%s%p", TPOOL_HNDLPREFIX, tpoolPtr);
Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj(buf,-1));
}
Tcl_MutexUnlock(&listMutex);
Tcl_SetObjResult(interp, listObj);
@@ -1289,14 +1301,16 @@
*
*----------------------------------------------------------------------
*/
static int
RunStopEvent(
- Tcl_Event *eventPtr,
+ Tcl_Event *dummy,
int mask
) {
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ (void)dummy;
+ (void)mask;
tsdPtr->stop = 1;
return 1;
}
@@ -1878,13 +1892,14 @@
*
*----------------------------------------------------------------------
*/
static void
AppExitHandler(
- ClientData clientData
+ ClientData dummy
) {
ThreadPool *tpoolPtr;
+ (void)dummy;
Tcl_MutexLock(&listMutex);
/*
* Restart with head of list each time until empty. [Bug 1427570]
*/
@@ -1895,11 +1910,11 @@
}
/*
*----------------------------------------------------------------------
*
- * Tpool_Init --
+ * TpoolInit --
*
* Create commands in current interpreter.
*
* Results:
* None.
@@ -1909,12 +1924,12 @@
* any threadpools left.
*
*----------------------------------------------------------------------
*/
-int
-Tpool_Init (
+const char *
+TpoolInit (
Tcl_Interp *interp /* Interp where to create cmds */
) {
static int initialized;
TCL_CMD(interp, TPOOL_CMD_PREFIX"create", TpoolCreateObjCmd);
@@ -1934,11 +1949,11 @@
Tcl_CreateExitHandler(AppExitHandler, (ClientData)-1);
initialized = 1;
}
Tcl_MutexUnlock(&listMutex);
}
- return TCL_OK;
+ return NULL;
}
/* EOF $RCSfile: threadPoolCmd.c,v $ */
/* Emacs Setup Variables */
Index: generic/threadSpCmd.c
==================================================================
--- generic/threadSpCmd.c
+++ generic/threadSpCmd.c
@@ -185,17 +185,17 @@
int opt, ret;
size_t nameLen;
const char *mutexName;
char type;
SpMutex *mutexPtr;
-
static const char *cmdOpts[] = {
"create", "destroy", "lock", "unlock", NULL
};
enum options {
m_CREATE, m_DESTROY, m_LOCK, m_UNLOCK
};
+ (void)dummy;
/*
* Syntax:
*
* thread::mutex create ?-recursive?
@@ -369,10 +369,11 @@
"create", "destroy", "rlock", "wlock", "unlock", NULL
};
enum options {
w_CREATE, w_DESTROY, w_RLOCK, w_WLOCK, w_UNLOCK
};
+ (void)dummy;
/*
* Syntax:
*
* thread::rwmutex create
@@ -532,10 +533,11 @@
"create", "destroy", "notify", "wait", NULL
};
enum options {
c_CREATE, c_DESTROY, c_NOTIFY, c_WAIT
};
+ (void)dummy;
/*
* Syntax:
*
* thread::cond create
@@ -693,10 +695,11 @@
int ret, optx, internal;
const char *mutexName;
Tcl_Obj *scriptObj;
SpMutex *mutexPtr = NULL;
static Sp_RecursiveMutex evalMutex;
+ (void)dummy;
/*
* Syntax:
*
* thread::eval ?-lock ? arg ?arg ...?
@@ -769,11 +772,11 @@
if (ret == TCL_ERROR) {
char msg[32 + TCL_INTEGER_SPACE];
/* Next line generates a Deprecation warning when compiled with Tcl 8.6.
* See Tcl bug #3562640 */
- sprintf(msg, "\n (\"eval\" body line %d)", Tcl_GetErrorLine(interp));
+ snprintf(msg, sizeof(msg), "\n (\"eval\" body line %d)", Tcl_GetErrorLine(interp));
Tcl_AddErrorInfo(interp, msg);
}
/*
* Unlock the mutex.
@@ -806,21 +809,22 @@
*
*----------------------------------------------------------------------
*/
static Tcl_Obj*
-GetName(int type, void *addrPtr)
+GetName(int type, void *dummy)
{
char name[32];
unsigned int id;
static unsigned int idcounter;
+ (void)dummy;
Tcl_MutexLock(&initMutex);
id = idcounter++;
Tcl_MutexUnlock(&initMutex);
- sprintf(name, "%cid%d", type, id);
+ snprintf(name, sizeof(name), "%cid%d", type, id);
return Tcl_NewStringObj(name, -1);
}
/*
@@ -1057,26 +1061,26 @@
}
/*
*----------------------------------------------------------------------
*
- * Sp_Init --
+ * SpInit --
*
* Create commands in current interpreter.
*
* Results:
- * Standard Tcl result.
+ * NULL
*
* Side effects:
* Initializes shared hash table for storing sync primitive
* handles and pointers.
*
*----------------------------------------------------------------------
*/
-int
-Sp_Init (
+const char *
+SpInit (
Tcl_Interp *interp /* Interp where to create cmds */
) {
SpBucket *bucketPtr;
if (!initOnce) {
@@ -1101,11 +1105,11 @@
TCL_CMD(interp, THREAD_CMD_PREFIX"::mutex", ThreadMutexObjCmd);
TCL_CMD(interp, THREAD_CMD_PREFIX"::rwmutex", ThreadRWMutexObjCmd);
TCL_CMD(interp, THREAD_CMD_PREFIX"::cond", ThreadCondObjCmd);
TCL_CMD(interp, THREAD_CMD_PREFIX"::eval", ThreadEvalObjCmd);
- return TCL_OK;
+ return NULL;
}
/*
*----------------------------------------------------------------------
*
Index: generic/threadSvCmd.c
==================================================================
--- generic/threadSvCmd.c
+++ generic/threadSvCmd.c
@@ -51,11 +51,11 @@
static const Tcl_ObjType* stringObjTypePtr = 0;
/*
* In order to be fully stub enabled, a small
* hack is needed to query the tclEmptyStringRep
- * global symbol defined by Tcl. See Sv_Init.
+ * global symbol defined by Tcl. See SvInit.
*/
static char *Sv_tclEmptyStringRep = NULL;
/*
@@ -412,11 +412,11 @@
static PsStore*
GetPsStore(const char *handle)
{
int i;
const char *type = handle;
- char *addr, *delimiter = strchr(handle, ':');
+ char *addr, *delimiter = (char *)strchr(handle, ':');
PsStore *tmpPtr, *psPtr = NULL;
/*
* Expect the handle in the following format: :
* where "type" must match one of the registered presistent store
@@ -1018,11 +1018,13 @@
|| objPtr->typePtr == stringObjTypePtr) {
/*
* Cover all "safe" obj types (see header comment)
*/
(*objPtr->typePtr->dupIntRepProc)(objPtr, dupPtr);
- Tcl_InvalidateStringRep(dupPtr);
+ if (dupPtr->typePtr != NULL) {
+ Tcl_InvalidateStringRep(dupPtr);
+ }
} else {
int found = 0;
RegType *regPtr;
/*
* Cover special registered types. Assume not
@@ -1030,11 +1032,13 @@
* should be fast enough.
*/
for (regPtr = regType; regPtr; regPtr = regPtr->nextPtr) {
if (objPtr->typePtr == regPtr->typePtr) {
(*regPtr->dupIntRepProc)(objPtr, dupPtr);
- Tcl_InvalidateStringRep(dupPtr);
+ if (dupPtr->typePtr != NULL) {
+ Tcl_InvalidateStringRep(dupPtr);
+ }
found = 1;
break;
}
}
/*
@@ -1052,20 +1056,22 @@
/*
* Handle the string rep
*/
if (objPtr->bytes == NULL) {
- dupPtr->bytes = NULL;
+ if (dupPtr->bytes != Sv_tclEmptyStringRep) {
+ dupPtr->bytes = NULL;
+ }
} else if (objPtr->bytes != Sv_tclEmptyStringRep) {
- /* A copy of TclInitStringRep macro */
- dupPtr->bytes = (char*)ckalloc((unsigned)objPtr->length + 1);
- if (objPtr->length > 0) {
- memcpy((void*)dupPtr->bytes,(void*)objPtr->bytes,
- (unsigned)objPtr->length);
- }
- dupPtr->length = objPtr->length;
- dupPtr->bytes[objPtr->length] = '\0';
+ /* A copy of TclInitStringRep macro */
+ dupPtr->bytes = (char*)ckalloc((unsigned)objPtr->length + 1);
+ if (objPtr->length > 0) {
+ memcpy(dupPtr->bytes, objPtr->bytes,
+ objPtr->length);
+ }
+ dupPtr->length = objPtr->length;
+ dupPtr->bytes[objPtr->length] = '\0';
}
return dupPtr;
}
@@ -1179,11 +1185,11 @@
/*
* Format the command name
*/
- sprintf(buf, "::%p", (int*)svObj);
+ snprintf(buf, sizeof(buf), "::%p", (int*)svObj);
svObj->aolSpecial = (arg != NULL);
Tcl_CreateObjCommand(interp, buf, SvObjDispatchObjCmd, svObj, NULL);
Tcl_ResetResult(interp);
Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
@@ -1444,10 +1450,11 @@
Tcl_Obj *const objv[]) /* Argument objects. */
{
int ii;
const char *arrayName;
Array *arrayPtr;
+ (void)dummy;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "array ?key ...?");
return TCL_ERROR;
}
@@ -2031,10 +2038,11 @@
{
int ret;
Tcl_Obj *scriptObj;
Bucket *bucketPtr;
Array *arrayPtr = NULL;
+ (void)dummy;
/*
* Syntax:
*
* tsv::lock array arg ?arg ...?
@@ -2066,11 +2074,11 @@
if (ret == TCL_ERROR) {
char msg[32 + TCL_INTEGER_SPACE];
/* Next line generates a Deprecation warning when compiled with Tcl 8.6.
* See Tcl bug #3562640 */
- sprintf(msg, "\n (\"eval\" body line %d)", Tcl_GetErrorLine(interp));
+ snprintf(msg, sizeof(msg), "\n (\"eval\" body line %d)", Tcl_GetErrorLine(interp));
Tcl_AddErrorInfo(interp, msg);
}
/*
* We unlock the bucket directly, w/o going to Sv_Unlock()
@@ -2098,16 +2106,17 @@
*
*-----------------------------------------------------------------------------
*/
static int
SvHandlersObjCmd(
- ClientData arg, /* Not used. */
+ ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
PsStore *tmpPtr = NULL;
+ (void)dummy;
/*
* Syntax:
*
* tsv::handlers
@@ -2174,25 +2183,25 @@
}
/*
*-----------------------------------------------------------------------------
*
- * Sv_Init --
+ * SvInit --
*
* Creates commands in current interpreter.
*
* Results:
- * None.
+ * NULL
*
* Side effects
* Many new command created in current interpreter. Global data
* structures used by them initialized as well.
*
*-----------------------------------------------------------------------------
*/
-int
-Sv_Init (
+const char *
+SvInit (
Tcl_Interp *interp
) {
int i;
Bucket *bucketPtr;
SvCmdInfo *cmdPtr;
@@ -2266,11 +2275,11 @@
for (cmdPtr = svCmdInfo; cmdPtr; cmdPtr = cmdPtr->nextPtr) {
Tcl_CreateObjCommand(interp, cmdPtr->cmdName, cmdPtr->objProcPtr,
NULL, (Tcl_CmdDeleteProc*)0);
#ifdef NS_AOLSERVER
Tcl_CreateObjCommand(interp, cmdPtr->cmdName2, cmdPtr->objProcPtr,
- (ClientData)(size_t)cmdPtr->aolSpecial, NULL);
+ (ClientData)(size_t)cmdPtr->aolSpecial, (Tcl_CmdDeleteProc*)0);
#endif
}
/*
* Create array of buckets and initialize each bucket
@@ -2310,11 +2319,11 @@
#endif
}
Tcl_MutexUnlock(&bucketsMutex);
}
- return TCL_OK;
+ return NULL;
}
#ifdef SV_FINALIZE
/*
* Left for reference, but unused since multithreaded finalization is
@@ -2338,18 +2347,19 @@
*
*-----------------------------------------------------------------------------
*/
static void
-SvFinalize (ClientData clientData)
+SvFinalize (ClientData dummy)
{
int i;
SvCmdInfo *cmdPtr;
RegType *regPtr;
Tcl_HashEntry *hashPtr;
Tcl_HashSearch search;
+ (void)dummy;
/*
* Decrement number of threads. Proceed only if I was the last one. The
* mutex is unlocked at the end of this function, so new threads that might
* want to register in the meanwhile will find a clean environment when
Index: generic/threadSvListCmd.c
==================================================================
--- generic/threadSvListCmd.c
+++ generic/threadSvListCmd.c
@@ -10,28 +10,25 @@
*/
#include "threadSvCmd.h"
#include "threadSvListCmd.h"
-#if TCL_MAJOR_VERSION > 8
-#define tclSizeT size_t
-#elif defined(USE_TCL_STUBS)
-#define tclSizeT int
+#if defined(USE_TCL_STUBS)
/* Little hack to eliminate the need for "tclInt.h" here:
Just copy a small portion of TclIntStubs, just
enough to make it work */
typedef struct TclIntStubs {
int magic;
void *hooks;
void (*dummy[34]) (void); /* dummy entries 0-33, not used */
int (*tclGetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* 34 */
} TclIntStubs;
-extern const struct TclIntStubs *tclIntStubsPtr;
+extern const TclIntStubs *tclIntStubsPtr;
# undef Tcl_GetIntForIndex
-# define Tcl_GetIntForIndex(interp, obj, max, ptr) ((threadTclVersion>86)? \
- ((int (*)(Tcl_Interp*, Tcl_Obj *, int, int*))((&(tclStubsPtr->tcl_PkgProvideEx))[645]))((interp), (obj), (max), (ptr)): \
+# define Tcl_GetIntForIndex(interp, obj, max, ptr) ((tclIntStubsPtr->tclGetIntForIndex == NULL)? \
+ ((int (*)(Tcl_Interp*, Tcl_Obj *, int, int*))(void *)((&(tclStubsPtr->tcl_PkgProvideEx))[645]))((interp), (obj), (max), (ptr)): \
tclIntStubsPtr->tclGetIntForIndex((interp), (obj), (max), (ptr)))
#elif TCL_MINOR_VERSION < 7
extern int TclGetIntForIndex(Tcl_Interp*, Tcl_Obj *, int, int*);
# define Tcl_GetIntForIndex TclGetIntForIndex
#endif
@@ -154,11 +151,11 @@
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[]
) {
int ret, off, llen, iarg = 0;
- tclSizeT index = 0;
+ int index = 0;
Tcl_Obj *elPtr = NULL;
Container *svObj = (Container*)arg;
/*
* Syntax:
@@ -185,11 +182,11 @@
ret = Tcl_GetIntForIndex(interp, objv[iarg], llen-1, &index);
if (ret != TCL_OK) {
goto cmd_err;
}
}
- if ((index < 0) || (index >= (tclSizeT)llen)) {
+ if ((index < 0) || (index >= llen)) {
goto cmd_ok; /* Ignore out-of bounds, like Tcl does */
}
ret = Tcl_ListObjIndex(interp, svObj->tclObj, index, &elPtr);
if (ret != TCL_OK) {
goto cmd_err;
@@ -234,11 +231,11 @@
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[]
) {
int off, ret, flg, llen;
- tclSizeT index = 0;
+ int index = 0;
Tcl_Obj *args[1];
Container *svObj = (Container*)arg;
/*
* Syntax:
@@ -262,13 +259,13 @@
if ((objc - off) == 2) {
ret = Tcl_GetIntForIndex(interp, objv[off+1], llen, &index);
if (ret != TCL_OK) {
goto cmd_err;
}
- if ((index == TCL_INDEX_NONE) || (index < 0)) {
+ if (index < 0) {
index = 0;
- } else if (index > (tclSizeT)llen) {
+ } else if (index > llen) {
index = llen;
}
}
args[0] = Sv_DuplicateObj(objv[off]);
@@ -369,11 +366,11 @@
Tcl_Obj *const objv[]
) {
const char *firstArg;
size_t argLen;
int ret, off, llen, ndel, nargs, i, j;
- tclSizeT first, last;
+ int first, last;
Tcl_Obj **args = NULL;
Container *svObj = (Container*)arg;
/*
* Syntax:
@@ -402,21 +399,21 @@
goto cmd_err;
}
firstArg = Tcl_GetString(objv[off]);
argLen = objv[off]->length;
- if ((first == TCL_INDEX_NONE) || (first < 0)) {
+ if (first < 0) {
first = 0;
}
- if (llen && first >= (tclSizeT)llen && strncmp(firstArg, "end", argLen)) {
+ if (llen && first >= llen && strncmp(firstArg, "end", argLen)) {
Tcl_AppendResult(interp, "list doesn't have element ", firstArg, NULL);
goto cmd_err;
}
- if (last + 1 >= (tclSizeT)llen + 1) {
+ if (last >= llen) {
last = llen - 1;
}
- if (first + 1 <= last + 1) {
+ if (first <= last) {
ndel = last - first + 1;
} else {
ndel = 0;
}
@@ -467,11 +464,11 @@
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[]
) {
int ret, off, llen, nargs, j;
- tclSizeT first, last, i;
+ int first, last, i;
Tcl_Obj **elPtrs, **args;
Container *svObj = (Container*)arg;
/*
* Syntax:
@@ -497,17 +494,17 @@
}
ret = Tcl_GetIntForIndex(interp, objv[off+1], llen-1, &last);
if (ret != TCL_OK) {
goto cmd_err;
}
- if ((first == TCL_INDEX_NONE) || (first < 0)) {
+ if (first < 0) {
first = 0;
}
- if (last + 1 >= (tclSizeT)llen + 1) {
+ if (last >= llen) {
last = llen - 1;
}
- if (first + 1 > last + 1) {
+ if (first > last) {
goto cmd_ok;
}
nargs = last - first + 1;
args = (Tcl_Obj**)ckalloc(nargs * sizeof(Tcl_Obj*));
@@ -549,11 +546,11 @@
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[]
) {
int off, ret, flg, llen, nargs, i, j;
- tclSizeT index = 0;
+ int index = 0;
Tcl_Obj **args;
Container *svObj = (Container*)arg;
/*
* Syntax:
@@ -576,17 +573,17 @@
}
ret = Tcl_GetIntForIndex(interp, objv[off], llen, &index);
if (ret != TCL_OK) {
goto cmd_err;
}
- if ((index == TCL_INDEX_NONE) || (index < 0)) {
+ if (index < 0) {
index = 0;
- } else if (index > (tclSizeT)llen) {
+ } else if (index > llen) {
index = llen;
}
- nargs = objc - (off + 1);
+ nargs = objc - off - 1;
args = (Tcl_Obj**)ckalloc(nargs * sizeof(Tcl_Obj*));
for (i = off + 1, j = 0; i < objc; i++, j++) {
args[j] = Sv_DuplicateObj(objv[i]);
}
ret = Tcl_ListObjReplace(interp, svObj->tclObj, index, 0, nargs, args);
@@ -785,11 +782,11 @@
int objc,
Tcl_Obj *const objv[]
) {
Tcl_Obj **elPtrs;
int ret, off, llen;
- tclSizeT index;
+ int index;
Container *svObj = (Container*)arg;
/*
* Syntax:
* tsv::lindex array key index
@@ -810,11 +807,11 @@
}
ret = Tcl_GetIntForIndex(interp, objv[off], llen-1, &index);
if (ret != TCL_OK) {
goto cmd_err;
}
- if ((index >= 0) && index < (tclSizeT)llen) {
+ if ((index >= 0) && (index < llen)) {
Tcl_SetObjResult(interp, Sv_DuplicateObj(elPtrs[index]));
}
return Sv_PutContainer(interp, svObj, SV_UNCHANGED);
@@ -908,28 +905,25 @@
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr /* Object with internal rep to set. */
) {
int i, llen;
Tcl_Obj *elObj, **newObjList;
+ Tcl_Obj *buf[16];
Tcl_ListObjLength(NULL, srcPtr, &llen);
- if (llen == 0) {
- (*srcPtr->typePtr->dupIntRepProc)(srcPtr, copyPtr);
- copyPtr->refCount = 0;
- return;
- }
-
- newObjList = (Tcl_Obj**)ckalloc(llen*sizeof(Tcl_Obj*));
+ newObjList = (llen > 16) ? (Tcl_Obj**)ckalloc(llen*sizeof(Tcl_Obj*)) : &buf[0];
for (i = 0; i < llen; i++) {
- Tcl_ListObjIndex(NULL, srcPtr, i, &elObj);
- newObjList[i] = Sv_DuplicateObj(elObj);
+ Tcl_ListObjIndex(NULL, srcPtr, i, &elObj);
+ newObjList[i] = Sv_DuplicateObj(elObj);
}
Tcl_SetListObj(copyPtr, llen, newObjList);
- ckfree((char*)newObjList);
+ if (newObjList != &buf[0]) {
+ ckfree((char*)newObjList);
+ }
}
/*
*----------------------------------------------------------------------
*
@@ -952,11 +946,11 @@
int indexCount, /* Number of index args */
Tcl_Obj **indexArray,
Tcl_Obj *valuePtr /* Value arg to 'lset' */
) {
int elemCount, result, i;
- tclSizeT index;
+ int index;
Tcl_Obj **elemPtrs, *chainPtr, *subListPtr;
/*
* Determine whether the index arg designates a list
* or a single index.
@@ -1017,11 +1011,11 @@
/*
* Check that the index is in range.
*/
- if ((index < 0) || index >= (tclSizeT)elemCount) {
+ if ((index < 0) || (index >= elemCount)) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("list index out of range", -1));
result = TCL_ERROR;
break;
}
Index: lib/ttrace.tcl
==================================================================
--- lib/ttrace.tcl
+++ lib/ttrace.tcl
@@ -71,11 +71,11 @@
} else {
error "requires NaviServer/AOLserver or Tcl threading extension"
}
# Keep in sync with the Thread package
- package provide Ttrace 2.9a1
+ package provide Ttrace 2.8.9
# Package variables
variable resolvers "" ; # List of registered resolvers
variable tracers "" ; # List of registered cmd tracers
variable scripts "" ; # List of registered script makers
@@ -185,19 +185,19 @@
variable enabled
expr {$enabled > 0}
}
proc update {{from -1}} {
- if {$from == -1} {
+ if {$from < 0} {
variable epoch [_set ttrace lastepoch]
} else {
- if {[lsearch [_set ttrace epochlist] $from] == -1} {
+ if {[lsearch [_set ttrace epochlist] $from] < 0} {
error "no such epoch: $from"
}
variable epoch $from
}
- uplevel [getscript]
+ uplevel 1 [getscript]
}
proc getscript {} {
variable preloads
variable epoch
@@ -216,44 +216,44 @@
return $script
}
proc cleanup {args} {
foreach cmd [info commands resolve::cleaner_*] {
- uplevel $cmd $args
+ uplevel 1 $cmd $args
}
}
proc preload {cmd} {
variable preloads
- if {[lsearch $preloads $cmd] == -1} {
+ if {[lsearch $preloads $cmd] < 0} {
lappend preloads $cmd
}
}
proc atenable {cmd arglist body} {
variable enables
- if {[lsearch $enables $cmd] == -1} {
+ if {[lsearch $enables $cmd] < 0} {
lappend enables $cmd
set cmd [namespace current]::enable::_$cmd
proc $cmd $arglist $body
return $cmd
}
}
proc atdisable {cmd arglist body} {
variable disables
- if {[lsearch $disables $cmd] == -1} {
+ if {[lsearch $disables $cmd] < 0} {
lappend disables $cmd
set cmd [namespace current]::disable::_$cmd
proc $cmd $arglist $body
return $cmd
}
}
proc addtrace {cmd arglist body} {
variable tracers
- if {[lsearch $tracers $cmd] == -1} {
+ if {[lsearch $tracers $cmd] < 0} {
lappend tracers $cmd
set tracer [namespace current]::trace::_$cmd
proc $tracer $arglist $body
if {[isenabled]} {
trace add execution $cmd leave $tracer
@@ -262,21 +262,21 @@
}
}
proc addscript {cmd body} {
variable scripts
- if {[lsearch $scripts $cmd] == -1} {
+ if {[lsearch $scripts $cmd] < 0} {
lappend scripts $cmd
set cmd [namespace current]::script::_$cmd
proc $cmd args $body
return $cmd
}
}
proc addresolver {cmd arglist body} {
variable resolvers
- if {[lsearch $resolvers $cmd] == -1} {
+ if {[lsearch $resolvers $cmd] < 0} {
lappend resolvers $cmd
set cmd [namespace current]::resolve::$cmd
proc $cmd $arglist $body
return $cmd
}
@@ -320,22 +320,22 @@
_array names ${epoch}-$cmd $pattern
}
proc unknown {args} {
set cmd [lindex $args 0]
- if {[uplevel ttrace::_resolve [list $cmd]]} {
- set c [catch {uplevel $cmd [lrange $args 1 end]} r]
+ if {[uplevel 1 ttrace::_resolve [list $cmd]]} {
+ set c [catch {uplevel 1 $cmd [lrange $args 1 end]} r]
} else {
- set c [catch {::eval ::tcl::unknown $args} r]
+ set c [catch {uplevel 1 ::tcl::unknown $args} r]
}
return -code $c -errorcode $::errorCode -errorinfo $::errorInfo $r
}
proc _resolve {cmd} {
variable resolvers
foreach resolver $resolvers {
- if {[uplevel [info comm resolve::$resolver] [list $cmd]]} {
+ if {[uplevel 1 [info comm resolve::$resolver] [list $cmd]]} {
return 1
}
}
return 0
}
@@ -540,11 +540,11 @@
ttrace::addtrace namespace {cmdline code args} {
if {$code != 0} {
return
}
set nop [lindex $cmdline 1]
- set cns [uplevel namespace current]
+ set cns [uplevel 1 namespace current]
if {$cns == "::"} {
set cns ""
}
switch -glob $nop {
eva* {
@@ -612,11 +612,11 @@
if {$code != 0} {
return
}
set opts [lrange $cmdline 1 end]
if {[llength $opts]} {
- set cns [uplevel namespace current]
+ set cns [uplevel 1 namespace current]
if {$cns == "::"} {
set cns ""
}
foreach {var val} $opts {
if {![string match "::*" $var]} {
@@ -660,11 +660,11 @@
ttrace::addtrace rename {cmdline code args} {
if {$code != 0} {
return
}
- set cns [uplevel namespace current]
+ set cns [uplevel 1 namespace current]
if {$cns == "::"} {
set cns ""
}
set old [lindex $cmdline 1]
if {![string match "::*" $old]} {
@@ -705,11 +705,11 @@
ttrace::addtrace proc {cmdline code args} {
if {$code != 0} {
return
}
- set cns [uplevel namespace current]
+ set cns [uplevel 1 namespace current]
if {$cns == "::"} {
set cns ""
}
set cmd [lindex $cmdline 1]
if {![string match "::*" $cmd]} {
@@ -745,19 +745,19 @@
}
proc ::info args {
set cmd [lindex $args 0]
set hit [lsearch -glob {commands procs args default body} $cmd*]
if {$hit > 1} {
- if {[catch {uplevel ::tcl::info $args}]} {
- uplevel ttrace::_resolve [list [lindex $args 1]]
+ if {[catch {uplevel 1 ::tcl::info $args}]} {
+ uplevel 1 ttrace::_resolve [list [lindex $args 1]]
}
- return [uplevel ::tcl::info $args]
+ return [uplevel 1 ::tcl::info $args]
}
if {$hit == -1} {
- return [uplevel ::tcl::info $args]
+ return [uplevel 1 ::tcl::info $args]
}
- set cns [uplevel namespace current]
+ set cns [uplevel 1 namespace current]
if {$cns == "::"} {
set cns ""
}
set pat [lindex $args 1]
if {![string match "::*" $pat]} {
@@ -772,11 +772,11 @@
set lazy($entry) 1
} else {
set lazy([namespace tail $entry]) 1
}
}
- foreach entry [uplevel ::tcl::info $args] {
+ foreach entry [uplevel 1 ::tcl::info $args] {
set lazy($entry) 1
}
array names lazy
}
}
@@ -787,11 +787,11 @@
# current namespace first, and if not found, in global namespace. It also
# handles commands imported from other namespaces.
#
ttrace::addresolver resolveprocs {cmd {export 0}} {
- set cns [uplevel namespace current]
+ set cns [uplevel 1 namespace current]
set name [namespace tail $cmd]
if {$cns == "::"} {
set cns ""
}
if {![string match "::*" $cmd]} {
@@ -877,11 +877,11 @@
::xotcl::Class instmixin ""
::xotcl::_creator destroy
}
set resolver [ttrace::addresolver resolveclasses {classname} {
- set cns [uplevel namespace current]
+ set cns [uplevel 1 namespace current]
set script [ttrace::getentry xotcl $classname]
if {$script == ""} {
set name [namespace tail $classname]
if {$cns == "::"} {
set script [ttrace::getentry xotcl ::$name]
@@ -893,11 +893,11 @@
}
if {$script == ""} {
return 0
}
}
- uplevel [list namespace eval $cns $script]
+ uplevel 1 [list namespace eval $cns $script]
return 1
}]
ttrace::addscript xotcl [subst -nocommands {
if {![catch {Serializer new} ss]} {
Index: pkgIndex.tcl.in
==================================================================
--- pkgIndex.tcl.in
+++ pkgIndex.tcl.in
@@ -21,25 +21,25 @@
# deferring the error has the advantage that a script calling
# [package require Thread] in a thread-disabled interp gets an error message
# about a thread-disabled interp, instead of the message
# "can't find package Thread".
-package ifneeded Thread @PACKAGE_VERSION@ [list load [file join $dir @PKG_LIB_FILE@]]
+package ifneeded Thread @PACKAGE_VERSION@ [list load [file join $dir @PKG_LIB_FILE@] [string totitle @PACKAGE_NAME@]]
# package Ttrace uses some support machinery.
# In Tcl 8.4 interps we use some older interfaces
if {![package vsatisfies [package provide Tcl] 8.5]} {
package ifneeded Ttrace @PACKAGE_VERSION@ "
[list proc @PACKAGE_NAME@_source {dir} {
if {[info exists ::env(TCL_THREAD_LIBRARY)] &&
[file readable $::env(TCL_THREAD_LIBRARY)/ttrace.tcl]} {
- source $::env(TCL_THREAD_LIBRARY)/ttrace.tcl
+ source -encoding utf-8 $::env(TCL_THREAD_LIBRARY)/ttrace.tcl
} elseif {[file readable [file join $dir .. lib ttrace.tcl]]} {
- source [file join $dir .. lib ttrace.tcl]
+ source -encoding utf-8 [file join $dir .. lib ttrace.tcl]
} elseif {[file readable [file join $dir ttrace.tcl]]} {
- source [file join $dir ttrace.tcl]
+ source -encoding utf-8 [file join $dir ttrace.tcl]
}
if {[namespace which ::ttrace::update] ne ""} {
::ttrace::update
}
}]
@@ -51,18 +51,18 @@
# In Tcl 8.5+ interps; use [::apply]
package ifneeded Ttrace @PACKAGE_VERSION@ [list ::apply {{dir} {
if {[info exists ::env(TCL_THREAD_LIBRARY)] &&
[file readable $::env(TCL_THREAD_LIBRARY)/ttrace.tcl]} {
- source $::env(TCL_THREAD_LIBRARY)/ttrace.tcl
+ source -encoding utf-8 $::env(TCL_THREAD_LIBRARY)/ttrace.tcl
} elseif {[file readable [file join $dir .. lib ttrace.tcl]]} {
- source [file join $dir .. lib ttrace.tcl]
+ source -encoding utf-8 [file join $dir .. lib ttrace.tcl]
} elseif {[file readable [file join $dir ttrace.tcl]]} {
- source [file join $dir ttrace.tcl]
+ source -encoding utf-8 [file join $dir ttrace.tcl]
}
if {[namespace which ::ttrace::update] ne ""} {
::ttrace::update
}
}} $dir]
Index: project.shed
==================================================================
--- project.shed
+++ project.shed
@@ -5,14 +5,14 @@
shed_class: project
version: {}
}
meta {
class: generic
- description: {The Tcl Thread package}
+ description: {The Tcl thread package}
distribution: fossil
generated: {2015-10-06 10:32:03 UTC}
- release: trunk
+ release: thread-2-8-branch
}
release/ {
ccc83b2283498a2ec86d00bf8593e7de0cf8a456
}
distribution/ {
@@ -32,16 +32,16 @@
032fb91c412db8ae1a282ae54d353fe33e45ff6a
}
}
ccc83b2283498a2ec86d00bf8593e7de0cf8a456 {
entity {
- name: trunk
+ name: thread-2-8-branch
shed_class: release
version: {}
}
meta {
- checkout: trunk
+ checkout: thread-2-8-branch
class: generic
timestamp: {2015-10-06 10:32:03 UTC}
}
}
e47b6a79a963c99b7de15a4817b3010fbb3dd693 {
@@ -52,21 +52,21 @@
}
meta {
class: generic
format: fossil
project: 7bce708b4197acccd1db4644fdbe5ee249f3b5dd
- project-name: {Tcl package Thread source code}
+ project-name: {Tcl package thread source code}
project-short-name: thread
- release: trunk
- url: http://fossil.etoyoc.com/fossil/thread
+ release: thread-2-8-branch
+ url: https://core.tcl-lang.org/thread
}
}
41c2f28a24688f0ad5c1431fbd22f1621b6b0d6e {
entity {
name: thread
shed_class: package
- version: 2.7.2
+ version: 2.8.9
}
meta {
build: tea
class: binary
}
@@ -91,11 +91,11 @@
version: {}
}
meta {
class: source
package-provide: {}
- package-require: {{Tcl 8.4} {Thread 2.5}}
+ package-require: {{Tcl 8.4} {Thread 2.8}}
path: tcl
}
}
cf5303e1f3f79bc837e9b1a18e5e2e3f4892c58c {
entity {
Index: tcl/cmdsrv/cmdsrv.tcl
==================================================================
--- tcl/cmdsrv/cmdsrv.tcl
+++ tcl/cmdsrv/cmdsrv.tcl
@@ -12,11 +12,11 @@
# -initcmd script to initialize new worker thread (def: empty)
#
# Example:
#
# # tclsh8.6
-# % source cmdsrv.tcl
+# % source -encoding utf-8 cmdsrv.tcl
# % cmdsrv::create 5000 -idletime 60
# % vwait forever
#
# Starts the server on the port 5000, sets idle timer to 1 minute.
# You can now use "telnet" utility to connect.
@@ -62,11 +62,11 @@
# Setup default pool data.
#
array set data {
-idletime 300000
- -initcmd {source cmdsrv.tcl}
+ -initcmd {source -encoding utf-8 cmdsrv.tcl}
}
#
# Override with user-supplied data
#
Index: tcl/phttpd/phttpd.tcl
==================================================================
--- tcl/phttpd/phttpd.tcl
+++ tcl/phttpd/phttpd.tcl
@@ -13,11 +13,11 @@
# port Tcp port where the server listens
#
# Example:
#
# # tclsh8.6
-# % source phttpd.tcl
+# % source -encoding utf-8 phttpd.tcl
# % phttpd::create 5000
# % vwait forever
#
# Starts the server on the port 5000. Also, look at the Httpd array
# definition in the "phttpd" namespace declaration to find out
@@ -40,11 +40,11 @@
# example Tcl implementation of threadpools.
# Per default, the C-level threadpool is used.
#
if {0} {
- eval [set TCL_TPOOL {source ../tpool/tpool.tcl}]
+ eval [set TCL_TPOOL {source -encoding utf-8 ../tpool/tpool.tcl}]
}
namespace eval phttpd {
variable Httpd; # Internal server state and config params
@@ -107,11 +107,11 @@
if {$arglen % 2} {
error "wrong \# args, should be: key1 val1 key2 val2..."
}
set opts [array names Httpd]
foreach {arg val} $args {
- if {[lsearch $opts $arg] == -1} {
+ if {[lsearch $opts $arg] < 0} {
error "unknown option \"$arg\""
}
set Httpd($arg) $val
}
}
@@ -122,16 +122,16 @@
if {[info exists ::TCL_TPOOL] == 0} {
#
# Using the internal C-based thread pool
#
- set initcmd "source ../phttpd/phttpd.tcl"
+ set initcmd "source -encoding utf-8 ../phttpd/phttpd.tcl"
} else {
#
# Using the Tcl-level hand-crafted thread pool
#
- append initcmd "source ../phttpd/phttpd.tcl" \n $::TCL_TPOOL
+ append initcmd "source -encoding utf-8 ../phttpd/phttpd.tcl" \n $::TCL_TPOOL
}
set Httpd(tpid) [tpool::create -maxworkers 8 -initcmd $initcmd]
#
Index: tcl/phttpd/uhttpd.tcl
==================================================================
--- tcl/phttpd/uhttpd.tcl
+++ tcl/phttpd/uhttpd.tcl
@@ -13,11 +13,11 @@
# port Tcp port where the server listens
#
# Example:
#
# # tclsh8.6
-# % source uhttpd.tcl
+# % source -encoding utf-8 uhttpd.tcl
# % uhttpd::create 5000
# % vwait forever
#
# Starts the server on the port 5000. Also, look at the Httpd array
# definition in the "uhttpd" namespace declaration to find out
@@ -81,11 +81,11 @@
if {$arglen % 2} {
error "wrong \# arguments, should be: key1 val1 key2 val2..."
}
set opts [array names Httpd]
foreach {arg val} $args {
- if {[lsearch $opts $arg] == -1} {
+ if {[lsearch $opts $arg] < 0} {
error "unknown option \"$arg\""
}
set Httpd($arg) $val
}
}
@@ -133,11 +133,11 @@
upvar \#0 [namespace current]::Httpd$s data
if {[catch {gets $s line} readCount] || [eof $s]} {
return [Done $s]
}
- if {$readCount == -1} {
+ if {$readCount < 0} {
return ;# Insufficient data on non-blocking socket !
}
if {![info exists data(state)]} {
set pat {(POST|GET) ([^?]+)\??([^ ]*) HTTP/1\.[0-9]}
if {[regexp $pat $line x data(proto) data(url) data(query)]} {
Index: tcl/tpool/tpool.tcl
==================================================================
--- tcl/tpool/tpool.tcl
+++ tcl/tpool/tpool.tcl
@@ -105,11 +105,11 @@
-idletime 0
-initcmd ""
-exitcmd ""
}
- tsv::set $tpid -initcmd "source $thisScript"
+ tsv::set $tpid -initcmd "source -encoding utf-8 $thisScript"
#
# Override with user-supplied data
#
Index: tests/all.tcl
==================================================================
--- tests/all.tcl
+++ tests/all.tcl
@@ -44,11 +44,11 @@
# Source each of the specified tests
foreach file [lsort [::tcltest::getMatchingFiles]] {
set tail [file tail $file]
puts stdout $tail
- if {[catch {source $file} msg]} {
+ if {[catch {source -encoding utf-8 $file} msg]} {
puts stdout $msg
}
}
# Cleanup
Index: tests/store-load.tcl
==================================================================
--- tests/store-load.tcl
+++ tests/store-load.tcl
@@ -36,11 +36,11 @@
while {[gets $fd line] > 0} {
if {[string index $line 0] eq {#}} {
continue
}
set tab [string first { } $line]
- if {$tab == -1} {
+ if {$tab < 0} {
continue
}
set k [string range $line 0 $tab-1]
set v [string range $line $tab+1 end]
Index: tests/thread.test
==================================================================
--- tests/thread.test
+++ tests/thread.test
@@ -36,15 +36,13 @@
test thread-2.0 {no global thread command} {
info commands thread
} {}
-test thread-2.84 {thread subcommands} {
- set cmds [info commands thread::*]
- set idx [lsearch -exact $cmds ::thread::cancel]
- lsort [lreplace $cmds $idx $idx]
-} {::thread::attach ::thread::broadcast ::thread::cond ::thread::configure ::thread::create ::thread::detach ::thread::errorproc ::thread::eval ::thread::exists ::thread::exit ::thread::id ::thread::join ::thread::mutex ::thread::names ::thread::preserve ::thread::release ::thread::rwmutex ::thread::send ::thread::transfer ::thread::unwind ::thread::wait}
+test thread-2.84 {thread subcommands} -body {
+ lsort [info commands thread::*]
+} -match glob -result {::thread::attach ::thread::broadcast *::thread::cond ::thread::configure ::thread::create ::thread::detach ::thread::errorproc ::thread::eval ::thread::exists ::thread::exit ::thread::id ::thread::join ::thread::mutex ::thread::names ::thread::preserve ::thread::release ::thread::rwmutex ::thread::send ::thread::transfer ::thread::unwind ::thread::wait}
test thread-3.0 {thread::names initial thread list} {
list [ThreadReap] [llength [thread::names]]
} {1 1}
@@ -1218,23 +1216,8 @@
set c2 [catch {thread::cond destroy $cond} r2]
ThreadReap
thread::mutex destroy $emutex
list $c1 $c2 $r1 $r2
} {1 0 {condition variable is in use} {}}
-
-test thread-22.1 {thread::send -command} {
- ThreadReap
- after 0 [list ::apply [list {} {
- set tid [thread::create]
- thread::send -command $tid {lindex hello} [list ::apply [list args {
- variable result
- set result $args
- } [namespace current]]]
- } [namespace current]]]
- vwait [namespace current]::result
- ThreadReap
- set result
-} hello
-
removeFile dummyForTransfer
::tcltest::cleanupTests
ADDED win/gitmanifest.in
Index: win/gitmanifest.in
==================================================================
--- /dev/null
+++ win/gitmanifest.in
@@ -0,0 +1,1 @@
+git-
Index: win/makefile.vc
==================================================================
--- win/makefile.vc
+++ win/makefile.vc
@@ -6,11 +6,11 @@
# nmake /f makefile.vc INSTALLDIR=c:\tcl
# nmake /f makefile.vc INSTALLDIR=c:\tcl test
# nmake /f makefile.vc INSTALLDIR=c:\tcl install
#
# For other build options (debug, static etc.),
-# See TIP 477 (https://core.tcl.tk/tips/doc/trunk/tip/477.md) for
+# See TIP 477 (https://core.tcl-lang.org/tips/doc/main/tip/477.md) for
# detailed documentation.
#
# In addition to the command line macros described there the following
# may also be defined.
# ADDOPTDEFINES - addition compiler options
@@ -27,10 +27,11 @@
RCFILE = thread.rc
DOCDIR = $(ROOT)\doc\html
PRJ_DEFINES = -D _CRT_SECURE_NO_DEPRECATE -D _CRT_NONSTDC_NO_DEPRECATE -D_CRT_SECURE_NO_WARNINGS
PRJ_DEFINES = $(PRJ_DEFINES) -DTCL_TIP143 -DTCL_TIP285 -DTCL_NO_DEPRECATED=1 $(ADDOPTDEFINES)
+PRJ_DEFINES = $(PRJ_DEFINES) -I$(TMP_DIR)
PRJ_LIBS = $(ADDLINKOPTS)
!include "rules-ext.vc"
PRJ_OBJS = \
@@ -48,15 +49,22 @@
!include "$(_RULESDIR)\targets.vc"
install: default-install-docs-html
pkgindex: default-pkgindex-tea
+$(ROOT)\manifest.uuid:
+ copy $(WIN_DIR)\gitmanifest.in $(ROOT)\manifest.uuid
+ git rev-parse HEAD >>$(ROOT)\manifest.uuid
+
+$(TMP_DIR)\threadUuid.h: $(ROOT)\manifest.uuid
+ copy $(WIN_DIR)\threadUuid.h.in+$(ROOT)\manifest.uuid $(TMP_DIR)\threadUuid.h
+
# Explicit dependency rules
$(GENERICDIR)\psGdbm.c: $(GENERICDIR)\psGdbm.h
$(GENERICDIR)\psLmdb.c: $(GENERICDIR)\psLmdb.h
-$(GENERICDIR)\threadCmd.c : $(GENERICDIR)\tclThreadInt.h
+$(GENERICDIR)\threadCmd.c : $(GENERICDIR)\tclThreadInt.h $(TMP_DIR)\threadUuid.h
$(GENERICDIR)\threadSpCmd.c : $(GENERICDIR)\tclThreadInt.h
$(GENERICDIR)\threadSvCmd.c : $(GENERICDIR)\tclThreadInt.h
$(GENERICDIR)\threadPoolCmd.c : $(GENERICDIR)\tclThreadInt.h
$(GENERICDIR)\threadSvListCmd.c : $(GENERICDIR)\tclThreadInt.h
$(GENERICDIR)\threadSvKeylistCmd.c : $(GENERICDIR)\tclThreadInt.h
Index: win/nmakehlp.c
==================================================================
--- win/nmakehlp.c
+++ win/nmakehlp.c
@@ -2,22 +2,24 @@
* ----------------------------------------------------------------------------
* nmakehlp.c --
*
* This is used to fix limitations within nmake and the environment.
*
- * Copyright (c) 2002 by David Gravereaux.
- * Copyright (c) 2006 by Pat Thoyts
+ * Copyright (c) 2002 David Gravereaux.
+ * Copyright (c) 2006 Pat Thoyts
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
* ----------------------------------------------------------------------------
*/
#define _CRT_SECURE_NO_DEPRECATE
#include
+#ifdef _MSC_VER
#pragma comment (lib, "user32.lib")
#pragma comment (lib, "kernel32.lib")
+#endif
#include
#include
/*
* This library is required for x64 builds with _some_ versions of MSVC
@@ -27,19 +29,19 @@
#pragma comment(lib, "bufferoverflowU")
#endif
#endif
/* ISO hack for dumb VC++ */
-#ifdef _MSC_VER
+#if defined(_WIN32) && defined(_MSC_VER) && _MSC_VER < 1900
#define snprintf _snprintf
#endif
/* protos */
static int CheckForCompilerFeature(const char *option);
-static int CheckForLinkerFeature(const char **options, int count);
+static int CheckForLinkerFeature(char **options, int count);
static int IsIn(const char *string, const char *substring);
static int SubstituteFile(const char *substs, const char *filename);
static int QualifyPath(const char *path);
static int LocateDependency(const char *keyfile);
static const char *GetVersionFromFile(const char *filename, const char *match, int numdots);
@@ -52,12 +54,12 @@
typedef struct {
HANDLE pipe;
char buffer[STATICBUFFERSIZE];
} pipeinfo;
-pipeinfo Out = {INVALID_HANDLE_VALUE, '\0'};
-pipeinfo Err = {INVALID_HANDLE_VALUE, '\0'};
+pipeinfo Out = {INVALID_HANDLE_VALUE, ""};
+pipeinfo Err = {INVALID_HANDLE_VALUE, ""};
/*
* exitcodes: 0 == no, 1 == yes, 2 == error
*/
@@ -203,29 +205,29 @@
HANDLE hProcess, h, pipeThreads[2];
char cmdline[100];
hProcess = GetCurrentProcess();
- ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
- ZeroMemory(&si, sizeof(STARTUPINFO));
+ memset(&pi, 0, sizeof(PROCESS_INFORMATION));
+ memset(&si, 0, sizeof(STARTUPINFO));
si.cb = sizeof(STARTUPINFO);
si.dwFlags = STARTF_USESTDHANDLES;
si.hStdInput = INVALID_HANDLE_VALUE;
- ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES));
+ memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES));
sa.nLength = sizeof(SECURITY_ATTRIBUTES);
sa.lpSecurityDescriptor = NULL;
sa.bInheritHandle = FALSE;
/*
- * Create a non-inheritible pipe.
+ * Create a non-inheritable pipe.
*/
CreatePipe(&Out.pipe, &h, &sa, 0);
/*
- * Dupe the write side, make it inheritible, and close the original.
+ * Dupe the write side, make it inheritable, and close the original.
*/
DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE,
DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
@@ -271,11 +273,11 @@
DWORD err = GetLastError();
int chars = snprintf(msg, sizeof(msg) - 1,
"Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
- FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars],
+ FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPSTR)&msg[chars],
(300-chars), 0);
WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
return 2;
}
@@ -324,11 +326,11 @@
|| strstr(Err.buffer, "D2021") != NULL);
}
static int
CheckForLinkerFeature(
- const char **options,
+ char **options,
int count)
{
STARTUPINFO si;
PROCESS_INFORMATION pi;
SECURITY_ATTRIBUTES sa;
@@ -339,17 +341,17 @@
int i;
char cmdline[255];
hProcess = GetCurrentProcess();
- ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
- ZeroMemory(&si, sizeof(STARTUPINFO));
+ memset(&pi, 0, sizeof(PROCESS_INFORMATION));
+ memset(&si, 0, sizeof(STARTUPINFO));
si.cb = sizeof(STARTUPINFO);
si.dwFlags = STARTF_USESTDHANDLES;
si.hStdInput = INVALID_HANDLE_VALUE;
- ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES));
+ memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES));
sa.nLength = sizeof(SECURITY_ATTRIBUTES);
sa.lpSecurityDescriptor = NULL;
sa.bInheritHandle = TRUE;
/*
@@ -357,11 +359,11 @@
*/
CreatePipe(&Out.pipe, &h, &sa, 0);
/*
- * Dupe the write side, make it inheritible, and close the original.
+ * Dupe the write side, make it inheritable, and close the original.
*/
DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE,
DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
@@ -405,11 +407,11 @@
DWORD err = GetLastError();
int chars = snprintf(msg, sizeof(msg) - 1,
"Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
- FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars],
+ FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPSTR)&msg[chars],
(300-chars), 0);
WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
return 2;
}
@@ -501,47 +503,45 @@
GetVersionFromFile(
const char *filename,
const char *match,
int numdots)
{
- size_t cbBuffer = 100;
static char szBuffer[100];
char *szResult = NULL;
FILE *fp = fopen(filename, "rt");
if (fp != NULL) {
/*
* Read data until we see our match string.
*/
- while (fgets(szBuffer, cbBuffer, fp) != NULL) {
+ while (fgets(szBuffer, sizeof(szBuffer), fp) != NULL) {
LPSTR p, q;
p = strstr(szBuffer, match);
if (p != NULL) {
/*
* Skip to first digit after the match.
*/
p += strlen(match);
- while (*p && !isdigit(*p)) {
+ while (*p && !isdigit((unsigned char)*p)) {
++p;
}
/*
* Find ending whitespace.
*/
q = p;
- while (*q && (strchr("0123456789.ab", *q)) && ((!strchr(".ab", *q)
- && (!strchr("ab", q[-1])) || --numdots))) {
+ while (*q && (strchr("0123456789.ab", *q)) && (((!strchr(".ab", *q)
+ && !strchr("ab", q[-1])) || --numdots))) {
++q;
}
- memcpy(szBuffer, p, q - p);
- szBuffer[q-p] = 0;
- szResult = szBuffer;
+ *q = 0;
+ szResult = p;
break;
}
}
fclose(fp);
}
@@ -560,11 +560,11 @@
/* 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));
+ list_item_t *itemPtr = (list_item_t *)malloc(sizeof(list_item_t));
if (itemPtr) {
itemPtr->key = strdup(key);
itemPtr->value = strdup(value);
itemPtr->nextPtr = NULL;
@@ -591,11 +591,11 @@
/*
* 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
+ * e.g. 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*$
*
@@ -609,26 +609,24 @@
static 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
+ * Build a list of substitutions from the first filename
*/
sp = fopen(substitutions, "rt");
if (sp != NULL) {
- while (fgets(szBuffer, cbBuffer, sp) != NULL) {
+ while (fgets(szBuffer, sizeof(szBuffer), sp) != NULL) {
unsigned char *ks, *ke, *vs, *ve;
ks = (unsigned char*)szBuffer;
while (ks && *ks && isspace(*ks)) ++ks;
ke = ks;
while (ke && *ke && !isspace(*ke)) ++ke;
@@ -641,11 +639,11 @@
}
fclose(sp);
}
/* debug: dump the list */
-#ifdef _DEBUG
+#ifndef NDEBUG
{
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);
@@ -655,11 +653,11 @@
/*
* Run the substitutions over each line of the input
*/
- while (fgets(szBuffer, cbBuffer, fp) != NULL) {
+ while (fgets(szBuffer, sizeof(szBuffer), 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;
@@ -672,11 +670,11 @@
while (*op) *cp++ = *op++;
*cp = 0;
memcpy(szBuffer, szCopy, sizeof(szCopy));
}
}
- printf(szBuffer);
+ printf("%s", szBuffer);
}
list_free(&substPtr);
}
fclose(fp);
@@ -706,11 +704,11 @@
QualifyPath(
const char *szPath)
{
char szCwd[MAX_PATH + 1];
- GetFullPathName(szPath, sizeof(szCwd)-1, szCwd, NULL);
+ GetFullPathName(szPath, sizeof(szCwd)-1, szCwd, NULL);
printf("%s\n", szCwd);
return 0;
}
/*
@@ -723,18 +721,21 @@
*/
static int LocateDependencyHelper(const char *dir, const char *keypath)
{
HANDLE hSearch;
char path[MAX_PATH+1];
- int dirlen, keylen, ret;
+ size_t dirlen;
+ int keylen, ret;
WIN32_FIND_DATA finfo;
- if (dir == NULL || keypath == NULL)
+ if (dir == NULL || keypath == NULL) {
return 2; /* Have no real error reporting mechanism into nmake */
+ }
dirlen = strlen(dir);
- if ((dirlen + 3) > sizeof(path))
+ if (dirlen > sizeof(path) - 3) {
return 2;
+ }
strncpy(path, dir, dirlen);
strncpy(path+dirlen, "\\*", 3); /* Including terminating \0 */
keylen = strlen(keypath);
#if 0 /* This function is not available in Visual C++ 6 */
@@ -790,17 +791,19 @@
* name_DIRPATH=
* and returns 0. If not found, does not print anything and returns 1.
*/
static int LocateDependency(const char *keypath)
{
- int i, ret;
- static char *paths[] = {"..", "..\\..", "..\\..\\.."};
+ size_t i;
+ int ret;
+ static const char *paths[] = {"..", "..\\..", "..\\..\\.."};
for (i = 0; i < (sizeof(paths)/sizeof(paths[0])); ++i) {
ret = LocateDependencyHelper(paths[i], keypath);
- if (ret == 0)
+ if (ret == 0) {
return ret;
+ }
}
return ret;
}
Index: win/pkg.vc
==================================================================
--- win/pkg.vc
+++ win/pkg.vc
@@ -1,6 +1,6 @@
# remember to change configure.ac as well when these change
# (then re-autoconf)
PACKAGE_MAJOR = 2
-PACKAGE_MINOR = 9
-PACKAGE_VERSION = "2.9a1"
+PACKAGE_MINOR = 8
+PACKAGE_VERSION = "2.8.9"
Index: win/rules-ext.vc
==================================================================
--- win/rules-ext.vc
+++ win/rules-ext.vc
@@ -29,11 +29,16 @@
!endif
# We extract version numbers using the nmakehlp program. For now use
# the local copy of nmakehlp. Once we locate Tcl, we will use that
# one if it is newer.
-!if [$(CC) -nologo "nmakehlp.c" -link -subsystem:console > nul]
+!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)"
+!if [$(CC) -nologo -DNDEBUG "nmakehlp.c" -link -subsystem:console > nul]
+!endif
+!else
+!if [copy x86_64-w64-mingw32-nmakehlp.exe nmakehlp.exe >NUL]
+!endif
!endif
# First locate the Tcl directory that we are working with.
!if "$(TCLDIR)" != ""
Index: win/rules.vc
==================================================================
--- win/rules.vc
+++ win/rules.vc
@@ -4,11 +4,11 @@
# Part of the nmake based build system for Tcl and its extensions.
# This file does all the hard work in terms of parsing build options,
# compiler switches, defining common targets and macros. The Tcl makefile
# directly includes this. Extensions include it via "rules-ext.vc".
#
-# See TIP 477 (https://core.tcl.tk/tips/doc/trunk/tip/477.md) for
+# See TIP 477 (https://core.tcl-lang.org/tips/doc/main/tip/477.md) for
# detailed documentation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
@@ -22,11 +22,11 @@
# The following macros define the version of the rules.vc nmake build system
# For modifications that are not backward-compatible, you *must* change
# the major version.
RULES_VERSION_MAJOR = 1
-RULES_VERSION_MINOR = 4
+RULES_VERSION_MINOR = 11
# The PROJECT macro must be defined by parent makefile.
!if "$(PROJECT)" == ""
!error *** Error: Macro PROJECT not defined! Please define it before including rules.vc
!endif
@@ -77,14 +77,15 @@
# 2. Figure out our build structure in terms of the directory, whether
# we are building Tcl or an extension, etc.
# 3. Determine the compiler and linker versions
# 4. Build the nmakehlp helper application
# 5. Determine the supported compiler options and features
-# 6. Parse the OPTS macro value for user-specified build configuration
-# 7. Parse the STATS macro value for statistics instrumentation
-# 8. Parse the CHECKS macro for additional compilation checks
-# 9. Extract Tcl, and possibly Tk, version numbers from the headers
+# 6. Extract Tcl, Tk, and possibly extensions, version numbers from the
+# headers
+# 7. Parse the OPTS macro value for user-specified build configuration
+# 8. Parse the STATS macro value for statistics instrumentation
+# 9. Parse the CHECKS macro for additional compilation checks
# 10. Based on this selected configuration, construct the output
# directory and file paths
# 11. Construct the paths where the package is to be installed
# 12. Set up the actual options passed to compiler and linker based
# on the information gathered above.
@@ -300,11 +301,11 @@
# NOTE: we will be resetting _INSTALLDIR to _INSTALLDIR/lib for extensions
# later so the \.. accounts for the /lib
_TCLDIR = $(_INSTALLDIR)\..
_TCL_H = $(_TCLDIR)\include\tcl.h
-!else # exist(...) && ! $(NEED_TCL_SOURCE)
+!else # exist(...) && !$(NEED_TCL_SOURCE)
!if [echo _TCLDIR = \> nmakehlp.out] \
|| [nmakehlp -L generic\tcl.h >> nmakehlp.out]
!error *** Could not locate Tcl source directory.
!endif
@@ -311,11 +312,11 @@
!include nmakehlp.out
TCLINSTALL = 0
TCLDIR = $(_TCLDIR)
_TCL_H = $(_TCLDIR)\generic\tcl.h
-!endif # exist(...) && ! $(NEED_TCL_SOURCE)
+!endif # exist(...) && !$(NEED_TCL_SOURCE)
!endif # TCLDIR
!ifndef _TCL_H
MSG =^
@@ -409,17 +410,14 @@
# This is also printed by the compiler in dotted form 19.10 etc.
# VCVER - the "marketing version", for example Visual C++ 6 for internal
# compiler version 1200. This is kept only for legacy reasons as it
# does not make sense for recent Microsoft compilers. Only used for
# output directory names.
-# ARCH - set to IX86 or AMD64 depending on 32- or 64-bit target
-# NATIVE_ARCH - set to IX86 or AMD64 for the host machine
+# ARCH - set to IX86, ARM64 or AMD64 depending on 32- or 64-bit target
+# NATIVE_ARCH - set to IX86, ARM64 or AMD64 for the host machine
# MACHINE - same as $(ARCH) - legacy
# _VC_MANIFEST_EMBED_{DLL,EXE} - commands for embedding a manifest if needed
-# CFG_ENCODING - set to an character encoding.
-# TBD - this is passed to compiler as TCL_CFGVAL_ENCODING but can't
-# see where it is used
cc32 = $(CC) # built-in default.
link32 = link
lib32 = lib
rc32 = $(RC) # built-in default.
@@ -436,10 +434,12 @@
!if ![echo VCVERSION=_MSC_VER > vercl.x] \
&& ![echo $(_HASH)if defined(_M_IX86) >> vercl.x] \
&& ![echo ARCH=IX86 >> vercl.x] \
&& ![echo $(_HASH)elif defined(_M_AMD64) >> vercl.x] \
&& ![echo ARCH=AMD64 >> vercl.x] \
+ && ![echo $(_HASH)elif defined(_M_ARM64) >> vercl.x] \
+ && ![echo ARCH=ARM64 >> vercl.x] \
&& ![echo $(_HASH)endif >> vercl.x] \
&& ![$(cc32) -nologo -TC -P vercl.x 2>NUL]
!include vercl.i
!if $(VCVERSION) < 1900
!if ![echo VCVER= ^\> vercl.vc] \
@@ -460,10 +460,13 @@
# The MACHINE macro is used by legacy makefiles so set it as well
!ifdef MACHINE
!if "$(MACHINE)" == "x86"
!undef MACHINE
MACHINE = IX86
+!elseif "$(MACHINE)" == "arm64"
+!undef MACHINE
+MACHINE = ARM64
!elseif "$(MACHINE)" == "x64"
!undef MACHINE
MACHINE = AMD64
!endif
!if "$(MACHINE)" != "$(ARCH)"
@@ -476,10 +479,12 @@
#---------------------------------------------------------------
# The PLATFORM_IDENTIFY macro matches the values returned by
# the Tcl platform::identify command
!if "$(MACHINE)" == "AMD64"
PLATFORM_IDENTIFY = win32-x86_64
+!elseif "$(MACHINE)" == "ARM64"
+PLATFORM_IDENTIFY = win32-arm
!else
PLATFORM_IDENTIFY = win32-ix86
!endif
# The MULTIPLATFORM macro controls whether binary extensions are installed
@@ -491,10 +496,12 @@
#------------------------------------------------------------
# Figure out the *host* architecture by reading the registry
!if ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i x86]
NATIVE_ARCH=IX86
+!elseif ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i ARM | findstr /i 64-bit]
+NATIVE_ARCH=ARM64
!else
NATIVE_ARCH=AMD64
!endif
# Since MSVC8 we must deal with manifest resources.
@@ -501,22 +508,18 @@
!if $(VCVERSION) >= 1400
_VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1
_VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
!endif
-!ifndef CFG_ENCODING
-CFG_ENCODING = \"cp1252\"
-!endif
-
################################################################
# 4. Build the nmakehlp program
# This is a helper app we need to overcome nmake's limiting
# environment. We will call out to it to get various bits of
# information about supported compiler options etc.
#
# Tcl itself will always use the nmakehlp.c program which is
-# in its own source. This is the "master" copy and kept updated.
+# in its own source. It will be kept updated there.
#
# Extensions built against an installed Tcl will use the installed
# copy of Tcl's nmakehlp.c if there is one and their own version
# otherwise. In the latter case, they would also be using their own
# rules.vc. Note that older versions of Tcl do not install nmakehlp.c
@@ -535,11 +538,11 @@
!if !$(DOING_TCL)
!if $(TCLINSTALL)
!if exist("$(_TCLDIR)\lib\nmake\nmakehlp.c")
NMAKEHLPC = $(_TCLDIR)\lib\nmake\nmakehlp.c
!endif
-!else # ! $(TCLINSTALL)
+!else # !$(TCLINSTALL)
!if exist("$(_TCLDIR)\win\nmakehlp.c")
NMAKEHLPC = $(_TCLDIR)\win\nmakehlp.c
!endif
!endif # $(TCLINSTALL)
!endif # !$(DOING_TCL)
@@ -546,12 +549,17 @@
!endif # NMAKEHLPC
# We always build nmakehlp even if it exists since we do not know
# what source it was built from.
+!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)"
!if [$(cc32) -nologo "$(NMAKEHLPC)" -link -subsystem:console > nul]
!endif
+!else
+!if [copy $(NMAKEHLPC:nmakehlp.c=x86_64-w64-mingw32-nmakehlp.exe) nmakehlp.exe >NUL]
+!endif
+!endif
################################################################
# 5. Test for compiler features
# Visual C++ compiler options have changed over the years. Check
# which options are supported by the compiler in use.
@@ -657,12 +665,134 @@
!if [nmakehlp -l -ltcg $(LINKER_TESTFLAGS)]
LINKERFLAGS = $(LINKERFLAGS) -ltcg
!endif
!endif
+
+################################################################
+# 6. Extract various version numbers from headers
+# For Tcl and Tk, version numbers are extracted from tcl.h and tk.h
+# respectively. For extensions, versions are extracted from the
+# configure.in or configure.ac from the TEA configuration if it
+# exists, and unset otherwise.
+# Sets the following macros:
+# TCL_MAJOR_VERSION
+# TCL_MINOR_VERSION
+# TCL_RELEASE_SERIAL
+# TCL_PATCH_LEVEL
+# TCL_PATCH_LETTER
+# TCL_VERSION
+# TK_MAJOR_VERSION
+# TK_MINOR_VERSION
+# TK_RELEASE_SERIAL
+# TK_PATCH_LEVEL
+# TK_PATCH_LETTER
+# TK_VERSION
+# DOTVERSION - set as (for example) 2.5
+# VERSION - set as (for example 25)
+#--------------------------------------------------------------
+
+!if [echo REM = This file is generated from rules.vc > versions.vc]
+!endif
+!if [echo TCL_MAJOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V "$(_TCL_H)" "define TCL_MAJOR_VERSION" >> versions.vc]
+!endif
+!if [echo TCL_MINOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V "$(_TCL_H)" TCL_MINOR_VERSION >> versions.vc]
+!endif
+!if [echo TCL_RELEASE_SERIAL = \>> versions.vc] \
+ && [nmakehlp -V "$(_TCL_H)" TCL_RELEASE_SERIAL >> versions.vc]
+!endif
+!if [echo TCL_PATCH_LEVEL = \>> versions.vc] \
+ && [nmakehlp -V "$(_TCL_H)" TCL_PATCH_LEVEL >> versions.vc]
+!endif
+
+!if defined(_TK_H)
+!if [echo TK_MAJOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V $(_TK_H) "define TK_MAJOR_VERSION" >> versions.vc]
+!endif
+!if [echo TK_MINOR_VERSION = \>> versions.vc] \
+ && [nmakehlp -V $(_TK_H) TK_MINOR_VERSION >> versions.vc]
+!endif
+!if [echo TK_RELEASE_SERIAL = \>> versions.vc] \
+ && [nmakehlp -V "$(_TK_H)" TK_RELEASE_SERIAL >> versions.vc]
+!endif
+!if [echo TK_PATCH_LEVEL = \>> versions.vc] \
+ && [nmakehlp -V $(_TK_H) TK_PATCH_LEVEL >> versions.vc]
+!endif
+!endif # _TK_H
+
+!include versions.vc
+
+TCL_VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
+TCL_DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
+!if [nmakehlp -f $(TCL_PATCH_LEVEL) "a"]
+TCL_PATCH_LETTER = a
+!elseif [nmakehlp -f $(TCL_PATCH_LEVEL) "b"]
+TCL_PATCH_LETTER = b
+!else
+TCL_PATCH_LETTER = .
+!endif
+
+!if defined(_TK_H)
+
+TK_VERSION = $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION)
+TK_DOTVERSION = $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)
+!if [nmakehlp -f $(TK_PATCH_LEVEL) "a"]
+TK_PATCH_LETTER = a
+!elseif [nmakehlp -f $(TK_PATCH_LEVEL) "b"]
+TK_PATCH_LETTER = b
+!else
+TK_PATCH_LETTER = .
+!endif
+
+!endif
+
+# Set DOTVERSION and VERSION
+!if $(DOING_TCL)
+
+DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
+VERSION = $(TCL_VERSION)
+
+!elseif $(DOING_TK)
+
+DOTVERSION = $(TK_DOTVERSION)
+VERSION = $(TK_VERSION)
+
+!else # Doing a non-Tk extension
+
+# If parent makefile has not defined DOTVERSION, try to get it from TEA
+# first from a configure.in file, and then from configure.ac
+!ifndef DOTVERSION
+!if [echo DOTVERSION = \> versions.vc] \
+ || [nmakehlp -V $(ROOT)\configure.in ^[$(PROJECT)^] >> versions.vc]
+!if [echo DOTVERSION = \> versions.vc] \
+ || [nmakehlp -V $(ROOT)\configure.ac ^[$(PROJECT)^] >> versions.vc]
+!error *** Could not figure out extension version. Please define DOTVERSION in parent makefile before including rules.vc.
+!endif
+!endif
+!include versions.vc
+!endif # DOTVERSION
+VERSION = $(DOTVERSION:.=)
+
+!endif # $(DOING_TCL) ... etc.
+
+# Windows RC files have 3 version components. Ensure this irrespective
+# of how many components the package has specified. Basically, ensure
+# minimum 4 components by appending 4 0's and then pick out the first 4.
+# Also take care of the fact that DOTVERSION may have "a" or "b" instead
+# of "." separating the version components.
+DOTSEPARATED=$(DOTVERSION:a=.)
+DOTSEPARATED=$(DOTSEPARATED:b=.)
+!if [echo RCCOMMAVERSION = \> versions.vc] \
+ || [for /f "tokens=1,2,3,4,5* delims=." %a in ("$(DOTSEPARATED).0.0.0.0") do echo %a,%b,%c,%d >> versions.vc]
+!error *** Could not generate RCCOMMAVERSION ***
+!endif
+!include versions.vc
+
########################################################################
-# 6. Parse the OPTS macro to work out the requested build configuration.
+# 7. Parse the OPTS macro to work out the requested build configuration.
# Based on this, we will construct the actual switches to be passed to the
# compiler and linker using the macros defined in the previous section.
# The following macros are defined by this section based on OPTS
# STATIC_BUILD - 0 -> Tcl is to be built as a shared library
# 1 -> build as a static library and shell
@@ -672,23 +802,23 @@
# PROFILE - 1 -> generate profiling info, 0 -> no profiling
# PGO - 1 -> profile based optimization, 0 -> no
# MSVCRT - 1 -> link to dynamic C runtime even when building static Tcl build
# 0 -> link to static C runtime for static Tcl build.
# Does not impact shared Tcl builds (STATIC_BUILD == 0)
+# Default: 1 for Tcl 8.7 and up, 0 otherwise.
# TCL_USE_STATIC_PACKAGES - 1 -> statically link the registry and dde extensions
-# in the Tcl shell. 0 -> keep them as shared libraries
-# Does not impact shared Tcl builds.
+# in the Tcl and Wish shell. 0 -> keep them as shared libraries. Does
+# not impact shared Tcl builds. Implied by STATIC_BUILD since Tcl 8.7.
# USE_THREAD_ALLOC - 1 -> Use a shared global free pool for allocation.
# 0 -> Use the non-thread allocator.
# UNCHECKED - 1 -> when doing a debug build with symbols, use the release
# C runtime, 0 -> use the debug C runtime.
# USE_STUBS - 1 -> compile to use stubs interfaces, 0 -> direct linking
# CONFIG_CHECK - 1 -> check current build configuration against Tcl
# configuration (ignored for Tcl itself)
# _USE_64BIT_TIME_T - forces a build using 64-bit time_t for 32-bit build
-# (CRT library should support this)
-# TCL_UTF_MAX=6 - forces a build using 32-bit Tcl_UniChar in stead of 16-bit.
+# (CRT library should support this, not needed for Tcl 9.x)
# Further, LINKERFLAGS are modified based on above.
# Default values for all the above
STATIC_BUILD = 0
TCL_THREADS = 1
@@ -727,35 +857,38 @@
!message *** Doing nomsvcrt
MSVCRT = 0
!else
!if [nmakehlp -f $(OPTS) "msvcrt"]
!message *** Doing msvcrt
-MSVCRT = 1
!else
-!if !$(STATIC_BUILD)
-MSVCRT = 1
-!else
+!if $(TCL_MAJOR_VERSION) == 8 && $(TCL_MINOR_VERSION) < 7 && $(STATIC_BUILD)
MSVCRT = 0
!endif
!endif
!endif # [nmakehlp -f $(OPTS) "nomsvcrt"]
!if [nmakehlp -f $(OPTS) "staticpkg"] && $(STATIC_BUILD)
!message *** Doing staticpkg
TCL_USE_STATIC_PACKAGES = 1
-!else
-TCL_USE_STATIC_PACKAGES = 0
!endif
+!if [nmakehlp -f $(OPTS) "nothreads"]
+!message *** Compile explicitly for non-threaded tcl
+TCL_THREADS = 0
+USE_THREAD_ALLOC= 0
+!endif
+
+!if [nmakehlp -f $(OPTS) "tcl8"]
+!message *** Build for Tcl8
+TCL_BUILD_FOR = 8
+!endif
+
+!if $(TCL_MAJOR_VERSION) == 8
!if [nmakehlp -f $(OPTS) "time64bit"]
!message *** Force 64-bit time_t
_USE_64BIT_TIME_T = 1
!endif
-
-!if [nmakehlp -f $(OPTS) "utfmax"]
-!message *** Force 32-bit Tcl_UniChar
-TCL_UTF_MAX = 6
!endif
# Yes, it's weird that the "symbols" option controls DEBUG and
# the "pdbs" option controls SYMBOLS. That's historical.
!if [nmakehlp -f $(OPTS) "symbols"]
@@ -790,10 +923,16 @@
!endif
!if [nmakehlp -f $(OPTS) "loimpact"]
!message *** Warning: ignoring option "loimpact" - deprecated on modern Windows.
!endif
+
+# TBD - should get rid of this option
+!if [nmakehlp -f $(OPTS) "thrdalloc"]
+!message *** Doing thrdalloc
+USE_THREAD_ALLOC = 1
+!endif
!if [nmakehlp -f $(OPTS) "tclalloc"]
USE_THREAD_ALLOC = 0
!endif
@@ -831,11 +970,11 @@
!error $(MSG)
!endif
!endif
################################################################
-# 7. Parse the STATS macro to configure code instrumentation
+# 8. Parse the STATS macro to configure code instrumentation
# The following macros are set by this section:
# TCL_MEM_DEBUG - 1 -> enables memory allocation instrumentation
# 0 -> disables
# TCL_COMPILE_DEBUG - 1 -> enables byte compiler logging
# 0 -> disables
@@ -861,11 +1000,11 @@
!endif
!endif
####################################################################
-# 8. Parse the CHECKS macro to configure additional compiler checks
+# 9. Parse the CHECKS macro to configure additional compiler checks
# The following macros are set by this section:
# WARNINGS - compiler switches that control the warnings level
# TCL_NO_DEPRECATED - 1 -> disable support for deprecated functions
# 0 -> enable deprecated functions
@@ -893,90 +1032,10 @@
WARNINGS = $(WARNINGS) -Wp64
!endif
!endif
-################################################################
-# 9. Extract various version numbers
-# For Tcl and Tk, version numbers are extracted from tcl.h and tk.h
-# respectively. For extensions, versions are extracted from the
-# configure.in or configure.ac from the TEA configuration if it
-# exists, and unset otherwise.
-# Sets the following macros:
-# TCL_MAJOR_VERSION
-# TCL_MINOR_VERSION
-# TCL_PATCH_LEVEL
-# TCL_VERSION
-# TK_MAJOR_VERSION
-# TK_MINOR_VERSION
-# TK_PATCH_LEVEL
-# TK_VERSION
-# DOTVERSION - set as (for example) 2.5
-# VERSION - set as (for example 25)
-#--------------------------------------------------------------
-
-!if [echo REM = This file is generated from rules.vc > versions.vc]
-!endif
-!if [echo TCL_MAJOR_VERSION = \>> versions.vc] \
- && [nmakehlp -V "$(_TCL_H)" TCL_MAJOR_VERSION >> versions.vc]
-!endif
-!if [echo TCL_MINOR_VERSION = \>> versions.vc] \
- && [nmakehlp -V "$(_TCL_H)" TCL_MINOR_VERSION >> versions.vc]
-!endif
-!if [echo TCL_PATCH_LEVEL = \>> versions.vc] \
- && [nmakehlp -V "$(_TCL_H)" TCL_PATCH_LEVEL >> versions.vc]
-!endif
-
-!if defined(_TK_H)
-!if [echo TK_MAJOR_VERSION = \>> versions.vc] \
- && [nmakehlp -V $(_TK_H) TK_MAJOR_VERSION >> versions.vc]
-!endif
-!if [echo TK_MINOR_VERSION = \>> versions.vc] \
- && [nmakehlp -V $(_TK_H) TK_MINOR_VERSION >> versions.vc]
-!endif
-!if [echo TK_PATCH_LEVEL = \>> versions.vc] \
- && [nmakehlp -V $(_TK_H) TK_PATCH_LEVEL >> versions.vc]
-!endif
-!endif # _TK_H
-
-!include versions.vc
-
-TCL_VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
-TCL_DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
-!if defined(_TK_H)
-TK_VERSION = $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION)
-TK_DOTVERSION = $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)
-!endif
-
-# Set DOTVERSION and VERSION
-!if $(DOING_TCL)
-
-DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
-VERSION = $(TCL_VERSION)
-
-!elseif $(DOING_TK)
-
-DOTVERSION = $(TK_DOTVERSION)
-VERSION = $(TK_VERSION)
-
-!else # Doing a non-Tk extension
-
-# If parent makefile has not defined DOTVERSION, try to get it from TEA
-# first from a configure.in file, and then from configure.ac
-!ifndef DOTVERSION
-!if [echo DOTVERSION = \> versions.vc] \
- || [nmakehlp -V $(ROOT)\configure.in ^[$(PROJECT)^] >> versions.vc]
-!if [echo DOTVERSION = \> versions.vc] \
- || [nmakehlp -V $(ROOT)\configure.ac ^[$(PROJECT)^] >> versions.vc]
-!error *** Could not figure out extension version. Please define DOTVERSION in parent makefile before including rules.vc.
-!endif
-!endif
-!include versions.vc
-!endif # DOTVERSION
-VERSION = $(DOTVERSION:.=)
-
-!endif # $(DOING_TCL) ... etc.
################################################################
# 10. Construct output directory and file paths
# Figure-out how to name our intermediate and output directories.
# In order to avoid inadvertent mixing of object files built using
@@ -1018,11 +1077,11 @@
!endif
!if $(VCVER) > 6
BUILDDIRTOP =$(BUILDDIRTOP)_VC$(VCVER)
!endif
-!if !$(DEBUG) || $(DEBUG) && $(UNCHECKED)
+!if !$(DEBUG) || $(TCL_VERSION) > 86 || $(DEBUG) && $(UNCHECKED)
SUFX = $(SUFX:g=)
!endif
TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_ThreadedDynamicStaticX
@@ -1033,11 +1092,11 @@
TMP_DIRFULL = $(TMP_DIRFULL:X=)
SUFX = $(SUFX:x=)
!else
TMP_DIRFULL = $(TMP_DIRFULL:Dynamic=)
EXT = lib
-!if !$(MSVCRT)
+!if $(MSVCRT) && $(TCL_VERSION) > 86 || !$(MSVCRT) && $(TCL_VERSION) < 87
TMP_DIRFULL = $(TMP_DIRFULL:X=)
SUFX = $(SUFX:x=)
!endif
!endif
@@ -1069,24 +1128,35 @@
!include nmakehlp.out
# The name of the stubs library for the project being built
STUBPREFIX = $(PROJECT)stub
+#
# Set up paths to various Tcl executables and libraries needed by extensions
+#
+
+# TIP 430. Unused for 8.6 but no harm defining it to allow a common rules.vc
+TCLSCRIPTZIPNAME = libtcl$(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)$(TCL_PATCH_LETTER)$(TCL_RELEASE_SERIAL).zip
+TKSCRIPTZIPNAME = libtk$(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)$(TK_PATCH_LETTER)$(TK_RELEASE_SERIAL).zip
+
!if $(DOING_TCL)
-
TCLSHNAME = $(PROJECT)sh$(VERSION)$(SUFX).exe
TCLSH = $(OUT_DIR)\$(TCLSHNAME)
TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
TCLLIB = $(OUT_DIR)\$(TCLLIBNAME)
+TCLSCRIPTZIP = $(OUT_DIR)\$(TCLSCRIPTZIPNAME)
+!if $(TCL_MAJOR_VERSION) == 8
TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
+!else
+TCLSTUBLIBNAME = $(STUBPREFIX).lib
+!endif
TCLSTUBLIB = $(OUT_DIR)\$(TCLSTUBLIBNAME)
TCL_INCLUDES = -I"$(WIN_DIR)" -I"$(GENERICDIR)"
-!else # ! $(DOING_TCL)
+!else # !$(DOING_TCL)
!if $(TCLINSTALL) # Building against an installed Tcl
# When building extensions, we need to locate tclsh. Depending on version
# of Tcl we are building against, this may or may not have a "t" suffix.
@@ -1094,45 +1164,59 @@
TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:t=).exe
!if !exist("$(TCLSH)")
TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX:t=).exe
!endif
+!if $(TCL_MAJOR_VERSION) == 8
TCLSTUBLIB = $(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib
+!else
+TCLSTUBLIB = $(_TCLDIR)\lib\tclstub.lib
+!endif
TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:t=).lib
# When building extensions, may be linking against Tcl that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
!if !exist("$(TCLIMPLIB)")
TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)t$(SUFX:t=).lib
!endif
TCL_LIBRARY = $(_TCLDIR)\lib
TCLREGLIB = $(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib
TCLDDELIB = $(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib
+TCLSCRIPTZIP = $(_TCLDIR)\lib\$(TCLSCRIPTZIPNAME)
TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target
TCL_INCLUDES = -I"$(_TCLDIR)\include"
!else # Building against Tcl sources
TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX:t=).exe
!if !exist($(TCLSH))
TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX:t=).exe
!endif
+!if $(TCL_MAJOR_VERSION) == 8
TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib
+!else
+TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub.lib
+!endif
TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).lib
# When building extensions, may be linking against Tcl that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
!if !exist("$(TCLIMPLIB)")
TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)t$(SUFX:t=).lib
!endif
TCL_LIBRARY = $(_TCLDIR)\library
TCLREGLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib
TCLDDELIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib
+TCLSCRIPTZIP = $(_TCLDIR)\win\$(BUILDDIRTOP)\$(TCLSCRIPTZIPNAME)
TCLTOOLSDIR = $(_TCLDIR)\tools
TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
!endif # TCLINSTALL
+!if !$(STATIC_BUILD) && "$(TCL_BUILD_FOR)" == "8"
+tcllibs = "$(TCLSTUBLIB)"
+!else
tcllibs = "$(TCLSTUBLIB)" "$(TCLIMPLIB)"
+!endif
!endif # $(DOING_TCL)
# We need a tclsh that will run on the host machine as part of the build.
# IX86 runs on all architectures.
@@ -1146,20 +1230,32 @@
# Do the same for Tk and Tk extensions that require the Tk libraries
!if $(DOING_TK) || $(NEED_TK)
WISHNAMEPREFIX = wish
WISHNAME = $(WISHNAMEPREFIX)$(TK_VERSION)$(SUFX).exe
-TKLIBNAME = $(PROJECT)$(TK_VERSION)$(SUFX).$(EXT)
-TKSTUBLIBNAME = tkstub$(TK_VERSION).lib
+TKLIBNAME8 = tk$(TK_VERSION)$(SUFX).$(EXT)
+TKLIBNAME9 = tcl9tk$(TK_VERSION)$(SUFX).$(EXT)
+!if $(TCL_MAJOR_VERSION) == 8 || "$(TCL_BUILD_FOR)" == "8"
+TKLIBNAME = tk$(TK_VERSION)$(SUFX).$(EXT)
TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX).lib
+!else
+TKLIBNAME = tcl9tk$(TK_VERSION)$(SUFX).$(EXT)
+TKIMPLIBNAME = tcl9tk$(TK_VERSION)$(SUFX).lib
+!endif
+!if $(TK_MAJOR_VERSION) == 8
+TKSTUBLIBNAME = tkstub$(TK_VERSION).lib
+!else
+TKSTUBLIBNAME = tkstub.lib
+!endif
!if $(DOING_TK)
WISH = $(OUT_DIR)\$(WISHNAME)
TKSTUBLIB = $(OUT_DIR)\$(TKSTUBLIBNAME)
TKIMPLIB = $(OUT_DIR)\$(TKIMPLIBNAME)
TKLIB = $(OUT_DIR)\$(TKLIBNAME)
-TK_INCLUDES = -I"$(WIN_DIR)" -I"$(GENERICDIR)"
+TK_INCLUDES = -I"$(WIN_DIR)" -I"$(GENERICDIR)"
+TKSCRIPTZIP = $(OUT_DIR)\$(TKSCRIPTZIPNAME)
!else # effectively NEED_TK
!if $(TKINSTALL) # Building against installed Tk
WISH = $(_TKDIR)\bin\$(WISHNAME)
@@ -1170,11 +1266,14 @@
!if !exist("$(TKIMPLIB)")
TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX:t=).lib
TKIMPLIB = $(_TKDIR)\lib\$(TKIMPLIBNAME)
!endif
TK_INCLUDES = -I"$(_TKDIR)\include"
+TKSCRIPTZIP = $(_TKDIR)\lib\$(TKSCRIPTZIPNAME)
+
!else # Building against Tk sources
+
WISH = $(_TKDIR)\win\$(BUILDDIRTOP)\$(WISHNAME)
TKSTUBLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKSTUBLIBNAME)
TKIMPLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME)
# When building extensions, may be linking against Tk that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
@@ -1181,22 +1280,35 @@
!if !exist("$(TKIMPLIB)")
TKIMPLIBNAME = tk$(TK_VERSION)$(SUFX:t=).lib
TKIMPLIB = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME)
!endif
TK_INCLUDES = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib"
+TKSCRIPTZIP = $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKSCRIPTZIPNAME)
+
!endif # TKINSTALL
+
tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)"
!endif # $(DOING_TK)
!endif # $(DOING_TK) || $(NEED_TK)
# Various output paths
-PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX:t=).lib
-PRJLIBNAME = $(PROJECT)$(VERSION)$(SUFX:t=).$(EXT)
+PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
+PRJLIBNAME8 = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
+PRJLIBNAME9 = tcl9$(PROJECT)$(VERSION)$(SUFX).$(EXT)
+!if $(TCL_MAJOR_VERSION) == 8 || "$(TCL_BUILD_FOR)" == "8"
+PRJLIBNAME = $(PRJLIBNAME8)
+!else
+PRJLIBNAME = $(PRJLIBNAME9)
+!endif
PRJLIB = $(OUT_DIR)\$(PRJLIBNAME)
+!if $(TCL_MAJOR_VERSION) == 8
PRJSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
+!else
+PRJSTUBLIBNAME = $(STUBPREFIX).lib
+!endif
PRJSTUBLIB = $(OUT_DIR)\$(PRJSTUBLIBNAME)
# If extension parent makefile has not defined a resource definition file,
# we will generate one from standard template.
!if !$(DOING_TCL) && !$(DOING_TK) && !$(STATIC_BUILD)
@@ -1222,10 +1334,11 @@
LIB_INSTALL_DIR = $(_INSTALLDIR)\lib
BIN_INSTALL_DIR = $(_INSTALLDIR)\bin
DOC_INSTALL_DIR = $(_INSTALLDIR)\doc
!if $(DOING_TCL)
SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\$(PROJECT)$(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
+MODULE_INSTALL_DIR = $(_INSTALLDIR)\lib\tcl$(TCL_MAJOR_VERSION)
!else # DOING_TK
SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\$(PROJECT)$(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)
!endif
DEMO_INSTALL_DIR = $(SCRIPT_INSTALL_DIR)\demos
INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include
@@ -1253,11 +1366,11 @@
# options that we will pass to the compiler and linker. The main
# makefile should use these in combination with whatever other flags
# and switches are specific to it.
# The following macros are defined, names are for historical compatibility:
# OPTDEFINES - /Dxxx C macro flags based on user-specified OPTS
-# COMPILERFLAGS - /Dxxx C macro flags independent of any configuration opttions
+# COMPILERFLAGS - /Dxxx C macro flags independent of any configuration options
# crt - Compiler switch that selects the appropriate C runtime
# cdebug - Compiler switches related to debug AND optimizations
# cwarn - Compiler switches that set warning levels
# cflags - complete compiler switches (subsumes cdebug and cwarn)
# ldebug - Linker switches controlling debug information and optimization
@@ -1266,11 +1379,19 @@
# conlflags - complete linker switches for console program (subsumes lflags)
# guilflags - complete linker switches for GUI program (subsumes lflags)
# baselibs - minimum Windows libraries required. Parent makefile can
# define PRJ_LIBS before including rules.rc if additional libs are needed
-OPTDEFINES = /DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) /DSTDC_HEADERS
+OPTDEFINES = /DSTDC_HEADERS /DUSE_NMAKE=1
+!if $(VCVERSION) > 1600
+OPTDEFINES = $(OPTDEFINES) /DHAVE_STDINT_H=1
+!else
+OPTDEFINES = $(OPTDEFINES) /DMP_NO_STDINT=1
+!endif
+!if $(VCVERSION) >= 1800
+OPTDEFINES = $(OPTDEFINES) /DHAVE_INTTYPES_H=1 /DHAVE_STDBOOL_H=1
+!endif
!if $(TCL_MEM_DEBUG)
OPTDEFINES = $(OPTDEFINES) /DTCL_MEM_DEBUG
!endif
!if $(TCL_COMPILE_DEBUG)
@@ -1282,19 +1403,24 @@
OPTDEFINES = $(OPTDEFINES) /DUSE_THREAD_ALLOC=1
!endif
!endif
!if $(STATIC_BUILD)
OPTDEFINES = $(OPTDEFINES) /DSTATIC_BUILD
+!elseif $(TCL_VERSION) > 86
+OPTDEFINES = $(OPTDEFINES) /DTCL_WITH_EXTERNAL_TOMMATH
+!if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64"
+OPTDEFINES = $(OPTDEFINES) /DMP_64BIT
+!endif
!endif
!if $(TCL_NO_DEPRECATED)
OPTDEFINES = $(OPTDEFINES) /DTCL_NO_DEPRECATED
!endif
!if $(USE_STUBS)
# Note we do not define USE_TCL_STUBS even when building tk since some
# test targets in tk do not use stubs
-!if ! $(DOING_TCL)
+!if !$(DOING_TCL)
USE_STUBS_DEFS = /DUSE_TCL_STUBS /DUSE_TCLOO_STUBS
!if $(NEED_TK)
USE_STUBS_DEFS = $(USE_STUBS_DEFS) /DUSE_TK_STUBS
!endif
!endif
@@ -1307,26 +1433,28 @@
!endif
!endif
!if $(PROFILE)
OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_PROFILED
!endif
-!if "$(MACHINE)" == "AMD64"
+!if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64"
OPTDEFINES = $(OPTDEFINES) /DTCL_CFG_DO64BIT
!endif
!if $(VCVERSION) < 1300
-OPTDEFINES = $(OPTDEFINES) /DNO_STRTOI64
+OPTDEFINES = $(OPTDEFINES) /DNO_STRTOI64=1
!endif
+!if $(TCL_MAJOR_VERSION) == 8
!if "$(_USE_64BIT_TIME_T)" == "1"
-OPTDEFINES = $(OPTDEFINES) /D_USE_64BIT_TIME_T
-!endif
-!if "$(TCL_UTF_MAX)" == "6"
-OPTDEFINES = $(OPTDEFINES) /DTCL_UTF_MAX=6
+OPTDEFINES = $(OPTDEFINES) /D_USE_64BIT_TIME_T=1
!endif
# _ATL_XP_TARGETING - Newer SDK's need this to build for XP
COMPILERFLAGS = /D_ATL_XP_TARGETING
+!endif
+!if "$(TCL_BUILD_FOR)" == "8"
+OPTDEFINES = $(OPTDEFINES) /DTCL_MAJOR_VERSION=8
+!endif
# Like the TEA system only set this non empty for non-Tk extensions
# Note: some extensions use PACKAGE_NAME and others use PACKAGE_TCLNAME
# so we pass both
!if !$(DOING_TCL) && !$(DOING_TK)
@@ -1364,14 +1492,14 @@
cdebug = $(cdebug) -Zi
!endif
!endif # $(DEBUG)
-# cwarn includes default warning levels.
-cwarn = $(WARNINGS)
+# cwarn includes default warning levels, also C4090 (buggy) and C4146 is useless.
+cwarn = $(WARNINGS) -wd4090 -wd4146
-!if "$(MACHINE)" == "AMD64"
+!if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64"
# Disable pointer<->int warnings related to cast between different sizes
# There are a gadzillion of these due to use of ClientData and
# clutter up compiler
# output increasing chance of a real warning getting lost. So disable them.
# Eventually some day, Tcl will be 64-bit clean.
@@ -1382,10 +1510,15 @@
!if "$(MACHINE)" == "ARM"
carch = /D_ARM_WINAPI_PARTITION_DESKTOP_SDK_AVAILABLE
!else
carch =
!endif
+
+# cpuid is only available on intel machines
+!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "AMD64"
+carch = $(carch) /DHAVE_CPUID=1
+!endif
!if $(DEBUG)
# Turn warnings into errors
cwarn = $(cwarn) -WX
!endif
@@ -1399,10 +1532,14 @@
# rules.vc/makefile.vc to help visually compare that the pre- and
# post-reform build logs
# cflags contains generic flags used for building practically all object files
cflags = -nologo -c $(COMPILERFLAGS) $(carch) $(cwarn) -Fp$(TMP_DIR)^\ $(cdebug)
+
+!if $(TCL_MAJOR_VERSION) == 8 && $(TCL_MINOR_VERSION) < 7
+cflags = $(cflags) -DTcl_Size=int
+!endif
# appcflags contains $(cflags) and flags for building the application
# object files (e.g. tclsh, or wish) pkgcflags contains $(cflags) plus
# flags used for building shared object files The two differ in the
# BUILD_$(PROJECT) macro which should be defined only for the shared
@@ -1422,11 +1559,11 @@
# TBD - tclvfs has a comment that stubs libs should not be compiled with -GL
# without stating why. Tcl itself compiled stubs libs with this flag.
# so we do not remove it from cflags. -GL may prevent extensions
# compiled with one VC version to fail to link against stubs library
# compiled with another VC version. Check for this and fix accordingly.
-stubscflags = $(cflags) $(PKGNAMEFLAGS) $(PRJ_DEFINES) $(OPTDEFINES) -Zl /DSTATIC_BUILD $(INCLUDES) $(USE_STUBS_DEFS)
+stubscflags = $(cflags) $(PKGNAMEFLAGS) $(PRJ_DEFINES) $(OPTDEFINES) /Zl /GL- /DSTATIC_BUILD $(INCLUDES) $(USE_STUBS_DEFS)
# Link flags
!if $(DEBUG)
ldebug = -debug -debugtype:cv
@@ -1486,16 +1623,16 @@
DLLCMD = $(link32) $(dlllflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs)
CONEXECMD = $(link32) $(conlflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs)
GUIEXECMD = $(link32) $(guilflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs)
RESCMD = $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \
- $(TCL_INCLUDES) \
+ $(TCL_INCLUDES) /DSTATIC_BUILD=$(STATIC_BUILD) \
/DDEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \
- /DCOMMAVERSION=$(DOTVERSION:.=,),0 \
+ /DCOMMAVERSION=$(RCCOMMAVERSION) \
/DDOTVERSION=\"$(DOTVERSION)\" \
/DVERSION=\"$(VERSION)\" \
- /DSUFX=\"$(SUFX:t=)\" \
+ /DSUFX=\"$(SUFX)\" \
/DPROJECT=\"$(PROJECT)\" \
/DPRJLIBNAME=\"$(PRJLIBNAME)\"
!ifndef DEFAULT_BUILD_TARGET
DEFAULT_BUILD_TARGET = $(PROJECT)
@@ -1503,24 +1640,36 @@
default-target: $(DEFAULT_BUILD_TARGET)
!if $(MULTIPLATFORM_INSTALL)
default-pkgindex:
+ @echo if {[package vsatisfies [package provide Tcl] 9.0-]} { > $(OUT_DIR)\pkgIndex.tcl
+ @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
+ [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME9)]] >> $(OUT_DIR)\pkgIndex.tcl
+ @echo } else { >> $(OUT_DIR)\pkgIndex.tcl
@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
- [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME)]] > $(OUT_DIR)\pkgIndex.tcl
+ [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME8)]] >> $(OUT_DIR)\pkgIndex.tcl
+ @echo } >> $(OUT_DIR)\pkgIndex.tcl
!else
default-pkgindex:
+ @echo if {[package vsatisfies [package provide Tcl] 9.0-]} { > $(OUT_DIR)\pkgIndex.tcl
+ @echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
+ [list load [file join $$dir $(PRJLIBNAME9)]] >> $(OUT_DIR)\pkgIndex.tcl
+ @echo } else { >> $(OUT_DIR)\pkgIndex.tcl
@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
- [list load [file join $$dir $(PRJLIBNAME)]] > $(OUT_DIR)\pkgIndex.tcl
+ [list load [file join $$dir $(PRJLIBNAME8)]] >> $(OUT_DIR)\pkgIndex.tcl
+ @echo } >> $(OUT_DIR)\pkgIndex.tcl
!endif
default-pkgindex-tea:
@if exist $(ROOT)\pkgIndex.tcl.in nmakehlp -s << $(ROOT)\pkgIndex.tcl.in > $(OUT_DIR)\pkgIndex.tcl
@PACKAGE_VERSION@ $(DOTVERSION)
@PACKAGE_NAME@ $(PRJ_PACKAGE_TCLNAME)
@PACKAGE_TCLNAME@ $(PRJ_PACKAGE_TCLNAME)
@PKG_LIB_FILE@ $(PRJLIBNAME)
+@PKG_LIB_FILE8@ $(PRJLIBNAME8)
+@PKG_LIB_FILE9@ $(PRJLIBNAME9)
<<
default-install: default-install-binaries default-install-libraries
!if $(SYMBOLS)
default-install: default-install-pdbs
@@ -1553,10 +1702,12 @@
default-install-pdbs:
@echo Installing PDBs to '$(LIB_INSTALL_DIR)'
@if not exist "$(LIB_INSTALL_DIR)" mkdir "$(LIB_INSTALL_DIR)"
@$(CPY) "$(OUT_DIR)\*.pdb" "$(LIB_INSTALL_DIR)\"
+
+# "emacs font-lock highlighting fix
default-install-docs-html:
@echo Installing documentation files to '$(DOC_INSTALL_DIR)'
@if not exist "$(DOC_INSTALL_DIR)" mkdir "$(DOC_INSTALL_DIR)"
@if exist $(DOCDIR) for %f in ("$(DOCDIR)\*.html" "$(DOCDIR)\*.css" "$(DOCDIR)\*.png") do @$(COPY) %f "$(DOC_INSTALL_DIR)"
@@ -1616,11 +1767,11 @@
# Generation of Windows version resource
!ifdef RCFILE
# Note: don't use $** in below rule because there may be other dependencies
-# and only the "master" rc must be passed to the resource compiler
+# and only the "main" rc must be passed to the resource compiler
$(TMP_DIR)\$(PROJECT).res: $(RCDIR)\$(PROJECT).rc
$(RESCMD) $(RCDIR)\$(PROJECT).rc
!else
@@ -1670,11 +1821,11 @@
DISABLE_IMPLICIT_RULES = 0
!endif
!if !$(DISABLE_IMPLICIT_RULES)
# Implicit rule definitions - only for building library objects. For stubs and
-# main application, the master makefile should define explicit rules.
+# main application, the makefile should define explicit rules.
{$(ROOT)}.c{$(TMP_DIR)}.obj::
$(CCPKGCMD) @<<
$<
<<
@@ -1711,19 +1862,19 @@
################################################################
# 14. Sanity check selected options against Tcl build options
# When building an extension, certain configuration options should
# match the ones used when Tcl was built. Here we check and
# warn on a mismatch.
-!if ! $(DOING_TCL)
+!if !$(DOING_TCL)
!if $(TCLINSTALL) # Building against an installed Tcl
!if exist("$(_TCLDIR)\lib\nmake\tcl.nmake")
TCLNMAKECONFIG = "$(_TCLDIR)\lib\nmake\tcl.nmake"
!endif
-!else # ! $(TCLINSTALL) - building against Tcl source
-!if exist("$(OUT_DIR)\tcl.nmake")
-TCLNMAKECONFIG = "$(OUT_DIR)\tcl.nmake"
+!else # !$(TCLINSTALL) - building against Tcl source
+!if exist("$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl.nmake")
+TCLNMAKECONFIG = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl.nmake"
!endif
!endif # TCLINSTALL
!if $(CONFIG_CHECK)
!ifdef TCLNMAKECONFIG
@@ -1740,11 +1891,11 @@
!endif
!endif
!endif # TCLNMAKECONFIG
-!endif # ! $(DOING_TCL)
+!endif # !$(DOING_TCL)
#----------------------------------------------------------
# Display stats being used.
#----------------------------------------------------------
ADDED win/svnmanifest.in
Index: win/svnmanifest.in
==================================================================
--- /dev/null
+++ win/svnmanifest.in
@@ -0,0 +1,1 @@
+svn-r
Index: win/targets.vc
==================================================================
--- win/targets.vc
+++ win/targets.vc
@@ -2,11 +2,11 @@
# targets.vc --
#
# Part of the nmake based build system for Tcl and its extensions.
# This file defines some standard targets for the convenience of extensions
# and can be optionally included by the extension makefile.
-# See TIP 477 (https://core.tcl.tk/tips/doc/trunk/tip/477.md) for docs.
+# See TIP 477 (https://core.tcl-lang.org/tips/doc/main/tip/477.md) for docs.
$(PROJECT): setup pkgindex $(PRJLIB)
!ifdef PRJ_STUBOBJS
$(PROJECT): $(PRJSTUBLIB)
ADDED win/threadUuid.h.in
Index: win/threadUuid.h.in
==================================================================
--- /dev/null
+++ win/threadUuid.h.in
@@ -0,0 +1,1 @@
+#define THREAD_VERSION_UUID \
ADDED win/x86_64-w64-mingw32-nmakehlp.exe
Index: win/x86_64-w64-mingw32-nmakehlp.exe
==================================================================
--- /dev/null
+++ win/x86_64-w64-mingw32-nmakehlp.exe
cannot compute difference between binary files