cmp: move data inlining to the second pass

c1constant-value etc does not attempt to create inlined vv - it is the
responsibility of the data pre-processing pass.

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

@@ -266,19 +266,15 @@
 ;;;
 ;;; TODO implement handling of unboxed values.
 
-(defun try-value-c-inliner (val)
-  (unless (vv-p val)
-    (return-from try-value-c-inliner))
-  (let ((value (vv-value val)))
-    (ext:when-let ((x (assoc value *optimizable-constants*)))
-      (when (typep value '(or float (complex float)))
-        (pushnew "#include <float.h>" *clines-string-list*)
-        (pushnew "#include <complex.h>" *clines-string-list*))
-      (c1form-arg 0 (cdr x)))))
+(defun try-value-c-inliner (value)
+  (ext:when-let ((x (assoc value *optimizable-constants*)))
+    (when (typep value '(or float (complex float)))
+      (pushnew "#include <float.h>" *clines-string-list*)
+      (pushnew "#include <complex.h>" *clines-string-list*))
+    (c1form-arg 0 (cdr x))))
 
 (defun try-const-c-inliner (var)
-  (unless (var-p var)
-    (return-from try-const-c-inliner))
+  (check-type var var)
   (let ((name (var-name var)))
     (when (constant-variable-p name)
       (ext:when-let ((x (assoc name *optimizable-constants*)))
@@ -291,6 +287,30 @@
       (when foundp
         (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.
+  (typecase value
+    ((or fixnum character float #|#+complex-float (complex float)|#)
+     (make-vv :value value
+              :location nil
+              :rep-type (lisp-type->rep-type (type-of value))))
+    #+sse2
+    (ext:sse-pack
+     (let* ((bytes (ext:sse-pack-to-vector value '(unsigned-byte 8)))
+            (elt-type (ext:sse-pack-element-type value)))
+       (multiple-value-bind (wrapper rtype)
+           (case elt-type
+             (cl:single-float (values "_mm_castsi128_ps" :float-sse-pack))
+             (cl:double-float (values "_mm_castsi128_pd" :double-sse-pack))
+             (otherwise       (values ""                 :int-sse-pack)))
+         (make-vv :value value
+                  :location (format nil "~A(_mm_setr_epi8(~{~A~^,~}))"
+                                    wrapper (coerce bytes 'list))
+                  :rep-type rtype))))
+    (otherwise
+     nil)))
+
 
 
 (defun data-empty-loc* ()
@@ -330,7 +350,9 @@
            (let ((value (vv-value object)))
              (ext:if-let ((vv (and (not (vv-always object))
                                    (or (add-static-constant value)
-                                       (try-inline-core-sym value)))))
+                                       (try-inline-core-sym value)
+                                       (try-value-c-inliner value)
+                                       (try-immediate-value value)))))
                (update-vv object vv)
                (insert-vv object)))))
     (map nil #'optimize-vv objects)))

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

@@ -134,18 +134,14 @@
     (close-inline-blocks)))
 
 (defun c2location (c1form loc)
-  (unwind-exit (precise-loc-type
-                (or (try-value-c-inliner loc)
-                    loc)
-                (c1form-primary-type c1form))))
+  (unwind-exit (precise-loc-type loc (c1form-primary-type c1form))))
 
 ;;; When LOC is not NIL, then the variable is a constant.
 (defun c2var (c1form var loc)
   (unwind-exit (precise-loc-type
-                (or (try-value-c-inliner loc)
-                    (try-const-c-inliner var)
+                (if (and loc (not (numberp (vv-location loc))))
                     loc
-                    var)
+                    (or (try-const-c-inliner var) var))
                 (c1form-primary-type c1form))))
 
 (defun c2setq (c1form vref form)

src/cmp/cmppass1-call.lsp

@@ -272,7 +272,8 @@
                          (let ((results (mapcar #'c1constant-value results)))
                            (when (every #'identity results)
                              (make-c1form* 'CL:VALUES :args results)))))))
-      (error (c) (cmpdebug "Can't constant-fold ~s ~s: ~a~%" fname forms c)))))
+      (error (c)
+        (cmpdebug "Can't constant-fold ~s ~s: ~a~%" fname forms c)))))
 
 ;;; Transform a (funcall lambda-form arguments) or (apply lambda-form
 ;;; arguments) expression into an equivalent let* statement. Returns

src/cmp/cmppass1-eval.lsp

@@ -41,7 +41,7 @@
                  ((and (consp fun) (eq (car fun) 'LAMBDA))
                   (c1funcall form))
                  (t (cmperr "~s is not a legal function name." fun)))))
-        (t (c1constant-value form :always t))))
+        (t (c1constant-value form))))
 
 (defun c1expr (form)
   (let ((*current-form* form))
@@ -127,51 +127,19 @@
        (return form))
      (setf form new-form))))
 
-(defun c1constant-value (val &key always)
+(defun c1constant-value (val)
   (cond
     ((eq val nil) (c1nil))
     ((eq val t) (c1t))
-    ((ext:fixnump val)
-     (make-c1form* 'LOCATION :type 'FIXNUM :args (make-vv :rep-type :fixnum :value val)))
-    ((si:base-char-p val)
-     (make-c1form* 'LOCATION :type 'BASE-CHAR :args (make-vv :rep-type :unsigned-char :value val)))
-    ((characterp val)
-     (make-c1form* 'LOCATION :type 'CHARACTER :args (make-vv :rep-type :wchar :value val)))
-    ((typep val 'SINGLE-FLOAT)
-     (make-c1form* 'LOCATION :type 'SINGLE-FLOAT :args (make-vv :rep-type :float :value val)))
-    ((typep val 'DOUBLE-FLOAT)
-     (make-c1form* 'LOCATION :type 'DOUBLE-FLOAT :args (make-vv :rep-type :double :value val)))
-    ((typep val 'LONG-FLOAT)
-     (make-c1form* 'LOCATION :type 'LONG-FLOAT :args (make-vv :rep-type :long-double :value val)))
-    ;; FIXME C?FLOAT
-    #+sse2
-    ((typep val 'EXT:SSE-PACK)
-     (c1constant-value/sse val))
-    (always
-     (make-c1form* 'LOCATION :type `(eql ,val)
-                             :args (add-object val)))
-    (t nil)))
+    ((make-c1form* 'LOCATION :type `(eql ,val)
+                             :args (add-object val)))))
 
 ;;; To inline a constant it must be possible to externalize its value or copies
 ;;; of the value must be EQL to each other.
 (defun c1constant-symbol-value (name val)
   (declare (ignore name))
-  (let ((form (c1constant-value val)))
-    (and form (c1form-arg 0 form))))
-
-#+sse2
-(defun c1constant-value/sse (value)
-  (let* ((bytes (ext:sse-pack-to-vector value '(unsigned-byte 8)))
-         (elt-type (ext:sse-pack-element-type value)))
-    (multiple-value-bind (wrapper rtype)
-        (case elt-type
-          (cl:single-float (values "_mm_castsi128_ps" :float-sse-pack))
-          (cl:double-float (values "_mm_castsi128_pd" :double-sse-pack))
-          (otherwise       (values ""                 :int-sse-pack)))
-      `(ffi:c-inline () () ,rtype
-                     ,(format nil "~A(_mm_setr_epi8(~{~A~^,~}))"
-                              wrapper (coerce bytes 'list))
-                     :one-liner t :side-effects nil))))
+  (let ((si:*compiler-constants* t))    ; don't create make-load forms
+    (add-object val)))
 
 (defun c1if (args)
   (check-args-number 'IF args 2 3)

src/cmp/cmppass1-special.lsp

@@ -16,7 +16,7 @@
 
 (defun c1quote (args)
   (check-args-number 'QUOTE args 1 1)
-  (c1constant-value (car args) :always t))
+  (c1constant-value (car args)))
 
 (defun c1declare (args)
   (cmperr "The declaration ~s was found in a bad place." (cons 'DECLARE args)))

src/cmp/cmppass1-top.lsp

@@ -132,7 +132,7 @@
            ;; thus signal that we do not want to compile these forms, but
            ;; just to retain their value.
            (return-from c1load-time-value
-             (c1constant-value (cmp-eval form) :always t)))
+             (c1constant-value (cmp-eval form))))
           ((typep form '(or list symbol))
            (setf loc (data-empty-loc))
            (push (make-c1form* 'LOAD-TIME-VALUE :args loc (c1expr form))

src/cmp/cmptype.lsp

@@ -53,7 +53,7 @@
                                        (si:complex-single-float . #c(0.0l0 0.0l0)))))
                                :test #'subtypep))))
     (if new-value
-        (c1constant-value new-value :always t)
+        (c1constant-value new-value)
         (c1nil))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;