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")))]
&Instruction::CallUnwindEnvironments(_) |
&Instruction::CallUnwindStack(_) |
&Instruction::CallWAMInstructions(_) |
+ &Instruction::CallInlinedInstructions(_) |
&Instruction::CallWriteTerm(_) |
&Instruction::CallWriteTermToChars(_) |
&Instruction::CallScryerPrologVersion(_) |
&Instruction::ExecuteHttpListen(_) |
&Instruction::ExecuteHttpAccept(_) |
&Instruction::ExecuteHttpAnswer(_) |
- &Instruction::ExecuteLoadForeignLib(_) |
- &Instruction::ExecuteForeignCall(_) |
- &Instruction::ExecuteDefineForeignStruct(_) |
+ &Instruction::ExecuteLoadForeignLib(_) |
+ &Instruction::ExecuteForeignCall(_) |
+ &Instruction::ExecuteDefineForeignStruct(_) |
&Instruction::ExecutePredicateDefined(_) |
&Instruction::ExecuteStripModule(_) |
&Instruction::ExecuteCurrentTime(_) |
&Instruction::ExecuteUnwindEnvironments(_) |
&Instruction::ExecuteUnwindStack(_) |
&Instruction::ExecuteWAMInstructions(_) |
+ &Instruction::ExecuteInlinedInstructions(_) |
&Instruction::ExecuteWriteTerm(_) |
&Instruction::ExecuteWriteTermToChars(_) |
&Instruction::ExecuteScryerPrologVersion(_) |
-:- module(diag, [wam_instructions/2]).
+:- module(diag, [wam_instructions/2, inlined_instructions/2]).
/** Diagnostics library
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(...),...].
+```
*/
; 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),
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);
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));
}
};
- let mut h = self.machine_st.heap.len();
-
- 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();
+ let listing = self.walk_code_at_ptr(first_idx);
+ let listing_var = self.machine_st.registers[4];
- for index in old_len..new_len {
- let functor_len = functors[index].len();
+ unify!(self.machine_st, listing, listing_var);
+ Ok(())
+ }
- 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;
- }
- }
+ #[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!()
}
- });
-
- 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];
+ let listing = self.walk_code_at_ptr(index_ptr);
+ let listing_var = self.machine_st.registers[2];
unify!(self.machine_st, listing, listing_var);
- Ok(())
}
#[inline(always)]
projects / scryer-prolog.git / commitdiff