diff --git a/src/cmp/cmppass1-call.lsp b/src/cmp/cmppass1-call.lsp
index 14867726e..319af0b60 100644
--- a/src/cmp/cmppass1-call.lsp
+++ b/src/cmp/cmppass1-call.lsp
@@ -20,51 +20,72 @@
 (defun unoptimized-funcall (fun arguments)
   (let ((l (length arguments)))
     (if (<= l si:c-arguments-limit)
-        (make-c1form* 'FUNCALL :sp-change t :side-effects t
-                               :args (c1expr fun) (c1args* arguments))
+        (make-c1form* 'CL:FUNCALL :sp-change t :side-effects t
+                                  :args (c1expr fun) (c1args* arguments))
         (unoptimized-long-call fun arguments))))
 
-(defun macroexpand-lambda-block (lambda)
-  (if (eq (first lambda) 'EXT::LAMBDA-BLOCK)
-      (macroexpand-1 lambda)
-      lambda))
+(defun optimized-lambda-call (lambda-form arguments apply-p)
+  (multiple-value-bind (bindings body)
+      (transform-funcall/apply-into-let* lambda-form arguments apply-p)
+    `(let* ,bindings ,@body)))
+
+(defun try-optimized-lambda-call (fun args apply-p)
+  (unless (consp fun)
+    (return-from try-optimized-lambda-call nil))
+  (when (function-form-p fun)
+    (setf fun (second fun)))
+  (if (and (consp fun)
+           (member (first fun) '(cl:lambda ext:lambda-block)))
+      (optimized-lambda-call fun args apply-p)
+      nil))
+
+(defun try-macro-expression-call (fun args)
+  (unless (consp fun)
+    (return-from try-macro-expression-call nil))
+  (let* ((name (first fun))
+         (fd (and (symbolp name)
+                  ;; We do not want to macroexpand 'CL:THE
+                  (not (eq name 'CL:THE))
+                  (cmp-macro-function name))))
+    (if fd
+        (c1funcall (list* (cmp-expand-macro fd fun) args))
+        nil)))
+
+(defun try-function-special-call (fun args)
+  (unless (function-form-p fun)
+    (return-from try-function-special-call nil))
+  (let ((fname (second fun)))
+    (if (si:valid-function-name-p fname)
+        (c1call fname args nil)
+        (cmperr "Malformed function name: ~A." fun))))
+
+(defun not-a-closure-p (fname)
+  (declare (si::c-local))
+  (not (and (fboundp fname) (nth-value 1 (function-lambda-expression (fdefinition fname))))))
+
+(defun function-form-p (form)
+  (declare (si::c-local))
+  (if (and (consp form)
+           (eq (first form) 'CL:FUNCTION))
+      (prog1 t
+        (check-args-number 'CL:FUNCTION (rest form) 1 1))
+      nil))
 
 (defun c1funcall (args)
-  (check-args-number 'FUNCALL args 1)
-  (let ((fun (first args))
-        (arguments (rest args))
-        fd)
-    (cond ;; (FUNCALL (LAMBDA ...) ...) or (FUNCALL (EXT::LAMBDA-BLOCK ...) ...)
-      ((and (consp fun)
-            (member (first fun) '(LAMBDA EXT::LAMBDA-BLOCK)))
-       (optimize-funcall/apply-lambda (macroexpand-lambda-block fun)
-                                      arguments nil))
-      ;; (FUNCALL atomic-expression ...)
-      ((atom fun)
-       (unoptimized-funcall fun arguments))
-      ;; (FUNCALL macro-expression ...)
-      ((let ((name (first fun)))
-         (setq fd (and (symbolp name)
-                       ;; We do not want to macroexpand 'THE
-                       (not (eq name 'THE))
-                       (cmp-macro-function name))))
-       (c1funcall (list* (cmp-expand-macro fd fun) arguments)))
-      ;; (FUNCALL lisp-expression ...)
-      ((not (eq (first fun) 'FUNCTION))
-       (unoptimized-funcall fun arguments))
-      ;; (FUNCALL #'GENERALIZED-FUNCTION-NAME ...)
-      ((si::valid-function-name-p (setq fun (second fun)))
-       (c1call fun arguments nil))
-      ;; (FUNCALL #'(LAMBDA ...) ...) or (FUNCALL #'(EXT::LAMBDA-BLOCK ...) ...)
-      ((and (consp fun)
-            (member (first fun) '(LAMBDA EXT::LAMBDA-BLOCK)))
-       (optimize-funcall/apply-lambda (macroexpand-lambda-block fun)
-                                      arguments nil))
-      (t
-       (cmperr "Malformed function name: ~A" fun)))))
+  (check-args-number 'CL:FUNCALL args 1)
+  (destructuring-bind (fun . arguments) args
+    (or ;; (FUNCALL   (LAMBDA ...) ...) or (FUNCALL   (EXT:LAMBDA-BLOCK ...) ...)
+        ;; (FUNCALL #'(LAMBDA ...) ...) or (FUNCALL #'(EXT:LAMBDA-BLOCK ...) ...)
+        (try-optimized-lambda-call fun arguments nil)
+        ;; (FUNCALL macro-expression ...)
+        (try-macro-expression-call fun arguments)
+        ;; (FUNCALL (FUNCTION function-name) ...)
+        (try-function-special-call fun arguments)
+        ;; (FUNCALL lisp-expression ...) or (FUNCALL atomic-expression ...)
+        (unoptimized-funcall fun arguments))))
 
 (defun c1multiple-value-call (args &aux forms)
-  (check-args-number 'MULTIPLE-VALUE-CALL args 1)
+  (check-args-number 'CL:MULTIPLE-VALUE-CALL args 1)
   (cond
     ;; (M-V-C #'FUNCTION) => (FUNCALL #'FUNCTION)
     ((endp (rest args))
@@ -72,7 +93,7 @@
     ;; (M-V-C #'FUNCTION (VALUES A ... Z)) => (FUNCALL #'FUNCTION A ... Z)
     ((and (= (length args) 2)
           (consp (setq forms (second args)))
-          (eq 'VALUES (first forms)))
+          (eq 'CL:VALUES (first forms)))
      (c1funcall (list* (first args) (rest forms))))
     ;; More complicated case.
     (t
@@ -85,35 +106,23 @@
             (si::apply-from-stack-frame ,frame ,function)))))))
 
 (defun c1apply (args)
-  (check-args-number 'APPLY args 2)
+  (check-args-number 'CL:APPLY args 2)
   (flet ((default-apply (fun arguments)
            (let ((form (c1funcall (list* '#'APPLY fun arguments))))
-             (when (and (consp fun) (eq (first fun) 'FUNCTION))
+             (when (function-form-p fun)
                (let* ((fname (second fun))
                       (type (get-return-type fname)))
                  (when type
                    (setf (c1form-type form) type))))
-             form)))
-    (let* ((fun (first args))
-           (arguments (rest args)))
-      (cond ((eql (first (last arguments)) 'clos:.combined-method-args.)
-             ;; Uses frames instead of lists as last argumennt
-             (default-apply fun arguments))
-            ((and (consp fun)
-                  (member (first fun) '(LAMBDA EXT::LAMBDA-BLOCK)))
-             (optimize-funcall/apply-lambda (macroexpand-lambda-block fun)
-                                            arguments t))
-            ((and (consp fun)
-                  (eq (first fun) 'FUNCTION)
-                  (consp (second fun))
-                  (member (caadr fun) '(LAMBDA EXT::LAMBDA-BLOCK)))
-             (c1apply (list* (second fun) arguments)))
-            (t
-             (default-apply fun arguments))))))
-
-(defun not-a-closure-p (fname)
-  (declare (si::c-local))
-  (not (and (fboundp fname) (nth-value 1 (function-lambda-expression (fdefinition fname))))))
+             form))
+         (last-argument-is-frame-p (arguments)
+           ;; Uses frames instead of lists as last argument. ;; gross hack!
+           (eql (first (last arguments)) 'clos:.combined-method-args.)))
+    (destructuring-bind (fun . arguments) args
+      (if (last-argument-is-frame-p arguments)
+          (default-apply fun arguments)
+          (or (try-optimized-lambda-call fun arguments t)
+              (default-apply fun arguments))))))
 
 (defun c1call (fname args macros-allowed &aux fd success can-inline)
   (cond ((> (length args) si::c-arguments-limit)
@@ -151,9 +160,8 @@
                      (not (fun-closure fd)))
                 (cmpnote "Inlining ~a" fname)
                 (inline-local (fun-lambda-expression fd) fd args))
-               ((and (consp can-inline)
-                     (not-a-closure-p fname)
-                     (eq (first can-inline) 'function))
+               ((and (function-form-p can-inline)
+                     (not-a-closure-p fname))
                 (let ((*inline-max-depth* (1- *inline-max-depth*)))
                   (cmpnote "Inlining ~a" fname)
                   `(funcall ,can-inline ,@args)))
@@ -167,8 +175,7 @@
         (*cmp-env* (cmp-env-copy)))
     ;; To inline the function, we transform it into a let* statement.
     (multiple-value-bind (bindings body)
-        (transform-funcall/apply-into-let* (macroexpand-lambda-block lambda)
-                                           args nil)
+        (transform-funcall/apply-into-let* lambda args nil)
       (multiple-value-bind (let-vars let-inits specials other-decls body)
           (process-let-bindings 'LET* bindings body)
         ;; We have to compile the function body in the same
@@ -251,6 +258,8 @@
 (defun transform-funcall/apply-into-let* (lambda-form arguments apply-p
                                           &aux apply-list apply-var
                                           let-vars extra-stmts all-keys)
+  (when (eq (first lambda-form) 'ext:lambda-block)
+    (setf lambda-form (macroexpand-1 lambda-form)))
   (multiple-value-bind (requireds optionals rest key-flag keywords
                                   allow-other-keys aux-vars)
       (cmp-process-lambda-list (second lambda-form))