cache ball terms before unifying in handle_ball/3 (#1608)

diff --git a/build/instructions_template.rs b/build/instructions_template.rs
index 3622074efe9c1c5333e7188e9d4965387427fc69..bc1ca7030b4f3dc5d4a5ea1307f3f2c88d0a89ef 100644 (file)
--- a/build/instructions_template.rs
+++ b/build/instructions_template.rs
@@ -404,8 +404,6 @@ enum SystemClauseType {
     InferenceLevel,
     #[strum_discriminants(strum(props(Arity = "1", Name = "$clean_up_block")))]
     CleanUpBlock,
-    #[strum_discriminants(strum(props(Arity = "0", Name = "$erase_ball")))]
-    EraseBall,
     #[strum_discriminants(strum(props(Arity = "0", Name = "$fail")))]
     Fail,
     #[strum_discriminants(strum(props(Arity = "1", Name = "$get_ball")))]
@@ -434,6 +432,12 @@ enum SystemClauseType {
     ReturnFromVerifyAttr,
     #[strum_discriminants(strum(props(Arity = "1", Name = "$set_ball")))]
     SetBall,
+    #[strum_discriminants(strum(props(Arity = "0", Name = "$push_ball_stack")))]
+    PushBallStack,
+    #[strum_discriminants(strum(props(Arity = "0", Name = "$pop_ball_stack")))]
+    PopBallStack,
+    #[strum_discriminants(strum(props(Arity = "0", Name = "$pop_from_ball_stack")))]
+    PopFromBallStack,
     #[strum_discriminants(strum(props(Arity = "1", Name = "$set_cp_by_default")))]
     SetCutPointByDefault(RegType),
     #[strum_discriminants(strum(props(Arity = "1", Name = "$set_double_quotes")))]
@@ -1680,7 +1684,6 @@ fn generate_instruction_preface() -> TokenStream {
                     &Instruction::CallSetStreamPosition(_) |
                     &Instruction::CallInferenceLevel(_) |
                     &Instruction::CallCleanUpBlock(_) |
-                    &Instruction::CallEraseBall(_) |
                     &Instruction::CallFail(_) |
                     &Instruction::CallGetBall(_) |
                     &Instruction::CallGetCurrentBlock(_) |
@@ -1703,6 +1706,9 @@ fn generate_instruction_preface() -> TokenStream {
                     &Instruction::CallResetBlock(_) |
                     &Instruction::CallReturnFromVerifyAttr(_) |
                     &Instruction::CallSetBall(_) |
+                    &Instruction::CallPushBallStack(_) |
+                    &Instruction::CallPopBallStack(_) |
+                    &Instruction::CallPopFromBallStack(_) |
                     &Instruction::CallSetCutPointByDefault(..) |
                     &Instruction::CallSetDoubleQuotes(_) |
                     &Instruction::CallSetSeed(_) |
@@ -1892,7 +1898,6 @@ fn generate_instruction_preface() -> TokenStream {
                     &Instruction::ExecuteSetStreamPosition(_) |
                     &Instruction::ExecuteInferenceLevel(_) |
                     &Instruction::ExecuteCleanUpBlock(_) |
-                    &Instruction::ExecuteEraseBall(_) |
                     &Instruction::ExecuteFail(_) |
                     &Instruction::ExecuteGetBall(_) |
                     &Instruction::ExecuteGetCurrentBlock(_) |
@@ -1915,6 +1920,9 @@ fn generate_instruction_preface() -> TokenStream {
                     &Instruction::ExecuteResetBlock(_) |
                     &Instruction::ExecuteReturnFromVerifyAttr(_) |
                     &Instruction::ExecuteSetBall(_) |
+                    &Instruction::ExecutePushBallStack(_) |
+                    &Instruction::ExecutePopBallStack(_) |
+                    &Instruction::ExecutePopFromBallStack(_) |
                     &Instruction::ExecuteSetCutPointByDefault(_, _) |
                     &Instruction::ExecuteSetDoubleQuotes(_) |
                     &Instruction::ExecuteSetSeed(_) |

diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl
index a0df16bfbb8eb83459800c2219d0eb1f6656e1d9..8d7c020e74eb1dbe77f1ff214c1209647d602e42 100644 (file)
--- a/src/lib/builtins.pl
+++ b/src/lib/builtins.pl
@@ -644,6 +644,7 @@ catch(G,C,R,Bb) :-
 catch(G,C,R,Bb) :-
     '$reset_block'(Bb),
     '$get_ball'(Ball),
+    '$push_ball_stack', % move ball to ball stack.
     handle_ball(Ball, C, R).
 
 
@@ -660,9 +661,10 @@ end_block(Bb, NBb) :-
 
 handle_ball(C, C, R) :-
     !,
-    '$erase_ball',
+    '$pop_ball_stack', % remove ball from ball stack.
     call(R).
 handle_ball(_, _, _) :-
+    '$pop_from_ball_stack', % restore ball from ball stack.
     '$unwind_stack'.
 
 :- non_counted_backtracking throw/1.

diff --git a/src/lib/iso_ext.pl b/src/lib/iso_ext.pl
index b9dc1040fdd6b8305733e140ebd66fae55c6b738..1078cb27a1348ac1c09aa299454af4f66906fc03 100644 (file)
--- a/src/lib/iso_ext.pl
+++ b/src/lib/iso_ext.pl
@@ -75,19 +75,19 @@ scc_helper(C, G, Bb) :-
     '$get_cp'(Cp),
     '$install_scc_cleaner'(C, NBb),
     '$call_with_inference_counting'(call(G)),
-    ( '$check_cp'(Cp) ->
-      '$reset_block'(Bb),
-      run_cleaners_without_handling(Cp)
-    ; true
-    ; '$reset_block'(NBb),
-      '$fail'
+    (  '$check_cp'(Cp) ->
+       '$reset_block'(Bb),
+       run_cleaners_without_handling(Cp)
+    ;  true
+    ;  '$reset_block'(NBb),
+       '$fail'
     ).
 scc_helper(_, _, Bb) :-
     '$reset_block'(Bb),
-    '$get_ball'(Ball),
-    '$erase_ball',
+    '$push_ball_stack',
     run_cleaners_with_handling,
-    throw(Ball).
+    '$pop_from_ball_stack',
+    '$unwind_stack'.
 scc_helper(_, _, _) :-
     '$get_cp'(Cp),
     run_cleaners_without_handling(Cp),
@@ -130,10 +130,13 @@ end_block(B, _Bb, NBb, L) :-
 
 :- non_counted_backtracking handle_ile/3.
 
-handle_ile(B, inference_limit_exceeded(B), inference_limit_exceeded) :- !.
-handle_ile(B, E, _) :-
+handle_ile(B, inference_limit_exceeded(B), inference_limit_exceeded) :-
+    !,
+    '$pop_ball_stack'.
+handle_ile(B, _, _) :-
     '$remove_call_policy_check'(B),
-    throw(E).
+    '$pop_from_ball_stack',
+    '$unwind_stack'.
 
 :- meta_predicate(call_with_inference_limit(0, ?, ?)).
 
@@ -167,18 +170,18 @@ call_with_inference_limit(G, L, R, Bb, B) :-
     '$call_with_inference_counting'(call(G)),
     '$inference_level'(R, B),
     '$remove_inference_counter'(B, Count1),
-    is(Diff, L - (Count1 - Count0)),
+    Diff is L - (Count1 - Count0),
     end_block(B, Bb, NBb, Diff).
 call_with_inference_limit(_, _, R, Bb, B) :-
     '$reset_block'(Bb),
     '$remove_inference_counter'(B, _),
     (  '$get_ball'(Ball),
+       '$push_ball_stack',
        '$get_level'(Cp),
        '$set_cp_by_default'(Cp)
     ;  '$remove_call_policy_check'(B),
        '$fail'
     ),
-    '$erase_ball',
     handle_ile(B, Ball, R).
 
 partial_string(String, L, L0) :-

diff --git a/src/loader.pl b/src/loader.pl
index d276ae309b6df5f3ec76b765e9be3de40c80ff57..fe3d6fe25f80460e11844cb7d7024c3f3c7d9941 100644 (file)
--- a/src/loader.pl
+++ b/src/loader.pl
@@ -32,9 +32,9 @@ write_error(Error) :-
     ),
     write('.').
 
-'$print_message_and_fail'(inference_limit_exceeded(B)) :-
-    integer(B),
-    throw(inference_limit_exceeded(B)).
+% '$print_message_and_fail'(inference_limit_exceeded(B)) :-
+%     integer(B),
+%     throw(inference_limit_exceeded(B)).
 '$print_message_and_fail'(Error) :-
     write_error(Error),
     nl,

diff --git a/src/machine/dispatch.rs b/src/machine/dispatch.rs
index 39afe10ee3bc8f8429593d41aefbf2902c81b419..ee57a83ef86def43da17e4d73075a281a236097d 100644 (file)
--- a/src/machine/dispatch.rs
+++ b/src/machine/dispatch.rs
@@ -4125,14 +4125,6 @@ impl Machine {
                     self.clean_up_block();
                     self.machine_st.p = self.machine_st.cp;
                 }
-                &Instruction::CallEraseBall(_) => {
-                    self.erase_ball();
-                    self.machine_st.p += 1;
-                }
-                &Instruction::ExecuteEraseBall(_) => {
-                    self.erase_ball();
-                    self.machine_st.p = self.machine_st.cp;
-                }
                 &Instruction::CallFail(_) | &Instruction::ExecuteFail(_) => {
                     self.machine_st.backtrack();
                 }
@@ -4284,6 +4276,30 @@ impl Machine {
                     self.set_ball();
                     self.machine_st.p = self.machine_st.cp;
                 }
+                &Instruction::CallPushBallStack(_) => {
+                    self.push_ball_stack();
+                    step_or_fail!(self, self.machine_st.p += 1);
+                }
+                &Instruction::ExecutePushBallStack(_) => {
+                    self.push_ball_stack();
+                    step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
+                }
+                &Instruction::CallPopBallStack(_) => {
+                    self.pop_ball_stack();
+                    self.machine_st.p += 1;
+                }
+                &Instruction::ExecutePopBallStack(_) => {
+                    self.pop_ball_stack();
+                    self.machine_st.p = self.machine_st.cp;
+                }
+                &Instruction::CallPopFromBallStack(_) => {
+                    self.pop_from_ball_stack();
+                    self.machine_st.p += 1;
+                }
+                &Instruction::ExecutePopFromBallStack(_) => {
+                    self.pop_from_ball_stack();
+                    self.machine_st.p = self.machine_st.cp;
+                }
                 &Instruction::CallSetCutPointByDefault(r, _) => {
                     self.set_cut_point_by_default(r);
                     step_or_fail!(self, self.machine_st.p += 1);
@@ -4970,11 +4986,11 @@ impl Machine {
                 }
                 &Instruction::CallPredicateDefined(_) => {
                     self.machine_st.fail = !self.predicate_defined();
-                    self.machine_st.p += 1;
+                    step_or_fail!(self, self.machine_st.p += 1);
                 }
                 &Instruction::ExecutePredicateDefined(_) => {
                     self.machine_st.fail = !self.predicate_defined();
-                    self.machine_st.p = self.machine_st.cp;
+                    step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
                 }
                 &Instruction::CallStripModule(_) => {
                     let (module_loc, qualified_goal) = self.machine_st.strip_module(

diff --git a/src/machine/machine_state.rs b/src/machine/machine_state.rs
index 1d4be14a034e664e4c00ec741b5a4732e2aa021c..6aa5191674f0344bb9c8706a23e7316d079a01eb 100644 (file)
--- a/src/machine/machine_state.rs
+++ b/src/machine/machine_state.rs
@@ -75,6 +75,7 @@ pub struct MachineState {
     pub(super) hb: usize,
     pub(super) block: usize, // an offset into the OR stack.
     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.
@@ -113,6 +114,7 @@ impl fmt::Debug for MachineState {
             .field("hb", &self.hb)
             .field("block", &self.block)
             .field("ball", &self.ball)
+            .field("ball_stack", &self.ball_stack)
             .field("lifted_heap", &self.lifted_heap)
             .field("interms", &self.interms)
             .field("flags", &self.flags)

diff --git a/src/machine/machine_state_impl.rs b/src/machine/machine_state_impl.rs
index b72b9cfed0440954deb86778a7cff870b0698277..00e17649ce139db5041b27a3a724935cbebd88ab 100644 (file)
--- a/src/machine/machine_state_impl.rs
+++ b/src/machine/machine_state_impl.rs
@@ -47,6 +47,7 @@ impl MachineState {
             hb: 0,
             block: 0,
             ball: Ball::new(),
+            ball_stack: vec![],
             lifted_heap: Heap::new(),
             interms: vec![Number::default();256],
             cont_pts: Vec::with_capacity(256),

diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs
index dd2b5bf4a5c19f0c45bc7e7fb8b0fab18041d459..b154e266a591657356376cd515f72e343e719d78 100644 (file)
--- a/src/machine/system_calls.rs
+++ b/src/machine/system_calls.rs
@@ -4804,11 +4804,6 @@ impl Machine {
         }
     }
 
-    #[inline(always)]
-    pub(crate) fn erase_ball(&mut self) {
-        self.machine_st.ball.reset();
-    }
-
     #[inline(always)]
     pub(crate) fn get_ball(&mut self) {
         let addr = self.machine_st.store(self.machine_st.deref(self.machine_st.registers[1]));
@@ -4828,6 +4823,29 @@ impl Machine {
         };
     }
 
+    #[inline(always)]
+    pub(crate) fn push_ball_stack(&mut self) {
+        if self.machine_st.ball.stub.len() > 0 {
+            self.machine_st.ball_stack.push(
+                mem::replace(&mut self.machine_st.ball, Ball::new())
+            );
+        } else {
+            self.machine_st.fail = true;
+        }
+    }
+
+    #[inline(always)]
+    pub(crate) fn pop_ball_stack(&mut self) {
+        self.machine_st.ball_stack.pop();
+    }
+
+    #[inline(always)]
+    pub(crate) fn pop_from_ball_stack(&mut self) {
+        if let Some(ball) = self.machine_st.ball_stack.pop() {
+            self.machine_st.ball = ball;
+        }
+    }
+
     #[inline(always)]
     pub(crate) fn get_current_block(&mut self) {
         let n = Fixnum::build_with(i64::try_from(self.machine_st.block).unwrap());