From 483e4568a29adfc5d0e0172db6a92be4626758f6 Mon Sep 17 00:00:00 2001 From: Mark Date: Thu, 6 Jul 2023 11:20:49 -0600 Subject: [PATCH] add scc_block to MachineState to avoid SCC cleanup terms being deallocated too early (#1427) --- build/instructions_template.rs | 10 +++++- src/lib/iso_ext.pl | 11 +++---- src/machine/dispatch.rs | 16 ++++++++++ src/machine/machine_state.rs | 4 ++- src/machine/machine_state_impl.rs | 20 +++++------- src/machine/mod.rs | 2 +- src/machine/system_calls.rs | 52 +++++++++++++++++++++++++------ src/parser/ast.rs | 6 ++++ 8 files changed, 90 insertions(+), 31 deletions(-) diff --git a/build/instructions_template.rs b/build/instructions_template.rs index dc88a827..2629f7b3 100644 --- a/build/instructions_template.rs +++ b/build/instructions_template.rs @@ -322,7 +322,7 @@ enum SystemClauseType { GetSCCCleaner, #[strum_discriminants(strum(props(Arity = "2", Name = "$head_is_dynamic")))] HeadIsDynamic, - #[strum_discriminants(strum(props(Arity = "2", Name = "$install_scc_cleaner")))] + #[strum_discriminants(strum(props(Arity = "1", Name = "$install_scc_cleaner")))] InstallSCCCleaner, #[strum_discriminants(strum(props(Arity = "3", Name = "$install_inference_counter")))] InstallInferenceCounter, @@ -404,6 +404,8 @@ enum SystemClauseType { GetBall, #[strum_discriminants(strum(props(Arity = "1", Name = "$get_current_block")))] GetCurrentBlock, + #[strum_discriminants(strum(props(Arity = "1", Name = "$get_current_scc_block")))] + GetCurrentSCCBlock, #[strum_discriminants(strum(props(Arity = "1", Name = "$get_cp")))] GetCutPoint, #[strum_discriminants(strum(props(Arity = "1", Name = "$get_double_quotes")))] @@ -420,6 +422,8 @@ enum SystemClauseType { ReadTermFromChars, #[strum_discriminants(strum(props(Arity = "1", Name = "$reset_block")))] ResetBlock, + #[strum_discriminants(strum(props(Arity = "1", Name = "$reset_scc_block")))] + ResetSCCBlock, #[strum_discriminants(strum(props(Arity = "0", Name = "$return_from_verify_attr")))] ReturnFromVerifyAttr, #[strum_discriminants(strum(props(Arity = "1", Name = "$set_ball")))] @@ -1713,6 +1717,7 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::CallFail | &Instruction::CallGetBall | &Instruction::CallGetCurrentBlock | + &Instruction::CallGetCurrentSCCBlock | &Instruction::CallGetCutPoint | &Instruction::CallGetDoubleQuotes | &Instruction::CallInstallNewBlock | @@ -1732,6 +1737,7 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::CallQuotedToken | &Instruction::CallReadTermFromChars | &Instruction::CallResetBlock | + &Instruction::CallResetSCCBlock | &Instruction::CallReturnFromVerifyAttr | &Instruction::CallSetBall | &Instruction::CallPushBallStack | @@ -1935,6 +1941,7 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::ExecuteFail | &Instruction::ExecuteGetBall | &Instruction::ExecuteGetCurrentBlock | + &Instruction::ExecuteGetCurrentSCCBlock | &Instruction::ExecuteGetCutPoint | &Instruction::ExecuteGetDoubleQuotes | &Instruction::ExecuteInstallNewBlock | @@ -1954,6 +1961,7 @@ fn generate_instruction_preface() -> TokenStream { &Instruction::ExecuteQuotedToken | &Instruction::ExecuteReadTermFromChars | &Instruction::ExecuteResetBlock | + &Instruction::ExecuteResetSCCBlock | &Instruction::ExecuteReturnFromVerifyAttr | &Instruction::ExecuteSetBall | &Instruction::ExecutePushBallStack | diff --git a/src/lib/iso_ext.pl b/src/lib/iso_ext.pl index 0af55c99..8b3e8dc3 100644 --- a/src/lib/iso_ext.pl +++ b/src/lib/iso_ext.pl @@ -138,7 +138,7 @@ setup_call_cleanup(S, G, C) :- '$get_b_value'(B), '$call_with_inference_counting'(call(S)), '$set_cp_by_default'(B), - '$get_current_block'(Bb), + '$get_current_scc_block'(Bb), ( C = _:CC, var(CC) -> instantiation_error(setup_call_cleanup/3) @@ -151,17 +151,16 @@ setup_call_cleanup(S, G, C) :- scc_helper(C, G, Bb) :- '$get_cp'(Cp), - '$install_scc_cleaner'(C, NBb), + '$install_scc_cleaner'(C), '$call_with_inference_counting'(call(G)), ( '$check_cp'(Cp) -> - '$reset_block'(Bb), + '$reset_scc_block'(Bb), run_cleaners_without_handling(Cp) ; true - ; '$reset_block'(NBb), - '$fail' + ; '$fail' ). scc_helper(_, _, Bb) :- - '$reset_block'(Bb), + '$reset_scc_block'(Bb), '$push_ball_stack', run_cleaners_with_handling, '$pop_from_ball_stack', diff --git a/src/machine/dispatch.rs b/src/machine/dispatch.rs index 8029bb70..ba13cf5b 100644 --- a/src/machine/dispatch.rs +++ b/src/machine/dispatch.rs @@ -4114,6 +4114,14 @@ impl Machine { self.get_current_block(); step_or_fail!(self, self.machine_st.p = self.machine_st.cp); } + &Instruction::CallGetCurrentSCCBlock => { + self.get_current_scc_block(); + step_or_fail!(self, self.machine_st.p += 1); + } + &Instruction::ExecuteGetCurrentSCCBlock => { + self.get_current_scc_block(); + step_or_fail!(self, self.machine_st.p = self.machine_st.cp); + } &Instruction::CallGetCutPoint => { self.get_cut_point(); step_or_fail!(self, self.machine_st.p += 1); @@ -4250,6 +4258,14 @@ impl Machine { self.reset_block(); step_or_fail!(self, self.machine_st.p = self.machine_st.cp); } + &Instruction::CallResetSCCBlock => { + self.reset_scc_block(); + step_or_fail!(self, self.machine_st.p += 1); + } + &Instruction::ExecuteResetSCCBlock => { + self.reset_scc_block(); + step_or_fail!(self, self.machine_st.p = self.machine_st.cp); + } &Instruction::CallReturnFromVerifyAttr | &Instruction::ExecuteReturnFromVerifyAttr => { self.return_from_verify_attr(); diff --git a/src/machine/machine_state.rs b/src/machine/machine_state.rs index 5ef74003..2d62d368 100644 --- a/src/machine/machine_state.rs +++ b/src/machine/machine_state.rs @@ -73,11 +73,12 @@ pub struct MachineState { pub(super) tr: usize, pub(super) hb: usize, pub(super) block: usize, // an offset into the OR stack. + pub(super) scc_block: usize, // an offset into the OR stack for setup_call_cleanup/3. pub(super) ball: Ball, pub(super) ball_stack: Vec, // save current ball before jumping via, e.g., verify_attr interrupt. pub(super) lifted_heap: Heap, pub(super) interms: Vec, // intermediate numbers. - // locations of cleaners, cut points, the previous block. for setup_call_cleanup. + // locations of cleaners, cut points, the previous scc_block. for setup_call_cleanup/3. pub(super) cont_pts: Vec<(HeapCellValue, usize, usize)>, pub(super) cwil: CWIL, pub(crate) flags: MachineFlags, @@ -112,6 +113,7 @@ impl fmt::Debug for MachineState { .field("tr", &self.tr) .field("hb", &self.hb) .field("block", &self.block) + .field("scc_block", &self.scc_block) .field("ball", &self.ball) .field("ball_stack", &self.ball_stack) .field("lifted_heap", &self.lifted_heap) diff --git a/src/machine/machine_state_impl.rs b/src/machine/machine_state_impl.rs index 5cc07b1f..436641cd 100644 --- a/src/machine/machine_state_impl.rs +++ b/src/machine/machine_state_impl.rs @@ -47,6 +47,7 @@ impl MachineState { tr: 0, hb: 0, block: 0, + scc_block: 0, ball: Ball::new(), ball_stack: vec![], lifted_heap: Heap::new(), @@ -328,6 +329,11 @@ impl MachineState { unifier.unify_internal(); } + #[inline(always)] + pub(super) fn effective_block(&self) -> usize { + std::cmp::max(self.block, self.scc_block) + } + pub(super) fn set_ball(&mut self) { self.ball.reset(); @@ -341,8 +347,9 @@ impl MachineState { ); } + #[inline(always)] pub(super) fn unwind_stack(&mut self) { - self.b = self.block; + self.b = self.effective_block(); self.fail = true; } @@ -1437,17 +1444,6 @@ impl MachineState { .unwrap_or(true) } - pub fn reset_block(&mut self, addr: HeapCellValue) { - read_heap_cell!(self.store(addr), - (HeapCellValueTag::Fixnum, n) => { - self.block = n.get_num() as usize; - } - _ => { - self.fail = true; - } - ) - } - #[inline(always)] fn try_functor_compound_case(&mut self, name: Atom, arity: usize) { self.try_functor_unify_components(atom_as_cell!(name), arity); diff --git a/src/machine/mod.rs b/src/machine/mod.rs index ddf64d34..add3be4e 100644 --- a/src/machine/mod.rs +++ b/src/machine/mod.rs @@ -828,7 +828,7 @@ impl Machine { if let Some(&(_, b_cutoff, prev_block)) = self.machine_st.cont_pts.last() { if self.machine_st.b < b_cutoff { - let (idx, arity) = if self.machine_st.block > prev_block { + let (idx, arity) = if self.machine_st.effective_block() > prev_block { (r_c_w_h, 0) } else { self.machine_st.registers[1] = fixnum_as_cell!( diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 9fef738c..20b1e330 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -802,7 +802,7 @@ impl MachineState { unify_fn!(*self, list_of_vars, outcome); } - #[inline] + #[inline(always)] pub(crate) fn install_new_block(&mut self, value: HeapCellValue) -> usize { let value = self.store(self.deref(value)); @@ -5160,18 +5160,18 @@ impl Machine { pub(crate) fn get_scc_cleaner(&mut self) { let dest = self.machine_st.registers[1]; - if let Some((addr, b_cutoff, prev_b)) = self.machine_st.cont_pts.pop() { + if let Some((addr, b_cutoff, prev_block)) = self.machine_st.cont_pts.pop() { let b = self.machine_st.stack.index_or_frame(self.machine_st.b).prelude.b; if b <= b_cutoff { - self.machine_st.block = prev_b; + self.machine_st.scc_block = prev_block; if let Some(r) = dest.as_var() { self.machine_st.bind(r, addr); return; } } else { - self.machine_st.cont_pts.push((addr, b_cutoff, prev_b)); + self.machine_st.cont_pts.push((addr, b_cutoff, prev_block)); } } @@ -5203,11 +5203,11 @@ impl Machine { pub(crate) fn install_scc_cleaner(&mut self) { let addr = self.machine_st.registers[1]; let b = self.machine_st.b; - let prev_block = self.machine_st.block; + let prev_block = self.machine_st.scc_block; self.machine_st.run_cleaners_fn = Machine::run_cleaners; - self.machine_st.install_new_block(self.machine_st.registers[2]); + self.machine_st.scc_block = b; self.machine_st.cont_pts.push((addr, b, prev_block)); } @@ -5574,8 +5574,18 @@ impl Machine { #[inline(always)] pub(crate) fn get_current_block(&mut self) { - let n = Fixnum::build_with(i64::try_from(self.machine_st.block).unwrap()); - self.machine_st.unify_fixnum(n, self.machine_st.registers[1]); + let addr = self.machine_st.registers[1]; + let block = Fixnum::build_with(self.machine_st.block as i64); + + self.machine_st.unify_fixnum(block, addr); + } + + #[inline(always)] + pub(crate) fn get_current_scc_block(&mut self) { + let addr = self.machine_st.registers[1]; + let block = Fixnum::build_with(self.machine_st.scc_block as i64); + + self.machine_st.unify_fixnum(block, addr); } #[inline(always)] @@ -5782,8 +5792,30 @@ impl Machine { #[inline(always)] pub(crate) fn reset_block(&mut self) { - let addr = self.machine_st.deref(self.machine_st.registers[1]); - self.machine_st.reset_block(addr); + let addr = self.deref_register(1); + + read_heap_cell!(addr, + (HeapCellValueTag::Fixnum, block) => { + self.machine_st.block = block.get_num() as usize; + } + _ => { + self.machine_st.fail = true; + } + ); + } + + #[inline(always)] + pub(crate) fn reset_scc_block(&mut self) { + let addr = self.deref_register(1); + + read_heap_cell!(addr, + (HeapCellValueTag::Fixnum, block) => { + self.machine_st.scc_block = block.get_num() as usize; + } + _ => { + self.machine_st.fail = true; + } + ); } #[inline(always)] diff --git a/src/parser/ast.rs b/src/parser/ast.rs index 272d5b7e..6ac5d05e 100644 --- a/src/parser/ast.rs +++ b/src/parser/ast.rs @@ -502,6 +502,12 @@ impl Fixnum { .with_f(false) } + #[inline] + pub fn get_tag(&self) -> HeapCellValueTag { + use modular_bitfield::Specifier; + HeapCellValueTag::from_bytes(self.tag()).unwrap() + } + #[inline] pub fn build_with_checked(num: i64) -> Result { const UPPER_BOUND: i64 = (1 << 55) - 1; -- 2.54.0