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