PreviousUpNext

15.4.1064  src/lib/std/src/io/io-cleanup-at-shutdown.pkg

## io-cleanup-at-shutdown.pkg

# Compiled by:
#     src/lib/std/src/standard-core.sublib


# This module keeps track of open I/O streams,
# and closes themc cleanly at process exit.
#
# NOTE: there is currently a problem with removing
# the at-functions for streams that get dropped
# by the application, but the system limit on
# open files will limit this.                           XXX BUGGO FIXME

package io_cleanup_at_shutdown
:       Io_Cleanup_At_Shutdown                                          # Io_Cleanup_At_Shutdown        is from   src/lib/std/src/io/io-cleanup-at-shutdown.api
{
    Tag = Ref( Void );                                                  # Here we use refcells as ids, taking advantage of the fact that every refcell equals itself but does not equal any other refcell.
                                                                        # This saves us the usual bother of setting up a counter to issue unique small integers, protecting that counter with a mutex etc etc.
    Cleaner = {
        tag:    Tag,            #  unique ID for this cleaner 
        init:   Void -> Void,   #  Called STARTUP and APP_STARTUP 
        flush:  Void -> Void,   #  Called FORK_TO_DISK 
        close:  Void -> Void    #  Called SHUTDOWN and SPAWN_TO_DISK 
      };

    os_init_hook  = REF (fn () = ());
    std_strm_hook = REF (fn () = ());

    cleaners = REF ([]:  List( Cleaner ));

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

            cleaner_rec
                =
                { tag, init, flush, close };

            cleaners :=   cleaner_rec ! *cleaners;

            tag;
        };

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

    fun rebind_cleaner (t, { init, flush, close } )
        =
        cleaners := f *cleaners
        where
            fun f [] => raise exception FAIL "rebind_cleaner: tag not found";

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

                      if (t' == t)
                           { tag=>t, init, flush, close } ! r;
                      else x ! f r;  fi;
                  };
            end;
        end;

    fun remove_cleaner t
        =
        cleaners := f *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 run_selected_functions  sel_g
        =
        loop *cleaners
        where
            fun loop [] => ();
                loop (x ! r)
                    =>
                    {   ((sel_g x) ())
                        except
                            _ = ();

                        loop r;
                    };
            end;
        end;

                                        # at            is from   src/lib/std/src/nj/at.pkg

    fun run (at::FORK_TO_DISK)
            =>
            run_selected_functions .flush;

        run (at::SPAWN_TO_DISK | at::SHUTDOWN)
            =>
            run_selected_functions .close;

        run (at::STARTUP   | at::APP_STARTUP)
            =>
            {   *os_init_hook   ();
                *std_strm_hook  ();
                run_selected_functions .init;
            };
    end;
                                                             my _ = 
    at::schedule ("IO", at::all, run);

};                                                              # package io_cleanup_at_shutdown




Comments and suggestions to: bugs@mythryl.org

PreviousUpNext