PreviousUpNext

15.4.1105  src/lib/std/src/io/io-startup-and-shutdown.pkg

## io-startup-and-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-startup-and-shutdown--premicrothread.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 ssh =  run_at;                                      # run_at                                is from   src/lib/src/lib/thread-kit/src/core-thread-kit/run-at.pkg
    package md  =  maildrop;                                    # maildrop                              is from   src/lib/src/lib/thread-kit/src/core-thread-kit/maildrop.pkg
    package mps =  microthread_preemptive_scheduler;

    nb = log::note_on_stderr;                                   # log                                   is from   src/lib/std/src/log.pkg
herein

    package io_startup_and_shutdown
    :       Io_Startup_And_Shutdown                             # Io_Startup_And_Shutdown               is from   src/lib/std/src/io/io-startup-and-shutdown.api
    {
        Tag = Ref( Void );

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

        std_stream_hook =  REF (\\ () = ());

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

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

                md::put_in_maildrop (cleaners, cleaner_rec ! md::take_from_maildrop cleaners);
                tag;
            };

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

        fun change_stream_startup_and_shutdown_actions (t, close)
            =
            md::put_in_maildrop (cleaners, f (md::take_from_maildrop cleaners))
            where

                fun f []
                        =>
                        raise exception DIE "change_stream_startup_and_shutdown_actions: 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 drop_stream_startup_and_shutdown_actions t
            =
            md::put_in_maildrop (cleaners, f (md::take_from_maildrop 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_closes ()
            =
            do_closes' (md::get_from_maildrop cleaners)
            where

                fun do_closes' []
                        =>
                        ();

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


        fun clean_up  ssh::APP_SHUTDOWN
                =>
                {
#                                                                                               nb {. "clean_up(APP_SHUTDOWN) / AAA:  do_closes()        -- io-startup-and-shutdown.pkg\n"; };
                    do_closes ();
#                                                                                               nb {. "clean_up(APP_SHUTDOWN) / ZZZ        -- io-startup-and-shutdown.pkg\n"; };
                };

            clean_up  ssh::THREADKIT_SHUTDOWN
                =>
                {
#                                                                                               nb {. "clean_up(THREADKIT_SHUTDOWN) / AAA:  do_closes()        -- io-startup-and-shutdown.pkg\n"; };
                    do_closes ();
#                                                                                               nb {. "clean_up(THREADKIT_SHUTDOWN) / ZZZ        -- io-startup-and-shutdown.pkg\n"; };
                };

            clean_up  ssh::COMPILER_STARTUP
                =>
                {
#                                                                                               nb {. "clean_up(COMPILER_STARTUP) / AAA: *std_stream_hook ()        -- io-startup-and-shutdown.pkg\n"; };
                    *std_stream_hook ();
#                                                                                               nb {. "clean_up(COMPILER_STARTUP) / ZZZ        -- io-startup-and-shutdown.pkg\n"; };
                };
            clean_up  ssh::APP_STARTUP
                =>
                {
#                                                                                               nb {. "clean_up(APP_STARTUP) / AAA: *std_stream_hook ()        -- io-startup-and-shutdown.pkg\n"; };
                    *std_stream_hook ();
#                                                                                               nb {. "clean_up(APP_STARTUP) / ZZZ        -- io-startup-and-shutdown.pkg\n"; };
                };
        end;


        # Link master IO cleaner function
        # into the cleanup hook list:
        #
        io_cleaner
            =
            ( "io_cleaner",
              [ ssh::APP_SHUTDOWN,
                ssh::THREADKIT_SHUTDOWN,
                ssh::COMPILER_STARTUP,
                ssh::APP_STARTUP
              ],
              clean_up
            );

    };                                          # package threadkit_io_cleanup_at_shutodwn
end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext