15.4.1067  src/lib/std/src/io/threadkit-io-cleanup-at-shutdown.pkg

## threadkit-io-cleanup-at-shutdown.pkg
## COPYRIGHT (c) 1996 AT&T Research.
#
# This module keeps track of open I/O streams
# and handles the proper cleaning of them.
#
# It is a modified version of the standard.lib package
#
#     src/lib/std/src/io/io-cleanup-at-shutdown.pkg
#
# Unlike the standard.lib version we only do cleanup
# at shutdown/exit time:  We do not try to support the
# persistence of threadkit streams across invocations
# of run_threadkit::run_threadkit).
#
# Also, we only require a single clean-up function, which
# flushes the standard streams and closes all others.
#
# These operations should only be called while threadkit
# is running, since they use synchronization primitives.
#
# NOTE: There is currently a problem with removing the
# cleaners for streams that get dropped by the application,
# but the system limit on open files will limit this.

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




stipulate
    package hok =  threadkit_startup_and_shutdown_hooks;        # threadkit_startup_and_shutdown_hooks  is from   src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit-startup-and-shutdown-hooks.pkg
    package md  =  maildrop;                                    # maildrop                              is from   src/lib/src/lib/thread-kit/src/core-thread-kit/maildrop.pkg
herein

    package threadkit_io_cleanup_at_shutdown
    :       Threadkit_Io_Cleanup_At_Shutdown                    # Threadkit_Io_Cleanup_At_Shutdown      is from   src/lib/std/src/io/threadkit-io-cleanup-at-shutdown.api
    {
        Tag = Ref( Void );

        Cleaner = { tag:    Tag,                                # Unique ID for this cleaner. 
                    close:  Void -> Void                        # Called SHUTDOWN and THREADKIT_SHUTDOWN. 
                  };

        os_init_hook    =  REF (fn () = ());
        std_stream_hook =  REF (fn () = ());

        cleaners = md::make_full_maildrop ([] : List( Cleaner ));

        fun add_cleaner close
            =
            {   tag = REF();
                cleaner_rec = { tag, close };

                md::fill (cleaners, cleaner_rec ! md::empty cleaners);
                tag;
            };

        fun get_tag ( { tag, ... } : Cleaner)
            =
            tag;

        fun rebind_cleaner (t, close)
            =
            md::fill (cleaners, f (md::empty cleaners))
            where

                fun f []
                        =>
                        raise exception FAIL "rebind_cleaner: tag not found";

                    f (x ! r)
                        =>
                        {   t' = get_tag x;

                            if   (t' == t)

                                 { tag=>t, close } ! r;
                            else
                                 x ! f r;
                            fi;
                        };
                end;
            end;

        fun remove_cleaner t
            =
            md::fill (cleaners, f (md::empty cleaners))
            where
                fun f []      =>  [];                           # Should we raise an exception here? 
                    f (x ! r) =>  if (get_tag x == t)   r;
                                  else                  x ! f r;
                                  fi;
                end;
            end;

        fun do_clean ()
            =
            do_it (md::peek cleaners)
            where

                fun do_it []
                        =>
                        ();

                    do_it ({ tag, close }  !  rest)
                        =>
                        {   close ()   except   _ = ();
                            #
                            do_it  rest;
                        };
                end;
            end;


        fun clean_up (hok::SHUTDOWN | hok::THREADKIT_SHUTDOWN)
                =>
                do_clean ();

            clean_up (hok::STARTUP | hok::APP_STARTUP)
                =>
                {   *os_init_hook    ();
                    *std_stream_hook ();
                };
        end;


        # Link master IO cleaner function
        # into the cleanup hook list:
        #
        io_cleaner
            =
            ("IO", hok::at_all, clean_up);

    };                                          # package threadkit_io_cleanup_at_shutodwn
end;