Compare commits

...
20 changed files with 462 additions and 103 deletions
+14 -2
View File
@@ -9,7 +9,7 @@
.TH Threads 3 "8.1" Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_ConditionNotify, Tcl_ConditionWait, Tcl_ConditionFinalize, Tcl_GetThreadData, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_MutexFinalize, Tcl_CreateThread, Tcl_JoinThread \- Tcl thread support
Tcl_ConditionNotify, Tcl_ConditionWait, Tcl_ConditionFinalize, Tcl_GetThreadData, Tcl_UnsetThreadData, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_MutexFinalize, Tcl_CreateThread, Tcl_JoinThread \- Tcl thread support
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -27,6 +27,9 @@ Void *
\fBTcl_GetThreadData\fR(\fIkeyPtr, size\fR)
.sp
void
\fBTcl_UnsetThreadData\fR(\fIkeyPtr, size, all\fR)
.sp
void
\fBTcl_MutexLock\fR(\fImutexPtr\fR)
.sp
void
@@ -53,10 +56,13 @@ Note that a polling value of 0 seconds does not make much sense.
This identifies a block of thread local storage. The key should be
static and process-wide, yet each thread will end up associating
a different block of storage with this key.
.AP int *size in
.AP int size in
The size of the thread local storage block. This amount of data
is allocated and initialized to zero the first time each thread
calls \fBTcl_GetThreadData\fR.
.AP int all in
Non-zero if the thread local storage block is to be unset for all
threads.
.AP Tcl_ThreadId *idPtr out
The referred storage will contain the id of the newly created thread as
returned by the operating system.
@@ -129,6 +135,12 @@ thread-private data. Its argument is a key that is shared by all threads
and a size for the block of storage. The storage is automatically
allocated and initialized to all zeros the first time each thread asks for it.
The storage is automatically deallocated by \fBTcl_FinalizeThread\fR.
.PP
The \fBTcl_UnsetThreadData\fR function is used to manually destroy
and remove the block of thread local storage. Normally, calling this
function is not necessary. However, if an individual thread local
storage block needs to be manually removed, this function provides a
means to do it.
.SS "SYNCHRONIZATION AND COMMUNICATION"
Tcl provides \fBTcl_ThreadQueueEvent\fR and \fBTcl_ThreadAlert\fR
for handling event queuing in multithreaded applications. See
+2 -2
View File
@@ -96,7 +96,7 @@ The input substring must be an octal integer. It is read in and the
integer value is stored in the variable,
truncated as required by the size modifier value.
.TP 10
\fBx\fR
\fBx\fR or \fBX\fR
The input substring must be a hexadecimal integer.
It is read in and the integer value is stored in the variable,
truncated as required by the size modifier value.
@@ -126,7 +126,7 @@ substring may be a white-space character.
The input substring consists of all the characters up to the next
white-space character; the characters are copied to the variable.
.TP 10
\fBe\fR or \fBf\fR or \fBg\fR
\fBe\fR or \fBf\fR or \fBg\fR or \fBE\fR or \fBG\fR
The input substring must be a floating-point number consisting
of an optional sign, a string of decimal digits possibly
containing a decimal point, and an optional exponent consisting
+3
View File
@@ -2108,6 +2108,9 @@ declare 578 {
declare 579 {
void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr, const char *format, ...)
}
declare 580 {
void Tcl_UnsetThreadData(Tcl_ThreadDataKey *keyPtr, int size, int all)
}
declare 630 {
void TclUnusedStubEntry(void)
}
+11 -3
View File
@@ -3408,7 +3408,12 @@ EXTERN Tcl_Obj * Tcl_ObjPrintf(CONST char *format, ...);
EXTERN void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr,
CONST char *format, ...);
#endif
/* Slot 580 is reserved */
#ifndef Tcl_UnsetThreadData_TCL_DECLARED
#define Tcl_UnsetThreadData_TCL_DECLARED
/* 580 */
EXTERN void Tcl_UnsetThreadData(Tcl_ThreadDataKey *keyPtr,
int size, int all);
#endif
/* Slot 581 is reserved */
/* Slot 582 is reserved */
/* Slot 583 is reserved */
@@ -4078,7 +4083,7 @@ typedef struct TclStubs {
int (*tcl_AppendFormatToObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST char *format, int objc, Tcl_Obj *CONST objv[]); /* 577 */
Tcl_Obj * (*tcl_ObjPrintf) (CONST char *format, ...); /* 578 */
void (*tcl_AppendPrintfToObj) (Tcl_Obj *objPtr, CONST char *format, ...); /* 579 */
VOID *reserved580;
void (*tcl_UnsetThreadData) (Tcl_ThreadDataKey *keyPtr, int size, int all); /* 580 */
VOID *reserved581;
VOID *reserved582;
VOID *reserved583;
@@ -6483,7 +6488,10 @@ extern TclStubs *tclStubsPtr;
#define Tcl_AppendPrintfToObj \
(tclStubsPtr->tcl_AppendPrintfToObj) /* 579 */
#endif
/* Slot 580 is reserved */
#ifndef Tcl_UnsetThreadData
#define Tcl_UnsetThreadData \
(tclStubsPtr->tcl_UnsetThreadData) /* 580 */
#endif
/* Slot 581 is reserved */
/* Slot 582 is reserved */
/* Slot 583 is reserved */
+11 -2
View File
@@ -1230,13 +1230,17 @@ typedef void **TclHandle;
MODULE_SCOPE void * TclThreadDataKeyGet(Tcl_ThreadDataKey *keyPtr);
MODULE_SCOPE void TclThreadDataKeySet(Tcl_ThreadDataKey *keyPtr,
void *data);
MODULE_SCOPE void TclThreadFreeData(void *blockPtr, int size);
/*
* This is a convenience macro used to initialize a thread local storage ptr.
*/
#define TCL_TSD_INIT(keyPtr) \
(ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData))
#define TCL_TSD_INIT(keyPtr) (ThreadSpecificData *) \
Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData))
#define TCL_TSD_TERM(keyPtr) (ThreadSpecificData *) \
Tcl_UnsetThreadData((keyPtr), sizeof(ThreadSpecificData), 0)
/*
*----------------------------------------------------------------
@@ -2665,6 +2669,7 @@ MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr,
MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr);
MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr,
int *lengthPtr, Tcl_Encoding *encodingPtr);
MODULE_SCOPE void TclpResetLocks(void);
MODULE_SCOPE void TclpInitLock(void);
MODULE_SCOPE void TclpInitPlatform(void);
MODULE_SCOPE void TclpInitUnlock(void);
@@ -2705,6 +2710,10 @@ MODULE_SCOPE void TclpUnloadFile(Tcl_LoadHandle loadHandle);
MODULE_SCOPE void * TclpThreadDataKeyGet(Tcl_ThreadDataKey *keyPtr);
MODULE_SCOPE void TclpThreadDataKeySet(Tcl_ThreadDataKey *keyPtr,
void *data);
MODULE_SCOPE void TclpThreadDataKeyUnset(Tcl_ThreadDataKey *keyPtr,
int freeValue);
MODULE_SCOPE void TclpThreadDataKeyUnsetAll(Tcl_ThreadDataKey *keyPtr,
int freeValue);
MODULE_SCOPE void TclpThreadExit(int status);
MODULE_SCOPE size_t TclpThreadGetStackSize(void);
MODULE_SCOPE void TclRememberCondition(Tcl_Condition *mutex);
+6
View File
@@ -398,11 +398,14 @@ ValidateFormat(
*/
case 'd':
case 'e':
case 'E':
case 'f':
case 'g':
case 'G':
case 'i':
case 'o':
case 'x':
case 'X':
break;
case 'u':
if (flags & SCAN_BIG) {
@@ -727,6 +730,7 @@ Tcl_ScanObjCmd(
parseFlag |= TCL_PARSE_OCTAL_ONLY | TCL_PARSE_SCAN_PREFIXES;
break;
case 'x':
case 'X':
op = 'i';
parseFlag |= TCL_PARSE_HEXADECIMAL_ONLY;
break;
@@ -738,7 +742,9 @@ Tcl_ScanObjCmd(
case 'f':
case 'e':
case 'E':
case 'g':
case 'G':
op = 'f';
break;
+1 -1
View File
@@ -1340,7 +1340,7 @@ TclStubs tclStubs = {
Tcl_AppendFormatToObj, /* 577 */
Tcl_ObjPrintf, /* 578 */
Tcl_AppendPrintfToObj, /* 579 */
NULL, /* 580 */
Tcl_UnsetThreadData, /* 580 */
NULL, /* 581 */
NULL, /* 582 */
NULL, /* 583 */
+64
View File
@@ -101,6 +101,70 @@ Tcl_GetThreadData(
return result;
}
/*
*----------------------------------------------------------------------
*
* Tcl_UnsetThreadData --
*
* This function finalizes and deallocates a chunk of thread local
* storage.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
void
Tcl_UnsetThreadData(
Tcl_ThreadDataKey *keyPtr, /* Identifier for the data chunk */
int size, /* Size of storage block */
int all) /* Unset for all threads? */
{
#ifdef TCL_THREADS
void *result = TclpThreadDataKeyGet(keyPtr);
if (all) {
TclpThreadDataKeyUnsetAll(keyPtr, 1 /* free */);
} else {
TclpThreadDataKeyUnset(keyPtr, 1 /* free */);
}
#else
void *result = *keyPtr;
TclThreadFreeData(result, size);
ForgetSyncObject((char *) keyPtr, &keyRecord);
#endif /* TCL_THREADS */
}
/*
*----------------------------------------------------------------------
*
* TclThreadFreeData --
*
* This function deallocates a chunk of thread local storage.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
void
TclThreadFreeData(
void *blockPtr, /* Pointer to thread local data chunk */
int size) /* Size of storage block */
{
if (blockPtr != NULL) {
memset(blockPtr, 0, (size_t) size);
ckfree((char *) blockPtr);
}
}
/*
*----------------------------------------------------------------------
*
+90
View File
@@ -397,6 +397,96 @@ TclpThreadDataKeySet(
Tcl_SetHashValue(hPtr, data);
}
/*
*----------------------------------------------------------------------
*
* TclpThreadDataKeyUnset --
*
* This procedure removes the pointer to a block of thread local
* storage.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
void
TclpThreadDataKeyUnset(
Tcl_ThreadDataKey *keyPtr, /* Identifier for the data chunk, really
* (pthread_key_t **) */
int freeValue) /* Also free the value? */
{
Tcl_HashTable *hashTablePtr;
Tcl_HashEntry *hPtr;
hashTablePtr = ThreadStorageGetHashTable(Tcl_GetCurrentThread());
hPtr = Tcl_FindHashEntry(hashTablePtr, (char *) keyPtr);
if (hPtr != NULL) {
if (freeValue) {
void *blockPtr = Tcl_GetHashValue(hPtr);
if (blockPtr != NULL) {
ckfree(blockPtr);
}
}
Tcl_DeleteHashEntry(hPtr);
}
}
/*
*----------------------------------------------------------------------
*
* TclpThreadDataKeyUnsetAll --
*
* This procedure removes the pointer to a block of thread local
* storage from all threads.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
void
TclpThreadDataKeyUnsetAll(
Tcl_ThreadDataKey *keyPtr, /* Identifier for the data chunk, really
* (pthread_key_t **) */
int freeValue) /* Also free the value? */
{
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Tcl_MutexLock(&threadStorageLock);
for (hPtr = Tcl_FirstHashEntry(&threadStorageHashTable, &search);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
Tcl_HashTable *hashTablePtr = Tcl_GetHashValue(hPtr);
if (hashTablePtr != NULL) {
Tcl_HashEntry *hPtr2 = Tcl_FindHashEntry(hashTablePtr,
(char *) keyPtr);
if (hPtr2 != NULL) {
if (freeValue) {
void *blockPtr = Tcl_GetHashValue(hPtr2);
if (blockPtr != NULL) {
ckfree(blockPtr);
}
}
Tcl_DeleteHashEntry(hPtr2);
}
}
}
Tcl_MutexUnlock(&threadStorageLock);
}
/*
*----------------------------------------------------------------------
*
+12 -9
View File
@@ -11,7 +11,7 @@
package require Tcl 8.4
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.7.12
package provide http 2.7.13
namespace eval http {
# Allow resourcing to not clobber existing data
@@ -107,7 +107,7 @@ proc http::Log {args} {}
proc http::register {proto port command} {
variable urlTypes
set urlTypes($proto) [list $port $command]
set urlTypes([string tolower $proto]) [list $port $command]
}
# http::unregister --
@@ -121,11 +121,12 @@ proc http::register {proto port command} {
proc http::unregister {proto} {
variable urlTypes
if {![info exists urlTypes($proto)]} {
set lower [string tolower $proto]
if {![info exists urlTypes($lower)]} {
return -code error "unsupported url type \"$proto\""
}
set old $urlTypes($proto)
unset urlTypes($proto)
set old $urlTypes($lower)
unset urlTypes($lower)
return $old
}
@@ -505,12 +506,13 @@ proc http::geturl {url args} {
if {$proto eq ""} {
set proto http
}
if {![info exists urlTypes($proto)]} {
set lower [string tolower $proto]
if {![info exists urlTypes($lower)]} {
unset $token
return -code error "Unsupported URL type \"$proto\""
}
set defport [lindex $urlTypes($proto) 0]
set defcmd [lindex $urlTypes($proto) 1]
set defport [lindex $urlTypes($lower) 0]
set defcmd [lindex $urlTypes($lower) 1]
if {$port eq ""} {
set port $defport
@@ -641,7 +643,8 @@ proc http::Connected { token proto phost srvurl} {
set host [lindex [split $state(socketinfo) :] 0]
set port [lindex [split $state(socketinfo) :] 1]
set defport [lindex $urlTypes($proto) 0]
set lower [string tolower $proto]
set defport [lindex $urlTypes($lower) 0]
# Send data in cr-lf format, but accept any line terminators
+1 -1
View File
@@ -1,4 +1,4 @@
# Tcl package index file, version 1.1
if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded http 2.7.12 [list tclPkgSetup $dir http 2.7.12 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
package ifneeded http 2.7.13 [list tclPkgSetup $dir http 2.7.13 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+1 -1
View File
@@ -9,4 +9,4 @@
# full path name of this file's directory.
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded tcltest 2.3.5 [list source [file join $dir tcltest.tcl]]
package ifneeded tcltest 2.3.6 [list source [file join $dir tcltest.tcl]]
+1 -1
View File
@@ -22,7 +22,7 @@ namespace eval tcltest {
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the install directory in the Makefiles. When the minor version
# changes (new feature) be sure to update the man page as well.
variable Version 2.3.5
variable Version 2.3.6
# Compatibility support for dumb variables defined in tcltest 1
# Do not use these. Call [package provide Tcl] and [info patchlevel]
+2 -2
View File
@@ -120,7 +120,7 @@ test http-3.2 {http::geturl} {
set err
} {Unsupported URL: http:junk}
set url //[info hostname]:$port
set badurl //[info hostname]:6666
set badurl //[info hostname]:[expr $port+1]
test http-3.3 {http::geturl} {
set token [http::geturl $url]
http::data $token
@@ -130,7 +130,7 @@ test http-3.3 {http::geturl} {
</body></html>"
set tail /a/b/c
set url //[info hostname]:$port/a/b/c
set fullurl http://user:pass@[info hostname]:$port/a/b/c
set fullurl HTTP://user:pass@[info hostname]:$port/a/b/c
set binurl //[info hostname]:$port/binary
set posturl //[info hostname]:$port/post
set badposturl //[info hostname]:$port/droppost
+13 -4
View File
@@ -280,6 +280,12 @@ test scan-4.48 {Tcl_ScanObjCmd, float scanning} {
test scan-4.49 {Tcl_ScanObjCmd, float scanning} {
list [scan {.1 0.2 3.} {%e %f %g} x y z] $x $y $z
} {3 0.1 0.2 3.0}
test scan-4.49-uc-1 {Tcl_ScanObjCmd, float scanning} {
list [scan {0.5*0.75} {%E%c%G} x y z] $x $y $z
} {3 0.5 42 0.75}
test scan-4.49-uc-2 {Tcl_ScanObjCmd, float scanning} {
list [scan {5e-1*75E-2} {%E%c%G} x y z] $x $y $z
} {3 0.5 42 0.75}
test scan-4.50 {Tcl_ScanObjCmd, float scanning} {
list [scan {1234567890a} %f x] $x
} {1 1234567890.0}
@@ -359,6 +365,9 @@ test scan-4.63 {scanning of large and negative hex integers} {
list [scan $scanstring {%x %x %x} a b c] \
[expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }]
} {3 1 1 1}
test scan-4.64 {scanning of hex with %X} {
scan "123 abc f78" %X%X%X
} {291 2748 3960}
# clean up from last two tests
@@ -515,14 +524,14 @@ test scan-8.4 {error conditions} {
list [catch {scan a %O x} msg] $msg
} {1 {bad scan conversion character "O"}}
test scan-8.5 {error conditions} {
list [catch {scan a %X x} msg] $msg
} {1 {bad scan conversion character "X"}}
list [catch {scan a %B x} msg] $msg
} {1 {bad scan conversion character "B"}}
test scan-8.6 {error conditions} {
list [catch {scan a %F x} msg] $msg
} {1 {bad scan conversion character "F"}}
test scan-8.7 {error conditions} {
list [catch {scan a %E x} msg] $msg
} {1 {bad scan conversion character "E"}}
list [catch {scan a %p x} msg] $msg
} {1 {bad scan conversion character "p"}}
test scan-8.8 {error conditions} {
list [catch {scan a "%d %d" a} msg] $msg
} {1 {different numbers of variable names and field specifiers}}
+58 -35
View File
@@ -308,7 +308,7 @@ TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \
bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_neg.o bn_mp_or.o \
bn_mp_radix_size.o bn_mp_radix_smap.o \
bn_mp_read_radix.o bn_mp_rshd.o bn_mp_set.o bn_mp_set_int.o \
bn_mp_shrink.o \
bn_mp_shrink.o \
bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \
bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \
bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix_n.o \
@@ -540,6 +540,10 @@ DTRACE_SRC = $(GENERIC_DIR)/tclDTrace.d
SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \
$(STUB_SRCS) @PLAT_SRCS@
#--------------------------------------------------------------------------
# Start of rules
#--------------------------------------------------------------------------
all: binaries libraries doc
binaries: ${LIB_FILE} $(STUB_LIB_FILE) ${TCL_EXE}
@@ -719,11 +723,11 @@ install-binaries: binaries
done;
@echo "Installing $(LIB_FILE) to $(DLL_INSTALL_DIR)/"
@@INSTALL_LIB@
@chmod 555 "$(DLL_INSTALL_DIR)"/$(LIB_FILE)
@chmod 555 "$(DLL_INSTALL_DIR)/$(LIB_FILE)"
@echo "Installing ${TCL_EXE} as $(BIN_INSTALL_DIR)/tclsh$(VERSION)@EXEEXT@"
@$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)"/tclsh$(VERSION)@EXEEXT@
@$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)/tclsh$(VERSION)@EXEEXT@"
@echo "Installing tclConfig.sh to $(CONFIG_INSTALL_DIR)/"
@$(INSTALL_DATA) tclConfig.sh "$(CONFIG_INSTALL_DIR)"/tclConfig.sh
@$(INSTALL_DATA) tclConfig.sh "$(CONFIG_INSTALL_DIR)/tclConfig.sh"
@if test "$(STUB_LIB_FILE)" != "" ; then \
echo "Installing $(STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \
@INSTALL_STUB_LIB@ ; \
@@ -766,8 +770,8 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs
do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \
done;
@echo "Installing package http 2.7.12 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/http-2.7.12.tm;
@echo "Installing package http 2.7.13 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/http-2.7.13.tm;
@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
@for i in $(TOP_DIR)/library/opt/*.tcl ; \
do \
@@ -775,8 +779,8 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs
done;
@echo "Installing package msgcat 1.5.2 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.5.2.tm;
@echo "Installing package tcltest 2.3.5 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.5.tm;
@echo "Installing package tcltest 2.3.6 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.6.tm;
@echo "Installing package platform 1.0.12 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.12.tm;
@@ -854,10 +858,12 @@ install-doc: doc
@for i in $(TOP_DIR)/doc/*.1; do \
$(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MAN1_INSTALL_DIR)"; \
done
@echo "Installing and cross-linking C API (.3) docs to $(MAN3_INSTALL_DIR)/";
@for i in $(TOP_DIR)/doc/*.3; do \
$(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MAN3_INSTALL_DIR)"; \
done
@echo "Installing and cross-linking command (.n) docs to $(MANN_INSTALL_DIR)/";
@for i in $(TOP_DIR)/doc/*.n; do \
$(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MANN_INSTALL_DIR)"; \
@@ -902,6 +908,10 @@ distclean: clean
depend:
makedepend -- $(DEPEND_SWITCHES) -- $(SRCS)
#--------------------------------------------------------------------------
# Rules for how to compile C files
#--------------------------------------------------------------------------
# Test binaries. The rules for tclTestInit.o and xtTestInit.o are complicated
# because they are compiled from tclAppInit.c. Can't use the "-o" option
# because this doesn't work on some strange compilers (e.g. UnixWare).
@@ -1134,7 +1144,7 @@ tclPkg.o: $(GENERIC_DIR)/tclPkg.c
# prefix/exec_prefix but all the different paths individually.
tclPkgConfig.o: $(GENERIC_DIR)/tclPkgConfig.c
$(CC) -c $(CC_SWITCHES) \
$(CC) -c $(CC_SWITCHES) \
-DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR)\"" \
-DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR)\"" \
-DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR)\"" \
@@ -1475,11 +1485,13 @@ $(DTRACE_HDR): $(DTRACE_SRC)
$(DTRACE_OBJ): $(DTRACE_SRC) $(TCL_OBJS)
$(DTRACE) -G $(DTRACE_SWITCHES) -o $@ -s $(DTRACE_SRC) $(TCL_OBJS)
#--------------------------------------------------------------------------
# The following targets are not completely general. They are provide purely
# for documentation purposes so people who are interested in the Xt based
# notifier can modify them to suit their own installation.
#--------------------------------------------------------------------------
xttest: ${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \
xttest: ${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \
@DL_OBJS@ ${BUILD_DLTEST}
${CC} ${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \
@DL_OBJS@ @TCL_BUILD_LIB_SPEC@ ${LIBS} \
@@ -1493,10 +1505,12 @@ tclXtTest.o: $(UNIX_DIR)/tclXtTest.c
$(CC) -c $(APP_CC_SWITCHES) -I/usr/openwin/include \
$(UNIX_DIR)/tclXtTest.c
#--------------------------------------------------------------------------
# Compat binaries, these must be compiled for use in a shared library even
# though they may be placed in a static executable or library. Since they are
# included in both the tcl library and the stub library, they need to be
# relocatable.
#--------------------------------------------------------------------------
fixstrtod.o: $(COMPAT_DIR)/fixstrtod.c
$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/fixstrtod.c
@@ -1525,8 +1539,10 @@ strtoul.o: $(COMPAT_DIR)/strtoul.c
waitpid.o: $(COMPAT_DIR)/waitpid.c
$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/waitpid.c
#--------------------------------------------------------------------------
# Stub library binaries, these must be compiled for use in a shared library
# even though they will be placed in a static archive
#--------------------------------------------------------------------------
tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c
$(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD $(GENERIC_DIR)/tclStubLib.c
@@ -1600,6 +1616,10 @@ checkexports: $(TCL_LIB_FILE)
| awk '$$2 ~ /^[TDBCS]$$/ { sub("^_", "", $$3); print $$3 }' \
| sort -n | grep -E -v '^[Tt]cl' || true
#--------------------------------------------------------------------------
# Distribution building rules
#--------------------------------------------------------------------------
#
# Target to create a Tcl RPM for Linux. Requires that you be on a Linux
# system.
@@ -1633,6 +1653,7 @@ $(MAC_OSX_DIR)/configure: $(MAC_OSX_DIR)/configure.ac $(UNIX_DIR)/configure
$(UNIX_DIR)/tclConfig.h.in: $(MAC_OSX_DIR)/configure
cd $(MAC_OSX_DIR); autoheader; touch $@
EOLFIX=$(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl
dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(MAC_OSX_DIR)/configure genstubs
rm -rf $(DISTDIR)
mkdir -p $(DISTDIR)/unix
@@ -1647,7 +1668,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(MAC_OSX_DIR)/configure
$(DISTDIR)/unix
chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.in
chmod 775 $(DISTDIR)/unix/ldAix
mkdir $(DISTDIR)/generic
@mkdir $(DISTDIR)/generic
cp -p $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic
cp -p $(GENERIC_DIR)/*.decls $(DISTDIR)/generic
cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic
@@ -1655,7 +1676,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(MAC_OSX_DIR)/configure
cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README* \
$(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \
$(DISTDIR)
mkdir $(DISTDIR)/library
@mkdir $(DISTDIR)/library
cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
$(TOP_DIR)/library/tclIndex $(DISTDIR)/library
for i in http1.0 http opt msgcat reg dde tcltest platform; \
@@ -1663,26 +1684,27 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(MAC_OSX_DIR)/configure
mkdir $(DISTDIR)/library/$$i ;\
cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \
done;
mkdir $(DISTDIR)/library/encoding
@mkdir $(DISTDIR)/library/encoding
cp -p $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding
mkdir $(DISTDIR)/library/msgs
@mkdir $(DISTDIR)/library/msgs
cp -p $(TOP_DIR)/library/msgs/*.msg $(DISTDIR)/library/msgs
( cd $(TOP_DIR); \
@echo cp -r $(TOP_DIR)/library/tzdata $(DISTDIR)/library/tzdata
@( cd $(TOP_DIR); \
find library/tzdata -name CVS -prune -o -type f -print ) \
| ( cd $(TOP_DIR) ; xargs tar cf - ) \
| ( cd $(DISTDIR) ; tar xfp - )
mkdir $(DISTDIR)/doc
@mkdir $(DISTDIR)/doc
cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \
$(TOP_DIR)/doc/man.macros $(DISTDIR)/doc
mkdir $(DISTDIR)/compat
@mkdir $(DISTDIR)/compat
cp -p $(TOP_DIR)/license.terms $(COMPAT_DIR)/*.[ch] \
$(COMPAT_DIR)/README $(DISTDIR)/compat
mkdir $(DISTDIR)/tests
@mkdir $(DISTDIR)/tests
cp -p $(TOP_DIR)/license.terms $(DISTDIR)/tests
cp -p $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \
$(TOP_DIR)/tests/httpd $(TOP_DIR)/tests/*.tcl \
$(DISTDIR)/tests
mkdir $(DISTDIR)/win
@mkdir $(DISTDIR)/win
cp $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win
cp $(TOP_DIR)/win/configure.in $(TOP_DIR)/win/configure \
$(TOP_DIR)/win/tclConfig.sh.in \
@@ -1691,45 +1713,45 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(MAC_OSX_DIR)/configure
cp -p $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \
$(DISTDIR)/win
cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win
$(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/*.bat
@$(EOLFIX) -crlf $(DISTDIR)/win/*.bat
cp -p $(TOP_DIR)/win/makefile.* $(DISTDIR)/win
$(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/makefile.*
@$(EOLFIX) -crlf $(DISTDIR)/win/makefile.bc $(DISTDIR)/win/makefile.vc
cp -p $(TOP_DIR)/win/rules.vc $(DISTDIR)/win
$(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/rules.vc
@$(EOLFIX) -crlf $(DISTDIR)/win/rules.vc
cp -p $(TOP_DIR)/win/coffbase.txt $(DISTDIR)/win
$(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/coffbase.txt
@$(EOLFIX) -crlf $(DISTDIR)/win/coffbase.txt
cp -p $(TOP_DIR)/win/tcl.hpj.in $(DISTDIR)/win
$(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/tcl.hpj.in
@$(EOLFIX) -crlf $(DISTDIR)/win/tcl.hpj.in
cp -p $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win
$(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/tcl.ds*
@$(EOLFIX) -crlf $(DISTDIR)/win/tcl.ds*
cp -p $(TOP_DIR)/win/README $(DISTDIR)/win
cp -p $(TOP_DIR)/license.terms $(DISTDIR)/win
mkdir $(DISTDIR)/macosx
@mkdir $(DISTDIR)/macosx
cp -p $(MAC_OSX_DIR)/GNUmakefile $(MAC_OSX_DIR)/README \
$(MAC_OSX_DIR)/*.c $(MAC_OSX_DIR)/*.in \
$(MAC_OSX_DIR)/*.ac $(MAC_OSX_DIR)/*.xcconfig \
$(MAC_OSX_DIR)/configure $(DISTDIR)/macosx
cp -p $(TOP_DIR)/license.terms $(DISTDIR)/macosx
mkdir $(DISTDIR)/macosx/Tcl.pbproj
@mkdir $(DISTDIR)/macosx/Tcl.pbproj
cp -p $(MAC_OSX_DIR)/Tcl.pbproj/*.pbx* $(DISTDIR)/macosx/Tcl.pbproj
mkdir $(DISTDIR)/macosx/Tcl.xcode
@mkdir $(DISTDIR)/macosx/Tcl.xcode
cp -p $(MAC_OSX_DIR)/Tcl.xcode/*.pbx* $(DISTDIR)/macosx/Tcl.xcode
mkdir $(DISTDIR)/macosx/Tcl.xcodeproj
@mkdir $(DISTDIR)/macosx/Tcl.xcodeproj
cp -p $(TOP_DIR)/macosx/Tcl.xcodeproj/*.pbx* $(DISTDIR)/macosx/Tcl.xcodeproj
mkdir $(DISTDIR)/unix/dltest
@mkdir $(DISTDIR)/unix/dltest
cp -p $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \
$(UNIX_DIR)/dltest/README \
$(DISTDIR)/unix/dltest
mkdir $(DISTDIR)/tools
@mkdir $(DISTDIR)/tools
cp -p $(TOOL_DIR)/Makefile.in $(TOOL_DIR)/README \
$(TOOL_DIR)/configure $(TOOL_DIR)/configure.in \
$(TOOL_DIR)/*.tcl $(TOOL_DIR)/man2tcl.c \
$(TOOL_DIR)/tcl.wse.in $(TOOL_DIR)/*.bmp \
$(TOOL_DIR)/tcl.hpj.in \
$(DISTDIR)/tools
$(TCL_EXE) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/tools/tcl.hpj.in \
@$(EOLFIX)-crlf $(DISTDIR)/tools/tcl.hpj.in \
$(DISTDIR)/tools/tcl.wse.in
mkdir $(DISTDIR)/libtommath
@mkdir $(DISTDIR)/libtommath
cp -p $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h \
$(DISTDIR)/libtommath
@@ -1738,12 +1760,12 @@ alldist: dist
cd $(DISTROOT); tar cf $(DISTNAME)-src.tar $(DISTNAME); \
gzip -9 $(DISTNAME)-src.tar; zip -qr8 $(ZIPNAME) $(DISTNAME)
#
#--------------------------------------------------------------------------
# This target creates the HTML folder for Tcl & Tk and places it in
# DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool
# workspace. It depends on the Tcl & Tk being in directories called tcl8.* &
# tk8.* up two directories from the TOOL_DIR.
#
#--------------------------------------------------------------------------
html: ${TCL_EXE}
$(BUILD_HTML)
@@ -1839,4 +1861,5 @@ package-generate:
pkgtrans -s . $(PACKAGE).`arch` $(PACKAGE)
rm -rf $(PACKAGE)
#--------------------------------------------------------------------------
# DO NOT DELETE THIS LINE -- make depend depends on it.
+115 -36
View File
@@ -127,15 +127,6 @@ static Tcl_ThreadDataKey dataKey;
static int notifierCount = 0;
/*
* The following static stores the process ID of the initialized notifier
* thread. If it changes, we have passed a fork and we should start a new
* notifier thread.
*
* You must hold the notifierMutex lock before accessing this variable.
*/
static pid_t processIDInitialized = 0;
/*
* The following variable points to the head of a doubly-linked list of
* ThreadSpecificData structures for all threads that are currently waiting on
@@ -204,9 +195,9 @@ static Tcl_ThreadId notifierThread;
static void NotifierThreadProc(ClientData clientData);
#if defined(HAVE_PTHREAD_ATFORK) && !defined(__APPLE__)
static int atForkInit = 0;
static void AtForkPrepare(void);
static void AtForkParent(void);
static void AtForkChild(void);
static void AtForkPrepareProc(void);
static void AtForkParentProc(void);
static void AtForkChildProc(void);
#endif /* HAVE_PTHREAD_ATFORK */
#endif /* TCL_THREADS */
static int FileHandlerEventProc(Tcl_Event *evPtr, int flags);
@@ -282,14 +273,16 @@ Tcl_InitNotifier(void)
*/
Tcl_MutexLock(&notifierMutex);
#if defined(HAVE_PTHREAD_ATFORK) && !defined(__APPLE__)
/*
* Install pthread_atfork handlers to reinitialize the notifier in the
* child of a fork.
* Install pthread_atfork() handlers to deal with the notifier in the
* forked child.
*/
if (!atForkInit) {
int result = pthread_atfork(AtForkPrepare, AtForkParent, AtForkChild);
int result = pthread_atfork(AtForkPrepareProc, AtForkParentProc,
AtForkChildProc);
if (result) {
Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed");
@@ -297,23 +290,12 @@ Tcl_InitNotifier(void)
atForkInit = 1;
}
#endif /* HAVE_PTHREAD_ATFORK */
/*
* Check if my process id changed, e.g. I was forked
* In this case, restart the notifier thread and close the
* pipe to the original notifier thread
*/
if (notifierCount > 0 && processIDInitialized != getpid()) {
notifierCount = 0;
processIDInitialized = 0;
close(triggerPipe);
triggerPipe = -1;
}
if (notifierCount == 0) {
if (TclpThreadCreate(&notifierThread, NotifierThreadProc, NULL,
TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) {
Tcl_Panic("Tcl_InitNotifier: unable to start notifier thread");
}
processIDInitialized = getpid();
}
notifierCount++;
@@ -1277,7 +1259,7 @@ NotifierThreadProc(
/*
*----------------------------------------------------------------------
*
* AtForkPrepare --
* AtForkPrepareProc --
*
* Lock the notifier in preparation for a fork.
*
@@ -1291,14 +1273,15 @@ NotifierThreadProc(
*/
static void
AtForkPrepare(void)
AtForkPrepareProc(void)
{
Tcl_MutexLock(&notifierMutex);
}
/*
*----------------------------------------------------------------------
*
* AtForkParent --
* AtForkParentProc --
*
* Unlock the notifier in the parent after a fork.
*
@@ -1312,16 +1295,18 @@ AtForkPrepare(void)
*/
static void
AtForkParent(void)
AtForkParentProc(void)
{
Tcl_MutexUnlock(&notifierMutex);
}
/*
*----------------------------------------------------------------------
*
* AtForkChild --
* AtForkChildProc --
*
* Unlock and reinstall the notifier in the child after a fork.
* Assumes the notifier mutex is already held. Reset the notifier
* state and then re-initializes it for the child process.
*
* Results:
* None.
@@ -1333,11 +1318,105 @@ AtForkParent(void)
*/
static void
AtForkChild(void)
AtForkChildProc(void)
{
notifierMutex = NULL;
int shouldInitNotifier = (notifierCount > 0); /* Only when in use? */
struct ThreadSpecificData *tsdPtr;
/*
* Close the trigger pipe and reset it to the default value. This
* should cause it to be re-opened when the notifier is subsequently
* initialized. Since the trigger pipe is opened via the notifier
* thread (which may never have started?), check it before attempting
* to close it.
*/
if (triggerPipe >= 0) {
close(triggerPipe);
triggerPipe = -1;
}
/*
* Since the notifier thread is not really running, zero out its ID.
* This step is not strictly necessary since its value will not be
* checked before it is re-created.
*/
notifierThread = (Tcl_ThreadId)0;
/*
* Reset the notifier reference count to zero (i.e. not initialized).
* This should force the notifier initialization code to be re-run the
* very next time Tcl_InitNotifier is called, which will be at the end
* of this function.
*/
notifierCount = 0;
/*
* Finalize and reset the condition variable. This should force it to
* be re-created during the next call to Tcl_ConditionWait().
*/
Tcl_ConditionFinalize(&notifierCV);
notifierCV = NULL;
Tcl_InitNotifier();
/*
* Free all the thread specific data for the notifier now. Since the
* child has no other threads, this data should be completely useless
* at this point.
*/
for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
FileHandler *filePtr;
for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
/* NO LOOP UPDATE */) {
FileHandler *nextFilePtr = filePtr->nextPtr;
ckfree((char *) filePtr);
filePtr = nextFilePtr;
}
Tcl_ConditionFinalize(&(tsdPtr->waitCV));
}
waitingListPtr = NULL;
/*
* Release, finalize, and reset the notifier mutex (which has been
* held since the AtForkPrepareProc() was called via pthread_atfork()).
* This should force it to be re-created during the next call to
* Tcl_MutexLock().
*/
Tcl_MutexUnlock(&notifierMutex);
Tcl_MutexFinalize(&notifierMutex);
notifierMutex = NULL;
/*
* Next, forcibly reset all the "one time" locks used by the threading
* subsystem. This may be necessary on some (all?) variants of Unix
* where the pthread internal state does not survive a call to fork().
*/
TclpResetLocks();
/*
* Next, attempt to free thread specific data for this module, if that
* is necessary.
*/
if (dataKey != (Tcl_ThreadDataKey)0) {
Tcl_UnsetThreadData(&dataKey, sizeof(ThreadSpecificData), 1 /*all */);
dataKey = (Tcl_ThreadDataKey)0;
}
/*
* Force the notifier subsystem to be initialized now. This should
* create the notifier thread in this process. Subsequently, that new
* thread will re-open the trigger pipe.
*/
if (shouldInitNotifier) {
Tcl_InitNotifier();
}
}
#endif /* HAVE_PTHREAD_ATFORK */
+30
View File
@@ -314,6 +314,36 @@ Tcl_GetCurrentThread(void)
#endif
}
/*
*----------------------------------------------------------------------
*
* TclpResetLocks
*
* This procedure is used to forcibly reset all the "one time" locks
* used by the other platform-specific locking procedures. Currently,
* this procedure is only called from the notifier to handle fork()
* and must not be called from anywhere else.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
void
TclpResetLocks(void)
{
#ifdef TCL_THREADS
pthread_mutex_t dummyLock = PTHREAD_MUTEX_INITIALIZER;
memcpy((void *)&masterLock, (void *)&dummyLock, sizeof(pthread_mutex_t));
memcpy((void *)&initLock, (void *)&dummyLock, sizeof(pthread_mutex_t));
memcpy((void *)&allocLock, (void *)&dummyLock, sizeof(pthread_mutex_t));
#endif
}
/*
*----------------------------------------------------------------------
*
+4 -4
View File
@@ -642,8 +642,8 @@ install-libraries: libraries install-tzdata install-msgs
do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
done;
@echo "Installing package http 2.7.12 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.12.tm;
@echo "Installing package http 2.7.13 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.13.tm;
@echo "Installing library opt0.4 directory";
@for j in $(ROOT_DIR)/library/opt/*.tcl; \
do \
@@ -651,8 +651,8 @@ install-libraries: libraries install-tzdata install-msgs
done;
@echo "Installing package msgcat 1.5.2 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.2.tm;
@echo "Installing package tcltest 2.3.5 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.5.tm;
@echo "Installing package tcltest 2.3.6 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.6.tm;
@echo "Installing package platform 1.0.12 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.12.tm;
@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
+23
View File
@@ -337,6 +337,29 @@ Tcl_GetCurrentThread(void)
return (Tcl_ThreadId) INT2PTR(GetCurrentThreadId());
}
/*
*----------------------------------------------------------------------
*
* TclpResetLocks
*
* This procedure is used to forcibly reset all the "one time" locks
* used by the other platform-specific locking procedures. Currently,
* this procedure does nothing and should not be called.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
void
TclpResetLocks(void)
{
}
/*
*----------------------------------------------------------------------
*