Posted to tcl by davygrvy at Fri May 15 19:33:30 GMT 2020view raw

  1. unsigned RunTclLoop (void)
  2. {
  3. EXCEPTION_RECORD exceptRec;
  4. char buffer[578];
  5.  
  6. exceptRec.ExceptionCode = 0;
  7.  
  8. // enter Tcl's notifier and don't fall-out until the thread is
  9. // told to quit.
  10.  
  11. // If a fatal exception happens, catch it.
  12. //
  13. __try {
  14. __try {
  15. while (!done) {
  16. // *ALL* of Tcl runs from this loop.
  17. Tcl_DoOneEvent(TCL_ALL_EVENTS);
  18. }
  19. Tcl_AsyncDelete(*token);
  20. Tcl_Finalize();
  21. }
  22. __finally {
  23. // Be careful.. Tcl's DllMain() can lock-up.
  24. // Leave this here anyways as Tcl _should_ be OK.
  25. // Go fix the DllMain() bug instead!
  26. FreeLibrary(hTclMod);
  27. // Be explicit and reset the Stubs library just
  28. // cause we should.
  29. tclStubsPtr = nullptr;
  30. // Reset the async token, too. Renders QueueJob()
  31. // non-functional.
  32. *token = nullptr;
  33. }
  34. } __except (
  35. exceptRec = *(GetExceptionInformation())->ExceptionRecord,
  36. EXCEPTION_EXECUTE_HANDLER)
  37. {
  38. if (exceptRec.ExceptionCode != TES_PANIC_UNWIND) {
  39. // Something from Tcl's execution tossed a big one.
  40. wsprintf(buffer,
  41. "Tcl has crashed with exception [0x%X] (%s) "
  42. "at address 0x%X", exceptRec.ExceptionCode,
  43. GetExceptionString(exceptRec.ExceptionCode),
  44. exceptRec.ExceptionAddress);
  45. // We don't need RaiseException() for this call. We're
  46. // already unwound.
  47. nfatal(buffer);
  48. }
  49. }
  50. return exceptRec.ExceptionCode;
  51. }
  52.