## threadkit-spawn.pkg
# Compiled by:
# src/lib/std/standard.lib# This is a threadkit version of the
# UNIX interface that is provided by lib7.
### "If your happiness depends on what somebody else does,
### I guess you do have a problem."
###
### -- Richard Bach
# XXX BUGGO FIXME any concurrent code referencing 'exec' or 'Exec'
# probably needs to be fixed to reference 'threadkit_spawn' or 'Threadkit_Spawn' respectively
stipulate
package drv = threadkit_winix_text_file_io_driver_for_posix; # threadkit_winix_text_file_io_driver_for_posix is from src/lib/std/src/posix/threadkit-winix-text-file-io-driver-for-posix.pkg package mop = mailop; # mailop is from src/lib/src/lib/thread-kit/src/core-thread-kit/mailop.pkg package ts = thread_scheduler; # thread_scheduler is from src/lib/src/lib/thread-kit/src/core-thread-kit/thread-scheduler.pkg package pm = process_deathwatch; # process_deathwatch is from src/lib/src/lib/thread-kit/src/process-deathwatch.pkg package tkf = threadkit_file; # threadkit_file is from src/lib/std/src/posix/threadkit-file.pkg #
package pp = posix_1003_1b; # posix_1003_1b is from src/lib/std/src/posix-1003.1b/posix-1003-1b.pkg package pe = posix_1003_1b;
package pf = posix_1003_1b;
package pio = posix_1003_1b;
package psx = posix_1003_1b; # posix_1003_1b is from src/lib/std/src/posix-1003.1b/posix-1003-1b.pkg package ss = substring; # substring is from src/lib/std/substring.pkg package rs = runtime_signals; # runtime_signals is from src/lib/std/src/nj/runtime-signals.pkgherein
package threadkit_spawn
: (weak) Threadkit_Spawn # Threadkit_Spawn is from src/lib/std/src/posix/threadkit-spawn.api {
fun protect f x
=
{ rs::mask_signals rs::MASK_ALL;
#
y = (f x)
except ex
=
{ rs::unmask_signals rs::MASK_ALL;
raise exception ex;
};
rs::unmask_signals rs::MASK_ALL;
y;
};
fun fd_reader (filename: String, fd: pio::File_Descriptor)
=
drv::make_filereader { filename, fd };
fun fd_writer (filename, fd)
=
drv::make_filewriter
{
filename,
fd,
append_mode => FALSE,
best_io_quantum => 4096
};
fun open_out_fd (filename, fd)
=
tkf::make_outstream
(
tkf::pur::make_outstream
(
fd_writer (filename, fd),
io_exceptions::BLOCK_BUFFERING
)
);
fun open_in_fd (filename, fd)
=
tkf::make_instream
(
tkf::pur::make_instream
(
fd_reader (filename, fd),
""
)
);
Process
=
PROCESS {
pid: pp::Process_Id,
from_stream: tkf::Input_Stream,
to_stream: tkf::Output_Stream
};
fun spawn_process_in_environment (cmd, argv, env) # XXX SUCKO FIXME This should be upgraded per src/lib/std/src/posix/spawn.pkg =
{ p1 = pio::make_pipe ();
p2 = pio::make_pipe ();
fun close_pipes ()
=
{ pio::close p1.outfd;
pio::close p1.infd;
pio::close p2.outfd;
pio::close p2.infd;
};
base = ss::to_string
(ss::get_suffix
.{ #c != '/'; }
(ss::from_string cmd)
);
fun start_child ()
=
case (protect pp::fork ())
#
THE pid => pid; # parent
#
NULL =>
{ oldin = p1.infd; newin = psx::int_to_fd 0;
oldout = p2.outfd; newout = psx::int_to_fd 1;
pio::close p1.outfd;
pio::close p2.infd;
if (oldin != newin)
#
pio::dup2 { old => oldin, new => newin };
pio::close oldin;
fi;
if (oldout != newout)
#
pio::dup2 { old => oldout, new => newout };
pio::close oldout;
fi;
pp::exece (cmd, base ! argv, env)
except
ex = # The exec failed, so we
# need to shut down the child:
#
pp::exit 0u128;
};
esac;
tkf::flush tkf::stdout;
pid = {
ts::stop_thread_scheduler_timer();
start_child () before
ts::restart_thread_scheduler_timer();
}
except
whatever_exception
=
{ ts::restart_thread_scheduler_timer();
close_pipes();
raise exception whatever_exception;
};
from_stream = open_in_fd (base + "_exec_in", p2.infd);
to_stream = open_out_fd (base + "_exec_out", p1.outfd);
# Close the child-side fds
#
pio::close p2.outfd;
pio::close p1.infd;
# Set the fds close on exec:
#
pio::setfd (p2.infd, pio::fd::flags [ pio::fd::cloexec ]);
pio::setfd (p1.outfd, pio::fd::flags [ pio::fd::cloexec ]);
PROCESS { pid, from_stream, to_stream };
};
fun spawn_process (cmd, argv)
=
spawn_process_in_environment (cmd, argv, pe::environment());
fun streams_of (PROCESS { from_stream, to_stream, ... } )
=
(from_stream, to_stream);
fun spawn cmd
=
{ process = spawn_process cmd;
#
(streams_of process)
->
(from_stream, to_stream);
{ from_stream, to_stream, process };
};
fun kill (PROCESS { pid, ... }, signal)
=
pp::kill (pp::K_PROC pid, signal);
fun reap_mailop (PROCESS { pid, from_stream, to_stream } )
=
{ ts::disable_thread_switching ();
#
pm::add_pid pid
before
ts::reenable_thread_switching ();
};
reap = mop::do_mailop o reap_mailop;
};
end;