[PATCH v2] pvm: add new function to get current dispatch

[Mohammad-Reza Nabipoor]

2023-01-11  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>

        * libpoke/pvm.jitter (wrapped-globals): Add
        pvm_literal_dispatch_name.
        (pvm_literal_dispatch_name): New global constant.
        (vmdisp): New instruction for pushing the name of current
        dispatching strategy to the stack.
        * libpoke/pkl-rt.pk (vm_dispatch): New function.
        * doc/poke.texi (.vm dispatch): Add new subsection.
        * poke/pk-cmd-vm.c (pk_cmd_vm_dispatch): New function.
        (vm_dispatch_cmd): New variable.
        (vm_cmds): Add `vm_dispatch_cmd' command.
        * poke/pk-help.pk (.vm topic): Add `.vm dispatch'.
        * poke/poke.pk (pk_print_vm_dispatch): New function.
---

Hello Jose.

On Wed, Jan 11, 2023 at 01:42:06PM +0100, Jose E. Marchesi wrote:
> 1) To add a corresponding `.vm dispatch' command to poke.
> 2) To add a help topic for it in poke/pk-help.pk
> 3) To document vm_dispatch in the @section VM in the manual.

Fixed.
Thanks!

 ChangeLog          | 15 +++++++++++++++
 doc/poke.texi      | 23 +++++++++++++++++++++++
 libpoke/pkl-rt.pk  |  5 +++++
 libpoke/pvm.jitter | 14 ++++++++++++++
 poke/pk-cmd-vm.c   | 20 ++++++++++++++++++++
 poke/pk-help.pk    |  5 ++++-
 poke/poke.pk       |  7 +++++++
 7 files changed, 88 insertions(+), 1 deletion(-)

diff --git a/ChangeLog b/ChangeLog
index e9a306f5..d1a75413 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,18 @@
+2023-01-11  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>
+
+       * libpoke/pvm.jitter (wrapped-globals): Add
+       pvm_literal_dispatch_name.
+       (pvm_literal_dispatch_name): New global constant.
+       (vmdisp): New instruction for pushing the name of current
+       dispatching strategy to the stack.
+       * libpoke/pkl-rt.pk (vm_dispatch): New function.
+       * doc/poke.texi (.vm dispatch): Add new subsection.
+       * poke/pk-cmd-vm.c (pk_cmd_vm_dispatch): New function.
+       (vm_dispatch_cmd): New variable.
+       (vm_cmds): Add `vm_dispatch_cmd' command.
+       * poke/pk-help.pk (.vm topic): Add `.vm dispatch'.
+       * poke/poke.pk (pk_print_vm_dispatch): New function.
+
 2023-01-11  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>
 
        * libpoke/pvm.jitter (wrapped-globals): Add
diff --git a/doc/poke.texi b/doc/poke.texi
index 9ca92915..54cd398f 100644
--- a/doc/poke.texi
+++ b/doc/poke.texi
@@ -8800,6 +8800,7 @@ with the PVM.
 @menu
 * @:.vm disassemble::          PVM and native disassembler.
 * @:.vm profile::               Profiling Poke programs.
+* @:.vm dispatch                PVM dispatching strategy.
 @end menu
 
 @node @:.vm disassemble
@@ -8841,6 +8842,28 @@ Resets the profiling counts in the virtual machine.
 Outputs a summary with both counts and sample information.
 @end table
 
+@node @:.vm dispatch
+@subsection @code{.vm dispatch}
+@cindex dispatch
+
+The @command{.vm dispatch} command prints the current dispatching
+strategy in PVM (provided by Jitter).  There are four different kind
+of dispatches:
+
+@itemize
+@item switch
+@item direct threading
+@item minimal threading
+@item no threading
+@end itemize
+
+@code{no threading} is the fastest one and the least portable
+dispatch, and @code{switch} is the slowest and the most portable
+one.
+
+Jitter by default will use the most efficient dispatch which is
+both stable and available for the current configuration.
+
 @node exit command
 @section @code{.exit}
 @cindex @code{.exit}
diff --git a/libpoke/pkl-rt.pk b/libpoke/pkl-rt.pk
index 30cfb33e..f81b17f6 100644
--- a/libpoke/pkl-rt.pk
+++ b/libpoke/pkl-rt.pk
@@ -290,6 +290,11 @@ immutable fun vm_set_omode = (int<32> omode) void:
   asm ("popom" :: omode);
 }
 
+immutable fun vm_dispatch = string:
+{
+  return asm string: ("vmdisp");
+}
+
 immutable fun __pkl_unsafe_string_set = (string dst, uint<64> index,
                                          string str) void:
 {
diff --git a/libpoke/pvm.jitter b/libpoke/pvm.jitter
index 0e547786..d81caa76 100644
--- a/libpoke/pvm.jitter
+++ b/libpoke/pvm.jitter
@@ -165,6 +165,7 @@ wrapped-globals
   pvm_literal_newline
   pvm_literal_formatf_fmt
   pvm_literal_formatf_styles
+  pvm_literal_dispatch_name
   libpoke_term_if
   pvm_exception_names
 end
@@ -934,6 +935,7 @@ late-c
     static const char *pvm_literal_newline = "\n";
     static const char *pvm_literal_formatf_fmt = "%%.%u%c";
     static const char pvm_literal_formatf_styles[3] = { 'f', 'e', 'g' };
+    static const char *pvm_literal_dispatch_name = PVM_DISPATCH_HUMAN_READABLE;
 
 #define E(key) [PVM_E_##key] = PVM_E_##key##_NAME,
     static const char *pvm_exception_names[] = {
@@ -6780,6 +6782,18 @@ instruction note (?n pvm_literal_printer)
   end
 end
 
+# Instruction: vmdisp
+#
+# Pushes the current dispatching strategy of current VM to the stack.
+#
+# Stack: ( -- STR )
+
+instruction vmdisp ()
+  code
+    JITTER_PUSH_STACK (pvm_make_string (pvm_literal_dispatch_name));
+  end
+end
+
 
 ## System Interaction Instructions
 
diff --git a/poke/pk-cmd-vm.c b/poke/pk-cmd-vm.c
index 54c92780..90b25c33 100644
--- a/poke/pk-cmd-vm.c
+++ b/poke/pk-cmd-vm.c
@@ -104,6 +104,21 @@ pk_cmd_vm_profile_reset (int argc, struct pk_cmd_arg 
argv[], uint64_t uflags)
   return 1;
 }
 
+static int
+pk_cmd_vm_dispatch (int argc, struct pk_cmd_arg argv[], uint64_t uflags)
+{
+  pk_val vm_dispatch, retval, exception;
+
+  vm_dispatch = pk_decl_val (poke_compiler, "pk_print_vm_dispatch");
+  assert (vm_dispatch != PK_NULL);
+
+  if (pk_call (poke_compiler, vm_dispatch, &retval, &exception, 0)
+               == PK_ERROR
+      || exception != PK_NULL)
+    assert (0); /* This shouldn't happen.  */
+  return 1;
+}
+
 extern struct pk_cmd null_cmd; /* pk-cmd.c  */
 
 const struct pk_cmd vm_disas_exp_cmd =
@@ -166,10 +181,15 @@ const struct pk_cmd vm_profile_cmd =
 
 struct pk_trie *vm_trie;
 
+const struct pk_cmd vm_dispatch_cmd =
+  {"dispatch", "", "", 0, NULL, NULL, pk_cmd_vm_dispatch,
+   "vm dispatch", NULL};
+
 const struct pk_cmd *vm_cmds[] =
   {
     &vm_disas_cmd,
     &vm_profile_cmd,
+    &vm_dispatch_cmd,
     &null_cmd
   };
 
diff --git a/poke/pk-help.pk b/poke/pk-help.pk
index 53b2c7cc..0885aa54 100644
--- a/poke/pk-help.pk
+++ b/poke/pk-help.pk
@@ -330,7 +330,10 @@ Perform an operation related to the Poke Virtual Machine.
 .vm profile reset
   Reset the profiling counters.
 .vm profile show
-  Print a report with collected profiling information."
+  Print a report with collected profiling information.
+
+.vm dispatch
+  Print current dispatching strategy."
   };
 
 pk_help_add_topic
diff --git a/poke/poke.pk b/poke/poke.pk
index c13364d2..b1797015 100644
--- a/poke/poke.pk
+++ b/poke/poke.pk
@@ -80,6 +80,13 @@ fun pk_bounder_unbounded = any:
   return asm any: ("push 7");
 }
 
+/* Print current dispatching strategy of PVM.  */
+
+fun pk_print_vm_dispatch = void:
+{
+  printf ("%s\n", vm_dispatch);
+}
+
 /* Load some poke subsystems.  */
 
 load "pk-table.pk";
-- 
2.39.0