cmp: inl: remove the friction between inlined args and locations

Previously inlined args were not treated as locations (they were CONS, and later
INLINED-ARG). This commit makes inlined args VV instances with an appropriate
type assigned. Thanks to that we may use location operations directly on
arguments.

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

@@ -12,14 +12,11 @@
 
 (in-package "COMPILER")
 
-(defstruct (inlined-arg (:constructor %make-inlined-arg))
-  loc
-  type
-  host-type)
-
 (defun make-inlined-arg (loc lisp-type)
-  (%make-inlined-arg :loc loc :type lisp-type
-                     :host-type (loc-host-type loc)))
+  (make-vv :location loc
+           :value *inline-loc*
+           :type lisp-type
+           :host-type (loc-host-type loc)))
 
 (defun maybe-open-inline-block ()
   (unless (plusp *inline-blocks*)
@@ -35,7 +32,7 @@
 
 (defun coerce-locs (inlined-args &optional types args-to-be-saved)
   ;; INLINED-ARGS is a list of INLINED-ARG produced by the argument inliner.
-  ;; The structure contains a location, a lisp type, and the mach rep type.
+  ;; Each arg is a location, "inlined" means "evaluated in the correct order".
   ;;
   ;; ARGS-TO-BE-SAVED is a positional list created by C-INLINE, instructing that
   ;; the value should be saved in a temporary variable.
@@ -47,9 +44,8 @@
   ;;   - A lisp type (T, INTEGER, STRING, CHARACTER, ...))
   ;;
   (loop with block-opened = nil
-        for arg in inlined-args
-        for loc = (inlined-arg-loc arg)
-        for arg-host-type = (inlined-arg-host-type arg)
+        for loc in inlined-args
+        for arg-host-type = (loc-host-type loc)
         for type in (or types '#1=(:object . #1#))
         for i from 0
         for host-type = (lisp-type->host-type type)
@@ -138,7 +134,7 @@
 
 ;;;
 ;;; inline-args:
-;;;   returns a list of pairs (type loc)
+;;;   returns locations that contain results of evaluating forms
 ;;;   side effects: emits code for temporary variables
 ;;;
 ;;; Whoever calls this function must wrap the body in WITH-INLINE-BLOCKS.

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

@@ -38,7 +38,7 @@
     (default-c-inliner fname return-type inlined-args)))
 
 (defun default-c-inliner (fname return-type inlined-args)
-  (let* ((arg-types (mapcar #'inlined-arg-type inlined-args))
+  (let* ((arg-types (mapcar #'loc-type inlined-args))
          (ii (inline-function fname arg-types return-type)))
     (and ii (apply-inline-info ii inlined-args))))
 
@@ -243,7 +243,7 @@
 ;;; Whoever calls this function must wrap the body in WITH-INLINE-BLOCKS.
 (defun negate-argument (argument dest-loc)
   (let* ((inlined-arg (emit-inline-form argument nil))
-         (host-type (inlined-arg-host-type inlined-arg)))
+         (host-type (loc-host-type inlined-arg)))
     (apply #'produce-inline-loc
            (list inlined-arg)
            (if (eq (loc-host-type dest-loc) :bool)

src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp

@@ -18,10 +18,10 @@
 ;;; cases the compiler may do whatever it wants (and gcc does!)
 ;;;
 (define-c-inliner shift (return-type argument orig-shift)
-  (let* ((arg-type (inlined-arg-type argument))
+  (let* ((arg-type (loc-type argument))
          (arg-c-type (lisp-type->host-type arg-type))
          (return-c-type (lisp-type->host-type return-type))
-         (shift (loc-immediate-value (inlined-arg-loc orig-shift))))
+         (shift (loc-immediate-value orig-shift)))
     (if (or (not (c-integer-host-type-p arg-c-type))
             (not (c-integer-host-type-p return-c-type)))
         (produce-inline-loc (list argument orig-shift) '(:object :fixnum) '(:object)
@@ -52,8 +52,8 @@
                        r1))))
 
 (defun inline-binop (expected-type arg1 arg2 consing non-consing)
-  (let ((arg1-type (inlined-arg-type arg1))
-        (arg2-type (inlined-arg-type arg2)))
+  (let ((arg1-type (loc-type arg1))
+        (arg2-type (loc-type arg2)))
     (if (and (policy-assume-right-type)
              (c-number-type-p expected-type)
              (c-number-type-p arg1-type)
@@ -82,7 +82,7 @@
                             consing nil t))))
 
 (defun inline-arith-unop (expected-type arg1 consing non-consing)
-  (let ((arg1-type (inlined-arg-type arg1)))
+  (let ((arg1-type (loc-type arg1)))
     (if (and (policy-assume-right-type)
              (c-number-type-p expected-type)
              (c-number-type-p arg1-type))
@@ -98,7 +98,7 @@
     (return (make-vv :host-type :fixnum :value 1)))
   (setf arg1 (pop arguments))
   (when (null arguments)
-    (return (inlined-arg-loc arg1)))
+    (return arg1))
   (setf arg2 (pop arguments))
   (when (null arguments)
     (return (inline-binop return-type arg1 arg2 "ecl_times(#0,#1)" #\*)))
@@ -109,7 +109,7 @@
     (return (make-vv :host-type :fixnum :value 0)))
   (setf arg1 (pop arguments))
   (when (null arguments)
-    (return (inlined-arg-loc arg1)))
+    (return arg1))
   (setf arg2 (pop arguments))
   (when (null arguments)
     (return (inline-binop return-type arg1 arg2 "ecl_plus(#0,#1)" #\+)))
@@ -133,11 +133,11 @@
   (cmperr "The C inliner for (FUNCTION /) expected at most 2 arguments."))
 
 (define-c-inliner float (return-type arg &optional float)
-  (let ((arg-c-type (lisp-type->host-type (inlined-arg-type arg)))
-        (flt-c-type (and float (lisp-type->host-type (inlined-arg-type float)))))
+  (let ((arg-c-type (lisp-type->host-type (loc-type arg)))
+        (flt-c-type (and float (lisp-type->host-type (loc-type float)))))
     (if (member arg-c-type '(:float :double :long-double))
         (when (or (null float) (eq arg-c-type flt-c-type))
-          (inlined-arg-loc arg))
+          arg)
         (when (member flt-c-type '(:float :double :long-double))
           (produce-inline-loc (list arg)
                               (list :object)

src/cmp/cmpbackend-cxx/cmpc-opt-printer.lsp

@@ -16,7 +16,7 @@
   (unless stream
     (setf stream (emit-inline-form (c1nil) nil)))
   (multiple-value-bind (foundp value)
-      (loc-immediate-value-p (inlined-arg-loc expression))
+      (loc-immediate-value-p expression)
     (cond
       ((and foundp (characterp value))
        (produce-inline-loc (list expression stream)

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

@@ -48,7 +48,7 @@
 (defun c2call-stack (c1form form args values-p)
   (declare (ignore c1form))
   (with-stack-frame (frame)
-    (let ((loc (inlined-arg-loc (inline-arg0 form args))))
+    (let ((loc (inline-arg0 form args)))
       (let ((*destination* (if values-p 'VALUEZ 'LEAVE)))
         (dolist (arg args)
           (c2expr* arg)
@@ -90,7 +90,7 @@
   (let* ((form-type (c1form-primary-type form))
          (function-p (and (subtypep form-type 'function)
                           (policy-assume-right-type)))
-         (loc (inlined-arg-loc (inline-arg0 form args)))
+         (loc (inline-arg0 form args))
          (args (inline-args args)))
     (unwind-exit (call-unknown-global-loc loc args function-p))))
 

src/cmp/cmpglobals.lsp

@@ -29,6 +29,7 @@
 (defvar *active-protection* nil)
 (defvar *pending-actions* nil)
 (defvar *empty-loc* (gensym))
+(defvar *inline-loc* (gensym))
 
 (defvar *compiler-conditions* '()
   "This variable determines whether conditions are printed or just accumulated.")

src/cmp/cmplocs.lsp

@@ -175,9 +175,13 @@
          (values t loc))
         ((vv-p loc)
          (let ((value (vv-value loc)))
-           (if (eq value *empty-loc*)
-               (values nil nil)
-               (values t value))))
+           (cond
+             ((eq value *empty-loc*)
+              (values nil nil))
+             ((eq value *inline-loc*)
+              (loc-immediate-value-p (vv-location loc)))
+             (t
+              (values t value)))))
         ((atom loc)
          (values nil nil))
         ((eq (first loc) 'THE)