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

[Jose E. Marchesi]

Hi Mohammad.

Thanks for the patch.  OK for master.

> 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";