Add PrimCallConv support to GHCi

This adds support for calling Cmm code from bytecode using the native
calling convention, allowing modules that use `foreign import prim`
to be loaded and debugged in GHCi.

This patch introduces a new `PRIMCALL` bytecode instruction and
a helper stack frame `stg_primcall`. The code is based on the
existing functionality for dealing with unboxed tuples in bytecode,
which has been generalised to handle arbitrary calls.

Fixes #22051

6 files changed, 62 insertions, 15 deletions

diff --git a/rts/Disassembler.c b/rts/Disassembler.c
index ae6d7ac9f7..f8b270fa28 100644
--- a/rts/Disassembler.c
+++ b/rts/Disassembler.c
@@ -83,6 +83,9 @@ disInstr ( StgBCO *bco, int pc )
          debugBelch("CCALL    marshaller at 0x%" FMT_HexWord "\n",
                          literals[instrs[pc]] );
          pc += 1; break;
+      case bci_PRIMCALL:
+         debugBelch("PRIMCALL\n");
+         break;
      case bci_STKCHECK:  {
          StgWord stk_words_reqd = BCO_GET_LARGE_ARG + 1;
          debugBelch("STKCHECK %" FMT_Word "\n", (W_)stk_words_reqd );
diff --git a/rts/Interpreter.c b/rts/Interpreter.c
index 1108ca8ed0..f8885cdbce 100644
--- a/rts/Interpreter.c
+++ b/rts/Interpreter.c
@@ -2038,6 +2038,12 @@ run_BCO:
             goto nextInsn;
         }
 
+        case bci_PRIMCALL: {
+            Sp_subW(1);
+            SpW(0) = (W_)&stg_primcall_info;
+            RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
+        }
+
         case bci_CCALL: {
             void *tok;
             int stk_offset            = BCO_NEXT;
diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c
index 15c612751c..8e986f8d12 100644
--- a/rts/RtsSymbols.c
+++ b/rts/RtsSymbols.c
@@ -602,6 +602,7 @@ extern char **environ;
       SymI_HasDataProto(stg_ret_l_info)                                     \
       SymI_HasDataProto(stg_ret_t_info)                                     \
       SymI_HasDataProto(stg_ctoi_t)                                         \
+      SymI_HasDataProto(stg_primcall_info)                                  \
       SymI_HasDataProto(stg_gc_prim_p)                                      \
       SymI_HasDataProto(stg_gc_prim_pp)                                     \
       SymI_HasDataProto(stg_gc_prim_n)                                      \
diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm
index 66d86643b3..625bfd472a 100644
--- a/rts/StgMiscClosures.cmm
+++ b/rts/StgMiscClosures.cmm
@@ -366,20 +366,10 @@ MK_STG_CTOI_T(61)
 MK_STG_CTOI_T(62)
 
 /*
-  Note [GHCi tuple layout]
-  ~~~~~~~~~~~~~~~~~~~~~~~~
-  the tuple_info word describes the register and stack usage of the tuple:
+  Convert a tuple return value to be used in bytecode.
 
-  [ ssss ssss rrrr rrrr rrrr rrrr rrrr rrrr ]
-
-  - r: bitmap of live registers, corresponding to the list of registers
-       returned by GHC.Cmm.CallConv.tupleRegsCover (the least significant
-       bit corresponds to the first element in the list)
-  - s: number of words on stack (in addition to registers)
-
-  The order of the live registers in the bitmap is the same as the list
-  given by GHC.Cmm.CallConv.tupleRegsCover, with the least significant
-  bit corresponding to the first register in the list.
+  See Note [GHCi and native call registers] for information on how
+  values are moved between the stack and registers.
  */
 
 stg_ctoi_t
@@ -402,7 +392,7 @@ stg_ctoi_t
 
     Sp = Sp - WDS(tuple_stack);
 
-    PUSH_TUPLE_REGS(tuple_info);
+    PUSH_ARG_REGS(tuple_info);
 
     /* jump to the BCO that will finish the return of the tuple */
     Sp_adj(-3);
@@ -423,13 +413,57 @@ INFO_TABLE_RET( stg_ret_t, RET_BCO )
     /* number of words spilled on stack */
     tuple_stack  = (tuple_info >> 24) & 0xff;
 
-    POP_TUPLE_REGS(tuple_info);
+    POP_ARG_REGS(tuple_info);
 
     /* Sp points to the topmost argument now */
     jump %ENTRY_CODE(Sp(tuple_stack)) [*]; // NB. all registers live!
 }
 
 
+ /*
+
+    The stg_primcall frame is used by the bytecode interpreter to call
+    a Cmm function. The frame contains a call_info word that contains
+    a bitmap describing the register arguments.
+
+    When the target function is called, Sp points to the topmost stack
+    argument.
+
+       ...
+       next_stack_frame
+       arg_1
+       arg_2
+       ...
+       arg_n
+       target_funptr       (pointer to the function we're calling)
+       call_info           (describes the registers containing the arguments)
+       primcall_BCO        (contains bitmap describing pointers in args)
+       stg_primcall_info   <- Sp
+
+    See Note [GHCi and native call registers] for information on the call_info
+    word and how registers are moved between the stack and registers.
+
+ */
+
+INFO_TABLE_RET ( stg_primcall, RET_BCO )
+{
+    W_ args_info, prim_fun;
+
+    /* Sp(1) would be the BCO containing the stack description bitmap */
+    args_info = Sp(2);
+    prim_fun = Sp(3);
+
+    Sp_adj(4);
+
+    /* Sp points to the top of the register arguments now,
+       load them into actual registers */
+    POP_ARG_REGS(args_info);
+
+    /* Sp points to the topmost stack argument now */
+
+    jump prim_fun [*]; // NB. all registers live!
+}
+
 /*
  * Dummy info table pushed on the top of the stack when the interpreter
  * should apply the BCO on the stack to its arguments, also on the
diff --git a/rts/include/rts/Bytecodes.h b/rts/include/rts/Bytecodes.h
index 960fc454ee..e05ab26d99 100644
--- a/rts/include/rts/Bytecodes.h
+++ b/rts/include/rts/Bytecodes.h
@@ -112,6 +112,8 @@
 #define bci_TESTLT_W8                   85
 #define bci_TESTEQ_W8                   86
 
+#define bci_PRIMCALL                    87
+
 /* If you need to go past 255 then you will run into the flags */
 
 /* If you need to go below 0x0100 then you will run into the instructions */
diff --git a/rts/include/stg/MiscClosures.h b/rts/include/stg/MiscClosures.h
index 257d59a607..8e50336e4a 100644
--- a/rts/include/stg/MiscClosures.h
+++ b/rts/include/stg/MiscClosures.h
@@ -160,6 +160,7 @@ RTS_RET(stg_ctoi_t60);
 RTS_RET(stg_ctoi_t61);
 RTS_RET(stg_ctoi_t62);
 
+RTS_RET(stg_primcall);
 RTS_RET(stg_apply_interp);
 RTS_RET(stg_dead_thread);