15.4.943  src/lib/src/lib/thread-kit/src/lib/thread-deathwatch.pkg

# thread-deathwatch.pkg
#
# This package is adapted from
# Cliff Krumvieda's threadkit
# debug utility.
#
# See also:
#     src/lib/src/lib/thread-kit/src/lib/logger.pkg
#     src/lib/src/lib/thread-kit/src/lib/uncaught-exception-reporting.pkg

# Compiled by:
#     src/lib/std/standard.lib


stipulate
    include package   threadkit;                                        # threadkit                     is from   src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg
    package fil =  file__premicrothread;                                # file__premicrothread          is from   src/lib/std/src/posix/file--premicrothread.pkg
    include package   logger;                                           # logger                        is from   src/lib/src/lib/thread-kit/src/lib/logger.pkg
    #
    package tsc =  thread_scheduler_control;                            # thread_scheduler_control      is from   src/lib/src/lib/thread-kit/src/posix/thread-scheduler-control.pkg
herein


    package   thread_deathwatch
    : (weak)  Thread_Deathwatch                                         # Thread_Deathwatch     is from   src/lib/src/lib/thread-kit/src/lib/thread-deathwatch.api
    {

        ################################################################################
        # Thread deathwatches.

        # Controls printing of thread deathwatch messages: 
        #
        logging
            =
            make_logtree_leaf
              { parent  => fil::all_logging,
                name    => "thread_deathwatch::logging",
                default => TRUE                                         # Change to TRUE or call  (log::enable logging)   to enable logging in this file.
              };
        #

        Deathwatch_Mail
          = START_DEATHWATCH  (Microthread,         Mailslot(Void))
          |  STOP_DEATHWATCH  (Microthread, Oneshot_Maildrop(Void))
          ;


        deathwatch_mailqueue =   make_mailqueue (default_microthread) :   Mailqueue( Deathwatch_Mail );


        # Stop watching the named thread:
        #
        fun stop_thread_deathwatch  thread
            =
            {   ack_drop =  make_oneshot_maildrop ();
                #
                put_in_mailqueue (deathwatch_mailqueue, STOP_DEATHWATCH (thread, ack_drop));

                get_from_oneshot  ack_drop;
            };


        # Watch the given thread for unexpected termination:
        #
        fun start_thread_deathwatch (thread_name, thread)
            =
            {   unwatch_slot = make_mailslot ();

                fun handle_termination ()
                    =
                    {   log_if logging 0 {.

                            cat [ "WARNING!  Watched thread ", thread_name, get_thread's_id_as_string  thread,
                                  " has died."
                                ];
                        };

                        stop_thread_deathwatch  thread;
                    };

                fun deathwatch_thread ()
                    =
                    {
                        put_in_mailqueue (deathwatch_mailqueue, START_DEATHWATCH (thread, unwatch_slot));

                        do_one_mailop [

                            take_from_mailslot'  unwatch_slot,

                            thread_done__mailop  thread
                                ==>
                                handle_termination
                        ];
                    };

                make_thread  "thread_deathwatch"  deathwatch_thread;

                ();
            };


        package tht
            =
            typelocked_hashtable_g (
                #
                Hash_Key   = Microthread;
                hash_value = hash_thread;
                same_key   = same_thread;
            );


        # The deathwatch imp:
        #
        fun start_deathwatch_imp ()
            =
            {
# printf "start_deathwatch_imp/AAA      -- thread-deathwatch.pkg\n";
                table = tht::make_hashtable { size_hint => 32, not_found_exception => DIE "start_deathwatch_imp" };
                #
                fun loop ()
                    =
                    for (;;) {
                        #
                        case (take_from_mailqueue  deathwatch_mailqueue)
                            #
                            START_DEATHWATCH arg
                                =>
                                tht::set table arg;

                            STOP_DEATHWATCH (thread, ack_1shot)
                                =>
                                {   put_in_mailslot  (the (tht::get_and_drop table thread),  ())        # Notify the watcher that the thread is no longer being watched, and then acknowledge the unwatch command.
                                    except
                                        _ = ();

                                    put_in_oneshot (ack_1shot, ());                                     # Acknowledge that the thread has been removed.
                                };
                        esac;
                    };

                make_thread  "thread_deathwatch imp"  loop;

                ();
            };


        my _ =  {   tsc::note_mailqueue
                      (
                        "logging: deathwatch-mailqueue",
                        deathwatch_mailqueue
                      );

                    tsc::note_imp
                      {
                        name => "logging: deathwatch-imp",
                        #
                        at_startup  =>  start_deathwatch_imp,
                        at_shutdown =>  (\\ () = ())
                      };
                };
    };                                          # package thread_deathwatch
end;