Shell,
#[strum_discriminants(strum(props(Arity = "8", Name = "$process_create")))]
ProcessCreate,
+ #[strum_discriminants(strum(props(Arity = "2", Name = "$process_id")))]
+ ProcessId,
#[strum_discriminants(strum(props(Arity = "3", Name = "$process_wait")))]
ProcessWait,
#[strum_discriminants(strum(props(Arity = "1", Name = "$process_kill")))]
&Instruction::CallUnsetEnv |
&Instruction::CallShell |
&Instruction::CallProcessCreate |
+ &Instruction::CallProcessId |
&Instruction::CallProcessWait |
&Instruction::CallProcessKill |
&Instruction::CallProcessRelease |
&Instruction::ExecuteUnsetEnv |
&Instruction::ExecuteShell |
&Instruction::ExecuteProcessCreate |
+ &Instruction::ExecuteProcessId |
&Instruction::ExecuteProcessWait |
&Instruction::ExecuteProcessKill |
&Instruction::ExecuteProcessRelease |
use std::mem::ManuallyDrop;
use std::net::TcpListener;
use std::ops::{Deref, DerefMut};
+use std::process::Child;
use std::ptr;
use std::ptr::addr_of_mut;
use std::ptr::NonNull;
HttpResponse = 0b1000010,
PipeWriter = 0b1000011,
Dropped = 0b1000100,
- PipeReader = 0b1000101,
+ PipeReader = 0b1001001,
+ ChildProcess = 0b1001010,
}
#[bitfield]
}
}
+impl ArenaAllocated for Child {
+ type Payload = ManuallyDrop<Self>;
+ #[inline]
+ fn tag() -> ArenaHeaderTag {
+ ArenaHeaderTag::ChildProcess
+ }
+}
+impl AllocateInArena<Child> for Child {
+ fn arena_allocate(self, arena: &mut Arena) -> TypedArenaPtr<Child> {
+ Child::alloc(arena, ManuallyDrop::new(self))
+ }
+}
+
#[repr(C)]
#[derive(Debug)]
pub struct AllocSlab {
ArenaHeaderTag::PipeWriter => {
drop_typed_slab_in_place!(PipeWriter, value);
}
+ ArenaHeaderTag::ChildProcess => {
+ drop_typed_slab_in_place!(Child, value);
+ }
ArenaHeaderTag::NullStream => {
unreachable!("NullStream is never arena allocated!");
}
(ArenaHeaderTag::Dropped, _value) => {
self.print_impromptu_atom(atom!("$dropped_value"));
}
+ (ArenaHeaderTag::ChildProcess, process) => {
+
+ let process_atom = atom!("$process");
+
+ if self.format_struct(max_depth, 1, process_atom) {
+ let atom = TokenOrRedirect::NumberFocus(max_depth, NumberFocus::Unfocused(Number::Fixnum(Fixnum::build_with(process.id()))), op);
+
+ let process_root = self.state_stack.pop().unwrap();
+
+ self.state_stack.pop();
+ self.state_stack.pop();
+
+ self.state_stack.push(atom);
+ self.state_stack.push(TokenOrRedirect::Open);
+ self.state_stack.push(process_root);
+ }
+ }
_ => {
}
);
maplist/3, maplist/4, maplist/5, maplist/6,
maplist/7, maplist/8, maplist/9, same_length/2, nth0/3, nth0/4, nth1/3, nth1/4,
sum_list/2, transpose/2, list_to_set/2, list_max/2,
- list_min/2, permutation/2]).
+ list_min/2, permutation/2, filter/3]).
/* Author: Mark Thom, Jan Wielemaker, and Richard O'Keefe
Copyright (c) 2018-2021, Mark Thom
perm(List, [First|Perm]) :-
select(First, List, Rest),
perm(Rest, Perm).
+
+
+%% filter(+Predicate, ?Xs1 ?Xs2).
+%
+% Succeeds if Xs2 is the list of elements X from Xs1 for which call(Pred, X) succeeds.
+%
+filter(_, [], []).
+filter(Pred, [X1|XS1], XS) :- call(Pred, X1) -> filter(Pred, XS1, XS2), XS = [X1|XS2] ; filter(Pred, XS1, XS).
\ No newline at end of file
:- module(process, [
process_create/3,
+ process_id/2,
process_release/1,
process_wait/2,
process_wait/3,
:- use_module(library(error)).
:- use_module(library(iso_ext)).
-:- use_module(library(lists), [append/3, member/2, maplist/2, maplist/3, select/3]).
+:- use_module(library(lists), [member/2, maplist/2, filter/3]).
%% process_create(+Exe, +Args:list, +Options).
% Options is a list consisting of the following options:
%
% * `cwd(+Path)` Set the processes working directory to `Path`
-% * `process(-Pid)` `Pid` will be assigned the spawned processes process id
+% * `process(-Process)` `Process` will be assigned a process handle for the spawned process
% * `env(+List)` Don't inherit environment variables and set the variables defined in `List`
% * `environment(+List)` Inherit environment variables and set/override the variables defined in `List`
% * `stdin(Spec)`, `stdout(Spec)` or `stderr(Spec)` defines how to redirect the spawned processes io streams
([stdout], valid_stdio, stdout(std), stdout(Stdout)),
([stderr], valid_stdio, stderr(std), stderr(Stderr)),
([env, environment], valid_env, environment([]), Env),
- ([process], valid_process, process(_), process(Pid)),
+ ([process], valid_uninit_process, process(_), process(Process)),
([cwd], valid_cwd, cwd("."), cwd(Cwd))
],
Options
Stdout =.. Stdout1,
Stderr =.. Stderr1,
simplify_env(Env, Env1),
- '$process_create'(Exe, Args, Stdin1, Stdout1, Stderr1, Env1, Cwd, Pid).
+ '$process_create'(Exe, Args, Stdin1, Stdout1, Stderr1, Env1, Cwd, Process).
+%% process_id(+Process, -Pid).
+%
+process_id(Process, Pid) :-
+ valid_process(Process, process_id/2),
+ write(valid), nl,
+ must_be(var, Pid),
+ write(var), nl,
+ '$process_id'(Process, Pid).
-%% process_wait(+Pid, Status).
+%% process_wait(+Process, Status).
%
% See `process_create/3` with `Options = []`
%
-process_wait(Pid, Status) :- process_wait(Pid, Status, []).
+process_wait(Process, Status) :- process_wait(Process, Status, []).
-%% process_wait(+Pid, Status, Options).
-%
-% Wait for the child process with `Pid` to exit.
+%% process_wait(+Process, Status, Options).
%
-% Only works for processes spawned with `process_create/3` that have not yet been release with `process_release/1`
+% Wait for the process behind the process handle `Process` to exit.
%
% When the process exits regulary `Status` will be unified with `exit(Exit)` where `Exit` is the processes exit code.
% When the process exits was killed `Status` will be unified with `killed(Signal)` where `Signal` is the signal number that killed the process.
%
% - timeout(infinite)
%
-process_wait(Pid, Status, Options) :-
- must_be(integer, Pid),
+process_wait(Process, Status, Options) :-
+ valid_process(Process, process_wait/3),
must_be_known_options([timeout], [], Options),check_options(
[
([timeout], valid_timeout, timeout(infinite), timeout(Timeout))
],
Options
),
- '$process_wait'(Pid, Exit, Timeout),
+ '$process_wait'(Process, Exit, Timeout),
Exit = Status.
valid_timeout(timeout(infinite)).
valid_timeout(timeout(0)).
-%% process_kill(+Pid).
+%% process_kill(+Process).
%
-% Kill the child process identified by `Pid`.
+% Kill the process using the process handle `Process`.
% On Unix this sends SIGKILL.
%
% Only works for processes spawned with `process_create/3` that have not yet been release with `process_release/1`
%
-process_kill(Pid) :-
- must_be(integer, Pid),
- '$process_kill'(Pid).
+process_kill(Process) :-
+ valid_process(Process, process_kill/1),
+ '$process_kill'(Process).
-%% process_release(+Pid)
+%% process_release(+Process)
%
-% release child process object of the process identified by `Pid`
+% wait for the process to exit (if not already) and release process handle `Process`
%
-% It's an error if
-% * the `Pid` is not associated with a child process created by `process_create/3`,
-% * the child project object has already been released
+% It's an error if `Process` is not a valid process handle
%
-process_release(Pid) :-
- process_wait(Pid, _),
- '$process_release'(Pid).
+process_release(Process) :-
+ valid_process(Process, process_release/1),
+ process_wait(Process, _),
+ '$process_release'(Process).
must_be_known_options(_, _, []).
check_options([], _).
check_options([X | XS], Options) :-
(Kinds, Pred, Default, Choice) = X,
- findall(P, find_option(Kinds, P, Options), Solutions),
+ filter(process:find_option(Kinds), Options, Solutions),
(
Solutions = [] -> Choice = Default;
Solutions = [Provided] -> call(Pred, Provided), Choice = Provided ;
- error(evaluation_error(confliction_options), process_create/3)
+ error(evaluation_error(confliction_options, Solutions), process_create/3)
),
check_options(XS, Options).
-find_option([Kind|_], Found, Options) :- Found =.. [Kind,_], member(Found, Options).
-find_option([_|Kinds], Found, Options) :- find_option(Kinds, Found, Options).
+find_option([Kind|_], Found) :- Found =.. [Kind,_].
+find_option([_|Kinds], Found) :- find_option(Kinds, Found).
valid_stdio(IO) :- IO =.. [_, Arg],
(
must_be(chars, V),
valid_env_(ES).
-valid_process(process(Pid)) :- must_be(var, Pid).
+valid_uninit_process(process(Process)) :- must_be(var, Process).
+
+valid_process(Process, Context) :- var(Process) -> instantiation_error(Context) ; true.
valid_cwd(cwd(Cwd)) :- must_be(chars, Cwd).
try_or_throw!(self.machine_st, self.process_create());
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
+ &Instruction::CallProcessId => {
+ try_or_throw!(self.machine_st, self.process_id());
+ step_or_fail!(self, self.machine_st.p += 1);
+ }
+ &Instruction::ExecuteProcessId => {
+ try_or_throw!(self.machine_st, self.process_id());
+ step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
+ }
&Instruction::CallProcessWait => {
try_or_throw!(self.machine_st, self.process_wait());
step_or_fail!(self, self.machine_st.p += 1);
// PredicateIndicator,
// Variable
TcpListener,
+ Process,
}
impl ValidType {
// ValidType::PredicateIndicator => atom!("predicate_indicator"),
// ValidType::Variable => atom!("variable")
ValidType::TcpListener => atom!("tcp_listener"),
+ ValidType::Process => atom!("process"),
}
}
}
use indexmap::IndexMap;
-use std::collections::BTreeMap;
use std::convert::TryFrom;
use std::fmt;
use std::ops::{Index, IndexMut, Range};
-use std::process::Child;
use std::sync::Arc;
pub(crate) type Registers = [HeapCellValue; MAX_ARITY + 1];
pub(crate) unify_fn: fn(&mut MachineState),
pub(crate) bind_fn: fn(&mut MachineState, Ref, HeapCellValue),
pub(crate) run_cleaners_fn: fn(&mut Machine) -> bool,
- pub(crate) child_processes: BTreeMap<u32, Child>,
}
impl fmt::Debug for MachineState {
use indexmap::IndexSet;
use std::cmp::Ordering;
-use std::collections::BTreeMap;
use std::convert::TryFrom;
impl MachineState {
unify_fn: MachineState::unify,
bind_fn: MachineState::bind,
run_cleaners_fn: |_| false,
- child_processes: BTreeMap::new(),
}
}
use std::net::{TcpListener, TcpStream};
use std::num::NonZeroU32;
use std::process;
+use std::process::Child;
use std::process::Stdio;
#[cfg(feature = "http")]
use std::str::FromStr;
match command.spawn() {
Ok(child) => {
- let pid = child.id();
-
- dbg!(pid);
-
- self.machine_st.child_processes.insert(pid, child);
+ let child_process_alloc: TypedArenaPtr<Child> =
+ arena_alloc!(child, &mut self.machine_st.arena);
unify!(
self.machine_st,
pid_r,
- fixnum_as_cell!(Fixnum::build_with(pid))
+ typed_arena_ptr_as_cell!(child_process_alloc)
);
Ok(())
})
}
+ pub(crate) fn process_id(&mut self) -> CallResult {
+ fn stub_gen() -> Vec<FunctorElement> {
+ functor_stub(atom!("process_id"), 2)
+ }
+
+ // Process
+ let process_r = self.deref_register(1);
+ // Pid
+ let pid_r = self.deref_register(2);
+
+ let Some(ptr) = process_r.to_untyped_arena_ptr() else {
+ let err = self.machine_st.type_error(ValidType::Process, process_r);
+ return Err(self.machine_st.error_form(err, stub_gen()));
+ };
+
+ let process = match_untyped_arena_ptr!(ptr,
+ (ArenaHeaderTag::ChildProcess, child_process) => {
+ child_process
+ }
+ (ArenaHeaderTag::Dropped, _dropped) => {
+ let err = self.machine_st.existence_error(ExistenceError::Process(process_r));
+ return Err(self.machine_st.error_form(err, stub_gen()));
+ }
+ _ => {
+ let err = self.machine_st.type_error(ValidType::Process, process_r);
+ return Err(self.machine_st.error_form(err, stub_gen()));
+ }
+ );
+
+ self.machine_st.bind(
+ pid_r.as_var().unwrap(),
+ fixnum_as_cell!(Fixnum::build_with(process.id())),
+ );
+
+ Ok(())
+ }
+
pub(crate) fn process_wait(&mut self) -> CallResult {
fn stub_gen() -> Vec<FunctorElement> {
functor_stub(atom!("process_wait"), 2)
}
- // Pid
- let pid_r = self.deref_register(1);
+ // Process
+ let process_r = self.deref_register(1);
// Var | Status
let status_r = self.deref_register(2);
// timeout | 0
let timeout_r = self.deref_register(3);
- let Some(pid) = pid_r
- .to_fixnum()
- .and_then(|elem| elem.get_num().try_into().ok())
- else {
- let err = self
- .machine_st
- .existence_error(ExistenceError::Process(pid_r));
- return Err(self.machine_st.error_form(err, stub_gen()));
- };
- let Some(child) = self.machine_st.child_processes.get_mut(&pid) else {
- let err = self
- .machine_st
- .existence_error(ExistenceError::Process(pid_r));
+ let Some(ptr) = process_r.to_untyped_arena_ptr() else {
+ let err = self.machine_st.type_error(ValidType::Process, process_r);
return Err(self.machine_st.error_form(err, stub_gen()));
};
+ let mut process = match_untyped_arena_ptr!(ptr,
+ (ArenaHeaderTag::ChildProcess, child_process) => {
+ child_process
+ }
+ (ArenaHeaderTag::Dropped, _dropped) => {
+ let err = self.machine_st.existence_error(ExistenceError::Process(process_r));
+ return Err(self.machine_st.error_form(err, stub_gen()));
+ }
+ _ => {
+ let err = self.machine_st.type_error(ValidType::Process, process_r);
+ return Err(self.machine_st.error_form(err, stub_gen()));
+ }
+ );
+
let status = if let Some(atom) = timeout_r.to_atom() {
match atom {
- atom!("infinite") => child.wait().map(Some),
+ atom!("infinite") => process.wait().map(Some),
_ => {
panic!("Invalid Timeout value")
}
}
} else if let Some(timeout) = timeout_r.to_fixnum() {
if timeout.get_num() == 0 {
- child.try_wait()
+ process.try_wait()
} else {
panic!("Invalid Timeout value")
}
}
// Pid
- let pid_r = self.deref_register(1);
- let Some(pid) = pid_r
- .to_fixnum()
- .and_then(|elem| elem.get_num().try_into().ok())
- else {
- let err = self
- .machine_st
- .existence_error(ExistenceError::Process(pid_r));
- return Err(self.machine_st.error_form(err, stub_gen()));
- };
- let Some(child) = self.machine_st.child_processes.get_mut(&pid) else {
- let err = self
- .machine_st
- .existence_error(ExistenceError::Process(pid_r));
+ let process_r = self.deref_register(1);
+
+ let Some(ptr) = process_r.to_untyped_arena_ptr() else {
+ let err = self.machine_st.type_error(ValidType::Process, process_r);
return Err(self.machine_st.error_form(err, stub_gen()));
};
- if child.kill().is_err() {
+
+ let mut process = match_untyped_arena_ptr!(ptr,
+ (ArenaHeaderTag::ChildProcess, child_process) => {
+ child_process
+ }
+ (ArenaHeaderTag::Dropped, _dropped) => {
+ let err = self.machine_st.existence_error(ExistenceError::Process(process_r));
+ return Err(self.machine_st.error_form(err, stub_gen()));
+ }
+ _ => {
+ let err = self.machine_st.type_error(ValidType::Process, process_r);
+ return Err(self.machine_st.error_form(err, stub_gen()));
+ }
+ );
+
+ if process.kill().is_err() {
let perm_error =
self.machine_st
.permission_error(Permission::Modify, atom!("process"), stub_gen());
functor_stub(atom!("process_release"), 1)
}
- let pid_r = self.deref_register(1);
- let Some(pid) = pid_r
- .to_fixnum()
- .and_then(|elem| elem.get_num().try_into().ok())
- else {
- let err = self
- .machine_st
- .existence_error(ExistenceError::Process(pid_r));
- return Err(self.machine_st.error_form(err, stub_gen()));
- };
- self.machine_st.child_processes.remove(&pid);
- Ok(())
+ let process = self.deref_register(1);
+
+ if let Some(ptr) = process.to_untyped_arena_ptr() {
+ match_untyped_arena_ptr!(ptr,
+ (ArenaHeaderTag::ChildProcess, child_process) => {
+ child_process.drop_payload();
+
+ return Ok(());
+ }
+ _ => {
+ }
+ );
+ }
+
+ let err = self.machine_st.type_error(ValidType::Process, process);
+
+ Err(self.machine_st.error_form(err, stub_gen()))
}
#[inline(always)]
#[allow(unused_braces)]
$code
}};
+ ($ptr:ident, ChildProcess, $listener:ident, $code:expr) => {{
+ #[allow(unused_mut)]
+ let mut $listener = unsafe { $ptr.as_typed_ptr::<std::process::Child>() };
+ #[allow(unused_braces)]
+ $code
+ }};
($ptr:ident, $($tags:tt)|+, $s:ident, $code:expr) => {{
let $s = Stream::from_tag($ptr.get_tag(), $ptr);
#[allow(unused_braces)]
--- /dev/null
+```trycmd
+$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("false", [], [process(P)]), process_wait(P, exit(1)), halt'
+
+```
--- /dev/null
+```trycmd
+$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("cmd", ["/C", "exit", "1"], [process(P)]), process_wait(P, exit(1)), halt'
+
+```
ignore = "miri isolation, unsupported operation: can't call foreign function"
)]
fn cli_tests() {
- trycmd::TestCases::new()
+ let cases = trycmd::TestCases::new();
+ cases
.default_bin_name("scryer-prolog")
.case("tests/scryer/cli/issues/*.toml")
- .case("tests/scryer/cli/src_tests/*.toml")
- .case("tests/scryer/cli/src_tests/*.md");
+ .case("tests/scryer/cli/src_tests/*.toml");
+
+ #[cfg(windows)]
+ {
+ cases.case("tests/scryer/cli/windows/*.md");
+ }
+
+ #[cfg(unix)]
+ {
+ cases.case("tests/scryer/cli/unix/*.md");
+ }
}
projects / scryer-prolog.git / commitdiff