Tcl Source Code

Artifact Content
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Artifact ab07f515d40fd54719b3e577d1b368aeb784d213:

Attachment "uniq.patch" to ticket [2826430fff] added by ferrieux 2009-07-26 06:40:19.
Index: generic/tcl.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v
retrieving revision 1.169
diff -b -u -r1.169 tcl.decls
--- generic/tcl.decls	27 Feb 2009 23:03:42 -0000	1.169
+++ generic/tcl.decls	25 Jul 2009 23:36:14 -0000
@@ -2295,6 +2295,10 @@
     int Tcl_CloseEx(Tcl_Interp *interp, Tcl_Channel chan, int flags)
 }
 
+declare 625 generic {
+    int Tcl_GetProcessUniqueNum(void)
+}
+
 # ----- BASELINE -- FOR -- 8.6.0 ----- #
 
 ##############################################################################
Index: generic/tclDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDecls.h,v
retrieving revision 1.170
diff -b -u -r1.170 tclDecls.h
--- generic/tclDecls.h	27 Feb 2009 23:03:42 -0000	1.170
+++ generic/tclDecls.h	25 Jul 2009 23:36:27 -0000
@@ -3725,6 +3725,11 @@
 EXTERN int		Tcl_CloseEx (Tcl_Interp * interp, Tcl_Channel chan,
 				int flags);
 #endif
+#ifndef Tcl_GetProcessUniqueNum_TCL_DECLARED
+#define Tcl_GetProcessUniqueNum_TCL_DECLARED
+/* 625 */
+EXTERN int		Tcl_GetProcessUniqueNum (void);
+#endif
 
 typedef struct TclStubHooks {
     const struct TclPlatStubs *tclPlatStubs;
@@ -4385,6 +4390,7 @@
     void (*tcl_SetStartupScript) (Tcl_Obj * path, const char * encoding); /* 622 */
     Tcl_Obj * (*tcl_GetStartupScript) (const char ** encodingPtr); /* 623 */
     int (*tcl_CloseEx) (Tcl_Interp * interp, Tcl_Channel chan, int flags); /* 624 */
+    int (*tcl_GetProcessUniqueNum) (void); /* 625 */
 } TclStubs;
 
 #if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
@@ -6915,6 +6921,10 @@
 #define Tcl_CloseEx \
 	(tclStubsPtr->tcl_CloseEx) /* 624 */
 #endif
+#ifndef Tcl_GetProcessUniqueNum
+#define Tcl_GetProcessUniqueNum \
+	(tclStubsPtr->tcl_GetProcessUniqueNum) /* 625 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.183
diff -b -u -r1.183 tclStubInit.c
--- generic/tclStubInit.c	15 Jul 2009 13:17:19 -0000	1.183
+++ generic/tclStubInit.c	25 Jul 2009 23:36:39 -0000
@@ -1109,6 +1109,7 @@
     Tcl_SetStartupScript, /* 622 */
     Tcl_GetStartupScript, /* 623 */
     Tcl_CloseEx, /* 624 */
+    Tcl_GetProcessUniqueNum, /* 625 */
 };
 
 /* !END!: Do not edit above this line. */
Index: generic/tclUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclUtil.c,v
retrieving revision 1.111
diff -b -u -r1.111 tclUtil.c
--- generic/tclUtil.c	12 Jul 2009 18:04:33 -0000	1.111
+++ generic/tclUtil.c	25 Jul 2009 23:36:42 -0000
@@ -3117,6 +3117,36 @@
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_GetProcessUniqueNum --
+ *
+ *	Get a process-wide unique integer, wrapping in no less than MAXUNIT
+ *	steps. Typically used to generate non-recyclable opaque handle names,
+ *	e.g. for channels.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetProcessUniqueNum(void)
+{
+    static int unique=0;
+    int result;
+
+    TCL_DECLARE_MUTEX(uniqueMutex);
+#ifdef TCL_THREADS
+    Tcl_MutexLock(&uniqueMutex);
+#endif
+    result=unique++;
+#ifdef TCL_THREADS
+    Tcl_MutexUnlock(&uniqueMutex);
+#endif
+
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclSetObjNameOfExecutable --
  *
  *	This function stores the absolute pathname of the executable file
Index: unix/tclUnixChan.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixChan.c,v
retrieving revision 1.101
diff -b -u -r1.101 tclUnixChan.c
--- unix/tclUnixChan.c	15 Jun 2009 16:24:45 -0000	1.101
+++ unix/tclUnixChan.c	25 Jul 2009 23:36:44 -0000
@@ -1579,7 +1579,7 @@
 
     fcntl(fd, F_SETFD, FD_CLOEXEC);
 
-    sprintf(channelName, "file%d", fd);
+    sprintf(channelName, "file%d", Tcl_GetProcessUniqueNum());
 
 #ifdef SUPPORTS_TTY
     if (strcmp(native, "/dev/tty") != 0 && isatty(fd)) {
@@ -1672,7 +1672,7 @@
     if (isatty(fd)) {
 	fsPtr = TtyInit(fd, 0);
 	channelTypePtr = &ttyChannelType;
-	sprintf(channelName, "serial%d", fd);
+	sprintf(channelName, "serial%d", Tcl_GetProcessUniqueNum());
     } else
 #endif /* SUPPORTS_TTY */
     if (getsockname(fd, (struct sockaddr *)&sockaddr, &sockaddrLen) == 0
@@ -1682,7 +1682,7 @@
     } else {
 	channelTypePtr = &fileChannelType;
 	fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
-	sprintf(channelName, "file%d", fd);
+	sprintf(channelName, "file%d", Tcl_GetProcessUniqueNum());
     }
 
     fsPtr->fd = fd;
Index: unix/tclUnixPipe.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixPipe.c,v
retrieving revision 1.48
diff -b -u -r1.48 tclUnixPipe.c
--- unix/tclUnixPipe.c	9 Jan 2009 11:21:46 -0000	1.48
+++ unix/tclUnixPipe.c	25 Jul 2009 23:36:45 -0000
@@ -762,7 +762,7 @@
      * natural to use "pipe%d".
      */
 
-    sprintf(channelName, "file%d", channelId);
+    sprintf(channelName, "file%d", Tcl_GetProcessUniqueNum());
     statePtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
 	    (ClientData) statePtr, mode);
     return statePtr->channel;
Index: unix/tclUnixSock.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixSock.c,v
retrieving revision 1.22
diff -b -u -r1.22 tclUnixSock.c
--- unix/tclUnixSock.c	15 Jun 2009 16:24:45 -0000	1.22
+++ unix/tclUnixSock.c	25 Jul 2009 23:36:46 -0000
@@ -1131,7 +1131,7 @@
     statePtr->acceptProc = NULL;
     statePtr->acceptProcData = NULL;
 
-    sprintf(channelName, "sock%d", statePtr->fd);
+    sprintf(channelName, "sock%d", Tcl_GetProcessUniqueNum());
 
     statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
 	    (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE));
@@ -1198,7 +1198,7 @@
     statePtr->acceptProc = NULL;
     statePtr->acceptProcData = NULL;
 
-    sprintf(channelName, "sock%d", statePtr->fd);
+    sprintf(channelName, "sock%d", Tcl_GetProcessUniqueNum());
 
     statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
 	    (ClientData) statePtr, mode);
@@ -1259,7 +1259,7 @@
 
     Tcl_CreateFileHandler(statePtr->fd, TCL_READABLE, TcpAccept,
 	    (ClientData) statePtr);
-    sprintf(channelName, "sock%d", statePtr->fd);
+    sprintf(channelName, "sock%d", Tcl_GetProcessUniqueNum());
     statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
 	    (ClientData) statePtr, 0);
     return statePtr->channel;
@@ -1316,7 +1316,7 @@
     newSockState->acceptProc = NULL;
     newSockState->acceptProcData = NULL;
 
-    sprintf(channelName, "sock%d", newsock);
+    sprintf(channelName, "sock%d", Tcl_GetProcessUniqueNum());
     newSockState->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
 	    (ClientData) newSockState, (TCL_READABLE | TCL_WRITABLE));