rts: workaround cmm's improper variadic ccall breaking wasm32 typechecking

Unlike other targets, wasm requires the function signature of the call
site and callee to strictly match. So in Cmm, when we call a C
function that actually returns a value, we need to add an _unused
local variable to receive it, otherwise type error awaits.

An even bigger problem is calling variadic functions like barf() and
such. Cmm doesn't support CAPI calling convention yet, so calls to
variadic functions just happen to work in some cases with some
target's ABI. But again, it doesn't work with wasm. Fortunately, the
wasm C ABI lowers varargs to a stack pointer argument, and it can be
passed NULL when no other arguments are expected to be passed. So we
also add the additional unused NULL arguments to those functions, so
to fix wasm, while not affecting behavior on other targets.

6 files changed, 15 insertions, 10 deletions

diff --git a/rts/Apply.cmm b/rts/Apply.cmm
index e91418ab14..9b1e7f72e8 100644
--- a/rts/Apply.cmm
+++ b/rts/Apply.cmm
@@ -57,12 +57,14 @@ STRING(stg_ap_0_ret_str,"stg_ap_0_ret... ")
 
 stg_ap_0_fast ( P_ fun )
 {
+    W_ _unused;
+
     IF_DEBUG(apply,
-        ccall debugBelch(stg_ap_0_ret_str);
+        ccall debugBelch(stg_ap_0_ret_str, NULL);
         ccall printClosure(R1 "ptr"));
 
     IF_DEBUG(sanity,
-        ccall checkStackFrame(Sp "ptr"));
+        (_unused) = ccall checkStackFrame(Sp "ptr"));
 
 #if !defined(PROFILING)
 
diff --git a/rts/Compact.cmm b/rts/Compact.cmm
index 1a5b2162e2..ecb694cf5c 100644
--- a/rts/Compact.cmm
+++ b/rts/Compact.cmm
@@ -284,7 +284,7 @@ eval:
         goto constructor;
     }}
 
-    ccall barf("stg_compactWorkerzh");
+    ccall barf("stg_compactWorkerzh", NULL);
 }
 
 //
diff --git a/rts/Exception.cmm b/rts/Exception.cmm
index 6d040b37cd..ff577aace6 100644
--- a/rts/Exception.cmm
+++ b/rts/Exception.cmm
@@ -673,7 +673,7 @@ stg_raiseOverflowzh ()
  */
 stg_paniczh (W_ str)
 {
-    ccall barf(str) never returns;
+    ccall barf(str, NULL) never returns;
 }
 
 // See Note [Compiler error functions] in GHC.Prim.Panic
diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm
index 20dc531a80..013db8731b 100644
--- a/rts/StgMiscClosures.cmm
+++ b/rts/StgMiscClosures.cmm
@@ -76,6 +76,8 @@ INFO_TABLE_RET (stg_stack_underflow_frame, UNDERFLOW_FRAME,
 
 INFO_TABLE_RET (stg_restore_cccs, RET_SMALL, W_ info_ptr, W_ cccs)
 {
+    W_ _unused;
+
     unwind Sp = Sp + WDS(2);
 #if defined(PROFILING)
     CCCS = Sp(1);
@@ -83,7 +85,7 @@ INFO_TABLE_RET (stg_restore_cccs, RET_SMALL, W_ info_ptr, W_ cccs)
     Sp_adj(2);
 
     IF_DEBUG(sanity,
-      ccall checkStackFrame(Sp "ptr"));
+      (_unused) = ccall checkStackFrame(Sp "ptr"));
 
     jump %ENTRY_CODE(Sp(0)) [*]; // NB. all registers live!
 }
@@ -448,7 +450,7 @@ INFO_TABLE_RET( stg_dead_thread, RET_SMALL,
                 W_ info_ptr,
                 PROF_HDR_FIELDS(W_,p1,p2)
                 P_ result )
-{ foreign "C" barf("stg_dead_thread entered!") never returns; }
+{ foreign "C" barf("stg_dead_thread entered!", NULL) never returns; }
 
 /* ----------------------------------------------------------------------------
    Entry code for a BCO
diff --git a/rts/StgStartup.cmm b/rts/StgStartup.cmm
index cbdff480d9..f69c0dea87 100644
--- a/rts/StgStartup.cmm
+++ b/rts/StgStartup.cmm
@@ -178,5 +178,5 @@ INFO_TABLE_RET(stg_forceIO, RET_SMALL, P_ info_ptr)
 /* Called when compiled with -falignment-sanitisation on alignment failure */
 stg_badAlignment_entry
 {
-  foreign "C" barf();
+  foreign "C" barf("stg_badAlignment_entry", NULL);
 }
diff --git a/utils/genapply/Main.hs b/utils/genapply/Main.hs
index f3b4c174dd..74351ee5f0 100644
--- a/utils/genapply/Main.hs
+++ b/utils/genapply/Main.hs
@@ -639,6 +639,7 @@ genApply regstatus args =
         text "RET_SMALL, W_ info_ptr, " <> (cat $ zipWith formalParam args [1..]) <>
         text ")\n{",
       nest 4 (vcat [
+       text "W_ _unused;",
        text "W_ info;",
        text "W_ arity;",
        text "unwind Sp = Sp + WDS(" <> int (1+all_args_size) <> text ");",
@@ -668,9 +669,9 @@ genApply regstatus args =
        tickForArity (length args),
        text "",
        text "IF_DEBUG(apply,foreign \"C\" debugBelch(\"" <> fun_ret_label <>
-          text "... \"); foreign \"C\" printClosure(R1 \"ptr\"));",
+          text "... \", NULL); foreign \"C\" printClosure(R1 \"ptr\"));",
 
-       text "IF_DEBUG(sanity,foreign \"C\" checkStackFrame(Sp+WDS(" <> int (1 + all_args_size)
+       text "IF_DEBUG(sanity,(_unused) = foreign \"C\" checkStackFrame(Sp+WDS(" <> int (1 + all_args_size)
         <> text ")\"ptr\"));",
 
 --       text "IF_DEBUG(sanity,checkStackChunk(Sp+" <> int (1 + all_args_size) <>
@@ -795,7 +796,7 @@ genApply regstatus args =
 
        text "default: {",
        nest 4 (
-         text "foreign \"C\" barf(\"" <> fun_ret_label <> text "\") never returns;"
+         text "foreign \"C\" barf(\"" <> fun_ret_label <> text "\", NULL) never returns;"
        ),
        text "}"