15.4.947  src/lib/src/lib/thread-kit/src/process-deathwatch.pkg

## process-deathwatch.pkg
#
# Host-os subprocess exit status access for multithreaded Mythryl programs.

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


# Unix process management.

stipulate
    package psx =  posixlib;                            # posixlib                              is from   src/lib/std/src/psx/posixlib.pkg
    package pr  =  process_result;                      # process_result                        is from   src/lib/std/src/threadkit/process-result.pkg
    package mps =  microthread_preemptive_scheduler;    # microthread_preemptive_scheduler      is from   src/lib/src/lib/thread-kit/src/core-thread-kit/microthread-preemptive-scheduler.pkg
herein

    package   process_deathwatch
    : (weak)  Process_Deathwatch                        # Process_Deathwatch                    is from   src/lib/src/lib/thread-kit/src/process-deathwatch.api
    {
        Process_Id
            =
            PID  {
                wait:  pr::Threadkit_Process_Result( psx::Exit_Status ),
                pid:   psx::Process_Id
            };

        child_processes_on_deathwatch
            =
            REF ([]: List( Process_Id ));               # More icky thread-hostile mutable global state, looks like XXX SUCKO FIXME.

        fun start_child_process_deathwatch  pid
            =
            {   rv =  pr::make_threadkit_process_result ();
                #
                child_processes_on_deathwatch
                    :=
                    PID { wait =>  rv,
                          pid
                        }
                    !
                    *child_processes_on_deathwatch;

                pr::get_mailop  rv;
            };


        fun harvest_exit_statuses_of_dead_subprocesses__iu ()                                   # Let zombie processes die by doing a WAIT on them to collect their exit status.
            =
            child_processes_on_deathwatch :=   list::filter  poll_item__iu  *child_processes_on_deathwatch
            where

                # NOTE: It would be more efficient to
                #       poll for zombie processes
                #       until there are no more.                XXX SUCKO FIXME

                fun poll_pid  pid
                    =
                    psx::waitpid_without_blocking (psx::W_CHILD pid, []);


                fun poll_item__iu (item as PID { wait, pid } )
                    =
                    case (poll_pid  pid)
                        #
                        THE (_, status)
                            =>
                            {
                                mps::run_thunk_immediately__iu   {.  pr::put (wait, status);  };
                                #
                                FALSE;
                            };
                        #
                        NULL =>  TRUE;
                    esac
                    except
                        ex =
                            {
                                mps::run_thunk_immediately__iu   {.  pr::put_exception (wait, ex);  };
                                #
                                FALSE;
                            };
            end;


        fun have_child_processes_on_deathwatch ()
            =
            case *child_processes_on_deathwatch
                #
                [] =>  FALSE;
                _  =>  TRUE;
            esac;

    };
end;


## COPYRIGHT (c) 1989-1991 John H. Reppy
## COPYRIGHT (c) 1995 AT&T Bell Laboratories.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.