summaryrefslogtreecommitdiffstats
path: root/generic/tclIORChan.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclIORChan.c')
-rw-r--r--generic/tclIORChan.c456
1 files changed, 301 insertions, 155 deletions
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 69a8e11..629c8cc 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -10,7 +10,7 @@
*
* See TIP #219 for the specification of this functionality.
*
- * Copyright (c) 2004-2005 ActiveState, a division of Sophos
+ * Copyright © 2004-2005 ActiveState, a division of Sophos
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -31,31 +31,35 @@
* Signatures of all functions used in the C layer of the reflection.
*/
-static int ReflectClose(ClientData clientData,
- Tcl_Interp *interp);
-static int ReflectClose2(ClientData clientData,
+static int ReflectClose(void *clientData,
Tcl_Interp *interp, int flags);
-static int ReflectInput(ClientData clientData, char *buf,
+static int ReflectInput(void *clientData, char *buf,
int toRead, int *errorCodePtr);
-static int ReflectOutput(ClientData clientData, const char *buf,
+static int ReflectOutput(void *clientData, const char *buf,
int toWrite, int *errorCodePtr);
-static void ReflectWatch(ClientData clientData, int mask);
-static int ReflectBlock(ClientData clientData, int mode);
-#ifdef TCL_THREADS
-static void ReflectThread(ClientData clientData, int action);
+static void ReflectWatch(void *clientData, int mask);
+static int ReflectBlock(void *clientData, int mode);
+#if TCL_THREADS
+static void ReflectThread(void *clientData, int action);
static int ReflectEventRun(Tcl_Event *ev, int flags);
-static int ReflectEventDelete(Tcl_Event *ev, ClientData cd);
+static int ReflectEventDelete(Tcl_Event *ev, void *cd);
#endif
-static Tcl_WideInt ReflectSeekWide(ClientData clientData,
- Tcl_WideInt offset, int mode, int *errorCodePtr);
-static int ReflectSeek(ClientData clientData, long offset,
+static long long ReflectSeekWide(void *clientData,
+ long long offset, int mode, int *errorCodePtr);
+#ifndef TCL_NO_DEPRECATED
+static int ReflectSeek(void *clientData, long offset,
int mode, int *errorCodePtr);
-static int ReflectGetOption(ClientData clientData,
+#endif
+static int ReflectGetOption(void *clientData,
Tcl_Interp *interp, const char *optionName,
Tcl_DString *dsPtr);
-static int ReflectSetOption(ClientData clientData,
+static int ReflectSetOption(void *clientData,
Tcl_Interp *interp, const char *optionName,
const char *newValue);
+static int ReflectTruncate(void *clientData,
+ long long length);
+static void TimerRunRead(void *clientData);
+static void TimerRunWrite(void *clientData);
/*
* The C layer channel type/driver definition used by the reflection.
@@ -64,25 +68,29 @@ static int ReflectSetOption(ClientData clientData,
static const Tcl_ChannelType tclRChannelType = {
"tclrchannel", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
- ReflectClose, /* Close channel, clean instance data */
+ TCL_CLOSE2PROC, /* Close channel, clean instance data */
ReflectInput, /* Handle read request */
ReflectOutput, /* Handle write request */
+#ifndef TCL_NO_DEPRECATED
ReflectSeek, /* Move location of access point. NULL'able */
+#else
+ NULL,
+#endif
ReflectSetOption, /* Set options. NULL'able */
ReflectGetOption, /* Get options. NULL'able */
ReflectWatch, /* Initialize notifier */
NULL, /* Get OS handle from the channel. NULL'able */
- ReflectClose2, /* No close2 support. NULL'able */
+ ReflectClose, /* No close2 support. NULL'able */
ReflectBlock, /* Set blocking/nonblocking. NULL'able */
NULL, /* Flush channel. Not used by core. NULL'able */
NULL, /* Handle events. NULL'able */
ReflectSeekWide, /* Move access point (64 bit). NULL'able */
-#ifdef TCL_THREADS
+#if TCL_THREADS
ReflectThread, /* thread action, tracking owner */
#else
- NULL, /* thread action */
+ NULL, /* thread action */
#endif
- NULL /* truncate */
+ ReflectTruncate /* Truncate. NULL'able */
};
/*
@@ -98,7 +106,7 @@ typedef struct {
* interpreter/thread containing its Tcl
* command is gone.
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */
Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */
#endif
@@ -113,6 +121,17 @@ typedef struct {
int dead; /* Boolean signal that some operations
* should no longer be attempted. */
+ Tcl_TimerToken readTimer; /*
+ A token for the timer that is scheduled in
+ order to call Tcl_NotifyChannel when the
+ channel is readable
+ */
+ Tcl_TimerToken writeTimer; /*
+ A token for the timer that is scheduled in
+ order to call Tcl_NotifyChannel when the
+ channel is writable
+ */
+
/*
* Note regarding the usage of timers.
*
@@ -122,11 +141,9 @@ typedef struct {
*
* See 'refchan', 'memchan', etc.
*
- * Here this is _not_ required. Interest in events is posted to the Tcl
- * level via 'watch'. And posting of events is possible from the Tcl level
- * as well, via 'chan postevent'. This means that the generation of all
- * events, fake or not, timer based or not, is completely in the hands of
- * the Tcl level. Therefore no timer here.
+ * A timer is used here as well in order to ensure at least on pass through
+ * the event loop when a channel becomes ready. See issues 67a5eabbd3d1 and
+ * ef28eb1f1516.
*/
} ReflectedChannel;
@@ -171,6 +188,7 @@ static const char *const methodNames[] = {
"initialize", /* */
"read", /* OPT */
"seek", /* OPT */
+ "truncate", /* OPT */
"watch", /* */
"write", /* OPT */
NULL
@@ -184,6 +202,7 @@ typedef enum {
METH_INIT,
METH_READ,
METH_SEEK,
+ METH_TRUNCATE,
METH_WATCH,
METH_WRITE
} MethodName;
@@ -193,7 +212,8 @@ typedef enum {
(FLAG(METH_INIT) | FLAG(METH_FINAL) | FLAG(METH_WATCH))
#define NULLABLE_METHODS \
(FLAG(METH_BLOCKING) | FLAG(METH_SEEK) | \
- FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | FLAG(METH_CGETALL))
+ FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | \
+ FLAG(METH_CGETALL) | FLAG(METH_TRUNCATE))
#define RANDW \
(TCL_READABLE | TCL_WRITABLE)
@@ -202,7 +222,7 @@ typedef enum {
#define NEGIMPL(a,b)
#define HAS(x,f) ((x) & FLAG(f))
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Thread specific types and structures.
*
@@ -223,7 +243,8 @@ typedef enum {
ForwardedBlock,
ForwardedSetOpt,
ForwardedGetOpt,
- ForwardedGetOptAll
+ ForwardedGetOptAll,
+ ForwardedTruncate
} ForwardedOperation;
/*
@@ -237,7 +258,7 @@ typedef enum {
* sharing problems.
*/
-typedef struct ForwardParamBase {
+typedef struct {
int code; /* O: Ok/Fail of the cmd handler */
char *msgStr; /* O: Error message for handler failure */
int mustFree; /* O: True if msgStr is allocated, false if
@@ -253,13 +274,13 @@ typedef struct ForwardParamBase {
struct ForwardParamInput {
ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
char *buf; /* O: Where to store the read bytes */
- int toRead; /* I: #bytes to read,
+ Tcl_Size toRead; /* I: #bytes to read,
* O: #bytes actually read */
};
struct ForwardParamOutput {
ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
const char *buf; /* I: Where the bytes to write come from */
- int toWrite; /* I: #bytes to write,
+ Tcl_Size toWrite; /* I: #bytes to write,
* O: #bytes actually written */
};
struct ForwardParamSeek {
@@ -286,6 +307,10 @@ struct ForwardParamGetOpt {
const char *name; /* Name of option to get, maybe NULL */
Tcl_DString *value; /* Result */
};
+struct ForwardParamTruncate {
+ ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
+ Tcl_WideInt length; /* I: Length of file. */
+};
/*
* Now join all these together in a single union for convenience.
@@ -300,6 +325,7 @@ typedef union ForwardParam {
struct ForwardParamBlock block;
struct ForwardParamSetOpt setOpt;
struct ForwardParamGetOpt getOpt;
+ struct ForwardParamTruncate truncate;
} ForwardParam;
/*
@@ -312,7 +338,7 @@ typedef struct ForwardingResult ForwardingResult;
* General event structure, with reference to operation specific data.
*/
-typedef struct ForwardingEvent {
+typedef struct {
Tcl_Event event; /* Basic event data, has to be first item */
ForwardingResult *resultPtr;
ForwardedOperation op; /* Forwarded driver operation */
@@ -349,7 +375,7 @@ struct ForwardingResult {
* results. */
};
-typedef struct ThreadSpecificData {
+typedef struct {
/*
* Table of all reflected channels owned by this thread. This is the
* per-thread version of the per-interpreter map.
@@ -382,7 +408,7 @@ TCL_DECLARE_MUTEX(rcForwardMutex)
static void ForwardOpToHandlerThread(ReflectedChannel *rcPtr,
ForwardedOperation op, const void *param);
static int ForwardProc(Tcl_Event *evPtr, int mask);
-static void SrcExitProc(ClientData clientData);
+static void SrcExitProc(void *clientData);
#define FreeReceivedError(p) \
if ((p)->base.mustFree) { \
@@ -409,7 +435,7 @@ static void SrcExitProc(ClientData clientData);
static void ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr);
static ReflectedChannelMap * GetThreadReflectedChannelMap(void);
-static void DeleteThreadReflectedChannelMap(ClientData clientData);
+static Tcl_ExitProc DeleteThreadReflectedChannelMap;
#endif /* TCL_THREADS */
@@ -436,8 +462,7 @@ static int InvokeTclMethod(ReflectedChannel *rcPtr,
Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);
static ReflectedChannelMap * GetReflectedChannelMap(Tcl_Interp *interp);
-static void DeleteReflectedChannelMap(ClientData clientData,
- Tcl_Interp *interp);
+static Tcl_InterpDeleteProc DeleteReflectedChannelMap;
static int ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj);
static void MarkDead(ReflectedChannel *rcPtr);
@@ -452,7 +477,7 @@ static const char *msg_read_toomuch = "{read delivered more than requested}";
static const char *msg_write_toomuch = "{write wrote more than requested}";
static const char *msg_write_nothing = "{write wrote nothing}";
static const char *msg_seek_beforestart = "{Tried to seek before origin}";
-#ifdef TCL_THREADS
+#if TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
#endif /* TCL_THREADS */
static const char *msg_send_dstlost = "{Owner lost}";
@@ -482,7 +507,7 @@ static const char *msg_dstlost = "-code 1 -level 0 -errorcode NONE -errorinfo
int
TclChanCreateObjCmd(
- ClientData dummy,
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -495,7 +520,7 @@ TclChanCreateObjCmd(
Tcl_Obj *cmdNameObj; /* Command name */
Tcl_Channel chan; /* Token for the new channel */
Tcl_Obj *modeObj; /* mode in obj form for method call */
- int listc; /* Result of 'initialize', and of */
+ Tcl_Size listc; /* Result of 'initialize', and of */
Tcl_Obj **listv; /* its sublist in the 2nd element */
int methIndex; /* Encoded method name */
int result; /* Result code for 'initialize' */
@@ -508,7 +533,6 @@ TclChanCreateObjCmd(
* this interp. */
Tcl_HashEntry *hPtr; /* Entry in the above map */
int isNew; /* Placeholder. */
- (void)dummy;
/*
* Syntax: chan create MODE CMDPREFIX
@@ -592,10 +616,10 @@ TclChanCreateObjCmd(
* Compare open mode against optional r/w.
*/
- if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
+ if (TclListObjGetElementsM(NULL, resObj, &listc, &listv) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s initialize\" returned non-list: %s",
- Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
+ TclGetString(cmdObj), TclGetString(resObj)));
Tcl_DecrRefCount(resObj);
goto error;
}
@@ -621,35 +645,35 @@ TclChanCreateObjCmd(
if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" does not support all required methods",
- Tcl_GetString(cmdObj)));
+ TclGetString(cmdObj)));
goto error;
}
if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" lacks a \"read\" method",
- Tcl_GetString(cmdObj)));
+ TclGetString(cmdObj)));
goto error;
}
if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" lacks a \"write\" method",
- Tcl_GetString(cmdObj)));
+ TclGetString(cmdObj)));
goto error;
}
if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" supports \"cget\" but not \"cgetall\"",
- Tcl_GetString(cmdObj)));
+ TclGetString(cmdObj)));
goto error;
}
if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" supports \"cgetall\" but not \"cget\"",
- Tcl_GetString(cmdObj)));
+ TclGetString(cmdObj)));
goto error;
}
@@ -687,9 +711,14 @@ TclChanCreateObjCmd(
clonePtr->blockModeProc = NULL;
}
if (!(methods & FLAG(METH_SEEK))) {
+#ifndef TCL_NO_DEPRECATED
clonePtr->seekProc = NULL;
+#endif
clonePtr->wideSeekProc = NULL;
}
+ if (!(methods & FLAG(METH_TRUNCATE))) {
+ clonePtr->truncateProc = NULL;
+ }
chanPtr->typePtr = clonePtr;
}
@@ -708,7 +737,7 @@ TclChanCreateObjCmd(
Tcl_Panic("TclChanCreateObjCmd: duplicate channel names");
}
Tcl_SetHashValue(hPtr, chan);
-#ifdef TCL_THREADS
+#if TCL_THREADS
rcmPtr = GetThreadReflectedChannelMap();
hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName,
&isNew);
@@ -727,7 +756,7 @@ TclChanCreateObjCmd(
Tcl_DecrRefCount(rcPtr->name);
Tcl_DecrRefCount(rcPtr->methods);
Tcl_DecrRefCount(rcPtr->cmd);
- ckfree((char*) rcPtr);
+ ckfree(rcPtr);
return TCL_ERROR;
#undef MODE
@@ -752,8 +781,8 @@ TclChanCreateObjCmd(
*----------------------------------------------------------------------
*/
-#ifdef TCL_THREADS
-typedef struct ReflectEvent {
+#if TCL_THREADS
+typedef struct {
Tcl_Event header;
ReflectedChannel *rcPtr;
int events;
@@ -762,7 +791,7 @@ typedef struct ReflectEvent {
static int
ReflectEventRun(
Tcl_Event *ev,
- int flags)
+ TCL_UNUSED(int) /*flags*/)
{
/* OWNER thread
*
@@ -772,7 +801,6 @@ ReflectEventRun(
*/
ReflectEvent *e = (ReflectEvent *) ev;
- (void)flags;
Tcl_NotifyChannel(e->rcPtr->chan, e->events);
return 1;
@@ -781,7 +809,7 @@ ReflectEventRun(
static int
ReflectEventDelete(
Tcl_Event *ev,
- ClientData cd)
+ void *cd)
{
/* OWNER thread
*
@@ -801,7 +829,7 @@ ReflectEventDelete(
int
TclChanPostEventObjCmd(
- ClientData dummy,
+ TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -830,7 +858,6 @@ TclChanPostEventObjCmd(
ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
* this interp. */
Tcl_HashEntry *hPtr; /* Entry in the above map */
- (void)dummy;
/*
* Number of arguments...
@@ -926,11 +953,22 @@ TclChanPostEventObjCmd(
* We have the channel and the events to post.
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->owner == rcPtr->thread) {
#endif
- Tcl_NotifyChannel(chan, events);
-#ifdef TCL_THREADS
+ if (events & TCL_READABLE) {
+ if (rcPtr->readTimer == NULL) {
+ rcPtr->readTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
+ TimerRunRead, rcPtr);
+ }
+ }
+ if (events & TCL_WRITABLE) {
+ if (rcPtr->writeTimer == NULL) {
+ rcPtr->writeTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
+ TimerRunWrite, rcPtr);
+ }
+ }
+#if TCL_THREADS
} else {
ReflectEvent *ev = (ReflectEvent *)ckalloc(sizeof(ReflectEvent));
@@ -961,8 +999,8 @@ TclChanPostEventObjCmd(
* XXX Actually, in that case the channel should be dead also !
*/
- Tcl_ThreadQueueEvent(rcPtr->owner, (Tcl_Event *) ev, TCL_QUEUE_TAIL);
- Tcl_ThreadAlert(rcPtr->owner);
+ Tcl_ThreadQueueEvent(rcPtr->owner, (Tcl_Event *) ev,
+ TCL_QUEUE_TAIL|TCL_QUEUE_ALERT_IF_EMPTY);
}
#endif
@@ -977,6 +1015,24 @@ TclChanPostEventObjCmd(
#undef EVENT
}
+static void
+TimerRunRead(
+ void *clientData)
+{
+ ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
+ rcPtr->readTimer = NULL;
+ Tcl_NotifyChannel(rcPtr->chan, TCL_READABLE);
+}
+
+static void
+TimerRunWrite(
+ void *clientData)
+{
+ ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
+ rcPtr->writeTimer = NULL;
+ Tcl_NotifyChannel(rcPtr->chan, TCL_WRITABLE);
+}
+
/*
* Channel error message marshalling utilities.
*/
@@ -1006,10 +1062,10 @@ UnmarshallErrorResult(
Tcl_Interp *interp,
Tcl_Obj *msgObj)
{
- int lc;
+ Tcl_Size lc;
Tcl_Obj **lv;
int explicitResult;
- int numOptions;
+ Tcl_Size numOptions;
/*
* Process the caught message.
@@ -1021,7 +1077,7 @@ UnmarshallErrorResult(
* information; if we panic here, something has gone badly wrong already.
*/
- if (TclListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, msgObj, &lc, &lv) != TCL_OK) {
Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result");
}
if (interp == NULL) {
@@ -1102,10 +1158,10 @@ TclChanCaughtErrorBypass(
/*
*----------------------------------------------------------------------
*
- * ReflectClose/ReflectClose2 --
+ * ReflectClose --
*
* This function is invoked when the channel is closed, to delete the
- * driver specific instance data.
+ * driver-specific instance data.
*
* Results:
* A Posix error.
@@ -1118,8 +1174,9 @@ TclChanCaughtErrorBypass(
static int
ReflectClose(
- ClientData clientData,
- Tcl_Interp *interp)
+ void *clientData,
+ Tcl_Interp *interp,
+ int flags)
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
int result; /* Result code for 'close' */
@@ -1129,6 +1186,10 @@ ReflectClose(
Tcl_HashEntry *hPtr; /* Entry in the above map */
const Tcl_ChannelType *tctPtr;
+ if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
+ return EINVAL;
+ }
+
if (TclInThreadExit()) {
/*
* This call comes from TclFinalizeIOSystem. There are no
@@ -1146,7 +1207,7 @@ ReflectClose(
* if lost?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1167,10 +1228,16 @@ ReflectClose(
tctPtr = ((Channel *)rcPtr->chan)->typePtr;
if (tctPtr && tctPtr != &tclRChannelType) {
- ckfree((char *)tctPtr);
+ ckfree(tctPtr);
((Channel *)rcPtr->chan)->typePtr = NULL;
}
- Tcl_EventuallyFree(rcPtr, FreeReflectedChannel);
+ if (rcPtr->readTimer != NULL) {
+ Tcl_DeleteTimerHandler(rcPtr->readTimer);
+ }
+ if (rcPtr->writeTimer != NULL) {
+ Tcl_DeleteTimerHandler(rcPtr->writeTimer);
+ }
+ Tcl_EventuallyFree(rcPtr, FreeReflectedChannel);
return EOK;
}
@@ -1178,7 +1245,7 @@ ReflectClose(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1225,7 +1292,7 @@ ReflectClose(
Tcl_DeleteHashEntry(hPtr);
}
}
-#ifdef TCL_THREADS
+#if TCL_THREADS
rcmPtr = GetThreadReflectedChannelMap();
hPtr = Tcl_FindHashEntry(&rcmPtr->map,
Tcl_GetChannelName(rcPtr->chan));
@@ -1236,24 +1303,18 @@ ReflectClose(
#endif
tctPtr = ((Channel *)rcPtr->chan)->typePtr;
if (tctPtr && tctPtr != &tclRChannelType) {
- ckfree((char *)tctPtr);
- ((Channel *)rcPtr->chan)->typePtr = NULL;
+ ckfree(tctPtr);
+ ((Channel *)rcPtr->chan)->typePtr = NULL;
+ }
+ if (rcPtr->readTimer != NULL) {
+ Tcl_DeleteTimerHandler(rcPtr->readTimer);
+ }
+ if (rcPtr->writeTimer != NULL) {
+ Tcl_DeleteTimerHandler(rcPtr->writeTimer);
}
Tcl_EventuallyFree(rcPtr, FreeReflectedChannel);
return (result == TCL_OK) ? EOK : EINVAL;
}
-
-static int
-ReflectClose2(
- ClientData clientData,
- Tcl_Interp *interp,
- int flags)
-{
- if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) == 0) {
- return ReflectClose(clientData, interp);
- }
- return EINVAL;
-}
/*
*----------------------------------------------------------------------
@@ -1273,14 +1334,14 @@ ReflectClose2(
static int
ReflectInput(
- ClientData clientData,
+ void *clientData,
char *buf,
int toRead,
int *errorCodePtr)
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
Tcl_Obj *toReadObj;
- int bytec; /* Number of returned bytes */
+ Tcl_Size bytec; /* Number of returned bytes */
unsigned char *bytev; /* Array of returned bytes */
Tcl_Obj *resObj; /* Result data for 'read' */
@@ -1288,7 +1349,7 @@ ReflectInput(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1308,7 +1369,7 @@ ReflectInput(
PassReceivedError(rcPtr->chan, &p);
*errorCodePtr = EINVAL;
}
- p.input.toRead = -1;
+ p.input.toRead = TCL_INDEX_NONE;
} else {
*errorCodePtr = EOK;
}
@@ -1380,7 +1441,7 @@ ReflectInput(
static int
ReflectOutput(
- ClientData clientData,
+ void *clientData,
const char *buf,
int toWrite,
int *errorCodePtr)
@@ -1394,7 +1455,7 @@ ReflectOutput(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1507,10 +1568,10 @@ ReflectOutput(
*----------------------------------------------------------------------
*/
-static Tcl_WideInt
+static long long
ReflectSeekWide(
- ClientData clientData,
- Tcl_WideInt offset,
+ void *clientData,
+ long long offset,
int seekMode,
int *errorCodePtr)
{
@@ -1523,7 +1584,7 @@ ReflectSeekWide(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1548,7 +1609,7 @@ ReflectSeekWide(
Tcl_Preserve(rcPtr);
- offObj = Tcl_NewWideIntObj(offset);
+ TclNewIntObj(offObj, offset);
baseObj = Tcl_NewStringObj(
(seekMode == SEEK_SET) ? "start" :
(seekMode == SEEK_CUR) ? "current" : "end", -1);
@@ -1583,9 +1644,10 @@ ReflectSeekWide(
goto stop;
}
+#ifndef TCL_NO_DEPRECATED
static int
ReflectSeek(
- ClientData clientData,
+ void *clientData,
long offset,
int seekMode,
int *errorCodePtr)
@@ -1597,9 +1659,10 @@ ReflectSeek(
* routine.
*/
- return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode,
+ return ReflectSeekWide(clientData, offset, seekMode,
errorCodePtr);
}
+#endif
/*
*----------------------------------------------------------------------
@@ -1620,7 +1683,7 @@ ReflectSeek(
static void
ReflectWatch(
- ClientData clientData,
+ void *clientData,
int mask)
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
@@ -1646,7 +1709,7 @@ ReflectWatch(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1692,7 +1755,7 @@ ReflectWatch(
static int
ReflectBlock(
- ClientData clientData,
+ void *clientData,
int nonblocking)
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
@@ -1704,7 +1767,7 @@ ReflectBlock(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1740,7 +1803,7 @@ ReflectBlock(
return errorNum;
}
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
*----------------------------------------------------------------------
*
@@ -1759,7 +1822,7 @@ ReflectBlock(
static void
ReflectThread(
- ClientData clientData,
+ void *clientData,
int action)
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
@@ -1796,7 +1859,7 @@ ReflectThread(
static int
ReflectSetOption(
- ClientData clientData, /* Channel to query */
+ void *clientData, /* Channel to query */
Tcl_Interp *interp, /* Interpreter to leave error messages in */
const char *optionName, /* Name of requested option */
const char *newValue) /* The new value */
@@ -1810,7 +1873,7 @@ ReflectSetOption(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1868,7 +1931,7 @@ ReflectSetOption(
static int
ReflectGetOption(
- ClientData clientData, /* Channel to query */
+ void *clientData, /* Channel to query */
Tcl_Interp *interp, /* Interpreter to leave error messages in */
const char *optionName, /* Name of reuqested option */
Tcl_DString *dsPtr) /* String to place the result into */
@@ -1881,7 +1944,8 @@ ReflectGetOption(
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
Tcl_Obj *optionObj;
Tcl_Obj *resObj; /* Result data for 'configure' */
- int listc, result = TCL_OK;
+ Tcl_Size listc;
+ int result = TCL_OK;
Tcl_Obj **listv;
MethodName method;
@@ -1889,9 +1953,9 @@ ReflectGetOption(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
- int opcode;
+ ForwardedOperation opcode;
ForwardParam p;
p.getOpt.name = optionName;
@@ -1962,7 +2026,7 @@ ReflectGetOption(
* result is a valid list. Nor that the list has an even number elements.
*/
- if (TclListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, resObj, &listc, &listv) != TCL_OK) {
goto error;
}
@@ -1974,12 +2038,12 @@ ReflectGetOption(
Tcl_ResetResult(interp);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"Expected list with even number of "
- "elements, got %d element%s instead", listc,
+ "elements, got %" TCL_SIZE_MODIFIER "d element%s instead", listc,
(listc == 1 ? "" : "s")));
goto error;
} else {
- int len;
- const char *str = Tcl_GetStringFromObj(resObj, &len);
+ Tcl_Size len;
+ const char *str = TclGetStringFromObj(resObj, &len);
if (len) {
TclDStringAppendLiteral(dsPtr, " ");
@@ -2003,6 +2067,73 @@ ReflectGetOption(
}
/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectTruncate --
+ *
+ * This function is invoked to truncate a channel's file size.
+ *
+ * Results:
+ * A standard Tcl result code.
+ *
+ * Side effects:
+ * Arbitrary, as it calls upon a Tcl script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectTruncate(
+ void *clientData, /* Channel to query */
+ long long length) /* Length to truncate to. */
+{
+ ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
+ Tcl_Obj *lenObj;
+ int errorNum; /* EINVAL or EOK (success). */
+ Tcl_Obj *resObj; /* Result for 'truncate' */
+
+ /*
+ * Are we in the correct thread?
+ */
+
+#if TCL_THREADS
+ if (rcPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
+
+ p.truncate.length = length;
+
+ ForwardOpToHandlerThread(rcPtr, ForwardedTruncate, &p);
+
+ if (p.base.code != TCL_OK) {
+ PassReceivedError(rcPtr->chan, &p);
+ return EINVAL;
+ }
+
+ return EOK;
+ }
+#endif
+
+ /* ASSERT: rcPtr->method & FLAG(METH_TRUNCATE) */
+
+ Tcl_Preserve(rcPtr);
+
+ lenObj = Tcl_NewWideIntObj(length);
+ Tcl_IncrRefCount(lenObj);
+
+ if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) {
+ Tcl_SetChannelError(rcPtr->chan, resObj);
+ errorNum = EINVAL;
+ } else {
+ errorNum = EOK;
+ }
+
+ Tcl_DecrRefCount(lenObj);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ Tcl_Release(rcPtr);
+ return errorNum;
+}
+
+/*
* Helpers. =========================================================
*/
@@ -2036,12 +2167,12 @@ EncodeEventMask(
int *mask)
{
int events; /* Mask of events to post */
- int listc; /* #elements in eventspec list */
+ Tcl_Size listc; /* #elements in eventspec list */
Tcl_Obj **listv; /* Elements of eventspec list */
int evIndex; /* Id of event for an element of the eventspec
* list. */
- if (TclListObjGetElements(interp, obj, &listc, &listv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, obj, &listc, &listv) != TCL_OK) {
return TCL_ERROR;
}
@@ -2137,7 +2268,7 @@ NewReflectedChannel(
Tcl_Obj *handleObj)
{
ReflectedChannel *rcPtr;
- MethodName mn = METH_BLOCKING;
+ int mn = 0;
rcPtr = (ReflectedChannel *)ckalloc(sizeof(ReflectedChannel));
@@ -2146,17 +2277,18 @@ NewReflectedChannel(
rcPtr->chan = NULL;
rcPtr->interp = interp;
rcPtr->dead = 0;
-#ifdef TCL_THREADS
+ rcPtr->readTimer = 0;
+ rcPtr->writeTimer = 0;
+#if TCL_THREADS
rcPtr->thread = Tcl_GetCurrentThread();
#endif
rcPtr->mode = mode;
rcPtr->interest = 0; /* Initially no interest registered */
- /* ASSERT: cmdpfxObj is a Tcl List */
rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
Tcl_IncrRefCount(rcPtr->cmd);
rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
- while (mn <= METH_WRITE) {
+ while (mn <= (int)METH_WRITE) {
Tcl_ListObjAppendElement(NULL, rcPtr->methods,
Tcl_NewStringObj(methodNames[mn++], -1));
}
@@ -2292,7 +2424,6 @@ InvokeTclMethod(
*/
cmd = TclListObjCopy(NULL, rcPtr->cmd);
-
Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj);
Tcl_ListObjAppendElement(NULL, cmd, methObj);
Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name);
@@ -2346,8 +2477,8 @@ InvokeTclMethod(
*/
if (result != TCL_ERROR) {
- int cmdLen;
- const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);
+ Tcl_Size cmdLen;
+ const char *cmdString = TclGetStringFromObj(cmd, &cmdLen);
Tcl_IncrRefCount(cmd);
Tcl_ResetResult(rcPtr->interp);
@@ -2426,7 +2557,7 @@ ErrnoReturn(
if (((Tcl_GetIntFromObj(rcPtr->interp, resObj, &code) != TCL_OK)
|| (code >= 0))) {
- if (strcmp("EAGAIN", Tcl_GetString(resObj)) == 0) {
+ if (strcmp("EAGAIN", TclGetString(resObj)) == 0) {
code = -EAGAIN;
} else {
code = 0;
@@ -2463,8 +2594,7 @@ GetReflectedChannelMap(
if (rcmPtr == NULL) {
rcmPtr = (ReflectedChannelMap *)ckalloc(sizeof(ReflectedChannelMap));
Tcl_InitHashTable(&rcmPtr->map, TCL_STRING_KEYS);
- Tcl_SetAssocData(interp, RCMKEY,
- (Tcl_InterpDeleteProc *) DeleteReflectedChannelMap, rcmPtr);
+ Tcl_SetAssocData(interp, RCMKEY, DeleteReflectedChannelMap, rcmPtr);
}
return rcmPtr;
}
@@ -2513,7 +2643,7 @@ MarkDead(
static void
DeleteReflectedChannelMap(
- ClientData clientData, /* The per-interpreter data structure. */
+ void *clientData, /* The per-interpreter data structure. */
Tcl_Interp *interp) /* The interpreter being deleted. */
{
ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)clientData;
@@ -2522,7 +2652,7 @@ DeleteReflectedChannelMap(
Tcl_HashEntry *hPtr; /* Search variable. */
ReflectedChannel *rcPtr;
Tcl_Channel chan;
-#ifdef TCL_THREADS
+#if TCL_THREADS
ForwardingResult *resultPtr;
ForwardingEvent *evPtr;
ForwardParam *paramPtr;
@@ -2552,7 +2682,7 @@ DeleteReflectedChannelMap(
Tcl_DeleteHashTable(&rcmPtr->map);
ckfree(&rcmPtr->map);
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* The origin interpreter for one or more reflected channels is gone.
*/
@@ -2635,10 +2765,12 @@ DeleteReflectedChannelMap(
MarkDead(rcPtr);
Tcl_DeleteHashEntry(hPtr);
}
+#else
+ (void)interp;
#endif
}
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
*----------------------------------------------------------------------
*
@@ -2690,7 +2822,7 @@ GetThreadReflectedChannelMap(void)
static void
DeleteThreadReflectedChannelMap(
- ClientData dummy) /* The per-thread data structure. */
+ TCL_UNUSED(void *))
{
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
@@ -2698,7 +2830,6 @@ DeleteThreadReflectedChannelMap(
ReflectedChannelMap *rcmPtr; /* The map */
ForwardingResult *resultPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- (void)dummy;
/*
* The origin thread for one or more reflected channels is gone.
@@ -2868,8 +2999,8 @@ ForwardOpToHandlerThread(
* Queue the event and poke the other thread's notifier.
*/
- Tcl_ThreadQueueEvent(dst, (Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
- Tcl_ThreadAlert(dst);
+ Tcl_ThreadQueueEvent(dst, (Tcl_Event *) evPtr,
+ TCL_QUEUE_TAIL|TCL_QUEUE_ALERT_IF_EMPTY);
/*
* (*) Block until the handler thread has either processed the transfer or
@@ -2917,7 +3048,7 @@ ForwardOpToHandlerThread(
static int
ForwardProc(
Tcl_Event *evGPtr,
- int mask)
+ TCL_UNUSED(int) /* mask */)
{
/*
* HANDLER thread.
@@ -2946,7 +3077,6 @@ ForwardProc(
ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
* this interp. */
Tcl_HashEntry *hPtr; /* Entry in the above map */
- (void)mask;
/*
* Ignore the event if no one is waiting for its result anymore.
@@ -3014,20 +3144,20 @@ ForwardProc(
} else {
ForwardSetObjError(paramPtr, resObj);
}
- paramPtr->input.toRead = -1;
+ paramPtr->input.toRead = TCL_IO_FAILURE;
} else {
/*
* Process a regular result.
*/
- int bytec; /* Number of returned bytes */
+ Tcl_Size bytec; /* Number of returned bytes */
unsigned char *bytev; /* Array of returned bytes */
bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
if (paramPtr->input.toRead < bytec) {
ForwardSetStaticError(paramPtr, msg_read_toomuch);
- paramPtr->input.toRead = -1;
+ paramPtr->input.toRead = TCL_IO_FAILURE;
} else {
if (bytec > 0) {
memcpy(paramPtr->input.buf, bytev, bytec);
@@ -3080,10 +3210,13 @@ ForwardProc(
}
case ForwardedSeek: {
- Tcl_Obj *offObj = Tcl_NewWideIntObj(paramPtr->seek.offset);
- Tcl_Obj *baseObj = Tcl_NewStringObj(
- (paramPtr->seek.seekMode==SEEK_SET) ? "start" :
- (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1);
+ Tcl_Obj *offObj;
+ Tcl_Obj *baseObj;
+
+ TclNewIntObj(offObj, paramPtr->seek.offset);
+ baseObj = Tcl_NewStringObj(
+ (paramPtr->seek.seekMode==SEEK_SET) ? "start" :
+ (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1);
Tcl_IncrRefCount(offObj);
Tcl_IncrRefCount(baseObj);
@@ -3196,10 +3329,10 @@ ForwardProc(
* NOTE (4) as well.
*/
- int listc;
+ Tcl_Size listc;
Tcl_Obj **listv;
- if (TclListObjGetElements(interp, resObj, &listc,
+ if (TclListObjGetElementsM(interp, resObj, &listc,
&listv) != TCL_OK) {
Tcl_DecrRefCount(resObj);
resObj = MarshallError(interp);
@@ -3216,8 +3349,8 @@ ForwardProc(
ForwardSetDynamicError(paramPtr, buf);
} else {
- int len;
- const char *str = Tcl_GetStringFromObj(resObj, &len);
+ Tcl_Size len;
+ const char *str = TclGetStringFromObj(resObj, &len);
if (len) {
TclDStringAppendLiteral(paramPtr->getOpt.value, " ");
@@ -3228,6 +3361,19 @@ ForwardProc(
Tcl_Release(rcPtr);
break;
+ case ForwardedTruncate: {
+ Tcl_Obj *lenObj = Tcl_NewWideIntObj(paramPtr->truncate.length);
+
+ Tcl_IncrRefCount(lenObj);
+ Tcl_Preserve(rcPtr);
+ if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) {
+ ForwardSetObjError(paramPtr, resObj);
+ }
+ Tcl_Release(rcPtr);
+ Tcl_DecrRefCount(lenObj);
+ break;
+ }
+
default:
/*
* Bad operation code.
@@ -3264,7 +3410,7 @@ ForwardProc(
static void
SrcExitProc(
- ClientData clientData)
+ void *clientData)
{
ForwardingEvent *evPtr = (ForwardingEvent *)clientData;
ForwardingResult *resultPtr;
@@ -3315,8 +3461,8 @@ ForwardSetObjError(
ForwardParam *paramPtr,
Tcl_Obj *obj)
{
- int len;
- const char *msgStr = Tcl_GetStringFromObj(obj, &len);
+ Tcl_Size len;
+ const char *msgStr = TclGetStringFromObj(obj, &len);
len++;
ForwardSetDynamicError(paramPtr, ckalloc(len));
generated by cgit v0.12 at 2024-11-16 06:20:34 (GMT)