DN521885774

Subject: Re: Tcl threading and event loops - DN [1]

David Gravereaux <davygrvy@bigfoot.com> - 06 Sep 1999 - comp.lang.tcl

 ----=_HUjUN37cgdos=8+BRc0y4MQmIfQs.MFSBCHJLHS
 Content-Type: text/plain; charset=us-ascii
 Content-Transfer-Encoding: 7bit

 davex007@my-deja.com wrote:

 >If I understand correctly, versions 8.1 and 8.2 are thread-safe to
 >the point that I can create different interpreters in different
 >different threads, and each thread can access their own interpreter
 >simultaneously and nothing strange will happen.  Great.  If one
 >thread needs information from an interpreter created by another
 >thread, it can't just call Tcl_Eval on that interp.  It has to have
 >the other thread call the Eval on it's behalf (using queues, callbacks,
 >condition variables, or whatever).  I think I understand all of that,
 >but correct me if I'm wrong.

 AFAIK, yes to all.

 >Now here is where I get a bit confused.  Some of our apps are using
 >Tcl to manager their I/O, using Tcl file (channel) events,
 >callbacks, handlers, etc.  These are mainly single threaded apps
 >that are hooking into Tcl using a function like:
 >
 >void
 >ProcessTclEvents(int wait_time)
 >{
 >    if (wait_time == 0) {
 >        Tcl_DoOneEvent(TCL_DONT_WAIT);
 >        Tcl_ServiceAll();
 >    }
 >    else if (wait_time < 0) {
 >        Tcl_DoOneEvent(TCL_ALL_EVENTS);
 >        Tcl_ServiceAll();
 >    }
 >    else {
 >        Tcl_TimerToken tok = Tcl_CreateTimerHandler(wait_time,
 >                                                    NullTimerProc,
 >                                                    NULL);
 >        Tcl_DoOneEvent(TCL_ALL_EVENTS);
 >        Tcl_ServiceAll();
 >        Tcl_DeleteTimerHandler(tok);
 >    }
 >}

 Can I edit this just a hair?

 void
 ProcessTclEvents(int wait_time)
 {
     if (wait_time == 0) {
         Tcl_DoOneEvent(TCL_DONT_WAIT);
     }
     else if (wait_time < 0) {
         Tcl_DoOneEvent(TCL_ALL_EVENTS);
     }
     else {
         Tcl_TimerToken tok = Tcl_CreateTimerHandler(wait_time,
                                                     NullTimerProc,
                                                     NULL);
         Tcl_DoOneEvent(TCL_ALL_EVENTS);
         Tcl_DeleteTimerHandler(tok);
     }
 }

 As i recall Tcl_DoOneEvent(TCL_ALL_EVENTS)  will never return until
 the thread or app is told to shutdown.  Tcl_ServiceAll() is internal
 for Tcl_DoOneEvent().  Does it need to be called externally?

 >This function gets called frequently to process Tcl events.  Actually,
 >after the setup is done, it's usually just called like:
 >
 >while (1) {
 >  if (! some exit condition, possibly set from an io handler) {
 >      ProcessTclEvents(1000);
 >  } else {
 >      // do some cleanup
 >      break;
 >  }
 >}
 >
 >So the thing that I'm a bit unsure about is that the ProcessTclEvents
 >function makes no reference to a Tcl interpreter.

 Indirectly, yes it does.  TclThreadDataKeyGet() is used internally to
 retrieve thread specific data and is used in the notifier.

 >  In fact, it looks
 >as if you can use Tcl implement an I/O event loop without ever
 >creating an interpreter.  Again, great.

 Yes.  I do it.  I haven't fully tested it, but yes you can.

 >So what I'm wondering is what would happen if two or more separate
 >threads in the same process call the ProcessTclEvents function
 >at the same time.

 Shouldn't be a problem.  The TSDs will align.

 >  Does the Tcl_DoOneEvent() and Tcl_ServiceAllEvents()
 >implicitly apply only to event handlers created in the current thread,
 >or will they fight each other, with different threads calling event
 >callbacks all over the place?  Just to clarify, this is all being
 >done on Unix and we don't need things to be portable to NT/98 (though
 >it would be nice to know if their are any portability issues here).

 Can I suggest a slightly different model?  If you're going to use
 threads with Tcl, how about setting up a single thread for "servicing"
 the Tcl event loop.  So after it's started and paused in the notifier
 waiting on new Tcl events to be queued, all you do is queue it work.

 The way to queue it work from a different thread is quite easy.

 1) The Tcl servicing thread first creates an AsyncToken, then drops
 into the event loop with Tcl_DoOneEvent(TCL_ALL_EVENTS)

 2) The AsyncToken is then used by anyother thread to grab the
 attention of Tcl's notifier.

 3) The asyncproc associated to that token is called between command
 executions.

 4) (still not safe) just Tcl_QueueEvent here.

 5) The event system comes around to service it and calls the
 eventproc.  All safe, the world is yours.  Select interpreter, and run
 any Tcl_*.

 Attached is some unfinished code, but the idea is there how to do it.
 It creates a "free-wheeling" notifier that'll handle all events on
 it's own without being locked to an external message pump.

 int main (int argc, char *argv[]) {
  TclEventSystem *Tcl = TclEventSystem::Instance("tcl82.dll", argv[0]);
  ....
  Tcl->QueueWork(...);
  ....
  Tcl->Shutdown();
  return 0;
 };

 For another example of that thread event loop queueing technique look
 at http://www.maui.net/~davygrvy/files/ghe_dirwatch.zip

 * David Gravereaux *
 #include "http://www.maui.net/~davygrvy/std_disclaimer.h"
 Tomahawk Software Group

 ----=_HUjUN37cgdos=8+BRc0y4MQmIfQs.MFSBCHJLHS
 Content-Type: text/plain; charset=us-ascii; name=TclEventSystem.cpp
 Content-Transfer-Encoding: 7bit
 Content-Disposition: attachment; filename=TclEventSystem.cpp

 #include "TclEventSystem.h"
 #include <crtdbg.h>

 #ifdef _DEBUG
 #pragma comment(lib,"./DebugStubs/tclstub82.lib")
 #else
 #pragma comment(lib,"./ReleaseStubs/tclstub82.lib")
 #endif

 #ifdef _DEBUG
 #pragma comment(lib,"/Mcl/Debug/Mcl.lib")
 #else
 #pragma comment(lib,"/Mcl/Release/Mcl.lib")
 #endif

 // This structure is what gets queued into Tcl's notifier
 typedef struct {
   Tcl_Event header;
   TclAsyncInfo *ai;
 } ASYNCEVENT, *LPASYNCEVENT;

 TclEventSystem *TclEventSystem::m_instance = NULL;

 TclEventSystem *TclEventSystem::Instance(char *library, char *appfile) {
   if (m_instance == NULL) {
     m_instance = new TclEventSystem(library,appfile);
   };
   return m_instance;
 };

 void TclEventSystem::QueueAsyncWork(TclAsyncInfo *ai) {
   m_wQ.Put(ai);
   Tcl_AsyncMark(m_hAsync);
 };

 void TclEventSystem::ShutDown(void) {
  DWORD exitcode;

   if (!TclEventLoopThread.IsNull() &&
       CMclIsValidHandle(TclEventLoopThread.GetHandle())) {
     PostThreadMessage(TclEventLoopThread->GetThreadId(), WM_QUIT, 0L, 0L);
     do {
       Sleep(30);
       TclEventLoopThread->GetExitCode(&exitcode);
     } while (exitcode == STILL_ACTIVE);
   }

   delete m_instance;
   m_instance = NULL;
 };

 bool TclEventSystem::LoadOK(void) {
   return m_LoadOK;
 };

 TclEventSystem::TclEventSystem(char *library, char *appfile)
    : m_LoadOK(true), m_ErrorString(NULL)
 {
  typedef Tcl_Interp *(*LPFN_createInterpProc) ();
  LPFN_createInterpProc createInterpProc;
  Tcl_Interp *interp;

   _ASSERTE(library != NULL);

   // load it.
   m_hTclMod = LoadLibrary(library);

   if (m_hTclMod <= (HMODULE) HINSTANCE_ERROR) {
     m_ErrorString = new char [strlen(library)+14];
     sprintf(m_ErrorString,"%s did not load",library);
     m_LoadOK = false;
     return;
   };

   // LoadLibrary() loaded the module correctly.
   // get the location of Tcl_CreateInterp
   createInterpProc =
       (LPFN_createInterpProc) GetProcAddress(m_hTclMod, "Tcl_CreateInterp");

   // What?? no Tcl_CreateInterp export.. ditch out-a-here!
   if (createInterpProc == NULL) {
     m_ErrorString = new char [strlen(library)+46];
     sprintf(m_ErrorString,
         "The Tcl_CreateInterp export was not found in %s", library);
     m_LoadOK = false;
     return;
   };

   interp = createInterpProc();
   if (Tcl_InitStubs(interp, "8.0", 0) == NULL) {
     m_ErrorString = new char [54];
     strcpy(m_ErrorString,"This interpreter does not support the Stubs interface");
     m_LoadOK = false;
     return;
   };

   _ASSERTE(appfile != NULL);
   Tcl_FindExecutable(appfile);

   // we're done initializing the core, and now don't need this interp anymore.
   Tcl_DeleteInterp(interp);

   // grab an AsyncToken
   m_hAsync = Tcl_AsyncCreate(MainAsyncProc,(ClientData) NULL);

   // kickstart the eventloop.
   // from now on, all access to Tcl is through QueueAsyncWork()
   TclEventLoopThread = new CMclThread(&TclEventLoopHandler);

   return; //true;
 };

 TclEventSystem::~TclEventSystem() {
   if (m_hTclMod) FreeLibrary(m_hTclMod);
   if (m_ErrorString) delete m_ErrorString;
 };

 int TclEventSystem::MainAsyncProc(ClientData, Tcl_Interp *, int code) {
  TclAsyncInfo *ai;
  LPASYNCEVENT stuff;

   // WARNING: Only Tcl allocation routines are allowed in here.

   // Someone called QueueAsyncWork.  There must be at least one entry
   // in the WorkQueue, but pull them all off while we're here.  Don't
   // let a good context go to waste.
   while (m_instance->m_wQ.Get(ai,0)) {

     // run its custom AsyncProc.
     // returning true means done, so don't queue it.
     if (ai->AsyncProc()) {
       delete ai;
       continue;
     };

     stuff = (LPASYNCEVENT) Tcl_Alloc (sizeof(ASYNCEVENT));
     stuff->header.proc = TclEventSystem::MainEventProc;
     stuff->ai = ai;

     // Queue it into Tcl's notifier.
     Tcl_QueueEvent((Tcl_Event *)stuff, TCL_QUEUE_TAIL);
   };
   return code;
 };

 int TclEventSystem::MainEventProc(Tcl_Event *evPtr, int flags) {
  LPASYNCEVENT stuff = (LPASYNCEVENT) evPtr;

   // we only handle file-type events here.
   if (!(flags & TCL_FILE_EVENTS)) return 0;

   stuff->ai->EventProc();
   delete stuff->ai;

   return 1;
 };

 ----=_HUjUN37cgdos=8+BRc0y4MQmIfQs.MFSBCHJLHS
 Content-Type: text/plain; charset=us-ascii; name=TclEventSystem.h
 Content-Transfer-Encoding: 7bit
 Content-Disposition: attachment; filename=TclEventSystem.h

 #define USE_TCL_STUBS
 #include "e:/TclCvs/tcl8.2b1/generic/tcl.h"

 #if ((TCL_MAJOR_VERSION != 8) && (TCL_MINOR_VERSION != 2))
 #error "You need the Tcl 8.2.x source release from Scriptics for this"
 #endif

 #include "/Mcl/CMcl.h"

 // base class for all work to be handed over to Tcl.
 class TclAsyncInfo {
 public:
   // need copy constructor
   // need overloaded assignment operator
   // must also create instance only with 'new'
   virtual bool AsyncProc (void) = 0;
   virtual void EventProc (void) = 0;
 };

 // singleton design pattern to ensure there's only one instance.
 class TclEventSystem {
 public:
   static TclEventSystem *Instance(char *library = NULL, char *appfile = NULL);
   void QueueAsyncWork(TclAsyncInfo *ai);
   void ShutDown(void);
   bool LoadOK(void);

 protected:
   TclEventSystem(char *library, char *appfile);
   ~TclEventSystem();

 private:
   class TclEventLoop : public CMclThreadHandler {
   private:
     unsigned ThreadHandlerProc(void) {
       // enter Tcl's notifier and don't comeback until the thread is told to quit.
       Tcl_DoOneEvent(TCL_ALL_EVENTS);
       Tcl_Finalize();
       return 0;
     };
   } TclEventLoopHandler;

   static MainAsyncProc(ClientData, Tcl_Interp *, int code);
   static MainEventProc(Tcl_Event *evPtr, int flags);

   static TclEventSystem *m_instance;
   CMclQueue<TclAsyncInfo *> m_wQ;
   CMclThreadAutoPtr TclEventLoopThread;
   HMODULE m_hTclMod;
   Tcl_AsyncHandler m_hAsync;
   bool m_LoadOK;
   char *m_ErrorString;
 };

 ----=_HUjUN37cgdos=8+BRc0y4MQmIfQs.MFSBCHJLHS--