Tcl Source Code

2011-08-16  Jan Nijtmans  <[email protected]>

	* generic/tclCmdAH.c:    [Bug 3388350] mingw64 compiler warnings
	* generic/tclFCmd.c      In mingw, sys/stat.h must be included
	* generic/tclFileName.c  before winsock2.h, so make sure of that.
	* generic/tclIOUtil.c
	* generic/tclBasic.c
	* generic/tclBinary.c
	* generic/tclHash.c
	* generic/tclTest.c
	* win/tclWinChan.c
	* win/tclWinConsole.c
	* win/tclWinDde.c
	* win/tclWinFile.c
	* win/tclWinReg.c
	* win/tclWinSerial.c
	* win/tclWinSock.c
	* win/tclWinThrd.c

2011-08-15  Don Porter  <[email protected]>

	* generic/tclBasic.c: [Bug 3390272] Leak of [info script] value.

2011-08-15  Jan Nijtmans  <[email protected]>

	* win/tclWinPort.h:    [Bug 3388350] mingw64 compiler warnings

	iPtr->flags |= RAND_SEED_INITIALIZED;

	/*
	 * Take into consideration the thread this interp is running in order
	 * to insure different seeds in different threads (bug #416643)
	 */

	iPtr->randSeed = TclpGetClicks() + (PTR2INT(Tcl_GetCurrentThread())<<12);

	/*
	 * Make sure 1 <= randSeed <= (2^31) - 2. See below.
	 */

	iPtr->randSeed &= (unsigned long) 0x7fffffff;
	if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {

	if (*numberCachePtrPtr == NULL) {
	    return Tcl_NewLongObj(value);
	} else {
	    register Tcl_HashTable *tablePtr = *numberCachePtrPtr;
	    register Tcl_HashEntry *hPtr;
	    int isNew;

	    hPtr = Tcl_CreateHashEntry(tablePtr, INT2PTR(value), &isNew);
	    if (!isNew) {
		return (Tcl_Obj *) Tcl_GetHashValue(hPtr);
	    }
	    if (tablePtr->numEntries <= BINARY_SCAN_MAX_CACHE) {
		register Tcl_Obj *objPtr = Tcl_NewLongObj(value);

		Tcl_IncrRefCount(objPtr);

    } else {
	typePtr = &tclArrayHashKeyType;
    }

#if TCL_HASH_KEY_STORE_HASH
    if (typePtr->hashKeyProc == NULL
	    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
	index = RANDOM_INDEX(tablePtr, PTR2UINT(entryPtr->hash));
    } else {
	index = PTR2UINT(entryPtr->hash) & tablePtr->mask;
    }

    bucketPtr = &(tablePtr->buckets[index]);
#else
    bucketPtr = entryPtr->bucketPtr;

    for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
	for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
	    *oldChainPtr = hPtr->nextPtr;
#if TCL_HASH_KEY_STORE_HASH
	    if (typePtr->hashKeyProc == NULL
		    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
		index = RANDOM_INDEX (tablePtr, PTR2UINT(hPtr->hash));
	    } else {
		index = PTR2UINT(hPtr->hash) & tablePtr->mask;
	    }
	    hPtr->nextPtr = tablePtr->buckets[index];
	    tablePtr->buckets[index] = hPtr;
#else
	    VOID *key = (VOID *) Tcl_GetHashKey(tablePtr, hPtr);

TestmainthreadCmd(
    ClientData dummy,		/* Not used. */
    register Tcl_Interp *interp,/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
  if (argc == 1) {
      Tcl_Obj *idObj = Tcl_NewLongObj((long)(intptr_t)Tcl_GetCurrentThread());
      Tcl_SetObjResult(interp, idObj);
      return TCL_OK;
  } else {
      Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
      return TCL_ERROR;
  }
}

    if ((cmdName[0] == 'm') && (strncmp(cmdName, "mthread", len) == 0)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "channel name required", NULL);
	    return TCL_ERROR;
	}

	TclFormatInt(buf, (long)(intptr_t)Tcl_GetChannelThread(chan));
	Tcl_AppendResult(interp, buf, NULL);
	return TCL_OK;
    }

    if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "channel name required", NULL);

    int type)			/* One of TCL_STDIN, TCL_STDOUT, or
				 * TCL_STDERR. */
{
    Tcl_Channel channel;
    HANDLE handle;
    int mode = -1;
    char *bufMode = NULL;
    DWORD handleId = (DWORD)-1;
				/* Standard handle to retrieve. */

    switch (type) {
    case TCL_STDIN:
	handleId = STD_INPUT_HANDLE;
	mode = TCL_READABLE;
	bufMode = "line";

    infoPtr->nextPtr = NULL;
    infoPtr->validMask = permissions;
    infoPtr->watchMask = 0;
    infoPtr->flags = appendMode;
    infoPtr->handle = handle;
    infoPtr->dirty = 0;
    wsprintfA(channelName, "file%lx", PTR2INT(infoPtr));

    infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
	    (ClientData) infoPtr, permissions);

    /*
     * Files have default translation of AUTO and ^Z eof char, which means
     * that a ^Z will be accepted as EOF when reading.

    /*
     * Use the pointer for the name of the result channel. This keeps the
     * channel names unique, since some may share handles (stdin/stdout/stderr
     * for instance).
     */

    wsprintfA(channelName, "file%lx", PTR2INT(infoPtr));

    infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName,
	    (ClientData) infoPtr, permissions);

    if (permissions & TCL_READABLE) {
	/*
	 * Make sure the console input buffer is ready for only character

     * Make sure that the DDE server is there. This is done only once, add an
     * exit handler tear it down.
     */

    if (ddeInstance == 0) {
	Tcl_MutexLock(&ddeMutex);
	if (ddeInstance == 0) {
	    if (DdeInitialize(&ddeInstance, (PFNCALLBACK) DdeServerProc,
		    CBF_SKIP_REGISTRATIONS | CBF_SKIP_UNREGISTRATIONS
		    | CBF_FAIL_POKES, 0) != DMLERR_NO_ERROR) {
		ddeInstance = 0;
	    }
	}
	Tcl_MutexUnlock(&ddeMutex);
    }

    switch (uMsg) {
    case WM_CREATE: {
	LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam;
	struct DdeEnumServices *es =
		(struct DdeEnumServices *) lpcs->lpCreateParams;

#ifdef _WIN64
	SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es);
#else
	SetWindowLong(hwnd, GWL_USERDATA, (long)es);
#endif
	return (LRESULT) 0L;
    }
    case WM_DDE_ACK:
	return DdeServicesOnAck(hwnd, wParam, lParam);

}

static BOOL CALLBACK
DdeEnumWindowsCallback(
    HWND hwndTarget,
    LPARAM lParam)
{
    DWORD_PTR dwResult = 0;
    struct DdeEnumServices *es = (struct DdeEnumServices *) lParam;

    SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd,
	    MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000,
	    &dwResult);
    return TRUE;
}

static int
BroadcastValue(
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *CONST objv[])	/* Argument values. */
{
    LRESULT result;
    DWORD_PTR sendResult;
    UINT timeout = 3000;
    int len;
    CONST char *str;
    Tcl_Obj *objPtr;

    if ((objc != 3) && (objc != 5)) {
	Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?");

    infoPtr->sysBufWrite = 4096;

    /*
     * Use the pointer to keep the channel names unique, in case the handles
     * are shared between multiple channels (stdin/stdout).
     */

    wsprintfA(channelName, "file%lx", PTR2INT(infoPtr));

    infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
	    (ClientData) infoPtr, permissions);


    SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite);
    PurgeComm(handle,

    tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    /*
     * Set kernel space buffering and non-blocking.
     */

    TclSockMinimumBuffers(PTR2INT(sock), TCP_BUFFER_SIZE);

    infoPtr = NewSocketInfo((SOCKET) sock);

    /*
     * Start watching for read/write events on the socket.
     */

 *
 *----------------------------------------------------------------------
 */

Tcl_ThreadId
Tcl_GetCurrentThread(void)
{
    return (Tcl_ThreadId) INT2PTR(GetCurrentThreadId());
}

/*
 *----------------------------------------------------------------------
 *
 * TclpInitLock
 *