summaryrefslogtreecommitdiffstats
path: root/generic/tclIORTrans.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclIORTrans.c')
-rw-r--r--generic/tclIORTrans.c547
1 files changed, 299 insertions, 248 deletions
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index b550675..1de635f 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -14,12 +14,10 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclIORTrans.c,v 1.6 2008/10/26 18:34:04 dkf Exp $
*/
-#include <tclInt.h>
-#include <tclIO.h>
+#include "tclInt.h"
+#include "tclIO.h"
#include <assert.h>
#ifndef EINVAL
@@ -63,7 +61,7 @@ static int ReflectNotify(ClientData clientData, int mask);
* The C layer channel type/driver definition used by the reflection.
*/
-static Tcl_ChannelType tclRTransformType = {
+static const Tcl_ChannelType tclRTransformType = {
"tclrtransform", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel. */
ReflectClose, /* Close channel, clean instance data. */
@@ -74,14 +72,14 @@ static Tcl_ChannelType tclRTransformType = {
ReflectGetOption, /* Get options. */
ReflectWatch, /* Initialize notifier. */
ReflectHandle, /* Get OS handle from the channel. */
- NULL, /* No close2 support. NULL'able */
+ NULL, /* No close2 support. NULL'able. */
ReflectBlock, /* Set blocking/nonblocking. */
NULL, /* Flush channel. Not used by core.
* NULL'able. */
ReflectNotify, /* Handle events. */
ReflectSeekWide, /* Move access point (64 bit). */
NULL, /* thread action */
- NULL, /* truncate */
+ NULL /* truncate */
};
/*
@@ -90,14 +88,14 @@ static Tcl_ChannelType tclRTransformType = {
*/
typedef struct _ResultBuffer_ {
- unsigned char *buf; /* Reference to the buffer area. */
- int allocated; /* Allocated size of the buffer area. */
- int used; /* Number of bytes in the buffer,
+ unsigned char *buf; /* Reference to the buffer area. */
+ int allocated; /* Allocated size of the buffer area. */
+ int used; /* Number of bytes in the buffer,
* <= allocated. */
} ResultBuffer;
#define ResultLength(r) ((r)->used)
-/* static int ResultLength (ResultBuffer *r); */
+/* static int ResultLength(ResultBuffer *r); */
static void ResultClear(ResultBuffer *r);
static void ResultInit(ResultBuffer *r);
@@ -163,6 +161,8 @@ typedef struct {
int mode; /* Mask of R/W mode */
int nonblocking; /* Flag: Channel is blocking or not. */
int readIsDrained; /* Flag: Read buffers are flushed. */
+ int dead; /* Boolean signal that some operations
+ * should no longer be attempted. */
ResultBuffer result;
} ReflectedTransform;
@@ -363,33 +363,43 @@ static int ForwardProc(Tcl_Event *evPtr, int mask);
static void SrcExitProc(ClientData clientData);
#define FreeReceivedError(p) \
- if ((p)->base.mustFree) { \
- ckfree((p)->base.msgStr); \
- }
+ do { \
+ if ((p)->base.mustFree) { \
+ ckfree((p)->base.msgStr); \
+ } \
+ } while (0)
#define PassReceivedErrorInterp(i,p) \
- if ((i) != NULL) { \
- Tcl_SetChannelErrorInterp((i), \
- Tcl_NewStringObj((p)->base.msgStr, -1)); \
- } \
- FreeReceivedError(p)
+ do { \
+ if ((i) != NULL) { \
+ Tcl_SetChannelErrorInterp((i), \
+ Tcl_NewStringObj((p)->base.msgStr, -1)); \
+ } \
+ FreeReceivedError(p); \
+ } while (0)
#define PassReceivedError(c,p) \
- Tcl_SetChannelError((c), Tcl_NewStringObj((p)->base.msgStr, -1)); \
- FreeReceivedError(p)
+ do { \
+ Tcl_SetChannelError((c), \
+ Tcl_NewStringObj((p)->base.msgStr, -1)); \
+ FreeReceivedError(p); \
+ } while (0)
#define ForwardSetStaticError(p,emsg) \
- (p)->base.code = TCL_ERROR; \
- (p)->base.mustFree = 0; \
- (p)->base.msgStr = (char *) (emsg)
+ do { \
+ (p)->base.code = TCL_ERROR; \
+ (p)->base.mustFree = 0; \
+ (p)->base.msgStr = (char *) (emsg); \
+ } while (0)
#define ForwardSetDynamicError(p,emsg) \
- (p)->base.code = TCL_ERROR; \
- (p)->base.mustFree = 1; \
- (p)->base.msgStr = (char *) (emsg)
+ do { \
+ (p)->base.code = TCL_ERROR; \
+ (p)->base.mustFree = 1; \
+ (p)->base.msgStr = (char *) (emsg); \
+ } while (0)
static void ForwardSetObjError(ForwardParam *p,
Tcl_Obj *objPtr);
-
static ReflectedTransformMap * GetThreadReflectedTransformMap(void);
-static void DeleteThreadReflectedTransformMap(ClientData clientData);
-
+static void DeleteThreadReflectedTransformMap(
+ ClientData clientData);
#endif /* TCL_THREADS */
#define SetChannelErrorStr(c,msgStr) \
@@ -409,6 +419,7 @@ static ReflectedTransform * NewReflectedTransform(Tcl_Interp *interp,
Tcl_Channel parentChan);
static Tcl_Obj * NextHandle(void);
static void FreeReflectedTransform(ReflectedTransform *rtPtr);
+static void FreeReflectedTransformArgs(ReflectedTransform *rtPtr);
static int InvokeTclMethod(ReflectedTransform *rtPtr,
const char *method, Tcl_Obj *argOneObj,
Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);
@@ -424,8 +435,6 @@ static void DeleteReflectedTransformMap(ClientData clientData,
* list-quoting to keep the words of the message together. See also [x].
*/
-static const char *msg_read_badlimit =
- "{Tcl driver returned bad read limit '0'}";
static const char *msg_read_unsup = "{read not supported by Tcl driver}";
static const char *msg_write_unsup = "{write not supported by Tcl driver}";
#ifdef TCL_THREADS
@@ -440,21 +449,13 @@ static const char *msg_dstlost =
*/
/*
- * Number of milliseconds to wait before firing an event to try to flush out
- * information waiting in buffers (fileevent support).
- */
-
-#define FLUSH_DELAY (5)
-
-static void TimerKill(ReflectedTransform* rtPtr);
-static void TimerSetup(ReflectedTransform* rtPtr);
-static void TimerRun(ClientData clientData);
-
-/*
* Helper functions encapsulating some of the thread forwarding to make the
* control flow in callers easier.
*/
+static void TimerKill(ReflectedTransform *rtPtr);
+static void TimerSetup(ReflectedTransform *rtPtr);
+static void TimerRun(ClientData clientData);
static int TransformRead(ReflectedTransform *rtPtr,
int *errorCodePtr, unsigned char *buf,
int toRead);
@@ -469,9 +470,12 @@ static void TransformClear(ReflectedTransform *rtPtr);
static int TransformLimit(ReflectedTransform *rtPtr,
int *errorCodePtr, int *maxPtr);
-/* op'codes for TransformFlush */
-#define FLUSH_WRITE 1
-#define FLUSH_DISCARD 0
+/*
+ * Operation codes for TransformFlush().
+ */
+
+#define FLUSH_WRITE 1
+#define FLUSH_DISCARD 0
/*
* Main methods to plug into the 'chan' ensemble'. ==================
@@ -519,7 +523,6 @@ TclChanPushObjCmd(
int result; /* Result code for 'initialize' */
Tcl_Obj *resObj; /* Result data for 'initialize' */
int methods; /* Bitmask for supported methods. */
- Tcl_Obj *err; /* Error message */
ReflectedTransformMap *rtmPtr;
/* Map of reflected transforms with handlers
* in this interp. */
@@ -578,7 +581,7 @@ TclChanPushObjCmd(
* Now create the transformation (channel).
*/
- rtId = NextHandle();
+ rtId = NextHandle();
rtPtr = NewReflectedTransform(interp, cmdObj, mode, rtId, parentChan);
/*
@@ -587,7 +590,8 @@ TclChanPushObjCmd(
*/
modeObj = DecodeEventMask(mode);
- result = InvokeTclMethod(rtPtr, "initialize", modeObj, NULL, &resObj);
+ /* assert modeObj.refCount == 1 */
+ result = InvokeTclMethod(rtPtr, "initialize", modeObj, NULL, &resObj);
Tcl_DecrRefCount(modeObj);
if (result != TCL_OK) {
UnmarshallErrorResult(interp, resObj);
@@ -602,11 +606,9 @@ TclChanPushObjCmd(
*/
if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, " initialize\" returned non-list: ", -1);
- Tcl_AppendObjToObj(err, resObj);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s initialize\" returned non-list: %s",
+ Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
Tcl_DecrRefCount(resObj);
goto error;
}
@@ -615,11 +617,10 @@ TclChanPushObjCmd(
while (listc > 0) {
if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames,
"method", TCL_EXACT, &methIndex) != TCL_OK) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, " initialize\" returned ", -1);
- Tcl_AppendObjToObj(err, Tcl_GetObjResult(interp));
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s initialize\" returned %s",
+ Tcl_GetString(cmdObj),
+ Tcl_GetString(Tcl_GetObjResult(interp))));
Tcl_DecrRefCount(resObj);
goto error;
}
@@ -630,10 +631,9 @@ TclChanPushObjCmd(
Tcl_DecrRefCount(resObj);
if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" does not support all required methods", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" does not support all required methods",
+ Tcl_GetString(cmdObj)));
goto error;
}
@@ -653,10 +653,9 @@ TclChanPushObjCmd(
}
if (!mode) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" makes the channel inacessible", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" makes the channel inaccessible",
+ Tcl_GetString(cmdObj)));
goto error;
}
@@ -665,18 +664,16 @@ TclChanPushObjCmd(
*/
if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" supports \"drain\" but not \"read\"", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" supports \"drain\" but not \"read\"",
+ Tcl_GetString(cmdObj)));
goto error;
}
if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" supports \"flush\" but not \"write\"", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" supports \"flush\" but not \"write\"",
+ Tcl_GetString(cmdObj)));
goto error;
}
@@ -706,13 +703,14 @@ TclChanPushObjCmd(
rtmPtr = GetThreadReflectedTransformMap();
hPtr = Tcl_CreateHashEntry(&rtmPtr->map, Tcl_GetString(rtId), &isNew);
Tcl_SetHashValue(hPtr, rtPtr);
-#endif
+#endif /* TCL_THREADS */
/*
* Return the channel as the result of the command.
*/
- Tcl_AppendResult(interp, Tcl_GetChannelName(rtPtr->chan), NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ Tcl_GetChannelName(rtPtr->chan), -1));
return TCL_OK;
error:
@@ -721,7 +719,7 @@ TclChanPushObjCmd(
* structure.
*/
- FreeReflectedTransform(rtPtr);
+ Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
return TCL_ERROR;
#undef CHAN
@@ -888,14 +886,15 @@ ReflectClose(
Tcl_Interp *interp)
{
ReflectedTransform *rtPtr = clientData;
- int result; /* Result code for 'close' */
+ int errorCode, errorCodeSet = 0;
+ int result = TCL_OK; /* Result code for 'close' */
Tcl_Obj *resObj; /* Result data for 'close' */
ReflectedTransformMap *rtmPtr;
/* Map of reflected transforms with handlers
* in this interp. */
Tcl_HashEntry *hPtr; /* Entry in the above map */
- if (interp == NULL) {
+ if (TclInThreadExit()) {
/*
* This call comes from TclFinalizeIOSystem. There are no
* interpreters, and therefore we cannot call upon the handler command
@@ -919,19 +918,13 @@ ReflectClose(
ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
result = p.base.code;
- /*
- * FreeReflectedTransform is done in the forwarded operation!, in
- * the other thread. rtPtr here is gone!
- */
-
if (result != TCL_OK) {
FreeReceivedError(&p);
}
- return EOK;
}
-#endif
+#endif /* TCL_THREADS */
- FreeReflectedTransform(rtPtr);
+ Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
return EOK;
}
@@ -944,18 +937,30 @@ ReflectClose(
*/
if (HAS(rtPtr->methods, METH_DRAIN) && !rtPtr->readIsDrained) {
- int errorCode;
-
if (!TransformDrain(rtPtr, &errorCode)) {
- return errorCode;
+#ifdef TCL_THREADS
+ if (rtPtr->thread != Tcl_GetCurrentThread()) {
+ Tcl_EventuallyFree(rtPtr,
+ (Tcl_FreeProc *) FreeReflectedTransform);
+ return errorCode;
+ }
+#endif /* TCL_THREADS */
+ errorCodeSet = 1;
+ goto cleanup;
}
}
if (HAS(rtPtr->methods, METH_FLUSH)) {
- int errorCode;
-
if (!TransformFlush(rtPtr, &errorCode, FLUSH_WRITE)) {
- return errorCode;
+#ifdef TCL_THREADS
+ if (rtPtr->thread != Tcl_GetCurrentThread()) {
+ Tcl_EventuallyFree(rtPtr,
+ (Tcl_FreeProc *) FreeReflectedTransform);
+ return errorCode;
+ }
+#endif /* TCL_THREADS */
+ errorCodeSet = 1;
+ goto cleanup;
}
}
@@ -970,10 +975,7 @@ ReflectClose(
ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
result = p.base.code;
- /*
- * FreeReflectedTransform is done in the forwarded operation!, in the
- * other thread. rtPtr here is gone!
- */
+ Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
if (result != TCL_OK) {
PassReceivedErrorInterp(interp, &p);
@@ -981,7 +983,7 @@ ReflectClose(
}
return EOK;
}
-#endif
+#endif /* TCL_THREADS */
/*
* Do the actual invokation of "finalize" now; we're in the right thread.
@@ -995,6 +997,8 @@ ReflectClose(
Tcl_DecrRefCount(resObj); /* Remove reference we held from the
* invoke. */
+ cleanup:
+
/*
* Remove the transform from the map before releasing the memory, to
* prevent future accesses from finding and dereferencing a dangling
@@ -1003,30 +1007,35 @@ ReflectClose(
* NOTE: The transform may not be in the map. This is ok, that happens
* when the transform was created in a different interpreter and/or thread
* and then was moved here.
+ *
+ * NOTE: The channel may have been removed from the map already via
+ * the per-interp DeleteReflectedTransformMap exit-handler.
*/
- rtmPtr = GetReflectedTransformMap(interp);
- hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
- if (hPtr) {
- Tcl_DeleteHashEntry(hPtr);
- }
+ if (!rtPtr->dead) {
+ rtmPtr = GetReflectedTransformMap(rtPtr->interp);
+ hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
+ if (hPtr) {
+ Tcl_DeleteHashEntry(hPtr);
+ }
- /*
- * In a threaded interpreter we manage a per-thread map as well, to allow
- * us to survive if the script level pulls the rug out under a channel by
- * deleting the owning thread.
- */
+ /*
+ * In a threaded interpreter we manage a per-thread map as well,
+ * to allow us to survive if the script level pulls the rug out
+ * under a channel by deleting the owning thread.
+ */
#ifdef TCL_THREADS
- rtmPtr = GetThreadReflectedTransformMap();
- hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
- if (hPtr) {
- Tcl_DeleteHashEntry(hPtr);
+ rtmPtr = GetThreadReflectedTransformMap();
+ hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
+ if (hPtr) {
+ Tcl_DeleteHashEntry(hPtr);
+ }
+#endif /* TCL_THREADS */
}
-#endif
- FreeReflectedTransform(rtPtr);
- return (result == TCL_OK) ? EOK : EINVAL;
+ Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
+ return errorCodeSet ? errorCode : ((result == TCL_OK) ? EOK : EINVAL);
}
/*
@@ -1053,7 +1062,7 @@ ReflectInput(
int *errorCodePtr)
{
ReflectedTransform *rtPtr = clientData;
- int gotBytes, copied, read;
+ int gotBytes, copied, readBytes;
/*
* The following check can be done before thread redirection, because we
@@ -1067,8 +1076,9 @@ ReflectInput(
return -1;
}
- gotBytes = 0;
+ Tcl_Preserve(rtPtr);
+ gotBytes = 0;
while (toRead > 0) {
/*
* Loop until the request is satisfied (or no data available from
@@ -1081,7 +1091,7 @@ ReflectInput(
gotBytes += copied;
if (toRead == 0) {
- return gotBytes;
+ goto stop;
}
/*
@@ -1104,11 +1114,10 @@ ReflectInput(
int maxRead = -1;
if (!TransformLimit(rtPtr, errorCodePtr, &maxRead)) {
- return -1;
+ goto error;
}
if (maxRead == 0) {
- SetChannelErrorStr(rtPtr->chan, msg_read_badlimit);
- return -1;
+ goto stop;
} else if (maxRead > 0) {
if (maxRead < toRead) {
toRead = maxRead;
@@ -1117,11 +1126,11 @@ ReflectInput(
}
if (toRead <= 0) {
- return gotBytes;
+ goto stop;
}
- read = Tcl_ReadRaw(rtPtr->parent, buf, toRead);
- if (read < 0) {
+ readBytes = Tcl_ReadRaw(rtPtr->parent, buf, toRead);
+ if (readBytes < 0) {
/*
* Report errors to caller. The state of the seek system is
* unchanged!
@@ -1133,14 +1142,14 @@ ReflectInput(
* we report that instead of the request to re-try.
*/
- return gotBytes;
+ goto stop;
}
*errorCodePtr = Tcl_GetErrno();
- return -1;
+ goto error;
}
- if (read == 0) {
+ if (readBytes == 0) {
/*
* Check wether we hit on EOF in 'parent' or not. If not
* differentiate between blocking and non-blocking modes. In
@@ -1158,16 +1167,16 @@ ReflectInput(
if ((gotBytes == 0) && rtPtr->nonblocking) {
*errorCodePtr = EWOULDBLOCK;
- return -1;
+ goto error;
}
- return gotBytes;
+ goto stop;
} else {
/*
* Eof in parent.
*/
if (rtPtr->readIsDrained) {
- return gotBytes;
+ goto stop;
}
/*
@@ -1177,7 +1186,7 @@ ReflectInput(
if (HAS(rtPtr->methods, METH_DRAIN)) {
if (!TransformDrain(rtPtr, errorCodePtr)) {
- return -1;
+ goto error;
}
}
@@ -1186,17 +1195,17 @@ ReflectInput(
* The drain delivered nothing.
*/
- return gotBytes;
+ goto stop;
}
/*
* Reset eof, force caller to drain result buffer.
*/
- ((Channel *) rtPtr->parent)->state->flags &= ~CHANNEL_EOF;
+ ((Channel *) rtPtr->parent)->state->flags &= ~CHANNEL_EOF;
continue; /* at: while (toRead > 0) */
}
- } /* read == 0 */
+ } /* readBytes == 0 */
/*
* Transform the read chunk, which was not empty. Anything we got back
@@ -1204,12 +1213,18 @@ ReflectInput(
* iteration will put it into the result.
*/
- if (!TransformRead(rtPtr, errorCodePtr, UCHARP(buf), read)) {
- return -1;
+ if (!TransformRead(rtPtr, errorCodePtr, UCHARP(buf), readBytes)) {
+ goto error;
}
} /* while toRead > 0 */
+ stop:
+ Tcl_Release(rtPtr);
return gotBytes;
+
+ error:
+ gotBytes = -1;
+ goto stop;
}
/*
@@ -1217,7 +1232,7 @@ ReflectInput(
*
* ReflectOutput --
*
- * This function is invoked when data is writen to the channel.
+ * This function is invoked when data is written to the channel.
*
* Results:
* The number of bytes actually written.
@@ -1262,6 +1277,8 @@ ReflectOutput(
* we do when explicitly seeking as well.
*/
+ Tcl_Preserve(rtPtr);
+
if ((rtPtr->methods & FLAG(METH_CLEAR))) {
TransformClear(rtPtr);
}
@@ -1273,10 +1290,12 @@ ReflectOutput(
*/
if (!TransformWrite(rtPtr, errorCodePtr, UCHARP(buf), toWrite)) {
+ Tcl_Release(rtPtr);
return -1;
}
*errorCodePtr = EOK;
+ Tcl_Release(rtPtr);
return toWrite;
}
@@ -1327,15 +1346,18 @@ ReflectSeekWide(
* request down and the result back up unchanged.
*/
- if (((seekMode != SEEK_CUR) || (offset != 0)) &&
- (HAS(rtPtr->methods,METH_CLEAR) || HAS(rtPtr->methods,METH_FLUSH))){
+ Tcl_Preserve(rtPtr);
+
+ if (((seekMode != SEEK_CUR) || (offset != 0))
+ && (HAS(rtPtr->methods, METH_CLEAR)
+ || HAS(rtPtr->methods, METH_FLUSH))) {
/*
* Neither a tell request, nor clear/flush both not supported. We have
* to go through the Tcl level to clear and/or flush the
* transformation.
*/
- if ((rtPtr->methods & FLAG(METH_CLEAR))) {
+ if (rtPtr->methods & FLAG(METH_CLEAR)) {
TransformClear(rtPtr);
}
@@ -1348,6 +1370,7 @@ ReflectSeekWide(
if (HAS(rtPtr->methods, METH_FLUSH)) {
if (!TransformFlush(rtPtr, errorCodePtr, FLUSH_DISCARD)) {
+ Tcl_Release(rtPtr);
return -1;
}
}
@@ -1364,7 +1387,7 @@ ReflectSeekWide(
curPos = parent->typePtr->wideSeekProc(parent->instanceData, offset,
seekMode, errorCodePtr);
} else if (offset < Tcl_LongAsWide(LONG_MIN) ||
- offset > Tcl_LongAsWide(LONG_MAX)) {
+ offset > Tcl_LongAsWide(LONG_MAX)) {
*errorCodePtr = EOVERFLOW;
curPos = Tcl_LongAsWide(-1);
} else {
@@ -1377,6 +1400,7 @@ ReflectSeekWide(
}
*errorCodePtr = EOK;
+ Tcl_Release(rtPtr);
return curPos;
}
@@ -1515,7 +1539,7 @@ ReflectSetOption(
* level is not involved there is no need for thread forwarding.
*/
- Tcl_DriverSetOptionProc *setOptionProc =
+ Tcl_DriverSetOptionProc *setOptionProc =
Tcl_ChannelSetOptionProc(Tcl_GetChannelType(rtPtr->parent));
if (setOptionProc == NULL) {
@@ -1561,7 +1585,7 @@ ReflectGetOption(
* specific option has to fail.
*/
- Tcl_DriverGetOptionProc *getOptionProc =
+ Tcl_DriverGetOptionProc *getOptionProc =
Tcl_ChannelGetOptionProc(Tcl_GetChannelType(rtPtr->parent));
if (getOptionProc != NULL) {
@@ -1732,7 +1756,7 @@ NewReflectedTransform(
Tcl_Obj **listv;
int i;
- rtPtr = (ReflectedTransform *) ckalloc(sizeof(ReflectedTransform));
+ rtPtr = ckalloc(sizeof(ReflectedTransform));
/* rtPtr->chan: Assigned by caller. Dummy data here. */
/* rtPtr->methods: Assigned by caller. Dummy data here. */
@@ -1749,8 +1773,9 @@ NewReflectedTransform(
rtPtr->timer = NULL;
rtPtr->mode = 0;
rtPtr->readIsDrained = 0;
- rtPtr->nonblocking =
+ rtPtr->nonblocking =
(((Channel *) parentChan)->state->flags & CHANNEL_NONBLOCKING);
+ rtPtr->dead = 0;
/*
* Query parent for current blocking mode.
@@ -1777,7 +1802,7 @@ NewReflectedTransform(
*/
rtPtr->argc = listc + 2;
- rtPtr->argv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * (listc+4));
+ rtPtr->argv = ckalloc(sizeof(Tcl_Obj *) * (listc+4));
/*
* Duplicate object references.
@@ -1851,18 +1876,18 @@ NextHandle(void)
}
static void
-FreeReflectedTransform(
+FreeReflectedTransformArgs(
ReflectedTransform *rtPtr)
{
- int i, n;
+ int i, n = rtPtr->argc - 2;
- TimerKill(rtPtr);
- ResultClear(&rtPtr->result);
+ if (n < 0) {
+ return;
+ }
Tcl_DecrRefCount(rtPtr->handle);
rtPtr->handle = NULL;
- n = rtPtr->argc - 2;
for (i=0; i<n; i++) {
Tcl_DecrRefCount(rtPtr->argv[i]);
}
@@ -1873,8 +1898,20 @@ FreeReflectedTransform(
*/
Tcl_DecrRefCount(rtPtr->argv[n+1]);
- ckfree((char*) rtPtr->argv);
- ckfree((char*) rtPtr);
+ rtPtr->argc = 1;
+}
+
+static void
+FreeReflectedTransform(
+ ReflectedTransform *rtPtr)
+{
+ TimerKill(rtPtr);
+ ResultClear(&rtPtr->result);
+
+ FreeReflectedTransformArgs(rtPtr);
+
+ ckfree(rtPtr->argv);
+ ckfree(rtPtr);
}
/*
@@ -1893,6 +1930,11 @@ FreeReflectedTransform(
* Side effects:
* Arbitrary, as it calls upon a Tcl script.
*
+ * Contract:
+ * argOneObj.refCount >= 1 on entry and exit, if argOneObj != NULL
+ * argTwoObj.refCount >= 1 on entry and exit, if argTwoObj != NULL
+ * resObj.refCount in {0, 1, ...}
+ *
*----------------------------------------------------------------------
* Semi-DUPLICATE of 'InvokeTclMethod' in tclIORChan.c
* - Semi because different structures are used.
@@ -1913,7 +1955,7 @@ InvokeTclMethod(
int result; /* Result code of method invokation */
Tcl_Obj *resObj = NULL; /* Result of method invokation. */
- if (!rtPtr->interp) {
+ if (rtPtr->dead) {
/*
* The transform is marked as dead. Bail out immediately, with an
* appropriate error.
@@ -1946,15 +1988,16 @@ InvokeTclMethod(
/*
* Append the additional argument containing method specific details
* behind the channel id. If specified.
+ *
+ * Because of the contract there is no need to increment the refcounts.
+ * The objects will survive the Tcl_EvalObjv without change.
*/
cmdc = rtPtr->argc;
if (argOneObj) {
- Tcl_IncrRefCount(argOneObj);
rtPtr->argv[cmdc] = argOneObj;
cmdc++;
if (argTwoObj) {
- Tcl_IncrRefCount(argTwoObj);
rtPtr->argv[cmdc] = argTwoObj;
cmdc++;
}
@@ -1966,7 +2009,7 @@ InvokeTclMethod(
*/
sr = Tcl_SaveInterpState(rtPtr->interp, 0 /* Dummy */);
- Tcl_Preserve(rtPtr->interp);
+ Tcl_Preserve(rtPtr);
result = Tcl_EvalObjv(rtPtr->interp, cmdc, rtPtr->argv, TCL_EVAL_GLOBAL);
/*
@@ -2011,19 +2054,17 @@ InvokeTclMethod(
Tcl_IncrRefCount(resObj);
}
Tcl_RestoreInterpState(rtPtr->interp, sr);
- Tcl_Release(rtPtr->interp);
+ Tcl_Release(rtPtr);
/*
* Cleanup of the dynamic parts of the command.
+ *
+ * The detail objects survived the Tcl_EvalObjv without change because of
+ * the contract. Therefore there is no need to decrement the refcounts. Only
+ * the internal method object has to be disposed of.
*/
Tcl_DecrRefCount(methObj);
- if (argOneObj) {
- Tcl_DecrRefCount(argOneObj);
- if (argTwoObj) {
- Tcl_DecrRefCount(argTwoObj);
- }
- }
/*
* The resObj has a ref count of 1 at this location. This means that the
@@ -2067,8 +2108,7 @@ GetReflectedTransformMap(
ReflectedTransformMap *rtmPtr = Tcl_GetAssocData(interp, RTMKEY, NULL);
if (rtmPtr == NULL) {
- rtmPtr = (ReflectedTransformMap *)
- ckalloc(sizeof(ReflectedTransformMap));
+ rtmPtr = ckalloc(sizeof(ReflectedTransformMap));
Tcl_InitHashTable(&rtmPtr->map, TCL_STRING_KEYS);
Tcl_SetAssocData(interp, RTMKEY,
(Tcl_InterpDeleteProc *) DeleteReflectedTransformMap, rtmPtr);
@@ -2109,7 +2149,7 @@ DeleteReflectedTransformMap(
ForwardingResult *resultPtr;
ForwardingEvent *evPtr;
ForwardParam *paramPtr;
-#endif
+#endif /* TCL_THREADS */
/*
* Delete all entries. The channels may have been closed already, or will
@@ -2128,11 +2168,12 @@ DeleteReflectedTransformMap(
hPtr != NULL;
hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) {
rtPtr = Tcl_GetHashValue(hPtr);
- rtPtr->interp = NULL;
+
+ rtPtr->dead = 1;
Tcl_DeleteHashEntry(hPtr);
}
Tcl_DeleteHashTable(&rtmPtr->map);
- ckfree((char *) &rtmPtr->map);
+ ckfree(&rtmPtr->map);
#ifdef TCL_THREADS
/*
@@ -2140,6 +2181,32 @@ DeleteReflectedTransformMap(
*/
/*
+ * Get the map of all channels handled by the current thread. This is a
+ * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go
+ * through the channels and remove all which were handled by this
+ * interpreter. They have already been marked as dead.
+ */
+
+ rtmPtr = GetThreadReflectedTransformMap();
+ for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch);
+ hPtr != NULL;
+ hPtr = Tcl_NextHashEntry(&hSearch)) {
+ rtPtr = Tcl_GetHashValue(hPtr);
+
+ if (rtPtr->interp != interp) {
+ /*
+ * Ignore entries for other interpreters.
+ */
+
+ continue;
+ }
+
+ rtPtr->dead = 1;
+ FreeReflectedTransformArgs(rtPtr);
+ Tcl_DeleteHashEntry(hPtr);
+ }
+
+ /*
* Go through the list of pending results and cancel all whose events were
* destined for this interpreter. While this is in progress we block any
* other access to the list of pending results.
@@ -2173,33 +2240,8 @@ DeleteReflectedTransformMap(
Tcl_ConditionNotify(&resultPtr->done);
}
-
- /*
- * Get the map of all channels handled by the current thread. This is a
- * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go
- * through the channels and remove all which were handled by this
- * interpreter. They have already been marked as dead.
- */
-
- rtmPtr = GetThreadReflectedTransformMap();
- for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch);
- hPtr != NULL;
- hPtr = Tcl_NextHashEntry(&hSearch)) {
- rtPtr = Tcl_GetHashValue(hPtr);
-
- if (rtPtr->interp != interp) {
- /*
- * Ignore entries for other interpreters.
- */
-
- continue;
- }
-
- Tcl_DeleteHashEntry(hPtr);
- }
-
Tcl_MutexUnlock(&rtForwardMutex);
-#endif
+#endif /* TCL_THREADS */
}
#ifdef TCL_THREADS
@@ -2226,8 +2268,7 @@ GetThreadReflectedTransformMap(void)
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!tsdPtr->rtmPtr) {
- tsdPtr->rtmPtr = (ReflectedTransformMap *)
- ckalloc(sizeof(ReflectedTransformMap));
+ tsdPtr->rtmPtr = ckalloc(sizeof(ReflectedTransformMap));
Tcl_InitHashTable(&tsdPtr->rtmPtr->map, TCL_STRING_KEYS);
Tcl_CreateThreadExitHandler(DeleteThreadReflectedTransformMap, NULL);
}
@@ -2242,7 +2283,7 @@ GetThreadReflectedTransformMap(void)
*
* Deletes the channel table for a thread. This procedure is invoked when
* a thread is deleted. The channels have already been marked as dead, in
- * DeleteReflectedTransformMap().
+ * DeleteReflectedTransformMap().
*
* Results:
* None.
@@ -2270,6 +2311,24 @@ DeleteThreadReflectedTransformMap(
*/
/*
+ * Get the map of all channels handled by the current thread. This is a
+ * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go
+ * through the channels, remove all, mark them as dead.
+ */
+
+ rtmPtr = GetThreadReflectedTransformMap();
+ for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch);
+ hPtr != NULL;
+ hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) {
+ ReflectedTransform *rtPtr = Tcl_GetHashValue(hPtr);
+
+ rtPtr->dead = 1;
+ FreeReflectedTransformArgs(rtPtr);
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ ckfree(rtmPtr);
+
+ /*
* Go through the list of pending results and cancel all whose events were
* destined for this thread. While this is in progress we block any
* other access to the list of pending results.
@@ -2306,23 +2365,6 @@ DeleteThreadReflectedTransformMap(
Tcl_ConditionNotify(&resultPtr->done);
}
-
- /*
- * Get the map of all channels handled by the current thread. This is a
- * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go
- * through the channels, remove all, mark them as dead.
- */
-
- rtmPtr = GetThreadReflectedTransformMap();
- for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch);
- hPtr != NULL;
- hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) {
- ReflectedTransform *rtPtr = Tcl_GetHashValue(hPtr);
-
- rtPtr->interp = NULL;
- Tcl_DeleteHashEntry(hPtr);
- }
-
Tcl_MutexUnlock(&rtForwardMutex);
}
@@ -2335,7 +2377,6 @@ ForwardOpToOwnerThread(
Tcl_ThreadId dst = rtPtr->thread;
ForwardingEvent *evPtr;
ForwardingResult *resultPtr;
- int result;
/*
* We gather the lock early. This allows us to check the liveness of the
@@ -2344,7 +2385,7 @@ ForwardOpToOwnerThread(
Tcl_MutexLock(&rtForwardMutex);
- if (rtPtr->interp == NULL) {
+ if (rtPtr->dead) {
/*
* The channel is marked as dead. Bail out immediately, with an
* appropriate error. Do not forget to unlock the mutex on this path.
@@ -2359,8 +2400,8 @@ ForwardOpToOwnerThread(
* Create and initialize the event and data structures.
*/
- evPtr = (ForwardingEvent *) ckalloc(sizeof(ForwardingEvent));
- resultPtr = (ForwardingResult *) ckalloc(sizeof(ForwardingResult));
+ evPtr = ckalloc(sizeof(ForwardingEvent));
+ resultPtr = ckalloc(sizeof(ForwardingResult));
evPtr->event.proc = ForwardProc;
evPtr->resultPtr = resultPtr;
@@ -2370,6 +2411,7 @@ ForwardOpToOwnerThread(
resultPtr->src = Tcl_GetCurrentThread();
resultPtr->dst = dst;
+ resultPtr->dsti = rtPtr->interp;
resultPtr->done = NULL;
resultPtr->result = -1;
resultPtr->evPtr = evPtr;
@@ -2439,8 +2481,7 @@ ForwardOpToOwnerThread(
Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr);
- result = resultPtr->result;
- ckfree((char*) resultPtr);
+ ckfree(resultPtr);
}
static int
@@ -2523,15 +2564,17 @@ ForwardProc(
* channel by deleting the owning thread.
*/
- rtmPtr = GetThreadReflectedTransformMap();
+ rtmPtr = GetThreadReflectedTransformMap();
hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
Tcl_DeleteHashEntry(hPtr);
- FreeReflectedTransform(rtPtr);
+
+ FreeReflectedTransformArgs(rtPtr);
break;
case ForwardedInput: {
Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
paramPtr->transform.buf, paramPtr->transform.size);
+ Tcl_IncrRefCount(bufObj);
if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
@@ -2557,12 +2600,15 @@ ForwardProc(
paramPtr->transform.buf = NULL;
}
}
+
+ Tcl_DecrRefCount(bufObj);
break;
}
case ForwardedOutput: {
Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
paramPtr->transform.buf, paramPtr->transform.size);
+ Tcl_IncrRefCount(bufObj);
if (InvokeTclMethod(rtPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
@@ -2588,10 +2634,12 @@ ForwardProc(
paramPtr->transform.buf = NULL;
}
}
+
+ Tcl_DecrRefCount(bufObj);
break;
}
- case ForwardedDrain: {
+ case ForwardedDrain:
if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
paramPtr->transform.size = -1;
@@ -2616,9 +2664,8 @@ ForwardProc(
}
}
break;
- }
- case ForwardedFlush: {
+ case ForwardedFlush:
if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
paramPtr->transform.size = -1;
@@ -2644,16 +2691,12 @@ ForwardProc(
}
}
break;
- }
- case ForwardedClear: {
+ case ForwardedClear:
(void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL);
break;
- }
-
- case ForwardedLimit: {
- Tcl_Obj* resObj;
+ case ForwardedLimit:
if (InvokeTclMethod(rtPtr, "limit?", NULL, NULL, &resObj) != TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
paramPtr->limit.max = -1;
@@ -2662,10 +2705,7 @@ ForwardProc(
ForwardSetObjError(paramPtr, MarshallError(interp));
paramPtr->limit.max = -1;
}
-
- Tcl_DecrRefCount(resObj);
break;
- }
default:
/*
@@ -2757,10 +2797,10 @@ ForwardSetObjError(
const char *msgStr = Tcl_GetStringFromObj(obj, &len);
len++;
- ForwardSetDynamicError(paramPtr, ckalloc((unsigned) len));
+ ForwardSetDynamicError(paramPtr, ckalloc(len));
memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
}
-#endif
+#endif /* TCL_THREADS */
/*
*----------------------------------------------------------------------
@@ -2819,7 +2859,8 @@ TimerSetup(
return;
}
- rtPtr->timer = Tcl_CreateTimerHandler(FLUSH_DELAY, TimerRun, rtPtr);
+ rtPtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
+ TimerRun, rtPtr);
}
/*
@@ -2901,7 +2942,7 @@ ResultClear(
return;
}
- Tcl_Free((char *) rPtr->buf);
+ ckfree((char *) rPtr->buf);
rPtr->buf = NULL;
rPtr->allocated = 0;
}
@@ -2936,10 +2977,10 @@ ResultAdd(
if (rPtr->allocated == 0) {
rPtr->allocated = toWrite + RB_INCREMENT;
- rPtr->buf = UCHARP(Tcl_Alloc(rPtr->allocated));
+ rPtr->buf = UCHARP(ckalloc(rPtr->allocated));
} else {
rPtr->allocated += toWrite + RB_INCREMENT;
- rPtr->buf = UCHARP(Tcl_Realloc((char *) rPtr->buf,
+ rPtr->buf = UCHARP(ckrealloc((char *) rPtr->buf,
rPtr->allocated));
}
}
@@ -3056,14 +3097,17 @@ TransformRead(
ckfree(p.transform.buf);
return 1;
}
-#endif
+#endif /* TCL_THREADS */
/* ASSERT: rtPtr->method & FLAG(METH_READ) */
/* ASSERT: rtPtr->mode & TCL_READABLE */
bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toRead);
+ Tcl_IncrRefCount(bufObj);
+
if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) {
Tcl_SetChannelError(rtPtr->chan, resObj);
+ Tcl_DecrRefCount(bufObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
*errorCodePtr = EINVAL;
return 0;
@@ -3071,6 +3115,8 @@ TransformRead(
bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
ResultAdd(&rtPtr->result, bytev, bytec);
+
+ Tcl_DecrRefCount(bufObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
return 1;
}
@@ -3112,15 +3158,18 @@ TransformWrite(
p.transform.size);
ckfree(p.transform.buf);
} else
-#endif
+#endif /* TCL_THREADS */
{
/* ASSERT: rtPtr->method & FLAG(METH_WRITE) */
/* ASSERT: rtPtr->mode & TCL_WRITABLE */
bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
+ Tcl_IncrRefCount(bufObj);
if (InvokeTclMethod(rtPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
*errorCodePtr = EINVAL;
Tcl_SetChannelError(rtPtr->chan, resObj);
+
+ Tcl_DecrRefCount(bufObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
return 0;
}
@@ -3129,6 +3178,8 @@ TransformWrite(
bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec);
+
+ Tcl_DecrRefCount(bufObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
}
@@ -3169,7 +3220,7 @@ TransformDrain(
ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size);
ckfree(p.transform.buf);
} else
-#endif
+#endif /* TCL_THREADS */
{
if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj)!=TCL_OK) {
Tcl_SetChannelError(rtPtr->chan, resObj);
@@ -3194,7 +3245,7 @@ TransformFlush(
int *errorCodePtr,
int op)
{
- Tcl_Obj* resObj;
+ Tcl_Obj *resObj;
int bytec; /* Number of returned bytes */
unsigned char *bytev; /* Array of returned bytes */
int res;
@@ -3224,7 +3275,7 @@ TransformFlush(
}
ckfree(p.transform.buf);
} else
-#endif
+#endif /* TCL_THREADS */
{
if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj)!=TCL_OK) {
Tcl_SetChannelError(rtPtr->chan, resObj);
@@ -3265,7 +3316,7 @@ TransformClear(
ForwardOpToOwnerThread(rtPtr, ForwardedClear, &p);
return;
}
-#endif
+#endif /* TCL_THREADS */
/* ASSERT: rtPtr->method & FLAG(METH_READ) */
/* ASSERT: rtPtr->mode & TCL_READABLE */
generated by cgit v0.12 at 2025-10-26 18:08:12 (GMT)