add and document inlined_instructions/2 to/in diag.pl (#1791)

build/instructions_template.rs

@@ -470,6 +470,8 @@ enum SystemClauseType {
     UnwindStack,
     #[strum_discriminants(strum(props(Arity = "4", Name = "$wam_instructions")))]
     WAMInstructions,
+    #[strum_discriminants(strum(props(Arity = "2", Name = "$inlined_instructions")))]
+    InlinedInstructions,
     #[strum_discriminants(strum(props(Arity = "7", Name = "$write_term")))]
     WriteTerm,
     #[strum_discriminants(strum(props(Arity = "7", Name = "$write_term_to_chars")))]
@@ -1747,6 +1749,7 @@ fn generate_instruction_preface() -> TokenStream {
                     &Instruction::CallUnwindEnvironments(_) |
                     &Instruction::CallUnwindStack(_) |
                     &Instruction::CallWAMInstructions(_) |
+                    &Instruction::CallInlinedInstructions(_) |
                     &Instruction::CallWriteTerm(_) |
                     &Instruction::CallWriteTermToChars(_) |
                     &Instruction::CallScryerPrologVersion(_) |
@@ -1933,9 +1936,9 @@ fn generate_instruction_preface() -> TokenStream {
                     &Instruction::ExecuteHttpListen(_) |
                     &Instruction::ExecuteHttpAccept(_) |
                     &Instruction::ExecuteHttpAnswer(_) |
-		    &Instruction::ExecuteLoadForeignLib(_) |
+		            &Instruction::ExecuteLoadForeignLib(_) |
-		    &Instruction::ExecuteForeignCall(_) |
+		            &Instruction::ExecuteForeignCall(_) |
-		    &Instruction::ExecuteDefineForeignStruct(_) |
+		            &Instruction::ExecuteDefineForeignStruct(_) |
                     &Instruction::ExecutePredicateDefined(_) |
                     &Instruction::ExecuteStripModule(_) |
                     &Instruction::ExecuteCurrentTime(_) |
@@ -1967,6 +1970,7 @@ fn generate_instruction_preface() -> TokenStream {
                     &Instruction::ExecuteUnwindEnvironments(_) |
                     &Instruction::ExecuteUnwindStack(_) |
                     &Instruction::ExecuteWAMInstructions(_) |
+                    &Instruction::ExecuteInlinedInstructions(_) |
                     &Instruction::ExecuteWriteTerm(_) |
                     &Instruction::ExecuteWriteTermToChars(_) |
                     &Instruction::ExecuteScryerPrologVersion(_) |

src/lib/diag.pl

@@ -1,4 +1,4 @@
-:- module(diag, [wam_instructions/2]).
+:- module(diag, [wam_instructions/2, inlined_instructions/2]).
 
 /** Diagnostics library
 
@@ -33,6 +33,120 @@ unify_variable(x(3)).
 execute(append,3).
    Is = [switch_on_term(1,external(1),external(2),external(6),fail)|...].
 ```
+
+  `inlined_instructions/2` decompiles predicates at the code offset in
+  its first argument.
+
+  For example, given the program
+
+```
+?- [user].
+:- use_module(library(clpz)).
+
+all_eq(Vs, E) :- maplist(#=(E), Vs).
+
+```
+
+  we inspect the code of `all_eqs/2` using `wam_instructions/2`,
+  revealing:
+
+```
+?- wam_instructions(all_eq/2, Is),
+   maplist(portray_clause, Is).
+put_structure('$aux',2,x(3)).
+set_local_value(x(2)).
+set_void(1).
+set_constant('$index_ptr'(115334)).
+get_variable(x(4),1).
+put_structure(:,2,x(1)).
+set_constant(user).
+set_local_value(x(3)).
+get_variable(x(5),2).
+put_value(x(4),2).
+execute(maplist,2).
+   Is = [put_structure('$aux',2,x(3)),set_local_value(x(2)),set_void(1),set_constant('$index_ptr'(115334)),get_variable(x(4),1),put_structure(:,2,x(1)),set_constant(user),set_local_value(x(3)),get_variable(x(5),2),put_value(x(4),2),execute(maplist,2)].
+```
+
+  The `'$index_ptr(115334)` functor gives a code offset to an inlined
+  predicate compiled for the use of maplist/2. `inlined_instructions/2`
+  can be used to decompile its source code:
+
+```
+?- inlined_instructions(115334, Is),
+   maplist(portray_clause, Is).
+allocate(1).
+get_level(y(1)).
+get_variable(x(5),2).
+put_value(x(3),2).
+get_variable(x(6),3).
+put_value(x(5),3).
+put_unsafe_value(1,4).
+deallocate.
+jmp_by_execute(1).
+try_me_else(8).
+call(integer,1).
+neck_cut.
+get_variable(x(5),1).
+put_value(x(2),1).
+get_variable(x(6),2).
+put_value(x(5),2).
+jmp_by_execute(7).
+try_me_else(12).
+allocate(3).
+get_level(y(1)).
+get_variable(y(3),1).
+get_variable(y(2),2).
+call_default(true,0).
+call(var,1).
+cut(y(1)).
+put_unsafe_value(3,1).
+put_unsafe_value(2,2).
+deallocate.
+execute_default(is,2).
+default_retry_me_else(4).
+call(integer,1).
+neck_cut.
+execute(=:=,2).
+default_trust_me(0).
+allocate(2).
+get_variable(y(1),1).
+get_variable(y(2),3).
+put_value(y(2),1).
+call_default(is,2).
+put_unsafe_value(2,1).
+put_unsafe_value(1,2).
+deallocate.
+execute_default(clpz_equal,2).
+default_retry_me_else(4).
+call(integer,1).
+neck_cut.
+jmp_by_execute(29).
+try_me_else(12).
+allocate(3).
+get_level(y(1)).
+get_variable(y(3),1).
+get_variable(y(2),2).
+call_default(true,0).
+call(var,1).
+cut(y(1)).
+put_unsafe_value(3,1).
+put_unsafe_value(2,2).
+deallocate.
+execute_default(is,2).
+default_trust_me(0).
+allocate(2).
+get_variable(y(2),1).
+get_variable(y(1),3).
+put_value(y(1),1).
+call_default(is,2).
+put_unsafe_value(2,1).
+put_unsafe_value(1,2).
+deallocate.
+execute_default(clpz_equal,2).
+default_trust_me(0).
+execute_default(clpz_equal,2).
+   Is = [allocate(1),get_level(y(1)),get_variable(x(5),2),put_value(x(3),2),get_variable(x(6),3),put_value(x(5),3),put_unsafe_value(1,4),deallocate,jmp_by_execute(1),try_me_else(8),call(integer,1),neck_cut,get_variable(x(5),1),put_value(x(2),1),get_variable(x(6),2),put_value(x(5),2),jmp_by_execute(7),try_me_else(12),allocate(3),get_level(...),...].
+```
 */
 
 
@@ -52,6 +166,16 @@ wam_instructions(Clause, Listing) :-
     ;  throw(error(instantiation_error, wam_instructions/2))
     ).
 
+%% inlined_instructions(+IndexPtr, -Instrs)
+%
+%  _Instrs_ are the WAM instructions corresponding to code offset _IndexPtr_.
+
+inlined_instructions(IndexPtr, Listing) :-
+    must_be(integer, IndexPtr),
+    (  IndexPtr >= 0 ->
+       '$inlined_instructions'(IndexPtr, Listing)
+    ;  throw(error(domain_error(not_less_than_zero, IndexPtr), inlined_instructions/2))
+    ).
 
 fetch_instructions(Module, Name, Arity, Listing) :-
     must_be(atom, Module),

src/machine/dispatch.rs

@@ -4445,6 +4445,14 @@ impl Machine {
                     try_or_throw!(self.machine_st, self.wam_instructions());
                     step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
                 }
+                &Instruction::CallInlinedInstructions(_) => {
+                    self.inlined_instructions();
+                    self.machine_st.p += 1;
+                }
+                &Instruction::ExecuteInlinedInstructions(_) => {
+                    self.inlined_instructions();
+                    self.machine_st.p = self.machine_st.cp;
+                }
                 &Instruction::CallWriteTerm(_) => {
                     try_or_throw!(self.machine_st, self.write_term());
                     step_or_fail!(self, self.machine_st.p += 1);

src/machine/system_calls.rs

@@ -6267,6 +6267,43 @@ impl Machine {
         false
     }
 
+    fn walk_code_at_ptr(&mut self, index_ptr: usize) -> HeapCellValue {
+        let mut h = self.machine_st.heap.len();
+
+        let mut functors = vec![];
+        let mut functor_list = vec![];
+
+        walk_code(&self.code, index_ptr, |instr| {
+            let old_len = functors.len();
+            instr.enqueue_functors(h, &mut self.machine_st.arena, &mut functors);
+            let new_len = functors.len();
+
+            for index in old_len..new_len {
+                let functor_len = functors[index].len();
+
+                match functor_len {
+                    0 => {}
+                    1 => {
+                        functor_list.push(heap_loc_as_cell!(h));
+                        h += functor_len;
+                    }
+                    _ => {
+                        functor_list.push(str_loc_as_cell!(h));
+                        h += functor_len;
+                    }
+                }
+            }
+        });
+
+        for functor in functors {
+            self.machine_st.heap.extend(functor.into_iter());
+        }
+
+        heap_loc_as_cell!(
+            iter_to_heap_list(&mut self.machine_st.heap, functor_list.into_iter())
+        )
+    }
+
     #[inline(always)]
     pub(crate) fn wam_instructions(&mut self) -> CallResult {
         let module_name = cell_as_atom!(self.deref_register(1));
@@ -6318,47 +6355,30 @@ impl Machine {
             }
         };
 
-        let mut h = self.machine_st.heap.len();
+        let listing = self.walk_code_at_ptr(first_idx);
-
-        let mut functors = vec![];
-        let mut functor_list = vec![];
-
-        walk_code(&self.code, first_idx, |instr| {
-            let old_len = functors.len();
-            instr.enqueue_functors(h, &mut self.machine_st.arena, &mut functors);
-            let new_len = functors.len();
-
-            for index in old_len..new_len {
-                let functor_len = functors[index].len();
-
-                match functor_len {
-                    0 => {}
-                    1 => {
-                        functor_list.push(heap_loc_as_cell!(h));
-                        h += functor_len;
-                    }
-                    _ => {
-                        functor_list.push(str_loc_as_cell!(h));
-                        h += functor_len;
-                    }
-                }
-            }
-        });
-
-        for functor in functors {
-            self.machine_st.heap.extend(functor.into_iter());
-        }
-
-        let listing = heap_loc_as_cell!(
-            iter_to_heap_list(&mut self.machine_st.heap, functor_list.into_iter())
-        );
-
         let listing_var = self.machine_st.registers[4];
 
         unify!(self.machine_st, listing, listing_var);
         Ok(())
     }
 
+    #[inline(always)]
+    pub(crate) fn inlined_instructions(&mut self) {
+        let index_ptr = self.deref_register(1);
+        let index_ptr = match Number::try_from(index_ptr) {
+            Ok(Number::Fixnum(n)) => n.get_num() as usize,
+            Ok(Number::Integer(n)) => n.to_usize().unwrap(),
+            _ => {
+                unreachable!()
+            }
+        };
+
+        let listing = self.walk_code_at_ptr(index_ptr);
+        let listing_var = self.machine_st.registers[2];
+
+        unify!(self.machine_st, listing, listing_var);
+    }
+
     #[inline(always)]
     pub(crate) fn write_term(&mut self) -> CallResult {
         let mut stream = self.machine_st.get_stream_or_alias(