diff options
Diffstat (limited to 'generic/tclIOCmd.c')
| -rw-r--r-- | generic/tclIOCmd.c | 47 |
1 files changed, 24 insertions, 23 deletions
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 9d54dcd..d3980a4 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -16,7 +16,7 @@ */ typedef struct { - 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[]); @@ -1346,15 +1345,22 @@ AcceptCallbackProc( */ if (acceptCallbackPtr->interp != NULL) { - char portBuf[TCL_INTEGER_SPACE]; - Tcl_Obj *script = Tcl_NewStringObj(acceptCallbackPtr->script, -1); Tcl_Interp *interp = acceptCallbackPtr->interp; - int result; + 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_Preserve(interp); + Tcl_DecrRefCount(objv[1]); - TclFormatInt(portBuf, port); + Tcl_Preserve(interp); Tcl_RegisterChannel(interp, chan); /* @@ -1364,12 +1370,9 @@ AcceptCallbackProc( Tcl_RegisterChannel(NULL, chan); - result = Tcl_ListObjAppendElement(interp, script, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1)); - if (result == TCL_OK) { - Tcl_ListObjAppendElement(NULL, script, Tcl_NewStringObj(address, -1)); - Tcl_ListObjAppendElement(NULL, script, Tcl_NewStringObj(portBuf, -1)); - result = Tcl_EvalObjEx(interp, script, 0); - } + 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); @@ -1383,7 +1386,6 @@ AcceptCallbackProc( Tcl_UnregisterChannel(NULL, chan); Tcl_Release(interp); - Tcl_DecrRefCount(script); } else { /* * The interpreter has been deleted, so there is no useful way to use @@ -1427,7 +1429,7 @@ TcpServerCloseProc( UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp, acceptCallbackPtr); } - Tcl_EventuallyFree(acceptCallbackPtr->script, TCL_DYNAMIC); + Tcl_DecrRefCount(acceptCallbackPtr->script); ckfree(acceptCallbackPtr); } @@ -1462,7 +1464,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) { @@ -1525,7 +1528,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"); @@ -1566,16 +1569,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; } |