diff options
Diffstat (limited to 'generic/tclIOCmd.c')
| -rw-r--r-- | generic/tclIOCmd.c | 45 |
1 files changed, 25 insertions, 20 deletions
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 834f225..de65da5 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -16,7 +16,7 @@ */ typedef struct AcceptCallback { - char *script; /* Script to invoke. */ + Tcl_Obj *script; /* Script to invoke. */ Tcl_Interp *interp; /* Interpreter in which to run it. */ } AcceptCallback; @@ -37,8 +37,7 @@ static Tcl_ThreadDataKey dataKey; */ static void FinalizeIOCmdTSD(ClientData clientData); -static void AcceptCallbackProc(ClientData callbackData, - Tcl_Channel chan, char *address, int port); +static Tcl_TcpAcceptProc AcceptCallbackProc; static int ChanPendingObjCmd(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -1373,15 +1372,22 @@ AcceptCallbackProc( */ if (acceptCallbackPtr->interp != NULL) { - char portBuf[TCL_INTEGER_SPACE]; - char *script = acceptCallbackPtr->script; Tcl_Interp *interp = acceptCallbackPtr->interp; - int result; + Tcl_Obj *script, *objv[2]; + int result = TCL_OK; - Tcl_Preserve(script); - Tcl_Preserve(interp); + objv[0] = acceptCallbackPtr->script; + objv[1] = Tcl_NewListObj(3, NULL); + Tcl_ListObjAppendElement(NULL, objv[1], Tcl_NewStringObj( + Tcl_GetChannelName(chan), -1)); + Tcl_ListObjAppendElement(NULL, objv[1], Tcl_NewStringObj(address, -1)); + Tcl_ListObjAppendElement(NULL, objv[1], Tcl_NewIntObj(port)); + + script = Tcl_ConcatObj(2, objv); + Tcl_IncrRefCount(script); + Tcl_DecrRefCount(objv[1]); - TclFormatInt(portBuf, port); + Tcl_Preserve(interp); Tcl_RegisterChannel(interp, chan); /* @@ -1391,8 +1397,9 @@ AcceptCallbackProc( Tcl_RegisterChannel(NULL, chan); - result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan), - " ", address, " ", portBuf, NULL); + result = Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL); + Tcl_DecrRefCount(script); + if (result != TCL_OK) { Tcl_BackgroundException(interp, result); Tcl_UnregisterChannel(interp, chan); @@ -1406,7 +1413,6 @@ AcceptCallbackProc( Tcl_UnregisterChannel(NULL, chan); Tcl_Release(interp); - Tcl_Release(script); } else { /* * The interpreter has been deleted, so there is no useful way to use @@ -1450,7 +1456,7 @@ TcpServerCloseProc( UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp, acceptCallbackPtr); } - Tcl_EventuallyFree(acceptCallbackPtr->script, TCL_DYNAMIC); + Tcl_DecrRefCount(acceptCallbackPtr->script); ckfree(acceptCallbackPtr); } @@ -1485,7 +1491,8 @@ Tcl_SocketObjCmd( SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER }; int optionIndex, a, server = 0, port, myport = 0, async = 0; - const char *host, *script = NULL, *myaddr = NULL; + const char *host, *myaddr = NULL; + Tcl_Obj *script = NULL; Tcl_Channel chan; if (TclpHasSockets(interp) != TCL_OK) { @@ -1548,7 +1555,7 @@ Tcl_SocketObjCmd( "no argument given for -server option", -1)); return TCL_ERROR; } - script = TclGetString(objv[a]); + script = objv[a]; break; default: Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions"); @@ -1589,16 +1596,14 @@ Tcl_SocketObjCmd( if (server) { AcceptCallback *acceptCallbackPtr = ckalloc(sizeof(AcceptCallback)); - unsigned len = strlen(script) + 1; - char *copyScript = ckalloc(len); - memcpy(copyScript, script, len); - acceptCallbackPtr->script = copyScript; + Tcl_IncrRefCount(script); + acceptCallbackPtr->script = script; acceptCallbackPtr->interp = interp; chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc, acceptCallbackPtr); if (chan == NULL) { - ckfree(copyScript); + Tcl_DecrRefCount(script); ckfree(acceptCallbackPtr); return TCL_ERROR; } |