From 78d1add899407fee560bd88d14dbd318fa43b98f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Thu, 15 Jun 2023 14:18:08 +0200
Subject: [PATCH] cmp: cmppass1-call: don't use with-stack for multiple value
 calls

WITH-STACK depends on FFI:C-INLINE so it can't be present in the first pass for
standard operators. As a bonus disassembled result is less obfuscated.
---
 src/cmp/cmpbackend-cxx/cmppass2-call.lsp | 18 ++++++++++++++++++
 src/cmp/cmppass1-call.lsp                | 10 +++-------
 src/cmp/cmptables.lsp                    |  3 +++
 3 files changed, 24 insertions(+), 7 deletions(-)

diff --git a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp b/src/cmp/cmpbackend-cxx/cmppass2-call.lsp
index 28bc441ea..fba547582 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-call.lsp
@@ -57,6 +57,24 @@
     (wt-nl-close-brace)
     (unwind-exit 'values)))
 
+(defun c2mcall (c1form form args)
+  (declare (ignore c1form))
+  (let ((fun-var (make-temp-var)))
+    (wt-nl-open-brace)
+    (wt-nl "struct ecl_stack_frame _ecl_inner_frame_aux;")
+    (wt-nl *volatile* "cl_object _ecl_inner_frame = ecl_stack_frame_open(cl_env_copy,(cl_object)&_ecl_inner_frame_aux,0);")
+    (let ((*unwind-exit* `((STACK "_ecl_inner_frame") ,@*unwind-exit*)))
+      (let ((*destination* fun-var))
+        (c2expr* form))
+      (dolist (arg args)
+        (let ((*destination* 'values))
+          (c2expr* arg))
+        (wt-nl "ecl_stack_frame_push_values(_ecl_inner_frame);"))
+      (wt-nl "cl_env_copy->values[0]=ecl_apply_from_stack_frame(_ecl_inner_frame," fun-var ");"))
+    (wt-nl "ecl_stack_frame_close(_ecl_inner_frame);")
+    (wt-nl-close-brace)
+    (unwind-exit 'values)))
+
 ;;;
 ;;; c2call-global:
 ;;;   ARGS is the list of arguments
diff --git a/src/cmp/cmppass1-call.lsp b/src/cmp/cmppass1-call.lsp
index 1b181bf68..7cc4e15a1 100644
--- a/src/cmp/cmppass1-call.lsp
+++ b/src/cmp/cmppass1-call.lsp
@@ -89,13 +89,9 @@
      (c1funcall (list* (first args) (rest forms))))
     ;; More complicated case.
     (t
-     (let ((function (gensym))
-           (frame (gensym)))
-       `(with-stack ,frame
-          (let* ((,function ,(first args)))
-            ,@(loop for i in (rest args)
-                    collect `(stack-push-values ,frame ,i))
-            (si::apply-from-stack-frame ,frame ,function)))))))
+     (make-c1form* 'MCALL
+                   :sp-change t :side-effects t :args (c1expr (first args))
+                   (c1args* (rest args))))))
 
 (defun c1apply (args)
   (check-args-number 'CL:APPLY args 2)
diff --git a/src/cmp/cmptables.lsp b/src/cmp/cmptables.lsp
index 8b093c37b..c7042e863 100644
--- a/src/cmp/cmptables.lsp
+++ b/src/cmp/cmptables.lsp
@@ -34,6 +34,7 @@
     (CL:RETURN-FROM     blk-var nonlocal value :side-effects)
     (CL:FUNCALL         fun-value (arg-value*) :side-effects)
     (FCALL              fun-value (arg-value*) :side-effects)
+    (MCALL              fun-value (arg-value*) :side-effects)
     (CALL-LOCAL         obj-fun (arg-value*) :side-effects)
     (CALL-GLOBAL        fun-name (arg-value*))
     (CL:CATCH           catch-value body :side-effects)
@@ -218,6 +219,7 @@
     (cl:return-from . c2return-from)
     (cl:funcall . c2funcall)
     (fcall . c2fcall)
+    (mcall . c2mcall)
     (call-global . c2call-global)
     (cl:catch . c2catch)
     (cl:unwind-protect . c2unwind-protect)
@@ -276,6 +278,7 @@
     (cl:return-from . p1return-from)
     (cl:funcall . p1trivial)
     (fcall . p1trivial)
+    (mcall . p1trivial)
     (call-global . p1call-global)
     (call-local . p1call-local)
     (cl:catch . p1catch)