## 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.libstipulate
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.pkgherein
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;