Merge branch 'cl-bench-regressions' into 'develop'

Fix performance regressions identified by cl-bench

See merge request embeddable-common-lisp/ecl!365

src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp

@@ -108,6 +108,21 @@
        (let ((var-form (make-c1form 'VARIABLE form var nil)))
          (emit-inlined-temp-var var-form lisp-type (var-host-type var)))))))
 
+(defun emit-inlined-fcall (form)
+  (let ((args (c1form-arg 1 form))
+        (fname (c1form-arg 2 form))
+        (call-type (c1form-arg 3 form)))
+    (if (not (and (eq call-type :global)
+                  (<= (length args) si:c-arguments-limit)))
+        (emit-inlined-temp-var form t :object)
+        (let* ((return-type (c1form-primary-type form))
+               (fun (find fname *global-funs* :key #'fun-name :test #'same-fname-p))
+               (loc (call-global-loc fname fun (inline-args args) return-type))
+               (type (type-and return-type (loc-lisp-type loc)))
+               (temp (make-inlined-temp-var type (loc-host-type loc))))
+          (set-loc temp loc)
+          (precise-loc-lisp-type temp type)))))
+
 (defun emit-inlined-progn (form rest-forms)
   (let ((args (c1form-arg 0 form)))
     (loop with *destination* = 'TRASH
@@ -137,9 +152,10 @@
   (with-c1form-env (form form)
     (precise-loc-lisp-type
      (case (c1form-name form)
-       (LOCATION (c1form-arg 0 form) )
+       (LOCATION (c1form-arg 0 form))
        (VARIABLE (emit-inlined-variable form forms))
        (SETQ     (emit-inlined-setq form forms))
+       (FCALL    (emit-inlined-fcall form))
        (PROGN    (emit-inlined-progn form forms))
        (VALUES   (emit-inlined-values form forms))
        (t        (emit-inlined-temp-var form t :object)))

src/cmp/cmpbackend-cxx/cmppass2-data.lsp

@@ -280,10 +280,8 @@
         (make-vv :value object :location cname)))))
 
 (defun try-immediate-value (value)
-  ;; FIXME we could inline here also (COMPLEX FLOAT). That requires adding an
-  ;; emmiter of C complex floats in the function WT1.
   (cond
-    ((typep value '(or fixnum character float #|#+complex-float (complex float)|#) *cmp-env*)
+    ((typep value '(or fixnum character) *cmp-env*)
      (make-vv :value value
               :location nil
               :host-type (lisp-type->host-type (type-of value))))

src/cmp/cmppass1-var.lsp

@@ -20,25 +20,32 @@
            (c1let/let* 'let* bindings args))
           (t
            (loop :with temp
-              :for b :in bindings
-                :if (atom b)
-                  :collect b :into real-bindings :and
-                  :collect b :into names
-                :else
-                  :collect (setf temp (gensym "LET")) :into temp-names    :and
-                  :collect (cons temp (cdr b))        :into temp-bindings :and
-                  :collect (list (car b) temp)        :into real-bindings :and
-                  :collect (car b)                    :into names
-                :do
-                  (cmpck (member (car names) (cdr names) :test #'eq)
-                         "LET: The variable ~s occurs more than once in the LET."
-                         (car names))
-              :finally
-                (return (c1let/let* 'let*
-                                    (nconc temp-bindings real-bindings)
-                                    `((declare (ignorable ,@temp-names)
-                                               (:read-only ,@temp-names))
-                                      ,@args)))))
+                 :with type-decls = (nth-value 2 (c1body args nil))
+                 :with temp-type-decls = '()
+                 :for b :in bindings
+                 :if (atom b)
+                   :collect b :into real-bindings :and
+                   :collect b :into names
+                 :else
+                   :collect (setf temp (gensym "LET")) :into temp-names    :and
+                   :collect (cons temp (cdr b))        :into temp-bindings :and
+                   :collect (list (car b) temp)        :into real-bindings :and
+                   :collect (car b)                    :into names         :and
+                   :do
+                      (ext:when-let ((type-decl (find (car b) type-decls :key #'car :test #'eq)))
+                        (push `(type ,(cdr type-decl) ,temp)
+                              temp-type-decls))
+                 :do
+                    (cmpck (member (car names) (cdr names) :test #'eq)
+                           "LET: The variable ~s occurs more than once in the LET."
+                           (car names))
+                 :finally
+                    (return (c1let/let* 'let*
+                                        (nconc temp-bindings real-bindings)
+                                        `((declare (ignorable ,@temp-names)
+                                                   (:read-only ,@temp-names)
+                                                   ,@temp-type-decls)
+                                          ,@args)))))
           (t
            (c1let/let* 'let bindings args)))))
 
@@ -97,7 +104,9 @@
             (if (global-var-p var)
                 (cmpwarn "Found :READ-ONLY declaration for global var ~A"
                          name)
-                (setf (var-type var) (c1form-primary-type init)))
+                (setf (var-type var) (type-and
+                                      type
+                                      (c1form-primary-type init))))
             (multiple-value-bind (constantp value)
                 (c1form-constant-p init)
               (when constantp
@@ -130,8 +139,7 @@
                 :args vars forms body))
 
 (defun c1let-optimize-read-only-vars (all-vars all-forms body)
-  (loop with base = (list body)
-     for vars on all-vars
+  (loop for vars on all-vars
      for forms on (nconc all-forms (list body))
      for var = (first vars)
      for form = (first forms)