15.4.929  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    =  posix_1003_1b;                    # posix_1003_1b                 is from   src/lib/std/src/posix-1003.1b/posix-1003-1b.pkg
    package pr     =  threadkit_process_result;         # threadkit_process_result      is from   src/lib/std/src/threadkit/threadkit-process-result.pkg
    package sched  =  thread_scheduler;                 # thread_scheduler              is from   src/lib/src/lib/thread-kit/src/core-thread-kit/thread-scheduler.pkg
herein

    package   process_deathwatch
    : (weak)  Process_Deathwatch
    {
        Process_Id
            =
            PID  {
                wait:  pr::Threadkit_Process_Result( psx::Exit_Status ),
                pid:   psx::Process_Id
            };

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

        fun add_pid  pid
            =
            {   rv = pr::make_threadkit_process_result ();

                waiting :=  PID { wait =>  rv,
                                  pid
                                }
                            !
                            *waiting;

                pr::get_mailop  rv;
            };


        fun poll_processes ()
            =
            waiting
                :=
                list::filter
                    poll_item
                    *waiting
            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_nh (psx::W_CHILD pid, []);


                fun poll_item (item as PID { wait, pid } )
                    =
                    case (poll_pid  pid)
                        #
                        THE (_, status)
                            =>
                            {   sched::enqueue_tmp_thread
                                    .{  pr::put (wait, status);  };

                                FALSE;
                            };
                        #
                        NULL =>  TRUE;
                    esac
                    except
                        ex =
                            {   sched::enqueue_tmp_thread
                                    .{  pr::put_exception (wait, ex);  };

                                FALSE;
                            };
            end;


        fun any_waiting ()
            =
            case *waiting
                #
                [] =>  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-2012,
## released under Gnu Public Licence version 3.