add scc_block to MachineState to avoid SCC cleanup terms being deallocated too early (#1427)

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 |

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',

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();

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<Ball>, // save current ball before jumping via, e.g., verify_attr interrupt.
     pub(super) lifted_heap: Heap,
     pub(super) interms: Vec<Number>, // 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)

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);

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!(

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());
+        let addr = self.machine_st.registers[1];
-        self.machine_st.unify_fixnum(n, 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]);
+        let addr = self.deref_register(1);
-        self.machine_st.reset_block(addr);
+
+        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)]

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<Self, OutOfBounds> {
         const UPPER_BOUND: i64 = (1 << 55) - 1;