Skip to content

Commit

Permalink
add and document inlined_instructions/2 to/in diag.pl (#1791)
Browse files Browse the repository at this point in the history
  • Loading branch information
@mthom
mthom committed Apr 22, 2023
1 parent 198e925 commit 58a8fa9
Show file tree
Hide file tree
Showing 4 changed files with 189 additions and 37 deletions.
10 changes: 7 additions & 3 deletions build/instructions_template.rs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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")))]
Expand Down Expand Up @@ -1747,6 +1749,7 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::CallUnwindEnvironments(_) |
&Instruction::CallUnwindStack(_) |
&Instruction::CallWAMInstructions(_) |
&Instruction::CallInlinedInstructions(_) |
&Instruction::CallWriteTerm(_) |
&Instruction::CallWriteTermToChars(_) |
&Instruction::CallScryerPrologVersion(_) |
Expand Down Expand Up @@ -1933,9 +1936,9 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::ExecuteHttpListen(_) |
&Instruction::ExecuteHttpAccept(_) |
&Instruction::ExecuteHttpAnswer(_) |
&Instruction::ExecuteLoadForeignLib(_) |
&Instruction::ExecuteForeignCall(_) |
&Instruction::ExecuteDefineForeignStruct(_) |
&Instruction::ExecuteLoadForeignLib(_) |
&Instruction::ExecuteForeignCall(_) |
&Instruction::ExecuteDefineForeignStruct(_) |
&Instruction::ExecutePredicateDefined(_) |
&Instruction::ExecuteStripModule(_) |
&Instruction::ExecuteCurrentTime(_) |
Expand Down Expand Up @@ -1967,6 +1970,7 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::ExecuteUnwindEnvironments(_) |
&Instruction::ExecuteUnwindStack(_) |
&Instruction::ExecuteWAMInstructions(_) |
&Instruction::ExecuteInlinedInstructions(_) |
&Instruction::ExecuteWriteTerm(_) |
&Instruction::ExecuteWriteTermToChars(_) |
&Instruction::ExecuteScryerPrologVersion(_) |
Expand Down
122 changes: 121 additions & 1 deletion src/lib/diag.pl
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
:- module(diag, [wam_instructions/2]).
:- module(diag, [wam_instructions/2, inlined_instructions/2]).

/** Diagnostics library
Expand Down Expand Up @@ -33,6 +33,120 @@
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(...),...].
```
*/


Expand All @@ -52,6 +166,12 @@
; throw(error(instantiation_error, wam_instructions/2))
).

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),
Expand Down
8 changes: 8 additions & 0 deletions src/machine/dispatch.rs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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);
Expand Down
86 changes: 53 additions & 33 deletions src/machine/system_calls.rs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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));
Expand Down Expand Up @@ -6318,45 +6355,28 @@ impl Machine {
}
};

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)]
Expand Down

0 comments on commit 58a8fa9

Please sign in to comment.