rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Mark
2023-04-22 17:13:24 -06:00
parent 198e925430
commit f35298a227
4 changed files with 195 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
build/instructions_template.rs
View File

@@ -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::ExecuteForeignCall(_) |
&Instruction::ExecuteDefineForeignStruct(_) |
&Instruction::ExecuteLoadForeignLib(_) |
&Instruction::ExecuteForeignCall(_) |
&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(_) |

126
src/lib/diag.pl
View File

@@ -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),

8
src/machine/dispatch.rs
View File

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

90
src/machine/system_calls.rs
View File

@@ -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 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 = self.walk_code_at_ptr(first_idx);
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(