diff -uNr metakit-2.4.9.7.orig/tcl/mk4tcl.cpp metakit-2.4.9.7-1ptrsk/tcl/mk4tcl.cpp
--- metakit-2.4.9.7.orig/tcl/mk4tcl.cpp 2007-06-18 16:05:24.000000000 -0500
+++ metakit-2.4.9.7-1ptrsk/tcl/mk4tcl.cpp 2010-10-18 09:09:28.000000000 -0500
@@ -182,11 +182,14 @@
Tcl_Channel _chan;
int _validMask;
int _watchMask;
+ int _flags;
+ SiasStrategy *_next;
+ MkWorkspace *_workspace;
Tcl_Interp *_interp;
SiasStrategy(c4_Storage &storage_, const c4_View &view_, const c4_BytesProp
&memo_, int row_): _storage(storage_), _view(view_), _memo(memo_), _row
- (row_), _position(0), _interp(0) {
+ (row_), _position(0), _interp(0), _next(0), _workspace(0) {
// set up mapping if the memo itself is mapped in its entirety
c4_Strategy &strat = storage_.Strategy();
if (strat._mapStart != 0) {
@@ -259,23 +262,57 @@
///////////////////////////////////////////////////////////////////////////////
// New in 1.2: channel interface to memo fields
-typedef SiasStrategy MkChannel;
-
typedef struct {
Tcl_Event header;
MkChannel *chan;
+ int flags;
} MkEvent;
+#define CHANNEL_FLAG_PENDING (1<<1)
+
static int mkEventProc(Tcl_Event *evPtr, int flags) {
MkEvent *me = (MkEvent*)evPtr;
- if (!(flags &TCL_FILE_EVENTS))
+ if (!(flags & TCL_FILE_EVENTS))
return 0;
- Tcl_NotifyChannel(me->chan->_chan, me->chan->_watchMask);
+ me->chan->_flags &= ~CHANNEL_FLAG_PENDING;
+ Tcl_NotifyChannel(me->chan->_chan, me->chan->_watchMask & me->flags);
return 1;
}
+static void SetupProc(ClientData clientData, int flags) {
+ MkWorkspace *ws = (MkWorkspace *)clientData;
+ int msec = 10000;
+ Tcl_Time blockTime = {0, 0};
+ if (!(flags & TCL_FILE_EVENTS))
+ return;
+ if (ws->_chanList != 0)
+ msec = 10;
+ blockTime.sec = msec / 1000;
+ blockTime.usec = (msec % 1000) * 1000;
+ Tcl_SetMaxBlockTime(&blockTime);
+}
+
+static void CheckProc(ClientData clientData, int flags) {
+ MkWorkspace *ws = (MkWorkspace *)clientData;
+ if (!(flags & TCL_FILE_EVENTS))
+ return;
+ for (MkChannel *chan = ws->_chanList; chan != NULL; chan = chan->_next) {
+ if (chan->_watchMask == 0)
+ continue;
+ int mask = TCL_WRITABLE | TCL_READABLE;
+ if (chan->_watchMask & mask) {
+ MkEvent *me = (MkEvent *)ckalloc(sizeof(MkEvent));
+ chan->_flags |= CHANNEL_FLAG_PENDING;
+ me->header.proc = mkEventProc;
+ me->chan = chan;
+ me->flags = mask;
+ Tcl_QueueEvent((Tcl_Event *)me, TCL_QUEUE_TAIL);
+ }
+ }
+}
+
static int mkEventFilter(Tcl_Event *evPtr, ClientData instanceData) {
MkEvent *me = (MkEvent*)evPtr;
MkChannel *chan = (MkChannel*)instanceData;
@@ -284,8 +321,21 @@
static int mkClose(ClientData instanceData, Tcl_Interp *interp) {
MkChannel *chan = (MkChannel*)instanceData;
+ MkWorkspace *ws = chan->_workspace;
+ MkChannel **tmpPtrPtr = &ws->_chanList;
Tcl_DeleteEvents(mkEventFilter, (ClientData)chan);
+
+ /* remove this channel from the package list */
+ while (*tmpPtrPtr && (*tmpPtrPtr != chan)) {
+ tmpPtrPtr = &(*tmpPtrPtr)->_next;
+ }
+ if (*tmpPtrPtr == chan) {
+ *tmpPtrPtr = chan->_next;
+ chan->_next = 0;
+ } else {
+ d4_assert(false);
+ }
chan->_chan = 0;
delete chan;
@@ -726,21 +776,24 @@
++generation; // make sure all cached paths refresh on next access
}
-MkWorkspace::MkWorkspace(Tcl_Interp *ip_): _interp(ip_) {
+MkWorkspace::MkWorkspace(Tcl_Interp *ip_): _interp(ip_), _chanList(0) {
new Item("", "", 0, _items, 0);
// never uses entry zero (so atoi failure in ForgetPath is harmless)
_usedRows = _usedBuffer.SetBufferClear(16);
- // no realloc for first 16 temp rows
+ // no realloc for first 16 temp rows
}
MkWorkspace::~MkWorkspace() {
CleanupCommands();
+ d4_assert(_chanList == 0);
+
for (int i = _items.GetSize(); --i >= 0;)
delete Nth(i);
// need this to prevent recursion in Tcl_DeleteAssocData in 8.2 (not 8.0!)
+ Tcl_DeleteEventSource(SetupProc, CheckProc, this);
Tcl_SetAssocData(_interp, "mk4tcl", 0, 0);
Tcl_DeleteAssocData(_interp, "mk4tcl");
}
@@ -2371,6 +2424,7 @@
mkChan->_watchMask = 0;
mkChan->_validMask = mode;
+ mkChan->_flags = 0;
mkChan->_interp = interp;
mkChan->_chan = Tcl_CreateChannel(&mkChannelType, buffer, (ClientData)mkChan,
mode);
@@ -2383,6 +2437,11 @@
if (_error)
return _error;
+ /* insert this channel at the front of the workspace channels list */
+ mkChan->_workspace = &work;
+ mkChan->_next = work._chanList;
+ work._chanList = mkChan;
+
KeepRef o = tcl_NewStringObj(buffer);
return tcl_SetObjResult(o);
}
@@ -2579,6 +2638,7 @@
}
static void ExitProc(ClientData cd_) {
+ Tcl_DeleteEventSource(SetupProc, CheckProc, cd_);
delete (MkWorkspace*)cd_;
}
@@ -2603,6 +2663,7 @@
// since that does not seem to trigger exitproc handling (!)
Tcl_SetAssocData(interp, "mk4tcl", DelProc, ws);
Tcl_CreateExitHandler(ExitProc, ws);
+ Tcl_CreateEventSource(SetupProc, CheckProc, ws);
}
// this list must match the "CmdDef defTab []" above.
@@ -2648,3 +2709,11 @@
}
///////////////////////////////////////////////////////////////////////////////
+
+/*
+ * Local variables:
+ * mode: c
+ * c-basic-offset: 2
+ * indent-tabs-mode: nil
+ * End:
+ */
diff -uNr metakit-2.4.9.7.orig/tcl/mk4tcl.h metakit-2.4.9.7-1ptrsk/tcl/mk4tcl.h
--- metakit-2.4.9.7.orig/tcl/mk4tcl.h 2007-06-15 18:26:40.000000000 -0500
+++ metakit-2.4.9.7-1ptrsk/tcl/mk4tcl.h 2010-10-18 09:09:00.000000000 -0500
@@ -205,6 +205,9 @@
///////////////////////////////////////////////////////////////////////////////
// A workspace manages a number of storage objects and their associated paths.
+class SiasStrategy;
+typedef SiasStrategy MkChannel;
+
class MkWorkspace {
c4_PtrArray _items; // items, or null if released
c4_Bytes _usedBuffer; // buffer, using 1 byte per entry
@@ -213,6 +216,7 @@
public:
Tcl_Interp *_interp;
+ MkChannel *_chanList;
struct Item {
const c4_String _name; // the alias for this storage