diff options
author | stanton <stanton> | 1999-03-11 00:19:23 (GMT) |
---|---|---|
committer | stanton <stanton> | 1999-03-11 00:19:23 (GMT) |
commit | 959ef2397770f8b6b7319b28c4cee7ef60ba6ac4 (patch) | |
tree | 5395cacc9a5253542d062dfcb57426a2721a541b | |
parent | 17d56fd5b956aa638c25faaac51a8856ee8f51d7 (diff) | |
download | tcl-959ef2397770f8b6b7319b28c4cee7ef60ba6ac4.zip tcl-959ef2397770f8b6b7319b28c4cee7ef60ba6ac4.tar.gz tcl-959ef2397770f8b6b7319b28c4cee7ef60ba6ac4.tar.bz2 |
* win/tclWinPipe.c:
* generic/tclInt.decls: Added TclWinAddProcess to make it possible
for expect to use Tcl_WaitForPid(). This patch is from Gordon
Chaffee.
* mac/tclMacPort.h:
* win/tclWinInit.c:
* unix/tclUnixPort.h:
* generic/tclAsync.c: Added TclpAsyncMark to fix bug in async
handling on Windows where async events don't wake up the event
loop. This patch comes from Gordon Chaffee.
* generic/tcl.decls: Fixed declarations of reserved slots.
-rw-r--r-- | generic/tcl.decls | 26 | ||||
-rw-r--r-- | generic/tclAsync.c | 4 | ||||
-rw-r--r-- | generic/tclInt.decls | 8 | ||||
-rw-r--r-- | generic/tclIntPlatDecls.h | 17 | ||||
-rw-r--r-- | generic/tclIntPlatStubs.c | 19 | ||||
-rw-r--r-- | generic/tclStubInit.c | 4 | ||||
-rw-r--r-- | mac/tclMacPort.h | 3 | ||||
-rw-r--r-- | unix/tclUnixPort.h | 5 | ||||
-rw-r--r-- | win/tclWinInit.c | 43 | ||||
-rw-r--r-- | win/tclWinPipe.c | 44 |
10 files changed, 140 insertions, 33 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls index 7ece3f8..d8e6941 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tcl.decls,v 1.5 1999/03/10 23:45:50 redman Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.6 1999/03/11 00:19:23 stanton Exp $ library tcl @@ -962,18 +962,18 @@ declare 279 generic { Tcl_ReleaseType *type) } # Reserved for future use (8.0.x vs. 8.1) -declare 280 generic { -} -declare 281 generic { -} -declare 282 generic { -} -declare 283 generic { -} -declare 284 generic { -} -declare 285 generic { -} +# declare 280 generic { +# } +# declare 281 generic { +# } +# declare 282 generic { +# } +# declare 283 generic { +# } +# declare 284 generic { +# } +# declare 285 generic { +# } ############################################################################## diff --git a/generic/tclAsync.c b/generic/tclAsync.c index 67ccdbc..18af186 100644 --- a/generic/tclAsync.c +++ b/generic/tclAsync.c @@ -12,10 +12,11 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclAsync.c,v 1.2 1998/09/14 18:39:57 stanton Exp $ + * RCS: @(#) $Id: tclAsync.c,v 1.3 1999/03/11 00:19:23 stanton Exp $ */ #include "tclInt.h" +#include "tclPort.h" /* * One of the following structures exists for each asynchronous @@ -125,6 +126,7 @@ Tcl_AsyncMark(async) { ((AsyncHandler *) async)->ready = 1; if (!asyncActive) { + TclpAsyncMark(async); asyncReady = 1; } } diff --git a/generic/tclInt.decls b/generic/tclInt.decls index e8a5e1f..29f755e 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tclInt.decls,v 1.3 1999/03/10 05:52:48 stanton Exp $ +# RCS: @(#) $Id: tclInt.decls,v 1.4 1999/03/11 00:19:23 stanton Exp $ library tcl @@ -681,6 +681,12 @@ declare 18 win { declare 19 win { TclFile TclpOpenFile(char *fname, int mode) } +declare 20 win { + void TclWinAddProcess(HANDLE hProcess, DWORD id) +} +declare 21 win { + void TclpAsyncMark(Tcl_AsyncHandler async) +} ######################### # Unix specific internals diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index 4e78459..bfb3cf7 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -9,7 +9,7 @@ * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. * - * RCS: @(#) $Id: tclIntPlatDecls.h,v 1.3 1999/03/10 05:52:48 stanton Exp $ + * RCS: @(#) $Id: tclIntPlatDecls.h,v 1.4 1999/03/11 00:19:23 stanton Exp $ */ #ifndef _TCLINTPLATDECLS @@ -115,6 +115,11 @@ EXTERN TclFile TclpMakeFile _ANSI_ARGS_((Tcl_Channel channel, int direction)); /* 19 */ EXTERN TclFile TclpOpenFile _ANSI_ARGS_((char * fname, int mode)); +/* 20 */ +EXTERN void TclWinAddProcess _ANSI_ARGS_((HANDLE hProcess, + DWORD id)); +/* 21 */ +EXTERN void TclpAsyncMark _ANSI_ARGS_((Tcl_AsyncHandler async)); #endif /* __WIN32__ */ #ifdef MAC_TCL /* 0 */ @@ -222,6 +227,8 @@ typedef struct TclIntPlatStubs { char * (*tclpGetTZName) _ANSI_ARGS_((void)); /* 17 */ TclFile (*tclpMakeFile) _ANSI_ARGS_((Tcl_Channel channel, int direction)); /* 18 */ TclFile (*tclpOpenFile) _ANSI_ARGS_((char * fname, int mode)); /* 19 */ + void (*tclWinAddProcess) _ANSI_ARGS_((HANDLE hProcess, DWORD id)); /* 20 */ + void (*tclpAsyncMark) _ANSI_ARGS_((Tcl_AsyncHandler async)); /* 21 */ #endif /* __WIN32__ */ #ifdef MAC_TCL VOID * (*tclpSysAlloc) _ANSI_ARGS_((long size, int isBin)); /* 0 */ @@ -380,6 +387,14 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #define TclpOpenFile(fname, mode) \ (tclIntPlatStubsPtr->tclpOpenFile)(fname, mode) /* 19 */ #endif +#ifndef TclWinAddProcess +#define TclWinAddProcess(hProcess, id) \ + (tclIntPlatStubsPtr->tclWinAddProcess)(hProcess, id) /* 20 */ +#endif +#ifndef TclpAsyncMark +#define TclpAsyncMark(async) \ + (tclIntPlatStubsPtr->tclpAsyncMark)(async) /* 21 */ +#endif #endif /* __WIN32__ */ #ifdef MAC_TCL #ifndef TclpSysAlloc diff --git a/generic/tclIntPlatStubs.c b/generic/tclIntPlatStubs.c index 43bc4e5..2821567 100644 --- a/generic/tclIntPlatStubs.c +++ b/generic/tclIntPlatStubs.c @@ -7,7 +7,7 @@ * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. * - * RCS: @(#) $Id: tclIntPlatStubs.c,v 1.3 1999/03/10 05:52:49 stanton Exp $ + * RCS: @(#) $Id: tclIntPlatStubs.c,v 1.4 1999/03/11 00:19:23 stanton Exp $ */ #include "tclInt.h" @@ -301,6 +301,23 @@ TclpOpenFile(fname, mode) return (tclIntPlatStubsPtr->tclpOpenFile)(fname, mode); } +/* Slot 20 */ +void +TclWinAddProcess(hProcess, id) + HANDLE hProcess; + DWORD id; +{ + (tclIntPlatStubsPtr->tclWinAddProcess)(hProcess, id); +} + +/* Slot 21 */ +void +TclpAsyncMark(async) + Tcl_AsyncHandler async; +{ + (tclIntPlatStubsPtr->tclpAsyncMark)(async); +} + #endif /* __WIN32__ */ #ifdef MAC_TCL /* Slot 0 */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 521fe712..306da5e 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubInit.c,v 1.5 1999/03/10 23:45:51 redman Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.6 1999/03/11 00:19:23 stanton Exp $ */ #include "tclInt.h" @@ -532,6 +532,8 @@ TclIntPlatStubs tclIntPlatStubs = { TclpGetTZName, /* 17 */ TclpMakeFile, /* 18 */ TclpOpenFile, /* 19 */ + TclWinAddProcess, /* 20 */ + TclpAsyncMark, /* 21 */ #endif /* __WIN32__ */ #ifdef MAC_TCL TclpSysAlloc, /* 0 */ diff --git a/mac/tclMacPort.h b/mac/tclMacPort.h index cd269a9..558fecd 100644 --- a/mac/tclMacPort.h +++ b/mac/tclMacPort.h @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclMacPort.h,v 1.6 1999/03/10 05:52:51 stanton Exp $ + * RCS: @(#) $Id: tclMacPort.h,v 1.7 1999/03/11 00:19:24 stanton Exp $ */ #ifndef _MACPORT @@ -207,6 +207,7 @@ EXTERN int strncasecmp _ANSI_ARGS_((CONST char *s1, */ #define TclCreateCommandChannel(out, in, err, num, pidPtr) NULL #define TclClosePipeFile(x) +#define TclpAsyncMark(async) /* * These definitions force putenv & company to use the version diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h index da64295..6ab38ee 100644 --- a/unix/tclUnixPort.h +++ b/unix/tclUnixPort.h @@ -19,7 +19,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixPort.h,v 1.9 1999/03/10 05:52:52 stanton Exp $ + * RCS: @(#) $Id: tclUnixPort.h,v 1.10 1999/03/11 00:19:24 stanton Exp $ */ #ifndef _TCLUNIXPORT @@ -452,10 +452,11 @@ extern double strtod(); #define TclpReleaseFile(file) /* - * TclpFinalize is a noop on Unix systems. + * The following defines stub out functions that aren't needed on Unix. */ #define TclpFinalize() +#define TclpAsyncMark(async) #include "tclPlatDecls.h" #include "tclIntPlatDecls.h" diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 6173def..2a470df 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinInit.c,v 1.12 1999/02/02 18:36:31 stanton Exp $ + * RCS: @(#) $Id: tclWinInit.c,v 1.13 1999/03/11 00:19:24 stanton Exp $ */ #include "tclInt.h" @@ -82,6 +82,12 @@ static char* processors[NUMPROCESSORS] = { #include "tclInitScript.h" +/* + * Thread id used for asynchronous notification from signal handlers. + */ + +static DWORD threadId; + /* *---------------------------------------------------------------------- @@ -279,6 +285,13 @@ TclPlatformInit(interp) } Tcl_DStringFree(&ds); + + /* + * Save the current thread id so an async signal handler can poke + * the right thread using TclpAyncMark. + */ + + threadId = GetCurrentThreadId(); } /* @@ -396,3 +409,31 @@ Tcl_SourceRCFile(interp) Tcl_DStringFree(&temp); } } + +/* + *---------------------------------------------------------------------- + * + * TclpAsyncMark -- + * + * Wake up the main thread from a signal handler. + * + * Results: + * None. + * + * Side effects: + * Sends a message to the main thread. + * + *---------------------------------------------------------------------- + */ + +void +TclpAsyncMark(async) + Tcl_AsyncHandler async; /* Token for handler. */ +{ + /* + * Need a way to kick the Windows event loop and tell it to go look at + * asynchronous events. + */ + + PostThreadMessage(threadId, WM_USER, 0, 0); +} diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 76695e0..8194f64 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinPipe.c,v 1.3 1998/09/14 18:40:20 stanton Exp $ + * RCS: @(#) $Id: tclWinPipe.c,v 1.4 1999/03/11 00:19:24 stanton Exp $ */ #include "tclWinInt.h" @@ -998,11 +998,7 @@ TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile, } *pidPtr = (Tcl_Pid) procInfo.hProcess; if (*pidPtr != 0) { - ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo)); - procPtr->hProcess = procInfo.hProcess; - procPtr->dwProcessId = procInfo.dwProcessId; - procPtr->nextPtr = procList; - procList = procPtr; + TclWinAddProcess(procInfo.hProcess, procInfo.dwProcessId); } result = TCL_OK; } @@ -1303,11 +1299,7 @@ TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile, *pidPtr = (Tcl_Pid) procInfo.hProcess; if (*pidPtr != 0) { - ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo)); - procPtr->hProcess = procInfo.hProcess; - procPtr->dwProcessId = procInfo.dwProcessId; - procPtr->nextPtr = procList; - procList = procPtr; + TclWinAddProcess(procInfo.hProcess, procInfo.dwProcessId); } result = TCL_OK; @@ -2416,6 +2408,36 @@ Tcl_WaitPid(pid, statPtr, options) /* *---------------------------------------------------------------------- * + * TclWinAddProcess -- + * + * Add a process to the process list so that we can use + * Tcl_WaitPid on the process. + * + * Results: + * None + * + * Side effects: + * Adds the specified process handle to the process list so + * Tcl_WaitPid knows about it. + * + *---------------------------------------------------------------------- + */ + +void +TclWinAddProcess(hProcess, id) + HANDLE hProcess; /* Handle to process */ + DWORD id; /* Global process identifier */ +{ + ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo)); + procPtr->hProcess = hProcess; + procPtr->dwProcessId = id; + procPtr->nextPtr = procList; + procList = procPtr; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_PidObjCmd -- * * This procedure is invoked to process the "pid" Tcl command. |