Artifact Content

Artifact 95a5c09a03d95bea7071d6b6cbf846a739c79cc5:


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