[PATCH 2/2] 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.
---
 ChangeLog          |  9 +++++++++
 libpoke/pkl-rt.pk  |  5 +++++
 libpoke/pvm.jitter | 14 ++++++++++++++
 3 files changed, 28 insertions(+)

diff --git a/ChangeLog b/ChangeLog
index e9a306f5..e6584a38 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+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.
+
 2023-01-11  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>
 
        * libpoke/pvm.jitter (wrapped-globals): Add
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
 
-- 
2.39.0