From 951a1e7e56f641cee4878acb13f5d44128ac8a2b Mon Sep 17 00:00:00 2001
From: Bike <aeshtaer@gmail.com>
Date: Mon, 20 Apr 2026 14:30:50 -0400
Subject: [PATCH 01/14] b2b: use new bir-builder function

---
 src/lisp/kernel/cleavir/compile-bytecode.lisp | 12 +++++-------
 1 file changed, 5 insertions(+), 7 deletions(-)

diff --git a/src/lisp/kernel/cleavir/compile-bytecode.lisp b/src/lisp/kernel/cleavir/compile-bytecode.lisp
index bf83127a41..dd7eea0569 100644
--- a/src/lisp/kernel/cleavir/compile-bytecode.lisp
+++ b/src/lisp/kernel/cleavir/compile-bytecode.lisp
@@ -426,8 +426,7 @@
                      :policy cmp:*policy* ; FIXME
                      :attributes nil
                      :module module))
-         (start (make-start-block inserter function bytecode-function)))
-    (setf (bir:start function) start)
+         (start (make-start-block function bytecode-function)))
     (set:nadjoinf (bir:functions module) function)
     function))
 
@@ -462,12 +461,11 @@
   (assert (stack context))
   (pop (stack context)))
 
-(defun make-start-block (inserter irfun bcfun)
-  (build:make-iblock
-   inserter
+(defun make-start-block (irfun bcfun)
+  (build:make-start-iblock
+   irfun
    :name (symbolicate (write-to-string (bcfun/fname bcfun))
-                      '#:-start)
-   :function irfun :dynamic-environment irfun))
+                      '#:-start)))
 
 (defun symbolicate (&rest components)
   ;; FIXME: Probably just use concatenate

From 6a1cc0d586f381c8a65fcb72c7c6233b32d2ea00 Mon Sep 17 00:00:00 2001
From: Bike <aeshtaer@gmail.com>
Date: Fri, 24 Apr 2026 12:48:17 -0400
Subject: [PATCH 02/14] let wrong-number-of-arguments have a function name only

rather than a function. This will let us compile
wrong-number-of-arguments errors even in cases where we don't make
an actual function (because the function is only locally called).
---
 src/lisp/kernel/clos/conditions.lisp | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/src/lisp/kernel/clos/conditions.lisp b/src/lisp/kernel/clos/conditions.lisp
index 72cd53c2e1..8bf4eea520 100644
--- a/src/lisp/kernel/clos/conditions.lisp
+++ b/src/lisp/kernel/clos/conditions.lisp
@@ -1079,7 +1079,11 @@ The conflict resolver must be one of ~s" chosen-symbol candidates))
              (let* ((min (min-nargs condition))
                     (max (max-nargs condition))
                     (function (called-function condition))
-                    (name (and function (core:function-name function)))
+                    (name (typecase function
+                            (null 'cl:lambda)
+                            (function (core:function-name function))
+                            ;; assume it's a name, e.g. symbol
+                            (t function)))
                     (dname (if (eq name 'cl:lambda) "anonymous function" name)))
                (format stream "~@[Calling ~a - ~]Got ~d arguments, but expected ~@?"
                        dname (given-nargs condition)

From 728a6305aebd0492a53359e9bffa50143a628ae5 Mon Sep 17 00:00:00 2001
From: Bike <aeshtaer@gmail.com>
Date: Fri, 24 Apr 2026 12:51:58 -0400
Subject: [PATCH 03/14] Don't make closures for invalid local calls

this should be slightly faster, but the main importance here is
that it means we won't need a XEP or function.
---
 src/lisp/kernel/cleavir/translate.lisp | 24 +++++++++++++++---------
 1 file changed, 15 insertions(+), 9 deletions(-)

diff --git a/src/lisp/kernel/cleavir/translate.lisp b/src/lisp/kernel/cleavir/translate.lisp
index bc0f7d658d..3b3a1eca34 100644
--- a/src/lisp/kernel/cleavir/translate.lisp
+++ b/src/lisp/kernel/cleavir/translate.lisp
@@ -956,17 +956,23 @@ function-or-placeholder - the llvm function or a placeholder for
                (cmp:process-bir-lambda-list (bir:lambda-list callee))
              (declare (ignore keyargs aok aux))
              (assert (not key-flag))
-             (let ((largs (length arguments)))
-               (when (or (< largs (car req))
-                         (and (not rest-var)
-                              (> largs (+ (car req) (car opt)))))
+             (let ((largs (length arguments))
+                   (max (if rest-var
+                            nil
+                            (+ (car req) (car opt)))))
+               (when (or (< largs (car req)) (and max (> largs max)))
                  ;; too many or too few args; we can get here from
                  ;; fixed-mv-local-calls for instance.
+                 (cmp:irc-intrinsic "cc_wrong_number_of_arguments"
+                                    (literal (bir:name callee))
+                                    (%size_t largs) (%size_t (car req))
+                                    (%size_t (or max 0)))
+                 ;; TODO: (irc-unreachable)
+                 ;; but it's not a big deal, since llvm knows that
+                 ;; cc_wrong_number_of_arguments is noreturn.
                  (return-from gen-local-call
-                   (translate-cast (closure-call-or-invoke
-                                    (enclose callee :dynamic nil)
-                                    arguments)
-                                   :multiple-values outputrt))))
+                   (llvm-sys:undef-value-get
+                    (return-rtype->llvm outputrt)))))
              (let* ((rest-id (cond ((null rest-var) nil)
                                    ((bir:unused-p rest-var) :unused)
                                    (varest-p :va-rest)
@@ -1058,7 +1064,7 @@ function-or-placeholder - the llvm function or a placeholder for
           (cmp:irc-begin-block mismatch)
           (cmp::irc-intrinsic-call-or-invoke
            "cc_wrong_number_of_arguments"
-           (list (enclose callee :indefinite nil) rnret
+           (list (literal (bir:name callee)) rnret
                  (%size_t nreq) (%size_t nfixed)))
           (cmp:irc-unreachable))
         ;; Generate not-enough-args cases.

From d496e30781fbd7f82ce537d077b8137ac11fcd36 Mon Sep 17 00:00:00 2001
From: Bike <aeshtaer@gmail.com>
Date: Fri, 24 Apr 2026 16:13:01 -0400
Subject: [PATCH 04/14] use correct condition for unknown-keyword errors in
 native code

---
 src/llvmo/link_intrinsics.cc | 13 ++-----------
 1 file changed, 2 insertions(+), 11 deletions(-)

diff --git a/src/llvmo/link_intrinsics.cc b/src/llvmo/link_intrinsics.cc
index 2bf9f9c444..5ef1896f80 100644
--- a/src/llvmo/link_intrinsics.cc
+++ b/src/llvmo/link_intrinsics.cc
@@ -236,19 +236,10 @@ __attribute__((visibility("default"))) core::T_O* cc_gatherDynamicExtentRestArgu
   NO_UNWIND_END();
 }
 
-void badKeywordArgumentError(core::T_sp keyword, core::T_sp functionName, core::T_sp lambdaList) {
-  if (functionName.nilp()) {
-    SIMPLE_ERROR("When calling an unnamed function with the lambda list {} the bad keyword argument {} was passed",
-                 _rep_(lambdaList), _rep_(keyword));
-  }
-  SIMPLE_ERROR("When calling {} with the lambda-list {} the bad keyword argument {} was passed", _rep_(functionName),
-               _rep_(lambdaList), _rep_(keyword));
-}
-
 void cc_ifBadKeywordArgumentException(core::T_O* allowOtherKeys, core::T_O* kw, core::T_O* tclosure) {
-  core::Function_sp closure((gc::Tagged)tclosure);
+  core::T_sp closure((gc::Tagged)tclosure);
   if (gctools::tagged_nilp(allowOtherKeys))
-    badKeywordArgumentError(core::T_sp((gc::Tagged)kw), closure->functionName(), closure->lambdaList());
+    throwUnrecognizedKeywordArgumentError(closure, core::T_sp((gc::Tagged)kw));
 }
 };
 

From 4c726f88f39e9507063f59fe4b222ec7fb257c17 Mon Sep 17 00:00:00 2001
From: Bike <aeshtaer@gmail.com>
Date: Fri, 24 Apr 2026 16:34:55 -0400
Subject: [PATCH 05/14] accept function names in argument parsing errors

---
 src/lisp/kernel/clos/conditions.lisp | 20 +++++++++++++-------
 1 file changed, 13 insertions(+), 7 deletions(-)

diff --git a/src/lisp/kernel/clos/conditions.lisp b/src/lisp/kernel/clos/conditions.lisp
index 8bf4eea520..0d865df5d9 100644
--- a/src/lisp/kernel/clos/conditions.lisp
+++ b/src/lisp/kernel/clos/conditions.lisp
@@ -1119,18 +1119,24 @@ The conflict resolver must be one of ~s" chosen-symbol candidates))
 (define-condition core:odd-keywords (program-error)
   ((%called-function :initarg :called-function :reader called-function))
   (:report (lambda (condition stream)
-             (format stream "Odd number of keyword arguments~:[~; for ~s~]."
-                     (called-function condition)
-                     (core:function-name (called-function condition))))))
+             (let* ((function (called-function condition))
+                    (name (if (functionp function)
+                              (core:function-name function)
+                              function)))
+               (format stream "Odd number of keyword arguments~@[ for ~s~]."
+                       name)))))
 
 (define-condition core:unrecognized-keyword-argument-error (program-error)
   ((called-function :initarg :called-function :reader called-function :initform nil)
    (unrecognized-keywords :initarg :unrecognized-keywords :reader unrecognized-keywords))
   (:report (lambda (condition stream)
-             (format stream "Unrecognized keyword arguments ~S~:[~; for ~S~]."
-                     (unrecognized-keywords condition)
-                     (called-function condition)
-                     (core:function-name (called-function condition))))))
+             (let* ((function (called-function condition))
+                    (name (if (functionp function)
+                              (core:function-name function)
+                              function)))
+               (format stream "Unrecognized keyword arguments ~S~@[ for ~S~]."
+                       (unrecognized-keywords condition)
+                       name)))))
 
 (define-condition print-not-readable (error)
   ((object :INITARG :OBJECT :READER print-not-readable-object))

From e3f92e6c0bff8665c26e4ce0fd4650d6ba142847 Mon Sep 17 00:00:00 2001
From: Bike <aeshtaer@gmail.com>
Date: Sat, 25 Apr 2026 00:08:13 -0400
Subject: [PATCH 06/14] use general argument parser for mv-local-call

This means we don't need closures for multiple value local calls.
Plus we can remove some code duplication and just use the normal
argument parser, yahoo.
---
 src/lisp/kernel/cleavir/cmpintrinsics.lisp |   9 +-
 src/lisp/kernel/cleavir/translate.lisp     | 178 ++++++---------------
 2 files changed, 54 insertions(+), 133 deletions(-)

diff --git a/src/lisp/kernel/cleavir/cmpintrinsics.lisp b/src/lisp/kernel/cleavir/cmpintrinsics.lisp
index a536def97f..b1555f3c62 100644
--- a/src/lisp/kernel/cleavir/cmpintrinsics.lisp
+++ b/src/lisp/kernel/cleavir/cmpintrinsics.lisp
@@ -646,10 +646,13 @@ Boehm and MPS use a single pointer"
 ;;   or the vaslist is used to access the arguments
 ;;   one after the other with calling-convention.va-arg
 (defstruct calling-convention
+  ;; LLVM value: the closure. This is only used to feed errors, e.g.
+  ;; cc_wrong_number_of_arguments, so it can be a function name rather
+  ;; than an actual function or closure.
   closure
-  nargs
-  register-args ; The arguments that were passed in registers
-  vaslist*      ; The address of the vaslist, or NIL
+  nargs ; LLVM value: number of arguments
+  register-args ; List of LLVM values: The arguments that were passed in registers
+  vaslist*      ; LLVM Value: The address of the vaslist, or NIL
   cleavir-lambda-list-analysis ; analysis of cleavir-lambda-list
   rest-alloc ; whether we can dx or ignore a &rest argument
   )
diff --git a/src/lisp/kernel/cleavir/translate.lisp b/src/lisp/kernel/cleavir/translate.lisp
index 3b3a1eca34..bacedd9ea6 100644
--- a/src/lisp/kernel/cleavir/translate.lisp
+++ b/src/lisp/kernel/cleavir/translate.lisp
@@ -1012,123 +1012,6 @@ function-or-placeholder - the llvm function or a placeholder for
           :label (datum-name-as-string output))
          output)))
 
-(defun general-mv-local-call-vas (callee vaslist label outputrt)
-  (translate-cast (cmp:irc-apply (enclose callee :dynamic nil)
-                                 (cmp:irc-vaslist-nvals vaslist)
-                                 (cmp:irc-vaslist-values vaslist)
-                                 label)
-                  :multiple-values outputrt))
-
-(defun direct-mv-local-call-vas (vaslist callee req opt rest-var varest-p
-                                 label outputrt)
-  (let* ((callee-info (find-llvm-function-info callee))
-         (nreq (car req))
-         (nopt (car opt))
-         (rnret (cmp:irc-vaslist-nvals vaslist))
-         (rvalues (cmp:irc-vaslist-values vaslist))
-         (nfixed (+ nreq nopt))
-         (mismatch
-           (unless (and (zerop nreq) rest-var)
-             (cmp:irc-basic-block-create "lmvc-arg-mismatch")))
-         (mte (if rest-var
-                  (cmp:irc-basic-block-create "lmvc-more-than-enough")
-                  mismatch))
-         (merge (cmp:irc-basic-block-create "lmvc-after"))
-         (sw (cmp:irc-switch rnret mte (+ 1 nreq nopt)))
-         (environment (environment callee-info))
-         (rest-vaboxp (not (eq (rest-vrtype rest-var) :vaslist))))
-    (labels ((load-return-value (n)
-               (cmp:irc-t*-load (cmp:irc-typed-gep cmp:%t*% rvalues (list n))))
-             (load-return-values (low high)
-               (loop for i from low below high
-                     collect (load-return-value i)))
-             (optionals (n)
-               (parse-local-call-optional-arguments
-                opt (load-return-values nreq (+ nreq n)))))
-      ;; Generate phis for the merge block's call.
-      (cmp:irc-begin-block merge)
-      (let ((opt-phis
-              (loop for (op s-p) on (rest opt) by #'cdddr
-                    for op-ty = (argument-rtype->llvm op)
-                    for s-p-ty = (argument-rtype->llvm s-p)
-                    collect (cmp:irc-phi op-ty (1+ nopt))
-                    collect (cmp:irc-phi s-p-ty (1+ nopt))))
-            (rest-phi
-              (cond ((null rest-var) nil)
-                    ((bir:unused-p rest-var)
-                     (cmp:irc-undef-value-get cmp:%t*%))
-                    (t (cmp:irc-phi (argument-rtype->llvm rest-var)
-                                    (1+ nopt))))))
-        ;; Generate the mismatch block, if it exists.
-        (when mismatch
-          (cmp:irc-begin-block mismatch)
-          (cmp::irc-intrinsic-call-or-invoke
-           "cc_wrong_number_of_arguments"
-           (list (literal (bir:name callee)) rnret
-                 (%size_t nreq) (%size_t nfixed)))
-          (cmp:irc-unreachable))
-        ;; Generate not-enough-args cases.
-        (loop for i below nreq
-              do (cmp:irc-add-case sw (%size_t i) mismatch))
-        ;; Generate optional arg cases, including the exactly-enough case.
-        (loop for i upto nopt
-              for b = (cmp:irc-basic-block-create
-                       (format nil "lmvc-optional-~d" i))
-              do (cmp:irc-add-case sw (%size_t (+ nreq i)) b)
-                 (cmp:irc-begin-block b)
-                 (loop for phi in opt-phis
-                       for val in (optionals i)
-                       do (cmp:irc-phi-add-incoming phi val b))
-                 (when (and rest-var (not (bir:unused-p rest-var)))
-                   (cmp:irc-phi-add-incoming
-                    rest-phi
-                    (if varest-p
-                        (maybe-boxed-vaslist
-                         rest-vaboxp (%size_t 0)
-                         (llvm-sys:constant-pointer-null-get cmp:%t**%))
-                        (%nil))
-                    b))
-                 (cmp:irc-br merge))
-        ;; If there's a &rest, generate the more-than-enough arguments case.
-        (when rest-var
-          (cmp:irc-begin-block mte)
-          (loop for phi in opt-phis
-                for val in (optionals nopt)
-                do (cmp:irc-phi-add-incoming phi val mte))
-          (unless (bir:unused-p rest-var)
-            (cmp:irc-phi-add-incoming
-             rest-phi
-             (if varest-p
-                 (maybe-boxed-vaslist
-                  rest-vaboxp
-                  (cmp:irc-sub rnret (%size_t nfixed))
-                  (cmp:irc-typed-gep cmp:%t*% rvalues (list nfixed)))
-                 (%intrinsic-invoke-if-landing-pad-or-call
-                  "cc_mvcGatherRest2"
-                  (list (cmp:irc-typed-gep cmp:%t*% rvalues (list nfixed))
-                        (cmp:irc-sub rnret (%size_t nfixed)))))
-             mte))
-          (cmp:irc-br merge))
-        ;; Generate the call, in the merge block.
-        (cmp:irc-begin-block merge)
-        (let* ((arguments
-                 (nconc
-                  (environment-arguments environment)
-                  (loop for r in (rest req)
-                        for j from 0
-                        collect (translate-cast (load-return-value j) '(:object)
-                                                (cc-bmir:rtype r)))
-                  opt-phis
-                  (when rest-var (list rest-phi))))
-               (function (main-function callee-info))
-               (function-type (llvm-sys:get-function-type function))
-               (call
-                 (cmp:irc-call-or-invoke function-type function arguments
-                                         cmp:*current-unwind-landing-pad-dest*
-                                         label)))
-          #+(or)(llvm-sys:set-calling-conv call 'llvm-sys:fastcc)
-          (local-call-rv->inputs call outputrt))))))
-
 (defmethod translate-simple-instruction
     ((instruction bir:mv-local-call) abi)
   (declare (ignore abi))
@@ -1136,20 +1019,55 @@ function-or-placeholder - the llvm function or a placeholder for
          (outputrt (cc-bmir:rtype output))
          (oname (datum-name-as-string output))
          (callee (bir:callee instruction))
+         (callee-info (find-llvm-function-info callee))
          (mvarg (second (bir:inputs instruction)))
-         (mvargrt (cc-bmir:rtype mvarg))
-         (mvargi (in mvarg)))
-    (assert (eq mvargrt :vaslist))
-    (out
-     (multiple-value-bind (req opt rest-var key-flag keyargs
-                           aok aux varest-p)
-         (cmp::process-bir-lambda-list (bir:lambda-list callee))
-       (declare (ignore keyargs aok aux))
-       (if key-flag
-           (general-mv-local-call-vas callee mvargi oname outputrt)
-           (direct-mv-local-call-vas
-            mvargi callee req opt rest-var varest-p oname outputrt)))
-     output)))
+         (_1 (assert (eq (cc-bmir:rtype mvarg) :vaslist)))
+         (mvargi (in mvarg))
+         (nargs (cmp:irc-vaslist-nvals mvargi))
+         (ll-analysis (cmp:calculate-cleavir-lambda-list-analysis
+                       (bir:lambda-list callee)))
+         (vaslist* (cmp:alloca-vaslist))
+         (calling-convention
+           (cmp:make-calling-convention
+            :rest-alloc (compute-rest-alloc ll-analysis)
+            :cleavir-lambda-list-analysis ll-analysis
+            :vaslist* vaslist*
+            :register-args ()
+            ;; FIXME: the vaslist already has this so what gives
+            :nargs nargs
+            :closure (literal (bir:name callee))))
+         ;; An alist from BIR:ARGUMENTs to LLVM values for them.
+         ;; We use this instead of going through OUT/IN as we do for
+         ;; XEPs because there may be multiple calls to the same
+         ;; function (which thus use the same ARGUMENTs).
+         (argvalues ())
+         (arglist (arguments callee-info))
+         (environment (environment callee-info))
+         (_2
+           (cmp:vaslist-start vaslist* nargs
+                              (cmp:irc-vaslist-values mvargi)))
+         (_3
+           (cmp:compile-lambda-list-code
+            ll-analysis calling-convention
+            :general-entry
+            :argument-out (lambda (value arg)
+                            (push (cons arg value) argvalues))))
+         (arguments
+           (nconc (environment-arguments environment)
+                  (loop for arg in arglist
+                        for v = (cdr (assoc arg argvalues))
+                        unless v
+                          do (error "BUG: Missing argument ~a" arg)
+                        collect (translate-cast v '(:object)
+                                                (cc-bmir:rtype arg)))))
+         (function (main-function callee-info))
+         (function-type (llvm-sys:get-function-type function))
+         (call
+           (cmp:irc-call-or-invoke function-type function arguments
+                                   cmp:*current-unwind-landing-pad-dest*
+                                   oname)))
+    (declare (ignore _1 _2 _3))
+    (out (local-call-rv->inputs call outputrt) output)))
 
 (defmethod translate-simple-instruction
     ((instruction cc-bmir:fixed-mv-local-call) abi)

From ff4e5f2fa5f39c2044833b4531b414f24f869c83 Mon Sep 17 00:00:00 2001
From: Bike <aeshtaer@gmail.com>
Date: Mon, 27 Apr 2026 10:04:04 -0400
Subject: [PATCH 07/14] remove unneeded line

---
 src/lisp/kernel/cmp/arguments.lisp | 2 --
 1 file changed, 2 deletions(-)

diff --git a/src/lisp/kernel/cmp/arguments.lisp b/src/lisp/kernel/cmp/arguments.lisp
index f9d21ce3f1..29311ab323 100644
--- a/src/lisp/kernel/cmp/arguments.lisp
+++ b/src/lisp/kernel/cmp/arguments.lisp
@@ -236,8 +236,6 @@ a_p = a_p_temp; a = a_temp;
         (irc-cond-br evenp kw-loop odd-kw)
         ;; There have been an odd number of arguments, so signal an error.
         (irc-begin-block odd-kw)
-        (unless (calling-convention-closure calling-conv)
-          (error "The calling-conv ~s does not have a closure" calling-conv))
         (irc-intrinsic "cc_oddKeywordException"
                        (calling-convention-closure calling-conv))
         (irc-unreachable))

From b4e30118296f6ac42b4a558add8a2ccbada7963e Mon Sep 17 00:00:00 2001
From: Bike <aeshtaer@gmail.com>
Date: Mon, 27 Apr 2026 17:36:32 -0400
Subject: [PATCH 08/14] Harden representation selection for invalid local calls

---
 src/lisp/kernel/cleavir/representation-selection.lisp | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/src/lisp/kernel/cleavir/representation-selection.lisp b/src/lisp/kernel/cleavir/representation-selection.lisp
index 5e3426c1f0..ff5084399c 100644
--- a/src/lisp/kernel/cleavir/representation-selection.lisp
+++ b/src/lisp/kernel/cleavir/representation-selection.lisp
@@ -162,7 +162,9 @@
            (let ((rt '()))
              (cleavir-set:doset (call calls rt)
                (let* ((call-arg (nth pos (rest (bir:inputs call))))
-                      (next-rt (definition-rtype call-arg))
+                      (next-rt (if call-arg
+                                   (definition-rtype call-arg)
+                                   nil))
                       (real-next-rt
                         (cond ((null next-rt) nil)
                               ((member next-rt '(:vaslist
@@ -728,7 +730,9 @@
   (let ((args (rest (bir:inputs instruction))))
     (loop for item in (bir:lambda-list (bir:callee instruction))
           while (typep item 'bir:argument)
-          do (maybe-cast-before instruction (pop args) (cc-bmir:rtype item)))
+          do (let ((arg (pop args)))
+               (when arg ; there may not be enough arguments
+                 (maybe-cast-before instruction arg (cc-bmir:rtype item)))))
     (loop until (null args)
           do (maybe-cast-before instruction (pop args) '(:object))))
   (cast-local-call-output instruction))

From 160f729d82b69d682cee9c35a46496fee87783b3 Mon Sep 17 00:00:00 2001
From: Bike <aeshtaer@gmail.com>
Date: Mon, 27 Apr 2026 17:38:02 -0400
Subject: [PATCH 09/14] use general argument parser for local-call

---
 src/lisp/kernel/cleavir/translate.lisp | 118 +++++++++++++------------
 src/llvmo/llvmoExpose.cc               |  10 ++-
 2 files changed, 69 insertions(+), 59 deletions(-)

diff --git a/src/lisp/kernel/cleavir/translate.lisp b/src/lisp/kernel/cleavir/translate.lisp
index bacedd9ea6..d7c5599bae 100644
--- a/src/lisp/kernel/cleavir/translate.lisp
+++ b/src/lisp/kernel/cleavir/translate.lisp
@@ -935,62 +935,63 @@ function-or-placeholder - the llvm function or a placeholder for
       :vaslist
       :object))
 
-(defun gen-local-call (callee arguments outputrt)
-  (let ((callee-info (find-llvm-function-info callee)))
-    (cond ((lambda-list-too-hairy-p (bir:lambda-list callee))
-           ;; Has &key or something, so use the normal call protocol.
-           ;; We allocate a fresh closure for every call. Hopefully this
-           ;; isn't too expensive. We can always use stack allocation since
-           ;; there's no possibility of this closure being stored in a closure
-           ;; (If we local-call a self-referencing closure, the closure cell
-           ;;  will get its value from some enclose.
-           ;;  FIXME we could use that instead?)
-           (translate-cast (closure-call-or-invoke
-                            (enclose callee :dynamic nil)
-                            arguments)
-                           :multiple-values outputrt))
-          (t
-           ;; Call directly.
-           (multiple-value-bind (req opt rest-var key-flag keyargs aok aux
-                                 varest-p)
-               (cmp:process-bir-lambda-list (bir:lambda-list callee))
-             (declare (ignore keyargs aok aux))
-             (assert (not key-flag))
-             (let ((largs (length arguments))
-                   (max (if rest-var
-                            nil
-                            (+ (car req) (car opt)))))
-               (when (or (< largs (car req)) (and max (> largs max)))
-                 ;; too many or too few args; we can get here from
-                 ;; fixed-mv-local-calls for instance.
-                 (cmp:irc-intrinsic "cc_wrong_number_of_arguments"
-                                    (literal (bir:name callee))
-                                    (%size_t largs) (%size_t (car req))
-                                    (%size_t (or max 0)))
-                 ;; TODO: (irc-unreachable)
-                 ;; but it's not a big deal, since llvm knows that
-                 ;; cc_wrong_number_of_arguments is noreturn.
-                 (return-from gen-local-call
-                   (llvm-sys:undef-value-get
-                    (return-rtype->llvm outputrt)))))
-             (let* ((rest-id (cond ((null rest-var) nil)
-                                   ((bir:unused-p rest-var) :unused)
-                                   (varest-p :va-rest)
-                                   (t t)))
-                    (rest-vrtype (rest-vrtype rest-var))
-                    (subargs
-                      (parse-local-call-arguments
-                       req opt rest-id rest-vrtype arguments))
-                    (args (append (environment-arguments
-                                   (environment callee-info))
-                                  subargs))
-                    (function (main-function callee-info))
-                    (function-type (llvm-sys:get-function-type function))
-                    (result-in-registers
-                      (cmp::irc-call-or-invoke function-type function args)))
-               #+(or)
-               (llvm-sys:set-calling-conv result-in-registers 'llvm-sys:fastcc)
-               (local-call-rv->inputs result-in-registers outputrt)))))))
+(defun gen-local-call (callee arguments output-name outputrt)
+  ;; LLVM whines if we provide a name for a call returning void FIXME
+  (declare (ignore output-name))
+  (let* ((callee-info (find-llvm-function-info callee))
+         (parameters (arguments callee-info))
+         (environment (environment callee-info))
+         (function (main-function callee-info))
+         (function-type (llvm-sys:get-function-type function))
+         (ll-analysis (cmp:calculate-cleavir-lambda-list-analysis
+                       (bir:lambda-list callee)))
+         (calling-convention
+           (cmp:make-calling-convention
+            :rest-alloc (compute-rest-alloc ll-analysis)
+            :cleavir-lambda-list-analysis ll-analysis
+            :register-args arguments
+            :nargs (%size_t (length arguments))
+            :closure (literal (bir:name callee))))
+         (paramvalues ())
+         (ll-result
+           (cmp:compile-lambda-list-code
+            ll-analysis calling-convention
+            (length arguments)
+            :argument-out (lambda (value param)
+                            (push (cons param value) paramvalues))))
+         (_
+           (when (not ll-result)
+             ;; compile-lambda-list-code returned nil, which means we
+             ;; have an argcount mismatch and it has inserted an error
+             ;; call. Everything past this is unreachable, so don't
+             ;; call the function. TODO: poison instead of undef?
+             ;; also TODO: just delete these calls
+             (cmp:irc-begin-block
+              (cmp:irc-basic-block-create "unreachable"))
+             (return-from gen-local-call
+               (local-call-rv->inputs
+                (llvm-sys:undef-value-get
+                 (llvm-sys:function-type-return-type function-type))
+                outputrt))))
+         (arguments
+           (nconc (environment-arguments environment)
+                  (loop with nreq = (cmp::cleavir-lambda-list-analysis-min-nargs ll-analysis)
+                        for param in parameters
+                        for i from 0
+                        for v = (cdr (assoc param paramvalues))
+                        unless v
+                          do (error "BUG: Missing argument ~a" param)
+                        collect (if (< i nreq)
+                                    ;; required argument, so the param
+                                    ;; is just the argument and thus
+                                    ;; of the correct rtype already
+                                    v
+                                    (translate-cast v '(:object)
+                                                    (cc-bmir:rtype param))))))
+         (call
+           (cmp:irc-call-or-invoke function-type function arguments)))
+    (declare (ignore _))
+    (local-call-rv->inputs call outputrt)))
 
 (defmethod translate-simple-instruction ((instruction bir:local-call)
                                          abi)
@@ -998,7 +999,9 @@ function-or-placeholder - the llvm function or a placeholder for
   (let* ((callee (bir:callee instruction))
          (args (mapcar #'in (rest (bir:inputs instruction))))
          (output (bir:output instruction))
-         (call (gen-local-call callee args (cc-bmir:rtype output))))
+         (call (gen-local-call callee args
+                               (datum-name-as-string output)
+                               (cc-bmir:rtype output))))
     (out call output)))
 
 (defmethod translate-simple-instruction ((instruction bir:call) abi)
@@ -1083,6 +1086,7 @@ function-or-placeholder - the llvm function or a placeholder for
      (gen-local-call callee (if (= (length mvargrt) 1)
                                 (list mvargi)
                                 mvargi)
+                     (datum-name-as-string output)
                      (cc-bmir:rtype output))
      output)))
 
diff --git a/src/llvmo/llvmoExpose.cc b/src/llvmo/llvmoExpose.cc
index 477790f323..1fef917e60 100644
--- a/src/llvmo/llvmoExpose.cc
+++ b/src/llvmo/llvmoExpose.cc
@@ -3605,8 +3605,14 @@ CL_DEFUN core::T_sp FunctionType_O::get(llvm::Type* result_type, core::T_sp para
   return translate::to_object<llvm::FunctionType*>::convert(result);
 };
 
-// I can't get the following to work yet
-// CL_EXTERN_DEFMETHOD(FunctionType_O, &llvm::FunctionType::getReturnType);
+// Doesn't work. Clang complains it can't instantiate std::invoke:
+// note: candidate template ignored: substitution failure [with _Callable = llvm::Type *(llvm::FunctionType::*)() const, _Args = <PointerToExternalType>]: no type named 'type' in 'std::invoke_result<llvm::Type *(llvm::FunctionType::*)() const, llvm::Type *>'
+// I don't know why we're giving it a Type rather than a FunctionType.
+//CL_EXTERN_DEFMETHOD(FunctionType_O, &llvm::FunctionType::getReturnType);
+CL_DEFUN core::T_sp llvm_sys__function_type_return_type(llvmo::FunctionType_sp ftype) {
+  llvm::FunctionType* fty = ftype->wrapped();
+  return translate::to_object<llvm::Type*>::convert(fty->getReturnType());
+}
 
 DOCGROUP(clasp);
 CL_DEFUN core::T_sp llvm_sys__function_type_param_types(llvmo::FunctionType_sp ftype) {

From 142f269917e04177f270e096a12e2e237e4b03d0 Mon Sep 17 00:00:00 2001
From: Bike <aeshtaer@gmail.com>
Date: Mon, 27 Apr 2026 23:44:57 -0400
Subject: [PATCH 10/14] Don't make closures for any local calls

This will be an important property for inlining, because it means
we can introduce any functions we want without requiring new
functions in the fasl literals.

It also saves a little runtime consing.
---
 src/lisp/kernel/cleavir/translate.lisp | 26 --------------------------
 1 file changed, 26 deletions(-)

diff --git a/src/lisp/kernel/cleavir/translate.lisp b/src/lisp/kernel/cleavir/translate.lisp
index d7c5599bae..39eed456df 100644
--- a/src/lisp/kernel/cleavir/translate.lisp
+++ b/src/lisp/kernel/cleavir/translate.lisp
@@ -17,34 +17,8 @@
    ;; NIL if there's no XEP.
    (%prototype :initarg :prototype :reader prototype)))
 
-(defun lambda-list-too-hairy-p (lambda-list)
-  (multiple-value-bind (reqargs optargs rest-var key-flag keyargs aok aux varest-p)
-      (cmp:process-bir-lambda-list lambda-list)
-    (declare (ignore reqargs optargs keyargs aok aux rest-var varest-p))
-    key-flag))
-
-(defun nontrivial-mv-local-call-p (call)
-  (cond ((typep call 'cc-bmir:fixed-mv-local-call)
-         ;; Could still be nontrivial if the number of arguments is wrong
-         (multiple-value-bind (req opt rest)
-             (cmp:process-bir-lambda-list (bir:lambda-list (bir:callee call)))
-           (let ((lreq (length (cc-bmir:rtype (second (bir:inputs call))))))
-             (or (< lreq (car req))
-                 (and (not rest) (> lreq (+ (car req) (car opt))))))))
-        ((typep call 'bir:mv-local-call) t)
-        (t nil)))
-
 (defun xep-needed-p (function)
   (or (bir:enclose function)
-      ;; We need a XEP for more involved lambda lists.
-      (lambda-list-too-hairy-p (bir:lambda-list function))
-      ;; or for mv-calls that might need to signal an error.
-      (and (cleavir-set:some #'nontrivial-mv-local-call-p
-                             (bir:local-calls function))
-           (multiple-value-bind (req opt rest)
-               (cmp:process-bir-lambda-list (bir:lambda-list function))
-             (declare (ignore opt))
-             (or (plusp (car req)) (not rest))))
       ;; Assume that a function with no enclose and no local calls is
       ;; toplevel and needs an XEP. Else it would have been removed or
       ;; deleted as it is unreferenced otherwise.

From d958c9eaf93a7396173eb5ce5a727758b440af64 Mon Sep 17 00:00:00 2001
From: Bike <aeshtaer@gmail.com>
Date: Thu, 30 Apr 2026 13:03:45 -0400
Subject: [PATCH 11/14] Changes for entry points in Cleavir modules

We have to mark entry points in b2b now. And, we can use entry-point-p
instead of treating "no local calls or enclose" as being an entry point.
---
 src/lisp/kernel/cleavir/compile-bytecode.lisp | 41 +++++++++++++------
 .../cleavir/representation-selection.lisp     | 13 +++---
 src/lisp/kernel/cleavir/translate.lisp        |  7 +---
 3 files changed, 37 insertions(+), 24 deletions(-)

diff --git a/src/lisp/kernel/cleavir/compile-bytecode.lisp b/src/lisp/kernel/cleavir/compile-bytecode.lisp
index dd7eea0569..348314f222 100644
--- a/src/lisp/kernel/cleavir/compile-bytecode.lisp
+++ b/src/lisp/kernel/cleavir/compile-bytecode.lisp
@@ -165,18 +165,20 @@
                            (disassemble nil))
   (multiple-value-bind (module funmap)
       (compile-bcmodule (core:simple-fun-code function))
-    (bir:verify module)
-    (when disassemble
-      (cleavir-bir-disassembler:display module))
-    (clasp-cleavir::bir-transformations module system)
-    (dissociate-inappropriate-closures (fmap funmap))
-    (let (;; Ensure any closures have the same layout as original
-          ;; bytecode closures, so the simple fun can be swapped
-          ;; out transparently.
-          (clasp-cleavir::*fixed-closures*
-            (fixed-closures-map (fmap funmap)))
-          (bir (finfo-irfun (find-bcfun function funmap))))
-      (clasp-cleavir::bir->function bir :abi abi))))
+    (let ((bir (finfo-irfun (find-bcfun function funmap))))
+      (cleavir-set:nadjoinf (bir:entry-points module) bir)
+      (bir:remove-unused-values module)
+      (bir:verify module)
+      (when disassemble
+        (cleavir-bir-disassembler:display module))
+      (clasp-cleavir::bir-transformations module system)
+      (dissociate-inappropriate-closures (fmap funmap))
+      (let (;; Ensure any closures have the same layout as original
+            ;; bytecode closures, so the simple fun can be swapped
+            ;; out transparently.
+            (clasp-cleavir::*fixed-closures*
+              (fixed-closures-map (fmap funmap))))
+        (clasp-cleavir::bir->function bir :abi abi)))))
 
 ;;; Given a bytecode module, compute native functions for all bytecode functions
 ;;; in it, and install them as new simple funs. Return value irrelevant.
@@ -185,6 +187,13 @@
                        &key (abi clasp-cleavir::*abi-x86-64*)
                          (system clasp-cleavir:*clasp-system*))
   (multiple-value-bind (irmodule funmap) (compile-bcmodule module)
+    (loop for info across (core:bytecode-module/debug-info module)
+          when (typep info 'core:bytecode-simple-fun)
+            do (let ((finfo (find-bcfun info funmap)))
+                 (when finfo
+                   (cleavir-set:nadjoinf (bir:entry-points irmodule)
+                                         (finfo-irfun finfo)))))
+    (bir:remove-unused-values irmodule)
     (clasp-cleavir::bir-transformations irmodule system)
     (dissociate-inappropriate-closures (fmap funmap))
     (multiple-value-bind (function-infos constants ctable fvector)
@@ -1726,6 +1735,14 @@
   (let* ((irmodule (make-instance 'bir:module))
          (literals (compute-compiled-literals literals-info irmodule))
          (funmap (compile-bytecode-into bytecode debug-info literals irmodule)))
+    (loop for info across debug-info
+          when (typep info 'cmp:cfunction)
+            do (let ((finfo (find-bcfun info funmap)))
+                 (when finfo
+                   (cleavir-set:nadjoinf (bir:entry-points irmodule)
+                                         (finfo-irfun finfo)))))
+    (bir:remove-unused-values irmodule)
+    (bir:verify irmodule)
     ;;(cleavir-bir-disassembler:display irmodule) (terpri)
     (clasp-cleavir::bir-transformations irmodule clasp-cleavir:*clasp-system*)
     (dissociate-inappropriate-closures (fmap funmap))
diff --git a/src/lisp/kernel/cleavir/representation-selection.lisp b/src/lisp/kernel/cleavir/representation-selection.lisp
index ff5084399c..8582e60514 100644
--- a/src/lisp/kernel/cleavir/representation-selection.lisp
+++ b/src/lisp/kernel/cleavir/representation-selection.lisp
@@ -453,16 +453,15 @@
   (when (member returni-input *chasing-rtypes-of* :test #'eq)
     (return-from return-use-rtype '()))
   (let ((*chasing-rtypes-of* (cons returni-input *chasing-rtypes-of*))
-        (rt nil)
-        (local-calls (bir:local-calls function)))
-    (if (or (bir:enclose function) (cleavir-set:empty-set-p local-calls))
-        ;; The function is enclosed, so it could be called from anywhere, and
-        ;; we need to use the pessimistic protocol. No enclose and no local
-        ;; calls means it's the top level function, so the same situation.
+        (rt nil))
+    (if (or (bir:enclose function) (bir:entry-point-p function))
+        ;; The function is enclosed or an entry point,
+        ;; so it could be called from anywhere,
+        ;; and we need to use the pessimistic protocol.
         :multiple-values
         ;; No enclose, so we can look at all the call sites, and if they're
         ;; amenable, do something smarter.
-        (cleavir-set:doset (call local-calls rt)
+        (cleavir-set:doset (call (bir:local-calls function) rt)
           (setf rt (max-rtype rt (use-rtype (bir:output call))))))))
 
 (defgeneric compute-rtype (datum))
diff --git a/src/lisp/kernel/cleavir/translate.lisp b/src/lisp/kernel/cleavir/translate.lisp
index 39eed456df..c267fdc4af 100644
--- a/src/lisp/kernel/cleavir/translate.lisp
+++ b/src/lisp/kernel/cleavir/translate.lisp
@@ -18,11 +18,7 @@
    (%prototype :initarg :prototype :reader prototype)))
 
 (defun xep-needed-p (function)
-  (or (bir:enclose function)
-      ;; Assume that a function with no enclose and no local calls is
-      ;; toplevel and needs an XEP. Else it would have been removed or
-      ;; deleted as it is unreferenced otherwise.
-      (cleavir-set:empty-set-p (bir:local-calls function))))
+  (or (bir:enclose function) (bir:entry-point-p function)))
 
 (defun argument-rtype->llvm (arg)
   (let ((rtype (cc-bmir:rtype arg)))
@@ -2245,6 +2241,7 @@ function-or-placeholder - the llvm function or a placeholder for
                   :name (make-symbol (format nil "~a-CALLER-START" signature))
                   :function caller :dynamic-environment caller)))
     (cleavir-set:nadjoinf (bir:functions module) caller)
+    (cleavir-set:nadjoinf (bir:entry-points module) caller)
     (setf (bir:start caller) iblock
           (bir:lambda-list caller) arguments)
     (build:begin inserter iblock)

From fe0276fc3c466e915d1067f1cf084b818997c30b Mon Sep 17 00:00:00 2001
From: Bike <aeshtaer@gmail.com>
Date: Mon, 14 Sep 2026 15:31:51 -0400
Subject: [PATCH 12/14] fix comment

---
 src/lisp/kernel/cleavir/compile-bytecode.lisp | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/lisp/kernel/cleavir/compile-bytecode.lisp b/src/lisp/kernel/cleavir/compile-bytecode.lisp
index 348314f222..db043f6bc9 100644
--- a/src/lisp/kernel/cleavir/compile-bytecode.lisp
+++ b/src/lisp/kernel/cleavir/compile-bytecode.lisp
@@ -227,7 +227,7 @@
 ;;; from the funmap.
 ;;; This has to be called after bir-transformations, or more
 ;;; specifically, after determine-function-environments.
-;;; (simple example: (lambda (x) (flet ((foo () x)) (lambda () foo)))
+;;; (simple example: (lambda (x) (flet ((foo () x)) (lambda () (foo))))
 ;;;  the inner lambda is optimized to close over x not #'foo.)
 (defun dissociate-inappropriate-closures (fmap)
   (loop for entry in fmap

From f04cf0fabba45f72a1b00b1f35453a742c566d52 Mon Sep 17 00:00:00 2001
From: Bike <aeshtaer@gmail.com>
Date: Mon, 14 Sep 2026 16:23:05 -0400
Subject: [PATCH 13/14] workaround for Cleavir closure issue

compiling closures is weird and Cleavir is not really set up for
it. Without this recursive marking, you can compile a closure, and
the function that closes over it can be deleted as it is not an
entry point. That deletes the variables, which messes up the
functions' environments so they don't close correctly.
We'd need some kind of notion of a variable attached to a module
rather than a function, I guess, and even then there would be more
problems with a closure over an exit point. So here's a kludge
that should work, it just keeps more functions alive than it
needs to.
---
 src/lisp/kernel/cleavir/compile-bytecode.lisp | 18 +++++++++++++-----
 1 file changed, 13 insertions(+), 5 deletions(-)

diff --git a/src/lisp/kernel/cleavir/compile-bytecode.lisp b/src/lisp/kernel/cleavir/compile-bytecode.lisp
index db043f6bc9..bc8328852e 100644
--- a/src/lisp/kernel/cleavir/compile-bytecode.lisp
+++ b/src/lisp/kernel/cleavir/compile-bytecode.lisp
@@ -157,6 +157,16 @@
       (build:begin inserter (binfo-irblock binfo))
       (context-new-block context (binfo-context binfo)))))
 
+;;; Note a function as a module entry point.
+;;; KLUDGE: this should just be an nadjoinf, but Cleavir behaves poorly
+;;; if a closure is an entry point and its parent is not.
+;;; That's a FIXME for Cleavir.
+(defun mark-entry-point (function)
+  (cleavir-set:nadjoinf (bir:entry-points (bir:module function))
+                        function)
+  (when (bir:enclose function)
+    (mark-entry-point (bir:function (bir:enclose function)))))
+
 ;;; Given a bytecode function, return a compiled native function.
 ;;; Used for CL:COMPILE.
 (defun compile-function (function
@@ -166,7 +176,7 @@
   (multiple-value-bind (module funmap)
       (compile-bcmodule (core:simple-fun-code function))
     (let ((bir (finfo-irfun (find-bcfun function funmap))))
-      (cleavir-set:nadjoinf (bir:entry-points module) bir)
+      (mark-entry-point bir)
       (bir:remove-unused-values module)
       (bir:verify module)
       (when disassemble
@@ -191,8 +201,7 @@
           when (typep info 'core:bytecode-simple-fun)
             do (let ((finfo (find-bcfun info funmap)))
                  (when finfo
-                   (cleavir-set:nadjoinf (bir:entry-points irmodule)
-                                         (finfo-irfun finfo)))))
+                   (mark-entry-point (finfo-irfun finfo)))))
     (bir:remove-unused-values irmodule)
     (clasp-cleavir::bir-transformations irmodule system)
     (dissociate-inappropriate-closures (fmap funmap))
@@ -1739,8 +1748,7 @@
           when (typep info 'cmp:cfunction)
             do (let ((finfo (find-bcfun info funmap)))
                  (when finfo
-                   (cleavir-set:nadjoinf (bir:entry-points irmodule)
-                                         (finfo-irfun finfo)))))
+                   (mark-entry-point (finfo-irfun finfo)))))
     (bir:remove-unused-values irmodule)
     (bir:verify irmodule)
     ;;(cleavir-bir-disassembler:display irmodule) (terpri)

From be3f8cc0cb9992a9fc9d9113f6f82186eda5c969 Mon Sep 17 00:00:00 2001
From: Bike <aeshtaer@gmail.com>
Date: Mon, 14 Sep 2026 20:19:38 -0400
Subject: [PATCH 14/14] btb: only mark parent functions entries for actual
 closures

see comment. The point is this saves having to compile the DEFUN
garbage that is very common in bytecode.
---
 src/lisp/kernel/cleavir/compile-bytecode.lisp | 29 ++++++++++++++-----
 1 file changed, 21 insertions(+), 8 deletions(-)

diff --git a/src/lisp/kernel/cleavir/compile-bytecode.lisp b/src/lisp/kernel/cleavir/compile-bytecode.lisp
index bc8328852e..b4ec92fa46 100644
--- a/src/lisp/kernel/cleavir/compile-bytecode.lisp
+++ b/src/lisp/kernel/cleavir/compile-bytecode.lisp
@@ -161,11 +161,20 @@
 ;;; KLUDGE: this should just be an nadjoinf, but Cleavir behaves poorly
 ;;; if a closure is an entry point and its parent is not.
 ;;; That's a FIXME for Cleavir.
-(defun mark-entry-point (function)
-  (cleavir-set:nadjoinf (bir:entry-points (bir:module function))
-                        function)
-  (when (bir:enclose function)
-    (mark-entry-point (bir:function (bir:enclose function)))))
+(defun mark-entry-point (irfun funmap
+                         &optional (bcfun
+                                    (finfo-bcfun
+                                     (find-irfun irfun funmap))))
+  (cleavir-set:nadjoinf (bir:entry-points (bir:module irfun))
+                        irfun)
+  (when (and (bir:enclose irfun)
+             ;; if it doesn't actually close over anything
+             ;; we don't need the parent.
+             ;; This is an important case for e.g. DEFUN'd functions,
+             ;; which in bytecode are closed over by the function
+             ;; that does (setf fdefinition).
+             (> (length (bcfun/nvars bcfun)) 0))
+    (mark-entry-point (bir:function (bir:enclose irfun)) funmap)))
 
 ;;; Given a bytecode function, return a compiled native function.
 ;;; Used for CL:COMPILE.
@@ -176,7 +185,7 @@
   (multiple-value-bind (module funmap)
       (compile-bcmodule (core:simple-fun-code function))
     (let ((bir (finfo-irfun (find-bcfun function funmap))))
-      (mark-entry-point bir)
+      (mark-entry-point bir funmap function)
       (bir:remove-unused-values module)
       (bir:verify module)
       (when disassemble
@@ -201,7 +210,9 @@
           when (typep info 'core:bytecode-simple-fun)
             do (let ((finfo (find-bcfun info funmap)))
                  (when finfo
-                   (mark-entry-point (finfo-irfun finfo)))))
+                   (mark-entry-point (finfo-irfun finfo)
+                                     funmap
+                                     (finfo-bcfun finfo)))))
     (bir:remove-unused-values irmodule)
     (clasp-cleavir::bir-transformations irmodule system)
     (dissociate-inappropriate-closures (fmap funmap))
@@ -1748,7 +1759,9 @@
           when (typep info 'cmp:cfunction)
             do (let ((finfo (find-bcfun info funmap)))
                  (when finfo
-                   (mark-entry-point (finfo-irfun finfo)))))
+                   (mark-entry-point (finfo-irfun finfo)
+                                     funmap
+                                     (finfo-bcfun finfo)))))
     (bir:remove-unused-values irmodule)
     (bir:verify irmodule)
     ;;(cleavir-bir-disassembler:display irmodule) (terpri)