From: Bennet Bleßmann Date: Sun, 20 Jul 2025 20:57:06 +0000 (+0200) Subject: implement process_release/1, process_wait/2, process_wait/3, and process_kill/1 X-Git-Tag: v0.10.0~35^2^2~23 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=97e2e5d7f0259fcd066269fd37a46f0b9f9c9dbf;p=scryer-prolog.git implement process_release/1, process_wait/2, process_wait/3, and process_kill/1 --- diff --git a/build/instructions_template.rs b/build/instructions_template.rs index 6ea7a5a5..0c1320b1 100644 --- a/build/instructions_template.rs +++ b/build/instructions_template.rs @@ -539,6 +539,10 @@ enum SystemClauseType { Shell, #[strum_discriminants(strum(props(Arity = "8", Name = "$process_create")))] ProcessCreate, + #[strum_discriminants(strum(props(Arity = "3", Name = "$process_wait")))] + ProcessWait, + #[strum_discriminants(strum(props(Arity = "1", Name = "$process_kill")))] + ProcessKill, #[strum_discriminants(strum(props(Arity = "1", Name = "$pid")))] Pid, #[strum_discriminants(strum(props(Arity = "4", Name = "$chars_base64")))] @@ -1828,6 +1832,8 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::CallUnsetEnv | &Instruction::CallShell | &Instruction::CallProcessCreate | + &Instruction::CallProcessWait | + &Instruction::CallProcessKill | &Instruction::CallPid | &Instruction::CallCharsBase64 | &Instruction::CallDevourWhitespace | @@ -2067,6 +2073,8 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::ExecuteUnsetEnv | &Instruction::ExecuteShell | &Instruction::ExecuteProcessCreate | + &Instruction::ExecuteProcessWait | + &Instruction::ExecuteProcessKill | &Instruction::ExecutePid | &Instruction::ExecuteCharsBase64 | &Instruction::ExecuteDevourWhitespace | diff --git a/src/lib/process.pl b/src/lib/process.pl index 645841ff..d7bd15f9 100644 --- a/src/lib/process.pl +++ b/src/lib/process.pl @@ -1,4 +1,10 @@ -:- module(process, [process_create/3]). +:- module(process, [ + process_create/3, + process_release/1, + process_wait/2, + process_wait/3, + process_kill/1 +]). :- use_module(library(error)). :- use_module(library(iso_ext)). @@ -27,6 +33,29 @@ process_create(Exe, Args, Options) :- simplify_env(Env, Env1), '$process_create'(Exe, Args, Stdin1, Stdout1, Stderr1, Env1, Cwd, Pid). +process_wait(Pid, Status) :- process_wait(Pid, Status, []). + +process_wait(Pid, Status, Options) :- + must_be(integer, Pid), + must_be_known_options([timeout], [], Options),check_options( + [ + ([timeout], valid_timeout, infinite, timeout(Timeout)) + ], + Options + ), + '$process_wait'(Pid, Exit, Timeout), + Exit = Status. + +valid_timeout(timeout(infinite)). +valid_timeout(timeout(0)). + +process_kill(Pid) :- + must_be(integer, Pid), + '$process_kill'(Pid). + +process_release(Pid) :- process_wait(Pid, _). + + must_be_known_options(_, _, []). must_be_known_options(Valid, Found, [X|XS]) :- X =.. [Option|_], @@ -73,9 +102,7 @@ valid_env(environment(E)) :- ( valid_env_([]). valid_env_([E| ES]) :- - ( - E =.. [=, N, V] -> true ; - ), + E =.. [=, N, V], must_be(chars, N), must_be(chars, V), valid_env_(ES). diff --git a/src/machine/dispatch.rs b/src/machine/dispatch.rs index 36068ca2..66133c3c 100644 --- a/src/machine/dispatch.rs +++ b/src/machine/dispatch.rs @@ -4795,6 +4795,22 @@ impl Machine { try_or_throw!(self.machine_st, self.process_create()); 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); + } + &Instruction::ExecuteProcessWait => { + try_or_throw!(self.machine_st, self.process_wait()); + step_or_fail!(self, self.machine_st.p = self.machine_st.cp); + } + &Instruction::CallProcessKill => { + try_or_throw!(self.machine_st, self.process_kill()); + step_or_fail!(self, self.machine_st.p += 1); + } + &Instruction::ExecuteProcessKill => { + try_or_throw!(self.machine_st, self.process_kill()); + step_or_fail!(self, self.machine_st.p = self.machine_st.cp); + } &Instruction::CallPid => { self.pid(); step_or_fail!(self, self.machine_st.p += 1); diff --git a/src/machine/machine_errors.rs b/src/machine/machine_errors.rs index 4551991e..fec32ddd 100644 --- a/src/machine/machine_errors.rs +++ b/src/machine/machine_errors.rs @@ -405,6 +405,17 @@ impl MachineState { [atom_as_cell((atom!("stream"))), cell(culprit)] ); + MachineError { + stub, + location: None, + } + } + ExistenceError::Process(culprit) => { + let stub = functor!( + atom!("existence_error"), + [atom_as_cell((atom!("process"))), cell(culprit)] + ); + MachineError { stub, location: None, @@ -1003,6 +1014,7 @@ pub enum ExistenceError { }, SourceSink(HeapCellValue), Stream(HeapCellValue), + Process(HeapCellValue), } #[derive(Debug)] diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index ff95d22b..f40a6cbc 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -8616,6 +8616,142 @@ impl Machine { }) } + 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); + // 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(mut child) = self.machine_st.child_processes.remove(&pid) else { + let err = self + .machine_st + .existence_error(ExistenceError::Process(pid_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), + _ => { + panic!("Invalid Timeout value") + } + } + } else if let Some(timeout) = timeout_r.to_fixnum() { + if timeout.get_num() == 0 { + child.try_wait() + } else { + panic!("Invalid Timeout value") + } + } else { + panic!("Invalid Timeout value") + }; + + match status { + Ok(None) => { + unify!(self.machine_st, status_r, atom_as_cell!(atom!("timeout"))); + Ok(()) + } + Ok(Some(exit_status)) => { + if let Some(exit_code) = exit_status.code() { + let mut writer = + Heap::functor_writer(functor!(atom!("exit"), [fixnum(exit_code)])); + + match writer(&mut self.machine_st.heap) { + Ok(loc) => { + unify!(self.machine_st, status_r, loc); + } + Err(resource_err_loc) => { + self.machine_st.throw_resource_error(resource_err_loc); + } + } + Ok(()) + } else { + #[cfg(unix)] + { + use std::os::unix::process::ExitStatusExt; + + if let Some(signal) = ExitStatusExt::signal(&exit_status) { + let mut writer = + Heap::functor_writer(functor!(atom!("signal"), [fixnum(signal)])); + + match writer(&mut self.machine_st.heap) { + Ok(loc) => { + unify!(self.machine_st, status_r, loc); + } + Err(resource_err_loc) => { + self.machine_st.throw_resource_error(resource_err_loc); + } + }; + Ok(()) + } else { + unify!(self.machine_st, status_r, atom_as_cell!(atom!("unknown"))); + Ok(()) + } + } + #[cfg(not(unix))] + { + unify!(self.machine_st, status_r, atom_as_cell!(atom!("unknown"))); + Ok(()) + } + } + } + Err(_) => { + let perm_error = self.machine_st.permission_error( + Permission::Modify, + atom!("process"), + stub_gen(), + ); + Err(self.machine_st.error_form(perm_error, stub_gen())) + } + } + } + + pub(crate) fn process_kill(&mut self) -> CallResult { + fn stub_gen() -> Vec { + functor_stub(atom!("process_kill"), 1) + } + + // 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(mut child) = self.machine_st.child_processes.remove(&pid) else { + let err = self + .machine_st + .existence_error(ExistenceError::Process(pid_r)); + return Err(self.machine_st.error_form(err, stub_gen())); + }; + if child.kill().is_err() { + let perm_error = + self.machine_st + .permission_error(Permission::Modify, atom!("process"), stub_gen()); + return Err(self.machine_st.error_form(perm_error, stub_gen())); + } + Ok(()) + } + #[inline(always)] pub(crate) fn chars_base64(&mut self) -> CallResult { let padding = cell_as_atom!(self.deref_register(3));