From dc08a4ab11fcd9ee052215d4dae341e3346b91d6 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Bennet=20Ble=C3=9Fmann?= Date: Sat, 26 Jul 2025 18:21:00 +0200 Subject: [PATCH] get process_create working and add tests --- build/instructions_template.rs | 4 + src/arena.rs | 20 +++- src/heap_print.rs | 17 ++++ src/lib/lists.pl | 10 +- src/lib/process.pl | 70 +++++++------ src/machine/dispatch.rs | 8 ++ src/machine/machine_errors.rs | 2 + src/machine/machine_state.rs | 3 - src/machine/machine_state_impl.rs | 2 - src/machine/system_calls.rs | 148 ++++++++++++++++++---------- src/macros.rs | 6 ++ tests/scryer/cli/unix/process.md | 4 + tests/scryer/cli/windows/process.md | 4 + tests/scryer/main.rs | 16 ++- 14 files changed, 223 insertions(+), 91 deletions(-) create mode 100644 tests/scryer/cli/unix/process.md create mode 100644 tests/scryer/cli/windows/process.md diff --git a/build/instructions_template.rs b/build/instructions_template.rs index 346e68af..1cf004b1 100644 --- a/build/instructions_template.rs +++ b/build/instructions_template.rs @@ -539,6 +539,8 @@ enum SystemClauseType { 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")))] @@ -1834,6 +1836,7 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::CallUnsetEnv | &Instruction::CallShell | &Instruction::CallProcessCreate | + &Instruction::CallProcessId | &Instruction::CallProcessWait | &Instruction::CallProcessKill | &Instruction::CallProcessRelease | @@ -2076,6 +2079,7 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::ExecuteUnsetEnv | &Instruction::ExecuteShell | &Instruction::ExecuteProcessCreate | + &Instruction::ExecuteProcessId | &Instruction::ExecuteProcessWait | &Instruction::ExecuteProcessKill | &Instruction::ExecuteProcessRelease | diff --git a/src/arena.rs b/src/arena.rs index 2b312070..ee9dda20 100644 --- a/src/arena.rs +++ b/src/arena.rs @@ -20,6 +20,7 @@ use std::mem; 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; @@ -75,7 +76,8 @@ pub enum ArenaHeaderTag { HttpResponse = 0b1000010, PipeWriter = 0b1000011, Dropped = 0b1000100, - PipeReader = 0b1000101, + PipeReader = 0b1001001, + ChildProcess = 0b1001010, } #[bitfield] @@ -391,6 +393,19 @@ impl ArenaAllocated for HttpResponse { } } +impl ArenaAllocated for Child { + type Payload = ManuallyDrop; + #[inline] + fn tag() -> ArenaHeaderTag { + ArenaHeaderTag::ChildProcess + } +} +impl AllocateInArena for Child { + fn arena_allocate(self, arena: &mut Arena) -> TypedArenaPtr { + Child::alloc(arena, ManuallyDrop::new(self)) + } +} + #[repr(C)] #[derive(Debug)] pub struct AllocSlab { @@ -556,6 +571,9 @@ unsafe fn drop_slab_in_place(value: NonNull, tag: ArenaHeaderTag) { 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!"); } diff --git a/src/heap_print.rs b/src/heap_print.rs index 57fef895..2186c8ed 100644 --- a/src/heap_print.rs +++ b/src/heap_print.rs @@ -1789,6 +1789,23 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> { (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); + } + } _ => { } ); diff --git a/src/lib/lists.pl b/src/lib/lists.pl index 3d1cc6a2..9c972f01 100644 --- a/src/lib/lists.pl +++ b/src/lib/lists.pl @@ -7,7 +7,7 @@ List manipulation predicates 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 @@ -538,3 +538,11 @@ perm([], []). 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 diff --git a/src/lib/process.pl b/src/lib/process.pl index 603a3260..d66c2ea4 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -1,5 +1,6 @@ :- module(process, [ process_create/3, + process_id/2, process_release/1, process_wait/2, process_wait/3, @@ -8,7 +9,7 @@ :- 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). @@ -20,7 +21,7 @@ % 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 @@ -53,7 +54,7 @@ process_create(Exe, Args, Options) :- ([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 @@ -62,21 +63,27 @@ process_create(Exe, Args, 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. @@ -90,43 +97,42 @@ process_wait(Pid, Status) :- process_wait(Pid, Status, []). % % - 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(_, _, []). @@ -142,16 +148,16 @@ must_be_known_options(Valid, Found, [X|XS]) :- 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], ( @@ -179,7 +185,9 @@ valid_env_([N=V|ES]) :- 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). diff --git a/src/machine/dispatch.rs b/src/machine/dispatch.rs index 00396e23..8a8921e6 100644 --- a/src/machine/dispatch.rs +++ b/src/machine/dispatch.rs @@ -4795,6 +4795,14 @@ impl Machine { 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); diff --git a/src/machine/machine_errors.rs b/src/machine/machine_errors.rs index 084c8a83..c6836709 100644 --- a/src/machine/machine_errors.rs +++ b/src/machine/machine_errors.rs @@ -44,6 +44,7 @@ pub(crate) enum ValidType { // PredicateIndicator, // Variable TcpListener, + Process, } impl ValidType { @@ -67,6 +68,7 @@ impl ValidType { // ValidType::PredicateIndicator => atom!("predicate_indicator"), // ValidType::Variable => atom!("variable") ValidType::TcpListener => atom!("tcp_listener"), + ValidType::Process => atom!("process"), } } } diff --git a/src/machine/machine_state.rs b/src/machine/machine_state.rs index 6d583b00..7663c952 100644 --- a/src/machine/machine_state.rs +++ b/src/machine/machine_state.rs @@ -20,11 +20,9 @@ use crate::parser::dashu::Integer; 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]; @@ -99,7 +97,6 @@ pub struct MachineState { 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, } impl fmt::Debug for MachineState { diff --git a/src/machine/machine_state_impl.rs b/src/machine/machine_state_impl.rs index e8b9d644..3f14253d 100644 --- a/src/machine/machine_state_impl.rs +++ b/src/machine/machine_state_impl.rs @@ -19,7 +19,6 @@ use crate::types::*; use indexmap::IndexSet; use std::cmp::Ordering; -use std::collections::BTreeMap; use std::convert::TryFrom; impl MachineState { @@ -68,7 +67,6 @@ impl MachineState { unify_fn: MachineState::unify, bind_fn: MachineState::bind, run_cleaners_fn: |_| false, - child_processes: BTreeMap::new(), } } diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 214c6d3a..0fc6e35d 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -56,6 +56,7 @@ use std::net::{SocketAddr, ToSocketAddrs}; 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; @@ -8496,16 +8497,13 @@ impl Machine { match command.spawn() { Ok(child) => { - let pid = child.id(); - - dbg!(pid); - - self.machine_st.child_processes.insert(pid, child); + let child_process_alloc: TypedArenaPtr = + 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(()) @@ -8617,44 +8615,84 @@ impl Machine { }) } + pub(crate) fn process_id(&mut self) -> CallResult { + fn stub_gen() -> Vec { + 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 { 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") } @@ -8728,23 +8766,28 @@ impl Machine { } // 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()); @@ -8758,18 +8801,23 @@ impl Machine { 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)] diff --git a/src/macros.rs b/src/macros.rs index e301832b..10467419 100644 --- a/src/macros.rs +++ b/src/macros.rs @@ -218,6 +218,12 @@ macro_rules! match_untyped_arena_ptr_pat_body { #[allow(unused_braces)] $code }}; + ($ptr:ident, ChildProcess, $listener:ident, $code:expr) => {{ + #[allow(unused_mut)] + let mut $listener = unsafe { $ptr.as_typed_ptr::() }; + #[allow(unused_braces)] + $code + }}; ($ptr:ident, $($tags:tt)|+, $s:ident, $code:expr) => {{ let $s = Stream::from_tag($ptr.get_tag(), $ptr); #[allow(unused_braces)] diff --git a/tests/scryer/cli/unix/process.md b/tests/scryer/cli/unix/process.md new file mode 100644 index 00000000..8a1aef06 --- /dev/null +++ b/tests/scryer/cli/unix/process.md @@ -0,0 +1,4 @@ +```trycmd +$ scryer-prolog -f --no-add-history -g 'use_module(library(process)), process_create("false", [], [process(P)]), process_wait(P, exit(1)), halt' + +``` diff --git a/tests/scryer/cli/windows/process.md b/tests/scryer/cli/windows/process.md new file mode 100644 index 00000000..c83520cc --- /dev/null +++ b/tests/scryer/cli/windows/process.md @@ -0,0 +1,4 @@ +```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' + +``` diff --git a/tests/scryer/main.rs b/tests/scryer/main.rs index a501bd42..19c78c59 100644 --- a/tests/scryer/main.rs +++ b/tests/scryer/main.rs @@ -19,9 +19,19 @@ mod src_tests; 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"); + } } -- 2.54.0