From f35298a2277ad95f433a363dca139786c4f62392 Mon Sep 17 00:00:00 2001 From: Mark Date: Sat, 22 Apr 2023 17:13:24 -0600 Subject: [PATCH] add and document inlined_instructions/2 to/in diag.pl (#1791) --- build/instructions_template.rs | 10 ++- src/lib/diag.pl | 126 ++++++++++++++++++++++++++++++++- src/machine/dispatch.rs | 8 +++ src/machine/system_calls.rs | 86 +++++++++++++--------- 4 files changed, 193 insertions(+), 37 deletions(-) diff --git a/build/instructions_template.rs b/build/instructions_template.rs index 93615dec3..e9ba3a381 100644 --- a/build/instructions_template.rs +++ b/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::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(_) | diff --git a/src/lib/diag.pl b/src/lib/diag.pl index 636ed0a4c..fc989b340 100644 --- a/src/lib/diag.pl +++ b/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 @@ 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 @@ ; 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), diff --git a/src/machine/dispatch.rs b/src/machine/dispatch.rs index 39ca74c6a..e366dc81d 100644 --- a/src/machine/dispatch.rs +++ b/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); diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 21f3057c6..cc5bc5368 100644 --- a/src/machine/system_calls.rs +++ b/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,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)]