From a07b39ad657bac96c8196517d41f26c698c9e5ef Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Wed, 6 Dec 2023 10:51:54 +0100
Subject: [PATCH 01/15] cmp: cleanup: rename REP-TYPE to HOST-TYPE

The name HOST-TYPE is less ambiguous.
---
 src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp    |  30 +++---
 src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp    |  64 ++++++-------
 src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp |  26 +++---
 src/cmp/cmpbackend-cxx/cmpc-mach.lsp       | 100 ++++++++++----------
 src/cmp/cmpbackend-cxx/cmpc-opt-ct.lsp     |   6 +-
 src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp    |  44 ++++-----
 src/cmp/cmpbackend-cxx/cmppass2-data.lsp   |   8 +-
 src/cmp/cmpbackend-cxx/cmppass2-exit.lsp   |  10 +-
 src/cmp/cmpbackend-cxx/cmppass2-fun.lsp    |   2 +-
 src/cmp/cmpbackend-cxx/cmppass2-loc.lsp    | 104 ++++++++++-----------
 src/cmp/cmpbackend-cxx/cmppass2-top.lsp    |   4 +-
 src/cmp/cmpbackend-cxx/cmppass2-var.lsp    |  22 ++---
 src/cmp/cmplocs.lsp                        |  26 +++---
 src/cmp/cmppass1-ffi.lsp                   |  16 ++--
 src/cmp/cmppass1-var.lsp                   |   2 +-
 src/cmp/cmptables.lsp                      |   2 +-
 src/cmp/cmpvar.lsp                         |  14 +--
 17 files changed, 240 insertions(+), 240 deletions(-)

diff --git a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
index 6ca478510..b5a04bd54 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
+++ b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
@@ -15,11 +15,11 @@
 (defstruct (inlined-arg (:constructor %make-inlined-arg))
   loc
   type
-  rep-type)
+  host-type)
 
 (defun make-inlined-arg (loc lisp-type)
   (%make-inlined-arg :loc loc :type lisp-type
-                     :rep-type (loc-representation-type loc)))
+                     :host-type (loc-host-type loc)))
 
 (defun maybe-open-inline-block ()
   (unless (plusp *inline-blocks*)
@@ -49,43 +49,43 @@
   (loop with block-opened = nil
         for arg in inlined-args
         for loc = (inlined-arg-loc arg)
-        for arg-rep-type = (inlined-arg-rep-type arg)
+        for arg-host-type = (inlined-arg-host-type arg)
         for type in (or types '#1=(:object . #1#))
         for i from 0
-        for rep-type = (lisp-type->rep-type type)
+        for host-type = (lisp-type->host-type type)
         collect
         (cond ((and args-to-be-saved
                     (member i args-to-be-saved :test #'eql)
                     (not (loc-movable-p loc)))
-               (let ((lcl (make-lcl-var :rep-type rep-type)))
+               (let ((lcl (make-lcl-var :host-type host-type)))
                  (wt-nl)
                  (unless block-opened
                    (setf block-opened t)
                    (open-inline-block))
-                 (wt (rep-type->c-name rep-type) " " lcl "= ")
-                 (wt-coerce-loc rep-type loc)
+                 (wt (host-type->c-name host-type) " " lcl "= ")
+                 (wt-coerce-loc host-type loc)
                  (wt ";")
                  lcl))
-              ((equal rep-type arg-rep-type)
+              ((equal host-type arg-host-type)
                loc)
               (t
-               `(COERCE-LOC ,rep-type ,loc)))))
+               `(COERCE-LOC ,host-type ,loc)))))
 
-(defun make-inline-temp-var (value-type &optional rep-type)
-  (let ((out-rep-type (or rep-type (lisp-type->rep-type value-type))))
-    (if (eq out-rep-type :object)
+(defun make-inline-temp-var (value-type &optional host-type)
+  (let ((out-host-type (or host-type (lisp-type->host-type value-type))))
+    (if (eq out-host-type :object)
         (make-temp-var value-type)
-        (let ((var (make-lcl-var :rep-type out-rep-type
+        (let ((var (make-lcl-var :host-type out-host-type
                                  :type value-type)))
           (open-inline-block)
-          (wt-nl (rep-type->c-name out-rep-type) " " var ";")
+          (wt-nl (host-type->c-name out-host-type) " " var ";")
           var))))
 
 (defun emit-inlined-variable (form rest-forms)
   (let ((var (c1form-arg 0 form))
         (lisp-type (c1form-primary-type form)))
     (if (var-changed-in-form-list var rest-forms)
-        (let ((temp (make-inline-temp-var lisp-type (var-rep-type var))))
+        (let ((temp (make-inline-temp-var lisp-type (var-host-type var))))
           (set-loc temp var)
           (make-inlined-arg temp lisp-type))
         (make-inlined-arg var lisp-type))))
diff --git a/src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp
index 632d2f7f0..278ffa734 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp
+++ b/src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp
@@ -17,8 +17,8 @@
 
 (defstruct (inline-info)
   name                  ;;; Function name
-  arg-rep-types         ;;; List of representation types for the arguments
-  return-rep-type       ;;; Representation type for the output
+  arg-host-types        ;;; List of representation types for the arguments
+  return-host-type      ;;; Representation type for the output
   arg-types             ;;; List of lisp types for the arguments
   return-type           ;;; Lisp type for the output
   exact-return-type     ;;; Only use this expansion when the output is
@@ -47,33 +47,33 @@
 ;;;   locs are typed locs as produced by inline-args
 ;;;   returns NIL if inline expansion of the function is not possible
 ;;;
-(defun inline-function (fname arg-types return-type &optional (return-rep-type 'any))
+(defun inline-function (fname arg-types return-type &optional (return-host-type 'any))
   ;; Those functions that use INLINE-FUNCTION must rebind the variable
   ;; *INLINE-BLOCKS*.
   (and (inline-possible fname)
        (not (gethash fname *c2-dispatch-table*))
-       (let* (;; (dest-rep-type (loc-representation-type *destination*))
-              (ii (get-inline-info fname arg-types return-type return-rep-type)))
+       (let* (;; (dest-host-type (loc-host-type *destination*))
+              (ii (get-inline-info fname arg-types return-type return-host-type)))
          ii)))
 
 (defun apply-inline-info (ii inlined-locs)
   (let* ((arg-types (inline-info-arg-types ii))
-         (out-rep-type (inline-info-return-rep-type ii))
+         (out-host-type (inline-info-return-host-type ii))
          ;; (out-type (inline-info-return-type ii))
          (side-effects-p (function-may-have-side-effects (inline-info-name ii)))
          (fun (inline-info-expansion ii))
          (one-liner (inline-info-one-liner ii)))
-    (produce-inline-loc inlined-locs arg-types (list out-rep-type)
+    (produce-inline-loc inlined-locs arg-types (list out-host-type)
                         fun side-effects-p one-liner)))
 
-(defun choose-inline-info (ia ib return-type return-rep-type)
+(defun choose-inline-info (ia ib return-type return-host-type)
   (declare (ignore return-type))
   (cond
     ;; Only accept inliners that have the right rep type
-    ((not (or (eq return-rep-type 'any)
-              (eq return-rep-type :void)
-              (let ((info-type (inline-info-return-rep-type ib)))
-                (or (eq return-rep-type info-type)
+    ((not (or (eq return-host-type 'any)
+              (eq return-host-type :void)
+              (let ((info-type (inline-info-return-host-type ib)))
+                (or (eq return-host-type info-type)
                     ;; :bool can be coerced to any other location type
                     (eq info-type :bool)))))
      ia)
@@ -89,16 +89,16 @@
     (t
      ia)))
 
-(defun get-inline-info (fname types return-type return-rep-type)
+(defun get-inline-info (fname types return-type return-host-type)
   (declare (si::c-local))
   (let ((output nil))
     (unless (safe-compile)
       (dolist (x (inline-information fname ':INLINE-UNSAFE))
         (ext:when-let ((other (inline-type-matches x types return-type)))
-          (setf output (choose-inline-info output other return-type return-rep-type)))))
+          (setf output (choose-inline-info output other return-type return-host-type)))))
     (dolist (x (inline-information fname ':INLINE-ALWAYS))
       (ext:when-let ((other (inline-type-matches x types return-type)))
-        (setf output (choose-inline-info output other return-type return-rep-type))))
+        (setf output (choose-inline-info output other return-type return-host-type))))
     output))
 
 (defun to-fixnum-float-type (type)
@@ -150,7 +150,7 @@
     ;; Now there is an optional check of the return type. This check is
     ;; only used when enforced by the inliner.
     ;;
-    (when (or (eq (inline-info-return-rep-type inline-info) :bool)
+    (when (or (eq (inline-info-return-host-type inline-info) :bool)
               (null (inline-info-exact-return-type inline-info))
               (and (policy-assume-right-type)
                    (let ((inline-return-type (inline-info-return-type inline-info)))
@@ -172,7 +172,7 @@
               (nreverse rts))
         inline-info))))
 
-(defun produce-inline-loc (inlined-arguments arg-types output-rep-type
+(defun produce-inline-loc (inlined-arguments arg-types output-host-type
                            c-expression side-effects one-liner)
   (let* (args-to-be-saved
          coerced-arguments)
@@ -193,15 +193,15 @@
                 args-to-be-saved))))
 
     (setf coerced-arguments (coerce-locs inlined-arguments arg-types args-to-be-saved))
-    ;;(setf output-rep-type (lisp-type->rep-type output-rep-type))
+    ;;(setf output-host-type (lisp-type->host-type output-host-type))
 
     ;; If the form does not output any data, and there are no side
     ;; effects, try to omit it.
-    (when (null output-rep-type)
+    (when (null output-host-type)
       (if side-effects
           (progn
             (wt-nl)
-            (wt-c-inline-loc output-rep-type c-expression coerced-arguments t nil)
+            (wt-c-inline-loc output-host-type c-expression coerced-arguments t nil)
             (when one-liner (wt ";")))
           (cmpnote "Ignoring form ~S" c-expression))
       (wt-nl "value0 = ECL_NIL;")
@@ -212,25 +212,25 @@
     ;; place where the value is used.
     (when one-liner
       (return-from produce-inline-loc
-        `(ffi:c-inline ,output-rep-type ,c-expression ,coerced-arguments ,side-effects
-                       ,(if (equalp output-rep-type '((VALUES &REST T)))
+        `(ffi:c-inline ,output-host-type ,c-expression ,coerced-arguments ,side-effects
+                       ,(if (equalp output-host-type '((VALUES &REST T)))
                             'VALUES NIL))))
 
     ;; If the output is a in the VALUES vector, just write down the form and
     ;; output the location of the data.
-    (when (equalp output-rep-type '((VALUES &REST T)))
-      (wt-c-inline-loc output-rep-type c-expression coerced-arguments side-effects
+    (when (equalp output-host-type '((VALUES &REST T)))
+      (wt-c-inline-loc output-host-type c-expression coerced-arguments side-effects
                        'VALUES)
       (return-from produce-inline-loc 'VALUEZ))
 
     ;; Otherwise we have to set up variables for holding the output.
     (flet ((make-output-var (type)
-             (let ((var (make-lcl-var :rep-type type)))
-               (wt-nl (rep-type->c-name type) " " var ";")
+             (let ((var (make-lcl-var :host-type type)))
+               (wt-nl (host-type->c-name type) " " var ";")
                var)))
       (open-inline-block)
-      (let ((output-vars (mapcar #'make-output-var output-rep-type)))
-        (wt-c-inline-loc output-rep-type c-expression coerced-arguments side-effects output-vars)
+      (let ((output-vars (mapcar #'make-output-var output-host-type)))
+        (wt-c-inline-loc output-host-type c-expression coerced-arguments side-effects output-vars)
         (cond ((= (length output-vars) 1)
                (first output-vars))
               (t
@@ -243,15 +243,15 @@
 ;;; 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))
-         (rep-type (inlined-arg-rep-type inlined-arg)))
+         (host-type (inlined-arg-host-type inlined-arg)))
     (apply #'produce-inline-loc
            (list inlined-arg)
-           (if (eq (loc-representation-type dest-loc) :bool)
-               (case rep-type
+           (if (eq (loc-host-type dest-loc) :bool)
+               (case host-type
                  (:bool '((:bool) (:bool) "(#0)==ECL_NIL" nil t))
                  (:object '((:object) (:bool) "(#0)!=ECL_NIL" nil t))
                  (otherwise (return-from negate-argument nil)))
-               (case rep-type
+               (case host-type
                  (:bool '((:bool) (:object) "(#0)?ECL_NIL:ECL_T" nil t))
                  (:object '((:object) (:object) "Null(#0)?ECL_T:ECL_NIL" nil t))
                  (otherwise (return-from negate-argument *vv-nil*)))))))
diff --git a/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp b/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp
index 831e43985..045cb3de4 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp
+++ b/src/cmp/cmpbackend-cxx/cmpc-inl-sysfun.lsp
@@ -17,7 +17,7 @@
 ;;;
 ;;; DATABASE OF INLINE EXPANSIONS
 ;;;
-;;;     (DEF-INLINE function-name kind ([arg-type]*) return-rep-type
+;;;     (DEF-INLINE function-name kind ([arg-type]*) return-host-type
 ;;;             expansion-string)
 ;;;
 ;;; Here, ARG-TYPE is the list of argument types belonging to the lisp family,
@@ -52,10 +52,10 @@
 (defun (setf inline-information) (value name safety)
   (setf (gethash (list name safety) *inline-information*) value))
 
-(defun %def-inline (name safety arg-types return-rep-type expansion
+(defun %def-inline (name safety arg-types return-host-type expansion
                     &key (one-liner t) (exact-return-type nil)
                       (multiple-values t)
-                    &aux arg-rep-types)
+                    &aux arg-host-types)
   (setf safety
         (case safety
           (:unsafe :inline-unsafe)
@@ -64,26 +64,26 @@
   ;; Ensure we can inline this form. We only inline when the features are
   ;; there (checked above) and when the C types are part of this machine
   ;; (checked here).
-  (loop for type in (list* return-rep-type arg-types)
+  (loop for type in (list* return-host-type arg-types)
         unless (or (eq type 'fixnum-float)
                    (and (consp type) (eq (car type) 'values))
                    (lisp-type-p type)
                    (machine-c-type-p type))
           do (warn "Dropping inline form for ~A because of missing type ~A" name type)
              (return-from %def-inline))
-  (setf arg-rep-types
-        (mapcar #'(lambda (x) (if (eq x '*) x (lisp-type->rep-type x)))
+  (setf arg-host-types
+        (mapcar #'(lambda (x) (if (eq x '*) x (lisp-type->host-type x)))
                 arg-types))
-  (when (eq return-rep-type t)
-    (setf return-rep-type :object))
-  (let* ((return-type (if (and (consp return-rep-type)
-                               (eq (first return-rep-type) 'values))
+  (when (eq return-host-type t)
+    (setf return-host-type :object))
+  (let* ((return-type (if (and (consp return-host-type)
+                               (eq (first return-host-type) 'values))
                           t
-                          (rep-type->lisp-type return-rep-type)))
+                          (host-type->lisp-type return-host-type)))
          (inline-info
            (make-inline-info :name name
-                             :arg-rep-types arg-rep-types
-                             :return-rep-type return-rep-type
+                             :arg-host-types arg-host-types
+                             :return-host-type return-host-type
                              :return-type return-type
                              :arg-types arg-types
                              :exact-return-type exact-return-type
diff --git a/src/cmp/cmpbackend-cxx/cmpc-mach.lsp b/src/cmp/cmpbackend-cxx/cmpc-mach.lsp
index c10273eb9..abdd87ef3 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-mach.lsp
+++ b/src/cmp/cmpbackend-cxx/cmpc-mach.lsp
@@ -13,11 +13,11 @@
 
 (defstruct machine
   (c-types '())
-  rep-type-hash
+  host-type-hash
   sorted-types
   inline-information)
 
-(defstruct (rep-type (:constructor %make-rep-type))
+(defstruct (host-type (:constructor %make-host-type))
   (index 0)                             ; Precedence order in the type list
   (name t)
   (lisp-type t)
@@ -32,63 +32,63 @@
 (defun lisp-type-p (type)
   (subtypep type 'T))
 
-(defun rep-type-record-unsafe (rep-type)
-  (gethash rep-type (machine-rep-type-hash *machine*)))
+(defun host-type-record-unsafe (host-type)
+  (gethash host-type (machine-host-type-hash *machine*)))
 
-(defun rep-type-record (rep-type)
-  (ext:if-let ((record (gethash rep-type (machine-rep-type-hash *machine*))))
+(defun host-type-record (host-type)
+  (ext:if-let ((record (gethash host-type (machine-host-type-hash *machine*))))
     record
-    (cmperr "Not a valid C type name ~A" rep-type)))
+    (cmperr "Not a valid C type name ~A" host-type)))
 
-(defun rep-type->lisp-type (name)
-  (let ((output (rep-type-record-unsafe name)))
+(defun host-type->lisp-type (name)
+  (let ((output (host-type-record-unsafe name)))
     (cond (output
-           (rep-type-lisp-type output))
+           (host-type-lisp-type output))
           ((lisp-type-p name) name)
           (t (error "Unknown representation type ~S" name)))))
 
-(defun lisp-type->rep-type (type)
+(defun lisp-type->host-type (type)
   (cond
     ;; We expect type = NIL when we have no information. Should be fixed. FIXME!
     ((null type)
      :object)
-    ((let ((r (rep-type-record-unsafe type)))
-       (and r (rep-type-name r))))
+    ((let ((r (host-type-record-unsafe type)))
+       (and r (host-type-name r))))
     (t
      ;; Find the most specific type that fits
      (dolist (record (machine-sorted-types *machine*) :object)
-       (when (subtypep type (rep-type-lisp-type record))
-         (return-from lisp-type->rep-type (rep-type-name record)))))))
+       (when (subtypep type (host-type-lisp-type record))
+         (return-from lisp-type->host-type (host-type-name record)))))))
 
-(defun c-number-rep-type-p (rep-type)
-  (let ((r (rep-type-record-unsafe rep-type)))
-    (and r (rep-type-numberp r))))
+(defun c-number-host-type-p (host-type)
+  (let ((r (host-type-record-unsafe host-type)))
+    (and r (host-type-numberp r))))
 
-(defun c-integer-rep-type-p (rep-type)
-  (let ((r (rep-type-record-unsafe rep-type)))
-    (and r (rep-type-integerp r))))
+(defun c-integer-host-type-p (host-type)
+  (let ((r (host-type-record-unsafe host-type)))
+    (and r (host-type-integerp r))))
 
-(defun c-integer-rep-type-bits (rep-type)
-  (let ((r (rep-type-record-unsafe rep-type)))
-    (and r (rep-type-bits r))))
+(defun c-integer-host-type-bits (host-type)
+  (let ((r (host-type-record-unsafe host-type)))
+    (and r (host-type-bits r))))
 
 (defun c-number-type-p (type)
-  (c-number-rep-type-p (lisp-type->rep-type type)))
+  (c-number-host-type-p (lisp-type->host-type type)))
 
 (defun c-integer-type-p (type)
-  (c-integer-rep-type-p (lisp-type->rep-type type)))
+  (c-integer-host-type-p (lisp-type->host-type type)))
 
 (defun c-integer-type-bits (type)
-  (c-number-rep-type-bits (lisp-type->rep-type type)))
+  (c-number-host-type-bits (lisp-type->host-type type)))
 
-(defun rep-type->c-name (type)
-  (rep-type-c-name (rep-type-record type)))
+(defun host-type->c-name (type)
+  (host-type-c-name (host-type-record type)))
 
 ;; These types can be used by ECL to unbox data They are sorted from
 ;; the most specific, to the least specific one.  All functions must
 ;; be declared in external.h (not internal.h) header file.
-(defconstant +representation-types+
-  ;; ffi-type            lisp type                c type                 convert C->Lisp                     convert Lisp->C             unbox Lisp->C (unsafe)
+(defconstant +host-types+
+  ;; host type           lisp type                c type                 convert C->Lisp                     convert Lisp->C             unbox Lisp->C (unsafe)
   '((:byte             . #1=((signed-byte 8)      "int8_t"               "ecl_make_int8_t"                   "ecl_to_int8_t"             "ecl_fixnum"))
     (:unsigned-byte    . #2=((unsigned-byte 8)    "uint8_t"              "ecl_make_uint8_t"                  "ecl_to_uint8_t"            "ecl_fixnum"))
     (:fixnum             integer                  "cl_fixnum"            "ecl_make_fixnum"                   "ecl_to_fixnum"             "ecl_fixnum")
@@ -177,7 +177,7 @@
     (:void)
     (:pointer-void)))
 
-(defun make-rep-type (all-c-types name lisp-type c-name &optional to-lisp from-lisp from-lisp-unsafe)
+(defun make-host-type (all-c-types name lisp-type c-name &optional to-lisp from-lisp from-lisp-unsafe)
   (let* ((record (assoc name all-c-types))
          (bits (cdr record)))
     (when record
@@ -187,7 +187,7 @@
             (setf lisp-type `(unsigned-byte ,bits))
             (setf bits (- bits)
                   lisp-type `(signed-byte ,bits))))
-      (%make-rep-type
+      (%make-host-type
        :name name
        :lisp-type lisp-type
        :bits bits
@@ -201,34 +201,34 @@
 (defun default-machine ()
   (let* ((all-c-types (append +this-machine-c-types+ +all-machines-c-types+))
          (table (make-hash-table :size 128 :test 'eq))
-         (sorted-rep-types
-          ;; Create the rep-type objects
+         (sorted-host-types
+          ;; Create the host-type objects
           (loop for i from 0
-             for record in +representation-types+
-             for rep-type = (apply #'make-rep-type all-c-types record)
-             when rep-type
-             do (setf (rep-type-index rep-type) i)
-             and collect (setf (gethash (rep-type-name rep-type) table) rep-type))))
+             for record in +host-types+
+             for host-type = (apply #'make-host-type all-c-types record)
+             when host-type
+             do (setf (host-type-index host-type) i)
+             and collect (setf (gethash (host-type-name host-type) table) host-type))))
     ;; hack: sse-pack -> int, but int -> int-sse-pack
     (let ((r (gethash :int-sse-pack table)))
       (when r
-        (setf (rep-type-index r) 'ext:int-sse-pack)))
+        (setf (host-type-index r) 'ext:int-sse-pack)))
     ;; On a second pass, we replace types with more general ones
-    (loop with fixnum-rep-type = (gethash ':fixnum table)
-       with fixnum-lisp-type = (rep-type-lisp-type fixnum-rep-type)
-       for (name . rest) in +representation-types+
+    (loop with fixnum-host-type = (gethash ':fixnum table)
+       with fixnum-lisp-type = (host-type-lisp-type fixnum-host-type)
+       for (name . rest) in +host-types+
        for r = (gethash name table)
-       when (and r (subtypep (rep-type-lisp-type r) fixnum-lisp-type))
-       do (setf (rep-type-from-lisp-unsafe r) "ecl_fixnum"))
+       when (and r (subtypep (host-type-lisp-type r) fixnum-lisp-type))
+       do (setf (host-type-from-lisp-unsafe r) "ecl_fixnum"))
     ;; Create machine object
     (make-machine :c-types all-c-types
-                  :rep-type-hash table
-                  :sorted-types sorted-rep-types)))
+                  :host-type-hash table
+                  :sorted-types sorted-host-types)))
 
 (defun machine-c-type-p (name)
-  (gethash name (machine-rep-type-hash *machine*)))
+  (gethash name (machine-host-type-hash *machine*)))
 
 (defun machine-fixnump (number)
-  (typep number (rep-type-lisp-type (gethash :fixnum number))))
+  (typep number (host-type-lisp-type (gethash :fixnum number))))
 
 (defvar *default-machine* (setf *machine* (default-machine)))
diff --git a/src/cmp/cmpbackend-cxx/cmpc-opt-ct.lsp b/src/cmp/cmpbackend-cxx/cmpc-opt-ct.lsp
index 8b14750a0..6516c7c40 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-opt-ct.lsp
+++ b/src/cmp/cmpbackend-cxx/cmpc-opt-ct.lsp
@@ -19,12 +19,12 @@
 (defun make-single-constant-optimizer (name c-value)
   (cond ((symbolp name)
          (let* ((value (symbol-value name))
-                (rep-type (lisp-type->rep-type (type-of value)))
-                (location (make-vv :location c-value :value value :rep-type rep-type)))
+                (host-type (lisp-type->host-type (type-of value)))
+                (location (make-vv :location c-value :value value :host-type host-type)))
            (cons value location)))
         ((floatp name)
          (let* ((value name)
-                (location (make-vv :location c-value :value value :rep-type :object)))
+                (location (make-vv :location c-value :value value :host-type :object)))
            (cons value location)))
         (t
          (cons name (make-vv :location c-value :value name)))))
diff --git a/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp b/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp
index fbcb8d7b7..b06723e81 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp
+++ b/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp
@@ -19,15 +19,15 @@
 ;;;
 (define-c-inliner shift (return-type argument orig-shift)
   (let* ((arg-type (inlined-arg-type argument))
-         (arg-c-type (lisp-type->rep-type arg-type))
-         (return-c-type (lisp-type->rep-type return-type))
+         (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))))
-    (if (or (not (c-integer-rep-type-p arg-c-type))
-            (not (c-integer-rep-type-p return-c-type)))
+    (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)
                             "ecl_ash(#0,#1)" nil t)
-        (let* ((arg-bits (c-integer-rep-type-bits arg-c-type))
-               (return-bits (c-integer-rep-type-bits return-c-type))
+        (let* ((arg-bits (c-integer-host-type-bits arg-c-type))
+               (return-bits (c-integer-host-type-bits return-c-type))
                (max-type (if (and (plusp shift)
                                   (< arg-bits return-bits))
                              return-c-type
@@ -44,10 +44,10 @@
 ;;; Inliners for arithmetic operations.
 ;;;
 
-(defun most-generic-number-rep-type (r1 r2)
-  (let* ((r1 (rep-type-record r1))
-         (r2 (rep-type-record r2)))
-    (rep-type-name (if (< (rep-type-index r1) (rep-type-index r2))
+(defun most-generic-number-host-type (r1 r2)
+  (let* ((r1 (host-type-record r1))
+         (r2 (host-type-record r2)))
+    (host-type-name (if (< (host-type-index r1) (host-type-index r2))
                        r2
                        r1))))
 
@@ -62,13 +62,13 @@
         ;; type that fits the output, to avoid overflow which
         ;; would happen if we used say, long c = (int)a * (int)b
         ;; as the output would be an integer, not a long.
-        (let* ((arg1-rep (lisp-type->rep-type arg1-type))
-               (arg2-rep (lisp-type->rep-type arg2-type))
-               (out-rep (lisp-type->rep-type expected-type))
-               (max-rep (most-generic-number-rep-type
-                         (most-generic-number-rep-type
+        (let* ((arg1-rep (lisp-type->host-type arg1-type))
+               (arg2-rep (lisp-type->host-type arg2-type))
+               (out-rep (lisp-type->host-type expected-type))
+               (max-rep (most-generic-number-host-type
+                         (most-generic-number-host-type
                           arg1-rep arg2-rep) out-rep))
-               (max-name (rep-type->c-name max-rep)))
+               (max-name (host-type->c-name max-rep)))
           (produce-inline-loc
            (list arg1 arg2)
            (list arg1-rep arg2-rep)
@@ -87,15 +87,15 @@
              (c-number-type-p expected-type)
              (c-number-type-p arg1-type))
         (produce-inline-loc (list arg1)
-                            (list (lisp-type->rep-type arg1-type))
-                            (list (lisp-type->rep-type expected-type))
+                            (list (lisp-type->host-type arg1-type))
+                            (list (lisp-type->host-type expected-type))
                             non-consing nil t)
         (produce-inline-loc (list arg1) '(:object :object) '(:object)
                             consing nil t))))
 
 (define-c-inliner * (return-type &rest arguments &aux arg1 arg2)
   (when (null arguments)
-    (return (make-vv :rep-type :fixnum :value 1)))
+    (return (make-vv :host-type :fixnum :value 1)))
   (setf arg1 (pop arguments))
   (when (null arguments)
     (return (inlined-arg-loc arg1)))
@@ -106,7 +106,7 @@
 
 (define-c-inliner + (return-type &rest arguments &aux arg1 arg2)
   (when (null arguments)
-    (return (make-vv :rep-type :fixnum :value 0)))
+    (return (make-vv :host-type :fixnum :value 0)))
   (setf arg1 (pop arguments))
   (when (null arguments)
     (return (inlined-arg-loc arg1)))
@@ -133,8 +133,8 @@
   (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->rep-type (inlined-arg-type arg)))
-        (flt-c-type (and float (lisp-type->rep-type (inlined-arg-type 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)))))
     (if (member arg-c-type '(:float :double :long-double))
         (when (or (null float) (eq arg-c-type flt-c-type))
           (inlined-arg-loc arg))
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-data.lsp b/src/cmp/cmpbackend-cxx/cmppass2-data.lsp
index c66838d59..137fe5f13 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-data.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-data.lsp
@@ -289,7 +289,7 @@
     ((or fixnum character float #|#+complex-float (complex float)|#)
      (make-vv :value value
               :location nil
-              :rep-type (lisp-type->rep-type (type-of value))))
+              :host-type (lisp-type->host-type (type-of value))))
     #+sse2
     (ext:sse-pack
      (let* ((bytes (ext:sse-pack-to-vector value '(unsigned-byte 8)))
@@ -302,7 +302,7 @@
          (make-vv :value value
                   :location (format nil "~A(_mm_setr_epi8(~{~A~^,~}))"
                                     wrapper (coerce bytes 'list))
-                  :rep-type rtype))))
+                  :host-type rtype))))
     (otherwise
      nil)))
 
@@ -315,7 +315,7 @@
 (defun update-vv (target source)
   (assert (eql (vv-value target) (vv-value source)))
   (setf (vv-location target) (vv-location source)
-        (vv-rep-type target) (vv-rep-type source)))
+        (vv-host-type target) (vv-host-type source)))
 
 (defun insert-vv (vv)
   (let* ((arr (if (vv-permanent-p vv)
@@ -355,7 +355,7 @@
 ;;; module is loaded. Then the code refers to such objects as VV[13].
 ;;;
 ;;; TODO we could further optimize immediate values by duplicating some entries
-;;; depending on the expected rep-type, to avoid unnecessary coercions.
+;;; depending on the expected host-type, to avoid unnecessary coercions.
 (defun optimize-cxx-data (objects)
   (flet ((optimize-vv (object)
            (let ((value (vv-value object)))
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-exit.lsp b/src/cmp/cmpbackend-cxx/cmppass2-exit.lsp
index e3957d497..21300b52e 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-exit.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-exit.lsp
@@ -211,16 +211,16 @@
   (ecase kind
     (:jump-t
      (destructuring-bind (loc) args
-       (case (loc-representation-type loc)
+       (case (loc-host-type loc)
          (:bool     (wt-nl "if (" loc ") "))
          (:object   (wt-nl "if (" loc "!=ECL_NIL) "))
          (otherwise (wt-nl "if ((") (wt-coerce-loc :object loc) (wt ")!=ECL_NIL) ")))))
     (:jump-f
      (destructuring-bind (loc) args
-       (case (loc-representation-type loc)
-         (:bool     (wt-nl "if (!(" loc ")) "))
-         (:object   (wt-nl "if (Null(" loc ")) "))
-         (otherwise (wt-nl "if (Null(") (wt-coerce-loc :object loc) (wt ")) ")))))
+       (case (loc-host-type loc)
+         (:bool     (wt-nl "if (!(" loc "))"))
+         (:object   (wt-nl "if (Null(" loc "))"))
+         (otherwise (wt-nl "if (Null(") (wt-coerce-loc :object loc) (wt "))")))))
     (:jump-eq
      (destructuring-bind (x y) args
        (wt-nl "if (" `(coerce-loc :object ,x) "==" `(coerce-loc :object ,y) ") "))))
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp b/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp
index 0bb04d3d0..b53122d6d 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp
@@ -143,7 +143,7 @@
   (labels ((wt-decl (var)
              (let ((lcl (next-lcl (var-name var))))
                (wt-nl)
-               (wt (rep-type->c-name (var-rep-type var)) " " *volatile* lcl ";")
+               (wt (host-type->c-name (var-host-type var)) " " *volatile* lcl ";")
                lcl))
            (do-decl (var)
              (when (local var) ; no LCL needed for SPECIAL or LEX
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
index 7f0f85913..3440e75d1 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
@@ -48,8 +48,8 @@
   ;; overflow if we use a smaller integer type (overflows in long long
   ;; computations are taken care of by the compiler before we get to
   ;; this point).
-  #+msvc (princ (cond ((typep value (rep-type->lisp-type :long-long)) "LL")
-                      ((typep value (rep-type->lisp-type :unsigned-long-long)) "ULL")
+  #+msvc (princ (cond ((typep value (host-type->lisp-type :long-long)) "LL")
+                      ((typep value (host-type->lisp-type :unsigned-long-long)) "ULL")
                       (t (baboon :format-control
                                  "wt-fixnum: The number ~A doesn't fit any integer type."
                                  value)))
@@ -197,36 +197,36 @@
 ;;; COERCE-LOC
 ;;;
 
-(defun wt-to-object-conversion (loc-rep-type loc)
+(defun wt-to-object-conversion (loc-host-type loc)
   ;; FIXME we can do better for constant locations.
-  (let* ((record (rep-type-record loc-rep-type))
-         (coercer (and record (rep-type-to-lisp record))))
+  (let* ((record (host-type-record loc-host-type))
+         (coercer (and record (host-type-to-lisp record))))
     (unless coercer
-      (cmperr "Cannot coerce C variable of type ~S to lisp object" loc-rep-type))
+      (cmperr "Cannot coerce C variable of type ~S to lisp object" loc-host-type))
     (wt coercer "(" loc ")")))
 
-(defun wt-from-object-conversion (dest-type loc-type rep-type loc)
-  (let* ((record (rep-type-record rep-type))
-         (coercer (and record (rep-type-from-lisp record))))
+(defun wt-from-object-conversion (dest-type loc-type host-type loc)
+  (let* ((record (host-type-record host-type))
+         (coercer (and record (host-type-from-lisp record))))
     (unless coercer
-      (cmperr "Cannot coerce lisp object to C type ~A" rep-type))
+      (cmperr "Cannot coerce lisp object to C type ~A" host-type))
     (wt (if (or (policy-assume-no-errors)
                 (subtypep loc-type dest-type))
-            (rep-type-from-lisp-unsafe record)
+            (host-type-from-lisp-unsafe record)
             coercer)
         "(" loc ")")))
 
-(defun wt-coerce-loc (dest-rep-type loc)
-  (setq dest-rep-type (lisp-type->rep-type dest-rep-type))
-                                        ;(print dest-rep-type)
+(defun wt-coerce-loc (dest-host-type loc)
+  (setq dest-host-type (lisp-type->host-type dest-host-type))
+                                        ;(print dest-host-type)
                                         ;(print loc)
-  (let* ((dest-type (rep-type->lisp-type dest-rep-type))
+  (let* ((dest-type (host-type->lisp-type dest-host-type))
          (loc-type (loc-type loc))
-         (loc-rep-type (loc-representation-type loc)))
+         (loc-host-type (loc-host-type loc)))
     (labels ((coercion-error (&optional (write-zero t))
                (cmpwarn "Unable to coerce lisp object from type (~S,~S)~%~
                         to C/C++ type (~S,~S)"
-                        loc-type loc-rep-type dest-type dest-rep-type)
+                        loc-type loc-host-type dest-type dest-host-type)
                (when write-zero
                  ;; It is possible to reach this point due to a bug
                  ;; but also due to a failure of the dead code
@@ -237,60 +237,60 @@
              (ensure-valid-object-type (a-lisp-type)
                (when (subtypep `(AND ,loc-type ,a-lisp-type) NIL)
                  (coercion-error nil))))
-      (when (eq dest-rep-type loc-rep-type)
+      (when (eq dest-host-type loc-host-type)
         (wt loc)
         (return-from wt-coerce-loc))
-      (case dest-rep-type
+      (case dest-host-type
         ((:char :unsigned-char :wchar)
-         (case loc-rep-type
+         (case loc-host-type
            ((:char :unsigned-char :wchar)
-            (wt "(" (rep-type->c-name dest-rep-type) ")(" loc ")"))
+            (wt "(" (host-type->c-name dest-host-type) ")(" loc ")"))
            ((:object)
             (ensure-valid-object-type dest-type)
-            (wt-from-object-conversion dest-type loc-type dest-rep-type loc))
+            (wt-from-object-conversion dest-type loc-type dest-host-type loc))
            (otherwise
             (coercion-error))))
         ((:float :double :long-double)
          (cond
-           ((c-number-rep-type-p loc-rep-type)
-            (wt "(" (rep-type->c-name dest-rep-type) ")(" loc ")"))
-           ((eq loc-rep-type :object)
+           ((c-number-host-type-p loc-host-type)
+            (wt "(" (host-type->c-name dest-host-type) ")(" loc ")"))
+           ((eq loc-host-type :object)
             ;; We relax the check a bit, because it is valid in C to coerce
             ;; between floats of different types.
             (ensure-valid-object-type 'FLOAT)
-            (wt-from-object-conversion dest-type loc-type dest-rep-type loc))
+            (wt-from-object-conversion dest-type loc-type dest-host-type loc))
            (t
             (coercion-error))))
         ((:csfloat :cdfloat :clfloat)
          (cond
-           ((c-number-rep-type-p loc-rep-type)
-            (wt "(" (rep-type->c-name dest-rep-type) ")(" loc ")"))
-           ((eq loc-rep-type :object)
+           ((c-number-host-type-p loc-host-type)
+            (wt "(" (host-type->c-name dest-host-type) ")(" loc ")"))
+           ((eq loc-host-type :object)
             ;; We relax the check a bit, because it is valid in C to coerce
             ;; between COMPLEX floats of different types.
             (ensure-valid-object-type 'SI:COMPLEX-FLOAT)
-            (wt-from-object-conversion dest-type loc-type dest-rep-type loc))
+            (wt-from-object-conversion dest-type loc-type dest-host-type loc))
            (t
             (coercion-error))))
         ((:bool)
          (cond
-           ((c-number-rep-type-p loc-rep-type)
+           ((c-number-host-type-p loc-host-type)
             (wt "1"))
-           ((eq loc-rep-type :object)
+           ((eq loc-host-type :object)
             (wt "(" loc ")!=ECL_NIL"))
            (t
             (coercion-error))))
         ((:object)
-         (case loc-rep-type
+         (case loc-host-type
            ((:int-sse-pack :float-sse-pack :double-sse-pack)
             (when (>= (cmp-env-optimization 'speed) 1)
               (cmpwarn-style "Boxing a value of type ~S - performance degraded."
-                             loc-rep-type))))
-         (wt-to-object-conversion loc-rep-type loc))
+                             loc-host-type))))
+         (wt-to-object-conversion loc-host-type loc))
         ((:pointer-void)
-         (case loc-rep-type
+         (case loc-host-type
            ((:object)
-            (wt-from-object-conversion dest-type loc-type dest-rep-type loc))
+            (wt-from-object-conversion dest-type loc-type dest-host-type loc))
            ((:cstring)
             (wt "(char *)(" loc ")"))
            (otherwise
@@ -298,7 +298,7 @@
         ((:cstring)
          (coercion-error))
         ((:char*)
-         (case loc-rep-type
+         (case loc-host-type
            ((:object)
             (wt "ecl_base_string_pointer_safe(" loc ")"))
            ((:pointer-void)
@@ -306,19 +306,19 @@
            (otherwise
             (coercion-error))))
         ((:int-sse-pack :float-sse-pack :double-sse-pack)
-         (case loc-rep-type
+         (case loc-host-type
            ((:object)
-            (wt-from-object-conversion 'ext:sse-pack loc-type dest-rep-type loc))
+            (wt-from-object-conversion 'ext:sse-pack loc-type dest-host-type loc))
            ;; Implicitly cast between SSE subtypes
            ((:int-sse-pack :float-sse-pack :double-sse-pack)
-            (wt (ecase dest-rep-type
-                  (:int-sse-pack (ecase loc-rep-type
+            (wt (ecase dest-host-type
+                  (:int-sse-pack (ecase loc-host-type
                                    (:float-sse-pack "_mm_castps_si128")
                                    (:double-sse-pack "_mm_castpd_si128")))
-                  (:float-sse-pack (ecase loc-rep-type
+                  (:float-sse-pack (ecase loc-host-type
                                      (:int-sse-pack "_mm_castsi128_ps")
                                      (:double-sse-pack "_mm_castpd_ps")))
-                  (:double-sse-pack (ecase loc-rep-type
+                  (:double-sse-pack (ecase loc-host-type
                                       (:int-sse-pack "_mm_castsi128_pd")
                                       (:float-sse-pack "_mm_castps_pd"))))
                 "(" loc ")"))
@@ -327,13 +327,13 @@
         (t
          ;; At this point we only have coercions to integers
          (cond
-           ((not (c-integer-rep-type-p dest-rep-type))
+           ((not (c-integer-host-type-p dest-host-type))
             (coercion-error))
-           ((c-number-rep-type-p loc-rep-type)
-            (wt "(" (rep-type->c-name dest-rep-type) ")(" loc ")"))
-           ((eq :object loc-rep-type)
+           ((c-number-host-type-p loc-host-type)
+            (wt "(" (host-type->c-name dest-host-type) ")(" loc ")"))
+           ((eq :object loc-host-type)
             (ensure-valid-object-type dest-type)
-            (wt-from-object-conversion dest-type loc-type dest-rep-type loc))
+            (wt-from-object-conversion dest-type loc-type dest-host-type loc))
            (t
             (coercion-error))))))))
 
@@ -342,8 +342,8 @@
 ;;; INLINE-LOC
 ;;;
 
-(defun wt-c-inline-loc (output-rep-type c-expression coerced-arguments side-effects output-vars)
-  (declare (ignore output-rep-type side-effects))
+(defun wt-c-inline-loc (output-host-type c-expression coerced-arguments side-effects output-vars)
+  (declare (ignore output-host-type side-effects))
   (with-input-from-string (s c-expression)
     (when (and output-vars (not (eq output-vars 'VALUES)))
       (wt-nl))
@@ -403,7 +403,7 @@
            (progn
              (wt-nl)
              (wt-loc destination) (wt " = ")
-             (wt-coerce-loc (loc-representation-type destination) loc)
+             (wt-coerce-loc (loc-host-type destination) loc)
              (wt ";"))))))
 
 (defun set-the-loc (loc type orig-loc)
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-top.lsp b/src/cmp/cmpbackend-cxx/cmppass2-top.lsp
index 7e1cb4d1b..959c997d5 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-top.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-top.lsp
@@ -271,7 +271,7 @@
   (with-bir-env (:env 0 :level 0 :volatile "volatile ")
     (when (eql return-type :void)
       (setf return-p nil))
-    (let ((return-type-name (rep-type->c-name (ffi::%convert-to-arg-type return-type)))
+    (let ((return-type-name (host-type->c-name (ffi::%convert-to-arg-type return-type)))
           (vars (loop for n from 0 below (length arg-types)
                       collect (format nil "var~d" n)))
           (fmod (case call-type
@@ -284,7 +284,7 @@
       (loop with comma = ""
             for var in vars
             for type in arg-types
-            for arg-type-name = (rep-type->c-name (ffi::%convert-to-arg-type type))
+            for arg-type-name = (host-type->c-name (ffi::%convert-to-arg-type type))
             do (wt-h comma arg-type-name " " var)
                (wt   comma arg-type-name " " var)
                (setf comma ","))
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp
index 6f7621522..43f6346a2 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp
@@ -103,7 +103,7 @@
      do (when kind
           (maybe-open-inline-block)
           (bind (next-lcl (var-name var)) var)
-          (wt-nl *volatile* (rep-type->c-name kind) " " var ";")))
+          (wt-nl *volatile* (host-type->c-name kind) " " var ";")))
 
   ;; Create closure bindings for closed-over variables
   (when (some #'var-ref-ccb vars)
@@ -159,7 +159,7 @@
             (when (useful-var-p var)
               (maybe-open-inline-block)
               (bind (next-lcl) var)
-              (wt-nl (rep-type->c-name kind) " " *volatile* var ";")
+              (wt-nl (host-type->c-name kind) " " *volatile* var ";")
               (wt-comment (var-name var)))
             (unless env-grows (setq env-grows (var-ref-ccb var))))))
     ;; 3) If there are closure variables, set up an environment.
@@ -228,11 +228,11 @@
           (LOCATION (push (cons var (c1form-arg 0 form)) saves))
           (otherwise
             (if (local var)
-                (let* ((rep-type (var-rep-type var))
-                       (rep-type-c-name (rep-type->c-name rep-type))
-                       (temp (make-lcl-var :rep-type rep-type)))
+                (let* ((host-type (var-host-type var))
+                       (host-type-c-name (host-type->c-name host-type))
+                       (temp (make-lcl-var :host-type host-type)))
                   (wt-nl-open-brace)
-                  (wt-nl rep-type-c-name " " *volatile* temp ";")
+                  (wt-nl host-type-c-name " " *volatile* temp ";")
                   (let ((*destination* temp)) (c2expr* form))
                   (push (cons var temp) saves))
                 (let ((*destination* (make-temp-var)))
@@ -283,7 +283,7 @@
             ;; check they are not the same
             (unless (equal (var-loc var) loc)
               (wt-nl var " = ")
-              (wt-coerce-loc (var-rep-type var) loc)
+              (wt-coerce-loc (var-host-type var) loc)
               (wt ";")))
            ((and (consp loc) (eql (car loc) 'LCL))
             ;; set location for lambda list requireds
@@ -412,21 +412,21 @@
   (case (var-kind var)
     (CLOSURE
      (wt-nl)(wt-env var-loc)(wt " = ")
-     (wt-coerce-loc (var-rep-type var) loc)
+     (wt-coerce-loc (var-host-type var) loc)
      (wt #\;))
     (LEXICAL
      (wt-nl)(wt-lex var-loc)(wt " = ")
-     (wt-coerce-loc (var-rep-type var) loc)
+     (wt-coerce-loc (var-host-type var) loc)
      (wt #\;))
     ((SPECIAL GLOBAL)
      (if (safe-compile)
          (wt-nl "ecl_cmp_setq(cl_env_copy," var-loc ",")
          (wt-nl "ECL_SETQ(cl_env_copy," var-loc ","))
-     (wt-coerce-loc (var-rep-type var) loc)
+     (wt-coerce-loc (var-host-type var) loc)
      (wt ");"))
     (t
      (wt-nl var-loc " = ")
-     (wt-coerce-loc (var-rep-type var) loc)
+     (wt-coerce-loc (var-host-type var) loc)
      (wt #\;))
     ))
 
diff --git a/src/cmp/cmplocs.lsp b/src/cmp/cmplocs.lsp
index 2a4213f40..f14ac7c8d 100644
--- a/src/cmp/cmplocs.lsp
+++ b/src/cmp/cmplocs.lsp
@@ -29,7 +29,7 @@
   (always nil)       ; when true then vv is never optimized
   (permanent-p t)
   (value nil)
-  (rep-type :object))
+  (host-type :object))
 
 ;;; When the value is the "empty location" then it was created to be filled
 ;;; later and the real type of the object is not known. See DATA-EMPTY-LOC.
@@ -51,37 +51,37 @@
   (cond ((eq loc NIL) 'NULL)
         ((var-p loc) (var-type loc))
         ((vv-p loc) (vv-type loc))
-        ((numberp loc) (lisp-type->rep-type (type-of loc)))
+        ((numberp loc) (lisp-type->host-type (type-of loc)))
         ((atom loc) 'T)
         (t
          (case (first loc)
            (FFI:C-INLINE (let ((type (first (second loc))))
                            (cond ((and (consp type) (eq (first type) 'VALUES)) T)
                                  ((lisp-type-p type) type)
-                                 (t (rep-type->lisp-type type)))))
+                                 (t (host-type->lisp-type type)))))
            (BIND (var-type (second loc)))
            (LCL (or (third loc) T))
            (THE (second loc))
            (CALL-NORMAL (fourth loc))
            (otherwise T)))))
 
-(defun loc-representation-type (loc)
+(defun loc-host-type (loc)
   (cond ((member loc '(NIL T)) :object)
-        ((var-p loc) (var-rep-type loc))
-        ((vv-p loc) (vv-rep-type loc))
-        ((numberp loc) (lisp-type->rep-type (type-of loc)))
+        ((var-p loc) (var-host-type loc))
+        ((vv-p loc) (vv-host-type loc))
+        ((numberp loc) (lisp-type->host-type (type-of loc)))
         ((eq loc 'TRASH) :void)
         ((atom loc) :object)
         (t
          (case (first loc)
            (FFI:C-INLINE (let ((type (first (second loc))))
                            (cond ((and (consp type) (eq (first type) 'VALUES)) :object)
-                                 ((lisp-type-p type) (lisp-type->rep-type type))
+                                 ((lisp-type-p type) (lisp-type->host-type type))
                                  (t type))))
-           (BIND (var-rep-type (second loc)))
-           (LCL (lisp-type->rep-type (or (third loc) T)))
+           (BIND (var-host-type (second loc)))
+           (LCL (lisp-type->host-type (or (third loc) T)))
            ((JUMP-TRUE JUMP-FALSE) :bool)
-           (THE (loc-representation-type (third loc)))
+           (THE (loc-host-type (third loc)))
            (otherwise :object)))))
 
 (defun loc-with-side-effects-p (loc &aux name)
@@ -119,14 +119,14 @@
 ;;;     ( VALUE i )                     VALUES(i)
 ;;;     ( VV vv-index )
 ;;;     ( VV-temp vv-index )
-;;;     ( LCL lcl [representation-type]) local variable, type unboxed
+;;;     ( LCL lcl [host-type]) local variable, type unboxed
 ;;;     ( TEMP temp )                   local variable, type object
 ;;;     ( FRAME ndx )                   variable in local frame stack
 ;;;     ( CALL-NORMAL fun locs 1st-type ) similar as CALL, but number of arguments is fixed
 ;;;     ( CALL-INDIRECT fun narg args)  similar as CALL, but unknown function
 ;;;     ( CALL-STACK fun)  similar as CALL-INDIRECT, but args are on the stack
 ;;;     ( FFI:C-INLINE output-type fun/string locs side-effects output-var )
-;;;     ( COERCE-LOC representation-type location)
+;;;     ( COERCE-LOC host-type location)
 ;;;     ( FDEFINITION vv-index )
 ;;;     ( MAKE-CCLOSURE cfun )
 ;;;     ( STACK-POINTER index ) retrieve a value from the stack
diff --git a/src/cmp/cmppass1-ffi.lsp b/src/cmp/cmppass1-ffi.lsp
index 6eb22df4e..84be2eeef 100644
--- a/src/cmp/cmppass1-ffi.lsp
+++ b/src/cmp/cmppass1-ffi.lsp
@@ -20,7 +20,7 @@
   (destructuring-bind (arguments arg-types output-type c-expression
                                  &rest rest
                                  &key (side-effects t) one-liner
-                                 &aux output-rep-type)
+                                 &aux output-host-type)
       args
     (unless (= (length arguments) (length arg-types))
       (cmperr "In a C-INLINE form the number of declare arguments and the number of supplied ones do not match:~%~S"
@@ -44,21 +44,21 @@
     ;;  output-type = lisp-type | c-type | (values {lisp-type | c-type}*)
     (flet ((produce-type-pair (type)
              (if (lisp-type-p type)
-                 (cons type (lisp-type->rep-type type))
-                 (cons (rep-type->lisp-type type) type))))
+                 (cons type (lisp-type->host-type type))
+                 (cons (host-type->lisp-type type) type))))
       (cond ((eq output-type ':void)
-             (setf output-rep-type '()
+             (setf output-host-type '()
                    output-type 'NIL))
             ((equal output-type '(VALUES &REST t))
-             (setf output-rep-type '((VALUES &REST t))))
+             (setf output-host-type '((VALUES &REST t))))
             ((and (consp output-type) (eql (first output-type) 'VALUES))
              (let ((x (mapcar #'produce-type-pair (rest output-type))))
-               (setf output-rep-type (mapcar #'cdr x)
+               (setf output-host-type (mapcar #'cdr x)
                      output-type `(VALUES ,@(mapcar #'car x)))))
             (t
              (let ((x (produce-type-pair output-type)))
                (setf output-type (car x)
-                     output-rep-type (list (cdr x)))))))
+                     output-host-type (list (cdr x)))))))
     (unless (and (listp arguments)
                  (listp arg-types)
                  (stringp c-expression))
@@ -72,7 +72,7 @@
            (form (make-c1form* 'ffi:c-inline :type output-type
                                :side-effects side-effects
                                :args arguments arg-types
-                               output-rep-type
+                               output-host-type
                                c-expression
                                side-effects
                                one-liner)))
diff --git a/src/cmp/cmppass1-var.lsp b/src/cmp/cmppass1-var.lsp
index 7871fcf05..225e5a621 100644
--- a/src/cmp/cmppass1-var.lsp
+++ b/src/cmp/cmppass1-var.lsp
@@ -224,7 +224,7 @@
            (setq type 'T))
           ((machine-c-type-p (setq type (cdr type)))
            (setf kind type
-                 type (rep-type->lisp-type type))))
+                 type (host-type->lisp-type type))))
     (cond ((or (member name specials) (special-variable-p name))
            (unless (eq kind 'LEXICAL)
              (cmperr "Special variable ~A cannot be declared to have C type ~A"
diff --git a/src/cmp/cmptables.lsp b/src/cmp/cmptables.lsp
index b9e904b13..f69482165 100644
--- a/src/cmp/cmptables.lsp
+++ b/src/cmp/cmptables.lsp
@@ -63,7 +63,7 @@
     (ext:COMPILER-TYPECASE var expressions)
     (ext:CHECKED-VALUE  type value-c1form let-form)
     ;; Backend-specific operators
-    (FFI:C-INLINE (arg-c1form*) (arg-type-symbol*) output-rep-type
+    (FFI:C-INLINE (arg-c1form*) (arg-type-symbol*) output-host-type
                   c-expression-string
                   side-effects-p one-liner-p)
     (FFI:C-PROGN  variables forms))))
diff --git a/src/cmp/cmpvar.lsp b/src/cmp/cmpvar.lsp
index c51d4f15a..845260360 100644
--- a/src/cmp/cmpvar.lsp
+++ b/src/cmp/cmpvar.lsp
@@ -44,12 +44,12 @@
         (push var (fun-local-vars *current-function*))))
     var))
 
-(defun make-lcl-var (&key rep-type (type 'T))
-  (unless rep-type
-    (setq rep-type (if type (lisp-type->rep-type type) :object)))
+(defun make-lcl-var (&key host-type (type 'T))
+  (unless host-type
+    (setq host-type (if type (lisp-type->host-type type) :object)))
   (unless type
     (setq type 'T))
-  (make-var :kind rep-type :type type :loc (next-lcl)))
+  (make-var :kind host-type :type type :loc (next-lcl)))
 
 (defun make-global-var (name &key
                                (type (or (si:get-sysprop name 'CMP-TYPE) t))
@@ -165,7 +165,7 @@
     (add-to-set-nodes v form))
   form)
 
-(defun var-rep-type (var)
+(defun var-host-type (var)
   (case (var-kind var)
     ((LEXICAL CLOSURE SPECIAL GLOBAL) :object)
     (t (var-kind var))))
@@ -179,11 +179,11 @@
       ;; if the variable can be stored locally, set it var-kind to its type
       (setf (var-kind var)
             (if (plusp (var-ref var))
-                (lisp-type->rep-type (var-type var))
+                (lisp-type->host-type (var-type var))
                 :OBJECT)))))
 
 (defun unboxed (var)
-  (not (eq (var-rep-type var) :object)))
+  (not (eq (var-host-type var) :object)))
 
 (defun local (var)
   (and (not (member (var-kind var) '(LEXICAL CLOSURE SPECIAL GLOBAL)))

From 7dc7bda980beb810c0010aa627a07986d3291e72 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Wed, 6 Dec 2023 18:00:09 +0100
Subject: [PATCH 02/15] cmp: rename predicates to conform to the common style

local   -> local-var-p
unboxed -> unboxed-var-p
---
 src/cmp/cmpbackend-cxx/cmppass2-fun.lsp |  4 +--
 src/cmp/cmpbackend-cxx/cmppass2-var.lsp | 46 ++++++++++++-------------
 src/cmp/cmpvar.lsp                      |  4 +--
 3 files changed, 27 insertions(+), 27 deletions(-)

diff --git a/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp b/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp
index b53122d6d..5b0aa3977 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp
@@ -146,11 +146,11 @@
                (wt (host-type->c-name (var-host-type var)) " " *volatile* lcl ";")
                lcl))
            (do-decl (var)
-             (when (local var) ; no LCL needed for SPECIAL or LEX
+             (when (local-var-p var) ; no LCL needed for SPECIAL or LEX
                (setf (var-loc var) (wt-decl var)))))
     ;; Declare unboxed required arguments
     (loop for var in requireds
-       when (unboxed var)
+       when (unboxed-var-p var)
        do (setf (var-loc var) (wt-decl var)))
     ;; dont create rest or varargs if not used
     (when (and rest (< (var-ref rest) 1)
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp
index 43f6346a2..598b2fcd1 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp
@@ -12,13 +12,13 @@
 (defun c2let-replaceable-var-ref-p (var form rest-forms)
   (when (and (eq (c1form-name form) 'VARIABLE)
              (null (var-set-nodes var))
-             (local var))
+             (local-var-p var))
     (let ((var1 (c1form-arg 0 form)))
       (declare (type var var1))
       ;; FIXME We should be able to replace variable even if they are referenced
       ;; across functions.  We just need to keep track of their uses.
-      (when (and (local var1)
-                 (eq (unboxed var) (unboxed var1))
+      (when (and (local-var-p var1)
+                 (eq (unboxed-var-p var) (unboxed-var-p var1))
                  (not (var-changed-in-form-list var1 rest-forms)))
         (cmpdebug "Replacing variable ~a by its value" (var-name var))
         (nsubst-var var form)
@@ -90,20 +90,20 @@
                (*inline-blocks* 0))
   ;; Replace read-only variables when it is worth doing it.
   (loop for var in vars
-     for rest-forms on (append forms (list body))
-     for form = (first rest-forms)
-     unless (c2let-replaceable-var-ref-p var form rest-forms)
-     collect var into used-vars and
-     collect form into used-forms
-     finally (setf vars used-vars forms used-forms))
+        for rest-forms on (append forms (list body))
+        for form = (first rest-forms)
+        unless (c2let-replaceable-var-ref-p var form rest-forms)
+          collect var into used-vars and
+        collect form into used-forms
+        finally (setf vars used-vars forms used-forms))
 
   ;; Emit C definitions of local variables
   (loop for var in vars
-     for kind = (local var)
-     do (when kind
-          (maybe-open-inline-block)
-          (bind (next-lcl (var-name var)) var)
-          (wt-nl *volatile* (host-type->c-name kind) " " var ";")))
+        for kind = (local-var-p var)
+        do (when kind
+             (maybe-open-inline-block)
+             (bind (next-lcl (var-name var)) var)
+             (wt-nl *volatile* (host-type->c-name kind) " " var ";")))
 
   ;; Create closure bindings for closed-over variables
   (when (some #'var-ref-ccb vars)
@@ -154,14 +154,14 @@
     ;;    closure, make a local C variable.
     (dolist (var vars)
       (declare (type var var))
-      (let ((kind (local var)))
-        (if kind
-            (when (useful-var-p var)
-              (maybe-open-inline-block)
-              (bind (next-lcl) var)
-              (wt-nl (host-type->c-name kind) " " *volatile* var ";")
-              (wt-comment (var-name var)))
-            (unless env-grows (setq env-grows (var-ref-ccb var))))))
+      (ext:if-let ((kind (local-var-p var)))
+        (when (useful-var-p var)
+          (maybe-open-inline-block)
+          (bind (next-lcl) var)
+          (wt-nl (host-type->c-name kind) " " *volatile* var ";")
+          (wt-comment (var-name var)))
+        (unless env-grows
+          (setq env-grows (var-ref-ccb var)))))
     ;; 3) If there are closure variables, set up an environment.
     (when (setq env-grows (env-grows env-grows))
       (let ((env-lvl *env-lvl*))
@@ -227,7 +227,7 @@
         (case (c1form-name form)
           (LOCATION (push (cons var (c1form-arg 0 form)) saves))
           (otherwise
-            (if (local var)
+            (if (local-var-p var)
                 (let* ((host-type (var-host-type var))
                        (host-type-c-name (host-type->c-name host-type))
                        (temp (make-lcl-var :host-type host-type)))
diff --git a/src/cmp/cmpvar.lsp b/src/cmp/cmpvar.lsp
index 845260360..076940baa 100644
--- a/src/cmp/cmpvar.lsp
+++ b/src/cmp/cmpvar.lsp
@@ -182,10 +182,10 @@
                 (lisp-type->host-type (var-type var))
                 :OBJECT)))))
 
-(defun unboxed (var)
+(defun unboxed-var-p (var)
   (not (eq (var-host-type var) :object)))
 
-(defun local (var)
+(defun local-var-p (var)
   (and (not (member (var-kind var) '(LEXICAL CLOSURE SPECIAL GLOBAL)))
        (var-kind var)))
 

From f68c911ece52233f10cdd4ec6addd655de82ca06 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Wed, 6 Dec 2023 09:19:52 +0100
Subject: [PATCH 03/15] cmp: allow specifying the type of vv

This will be useful for inline locations where we don't know the real value, but
we can infer the type.
---
 src/cmp/cmplocs.lsp | 17 +++++++++--------
 src/cmp/cmpprop.lsp |  2 +-
 2 files changed, 10 insertions(+), 9 deletions(-)

diff --git a/src/cmp/cmplocs.lsp b/src/cmp/cmplocs.lsp
index f14ac7c8d..ee9b9407d 100644
--- a/src/cmp/cmplocs.lsp
+++ b/src/cmp/cmplocs.lsp
@@ -23,21 +23,22 @@
 ;;; second pass the backend decides if the referenced object can be inlined, or
 ;;; if it needs to be put in the data segment and initialized at load-time.
 
-(defstruct vv
+(defstruct (vv (:constructor %make-vv))
   (location nil)
   (used-p nil)
   (always nil)       ; when true then vv is never optimized
   (permanent-p t)
   (value nil)
+  (type nil)
   (host-type :object))
 
-;;; When the value is the "empty location" then it was created to be filled
-;;; later and the real type of the object is not known. See DATA-EMPTY-LOC.
-(defun vv-type (loc)
-  (let ((value (vv-value loc)))
-    (if (eq value *empty-loc*)
-        t
-        (type-of value))))
+(defun make-vv (&rest args &key location used-p always permanent-p value type host-type)
+  (declare (ignore location used-p always permanent-p host-type))
+  (unless type
+    ;; When the value is the "empty location" then it was created to be filled
+    ;; later and the real type of the object is not known. See DATA-EMPTY-LOC.
+    (setf type (if (eq value *empty-loc*) t (type-of value))))
+  (apply #'%make-vv :type type args))
 
 (defun loc-movable-p (loc)
   (if (atom loc)
diff --git a/src/cmp/cmpprop.lsp b/src/cmp/cmpprop.lsp
index 56bb324e0..cf74a5a1c 100644
--- a/src/cmp/cmpprop.lsp
+++ b/src/cmp/cmpprop.lsp
@@ -53,7 +53,7 @@
 
 (defun p1var (form var loc)
   ;; Use the type of C1FORM because it might have been coerced by a THE form.
-  (let* ((loc-type (if loc (object-type (vv-value loc)) t))
+  (let* ((loc-type (if loc (vv-type loc) t))
          (var-type (var-type var))
          (type (type-and (type-and loc-type var-type)
                          (c1form-primary-type form))))

From 2f8f7c0ada48d7c356e0b142f24d4025b0b56f65 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Tue, 5 Dec 2023 14:16:20 +0100
Subject: [PATCH 04/15] cmp: inl: fix a braino in emit-inlined-call-global

---
 src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
index b5a04bd54..bf49fb0f4 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
+++ b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
@@ -99,10 +99,12 @@
         (make-inlined-arg (c1form-arg 0 form1) (c1form-primary-type form1))
         (emit-inlined-variable (make-c1form 'VARIABLE form vref nil) rest-forms))))
 
-(defun emit-inlined-call-global (form expected-type)
+(defun emit-inlined-call-global (form rest-forms)
+  (declare (ignore rest-forms))
   (let* ((fname (c1form-arg 0 form))
          (args (c1form-arg 1 form))
          (return-type (c1form-primary-type form))
+         (expected-type (loc-type *destination*))
          (fun (find fname *global-funs* :key #'fun-name :test #'same-fname-p))
          (loc (call-global-loc fname fun args return-type expected-type))
          (type (type-and return-type (loc-type loc)))
@@ -164,8 +166,9 @@
        (make-inlined-arg (c1form-arg 0 form) (c1form-primary-type form)))
       (VARIABLE
        (emit-inlined-variable form forms))
+      ;; FIXME this c1form was incorporated into FCALL.
       (CALL-GLOBAL
-       (emit-inlined-call-global form (c1form-primary-type form)))
+       (emit-inlined-call-global form forms))
       (SI:STRUCTURE-REF
        (emit-inlined-structure-ref form forms))
       (SI:INSTANCE-REF

From c7da5bc919b47e38179391baf20412d8b335cc4b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Wed, 6 Dec 2023 09:50:51 +0100
Subject: [PATCH 05/15] cmp: inl: remove dead code

SI:STRUCTURE-REF, SI:STRUCTURE-SET, SI:INSTANCE-REF, SI:CALL-GLOBAL were all
removed or merged with other operators.

SI:CALL-GLOBAL was incorporated recently to FCALL. In upcoming commits we will
sort this out in a more regular way (by introducing an FCALL-ARG destination).
---
 src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp | 49 -------------------------
 src/cmp/cmptables.lsp                   |  4 --
 2 files changed, 53 deletions(-)

diff --git a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
index bf49fb0f4..9fc42ca0a 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
+++ b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
@@ -99,19 +99,6 @@
         (make-inlined-arg (c1form-arg 0 form1) (c1form-primary-type form1))
         (emit-inlined-variable (make-c1form 'VARIABLE form vref nil) rest-forms))))
 
-(defun emit-inlined-call-global (form rest-forms)
-  (declare (ignore rest-forms))
-  (let* ((fname (c1form-arg 0 form))
-         (args (c1form-arg 1 form))
-         (return-type (c1form-primary-type form))
-         (expected-type (loc-type *destination*))
-         (fun (find fname *global-funs* :key #'fun-name :test #'same-fname-p))
-         (loc (call-global-loc fname fun args return-type expected-type))
-         (type (type-and return-type (loc-type loc)))
-         (temp (make-inline-temp-var type (loc-representation-type loc))))
-    (set-loc temp loc)
-    (make-inlined-arg temp type)))
-
 (defun emit-inlined-progn (form forms)
   (let ((args (c1form-arg 0 form)))
     (loop with *destination* = 'TRASH
@@ -130,35 +117,6 @@
             for form in args
             do (c2expr* form)))))
 
-(defun emit-inlined-structure-ref (form rest-forms)
-  (let ((type (c1form-primary-type form)))
-    (if (some #'c1form-side-effects rest-forms)
-        (let* ((temp (make-inline-temp-var type :object))
-               (*destination* temp))
-          (c2expr* form)
-          (make-inlined-arg temp type))
-        (make-inlined-arg (list 'SI:STRUCTURE-REF
-                                (first (coerce-locs
-                                        (inline-args (list (c1form-arg 0 form)))))
-                                (c1form-arg 1 form)
-                                (c1form-arg 2 form)
-                                (c1form-arg 3 form))
-                          type))))
-
-(defun emit-inlined-instance-ref (form rest-forms)
-  (let ((type (c1form-primary-type form)))
-    (if (some #'c1form-side-effects rest-forms)
-        (let* ((temp (make-inline-temp-var type :object))
-               (*destination* temp))
-          (c2expr* form)
-          (make-inlined-arg temp type))
-        (make-inlined-arg (list 'SI:INSTANCE-REF
-                                (first (coerce-locs
-                                        (inline-args (list (c1form-arg 0 form)))))
-                                (c1form-arg 1 form)
-                                #+ (or) (c1form-arg 2 form))
-                          type))))
-
 (defun emit-inline-form (form forms)
   (with-c1form-env (form form)
     (case (c1form-name form)
@@ -166,13 +124,6 @@
        (make-inlined-arg (c1form-arg 0 form) (c1form-primary-type form)))
       (VARIABLE
        (emit-inlined-variable form forms))
-      ;; FIXME this c1form was incorporated into FCALL.
-      (CALL-GLOBAL
-       (emit-inlined-call-global form forms))
-      (SI:STRUCTURE-REF
-       (emit-inlined-structure-ref form forms))
-      (SI:INSTANCE-REF
-       (emit-inlined-instance-ref form forms))
       (SETQ
        (emit-inlined-setq form forms))
       (PROGN
diff --git a/src/cmp/cmptables.lsp b/src/cmp/cmptables.lsp
index f69482165..c53dd7288 100644
--- a/src/cmp/cmptables.lsp
+++ b/src/cmp/cmptables.lsp
@@ -35,9 +35,6 @@
     ;; Function namespace (should include also FSET)
     (CL:FUNCTION        fname :single-valued)
     (LOCALS             local-fun-list body labels-p :pure)
-    ;; Specialized accessors
-    (SI:STRUCTURE-REF   struct-c1form type-name slot-index (:UNSAFE/NIL) :pure)
-    (SI:STRUCTURE-SET   struct-c1form type-name slot-index value-c1form :side-effects)
     ;; Control structures
     (CL:BLOCK           blk-var progn-c1form :pure)
     (CL:RETURN-FROM     blk-var nonlocal value :side-effects)
@@ -180,7 +177,6 @@
     (cl:fdefinition . wt-fdefinition)
     (make-cclosure . wt-make-closure)
 
-    (si:structure-ref . wt-structure-ref)
     (ffi-data-ref . wt-ffi-data-ref)
 
     (leave . "value0")

From b1bebbdb2cfb7f1dbf6f305ae658f82e7de46d41 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Wed, 6 Dec 2023 10:28:26 +0100
Subject: [PATCH 06/15] 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     | 20 ++++++++------------
 src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp     |  4 ++--
 src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp     | 20 ++++++++++----------
 src/cmp/cmpbackend-cxx/cmpc-opt-printer.lsp |  2 +-
 src/cmp/cmpbackend-cxx/cmppass2-call.lsp    |  4 ++--
 src/cmp/cmpglobals.lsp                      |  1 +
 src/cmp/cmplocs.lsp                         | 10 +++++++---
 7 files changed, 31 insertions(+), 30 deletions(-)

diff --git a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
index 9fc42ca0a..997b6cae0 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
+++ b/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.
diff --git a/src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp
index 278ffa734..cdbde60e1 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp
+++ b/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)
diff --git a/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp b/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp
index b06723e81..bd2aa16d1 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp
+++ b/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)
diff --git a/src/cmp/cmpbackend-cxx/cmpc-opt-printer.lsp b/src/cmp/cmpbackend-cxx/cmpc-opt-printer.lsp
index b68d56040..5f75d819b 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-opt-printer.lsp
+++ b/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)
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp b/src/cmp/cmpbackend-cxx/cmppass2-call.lsp
index 6bbf24de9..f9a324a00 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp
+++ b/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))))
 
diff --git a/src/cmp/cmpglobals.lsp b/src/cmp/cmpglobals.lsp
index f62e95c79..a00c76467 100644
--- a/src/cmp/cmpglobals.lsp
+++ b/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.")
diff --git a/src/cmp/cmplocs.lsp b/src/cmp/cmplocs.lsp
index ee9b9407d..b1b824f96 100644
--- a/src/cmp/cmplocs.lsp
+++ b/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)

From 44088b8886c2d78c6fe54954a6261f4a16ce4c25 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Wed, 6 Dec 2023 13:01:59 +0100
Subject: [PATCH 07/15] cmp: inl: use the most specific location type for
 argument inlining

This commit effectively retires the function MAKE-INLINE-ARG in favor of more
specific location `(THE ...).
---
 src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp | 91 ++++++++++++++-----------
 1 file changed, 50 insertions(+), 41 deletions(-)

diff --git a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
index 997b6cae0..d8e500d9d 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
+++ b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
@@ -7,17 +7,10 @@
 ;;;;
 
 ;;;; Open coding nested forms as C expressions while preserving the order of
-;;;; evaluation. Resulting locations stored in the INLINE-ARG structure may be
-;;;; used inline in C expressions (locs still must to be coerced appropriately).
+;;;; evaluation. Resulting locations may be used inline in C expressions.
 
 (in-package "COMPILER")
 
-(defun make-inlined-arg (loc lisp-type)
-  (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*)
     (open-inline-block)))
@@ -67,48 +60,67 @@
               (t
                `(COERCE-LOC ,host-type ,loc)))))
 
-(defun make-inline-temp-var (value-type &optional host-type)
-  (let ((out-host-type (or host-type (lisp-type->host-type value-type))))
-    (if (eq out-host-type :object)
-        (make-temp-var value-type)
-        (let ((var (make-lcl-var :host-type out-host-type
-                                 :type value-type)))
-          (open-inline-block)
-          (wt-nl (host-type->c-name out-host-type) " " var ";")
-          var))))
+;;; We could use VV to represent inlined args, but the most specific for our
+;;; purposes is the location (THE LISP-TYPE LOCATION) which is created when
+;;; necessary by the function PRECISE-LOC-TYPE. -- jd 2023-12-06
+#+ (or)
+(defun make-inlined-arg (loc lisp-type)
+  (make-vv :location loc
+           :value *inline-loc*
+           :type lisp-type
+           :host-type (loc-host-type loc)))
+
+(defun make-inlined-temp-var (lisp-type host-type)
+  (declare (si::c-local))
+  (if (eq host-type :object)
+      (make-temp-var lisp-type)
+      (let ((var (make-lcl-var :host-type host-type
+                               :type lisp-type)))
+        (open-inline-block)
+        (wt-nl (host-type->c-name host-type) " " var ";")
+        var)))
+
+(defun emit-inlined-temp-var (form lisp-type host-type)
+  (let ((*destination* (make-inlined-temp-var lisp-type host-type)))
+    (c2expr* form)
+    *destination*))
 
 (defun emit-inlined-variable (form rest-forms)
   (let ((var (c1form-arg 0 form))
         (lisp-type (c1form-primary-type form)))
     (if (var-changed-in-form-list var rest-forms)
-        (let ((temp (make-inline-temp-var lisp-type (var-host-type var))))
-          (set-loc temp var)
-          (make-inlined-arg temp lisp-type))
-        (make-inlined-arg var lisp-type))))
+        (emit-inlined-temp-var form lisp-type (var-host-type var))
+        (precise-loc-type var lisp-type))))
 
 (defun emit-inlined-setq (form rest-forms)
-  (let ((vref (c1form-arg 0 form))
-        (form1 (c1form-arg 1 form)))
-    (let ((*destination* vref))
-      (c2expr* form1))
-    (if (eq (c1form-name form1) 'LOCATION)
-        (make-inlined-arg (c1form-arg 0 form1) (c1form-primary-type form1))
-        (emit-inlined-variable (make-c1form 'VARIABLE form vref nil) rest-forms))))
+  (let ((var (c1form-arg 0 form))
+        (val-form (c1form-arg 1 form))
+        (lisp-type (c1form-primary-type form)))
+    (let ((*destination* var))
+      (c2expr* val-form))
+    (cond
+      ((eq (c1form-name val-form) 'LOCATION)
+       (precise-loc-type (c1form-arg 0 val-form) lisp-type))
+      ((not (var-changed-in-form-list var rest-forms))
+       (precise-loc-type var lisp-type))
+      (t
+       (let ((var-form (make-c1form 'VARIABLE form var nil)))
+         (emit-inlined-temp-var var-form lisp-type (var-host-type var)))))))
 
-(defun emit-inlined-progn (form forms)
+(defun emit-inlined-progn (form rest-forms)
   (let ((args (c1form-arg 0 form)))
     (loop with *destination* = 'TRASH
           while (rest args)
           do (c2expr* (pop args)))
-    (emit-inline-form (first args) forms)))
+    (emit-inline-form (first args) rest-forms)))
 
-(defun emit-inlined-values (form forms)
+(defun emit-inlined-values (form rest-forms)
   (let ((args (c1form-arg 0 form)))
     (prog1 (emit-inline-form (or (pop args) (c1nil))
-                             ;; the rest of the values args need to be
-                             ;; added to the rest forms to execute side
-                             ;; effects in the correct order
-                             (append args forms))
+                             ;; The rest of the values args need to be added to
+                             ;; the rest forms to execute side effects in the
+                             ;; correct order.
+                             (append args rest-forms))
       (loop with *destination* = 'TRASH
             for form in args
             do (c2expr* form)))))
@@ -117,7 +129,7 @@
   (with-c1form-env (form form)
     (case (c1form-name form)
       (LOCATION
-       (make-inlined-arg (c1form-arg 0 form) (c1form-primary-type form)))
+       (precise-loc-type (c1form-arg 0 form) (c1form-primary-type form)))
       (VARIABLE
        (emit-inlined-variable form forms))
       (SETQ
@@ -126,11 +138,8 @@
        (emit-inlined-progn form forms))
       (VALUES
        (emit-inlined-values form forms))
-      (t (let* ((type (c1form-primary-type form))
-                (temp (make-inline-temp-var type))
-                (*destination* temp))
-           (c2expr* form)
-           (make-inlined-arg temp type))))))
+      (t
+       (emit-inlined-temp-var form (c1form-primary-type form) :object)))))
 
 ;;;
 ;;; inline-args:

From cae5241a8bf3132bb8e52d498b06db2efe6f4e54 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Wed, 6 Dec 2023 13:29:40 +0100
Subject: [PATCH 08/15] cmp: inl: add a new function coerce-args derived from
 coerce-locs

COERCE-LOCS optional parameters were used only by produce-inline-loc. All other
uses were much simpler, so we've spinned a separate function and removed
optionality of arguments in coerce-locs.
---
 src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp  | 16 +++++++++++-----
 src/cmp/cmpbackend-cxx/cmppass2-call.lsp |  8 ++++----
 src/cmp/cmpbackend-cxx/cmppass2-eval.lsp |  2 +-
 src/cmp/cmpbackend-cxx/cmppass2-var.lsp  |  2 +-
 4 files changed, 17 insertions(+), 11 deletions(-)

diff --git a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
index d8e500d9d..181563e96 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
+++ b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
@@ -23,7 +23,14 @@
   (loop for i of-type fixnum from 0 below *inline-blocks*
         do (wt-nl-close-brace)))
 
-(defun coerce-locs (inlined-args &optional types args-to-be-saved)
+(defun coerce-args (inlined-args)
+  (mapcar (lambda (loc)
+            (if (eq (loc-host-type loc) :object)
+                loc
+                `(COERCE-LOC :object ,LOC)))
+          inlined-args))
+
+(defun coerce-locs (inlined-args types args-to-be-saved)
   ;; INLINED-ARGS is a list of INLINED-ARG produced by the argument inliner.
   ;; Each arg is a location, "inlined" means "evaluated in the correct order".
   ;;
@@ -33,18 +40,17 @@
   ;; TYPES is a list of destination types, to which the former values are
   ;; coerced. The destination type can be:
   ;;
-  ;;   - A machine rep type (:OBJECT, :FIXNUM, :INT, ...)
+  ;;   - A host type (:OBJECT, :FIXNUM, :INT, :CHAR, ...)
   ;;   - A lisp type (T, INTEGER, STRING, CHARACTER, ...))
   ;;
   (loop with block-opened = nil
         for loc in inlined-args
         for arg-host-type = (loc-host-type loc)
-        for type in (or types '#1=(:object . #1#))
+        for type in types
         for i from 0
         for host-type = (lisp-type->host-type type)
         collect
-        (cond ((and args-to-be-saved
-                    (member i args-to-be-saved :test #'eql)
+        (cond ((and (member i args-to-be-saved :test #'eql)
                     (not (loc-movable-p loc)))
                (let ((lcl (make-lcl-var :host-type host-type)))
                  (wt-nl)
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp b/src/cmp/cmpbackend-cxx/cmppass2-call.lsp
index f9a324a00..7cec2aad9 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-call.lsp
@@ -157,7 +157,7 @@
 ;;;
 (defun call-loc (fname fun args type)
   (declare (ignore fname))
-  `(CALL-NORMAL ,fun ,(coerce-locs args) ,type))
+  `(CALL-NORMAL ,fun ,(coerce-args args) ,type))
 
 ;;;
 ;;; call-global:
@@ -252,7 +252,7 @@
 ;;;   FUNCTION-P: true when we can assume that LOC is the function
 ;;;
 (defun call-unknown-global-loc (loc args function-p)
-  `(CALL-INDIRECT ,loc ,(coerce-locs args) nil ,function-p))
+  `(CALL-INDIRECT ,loc ,(coerce-args args) nil ,function-p))
 
 ;;;
 ;;; call-unknown-global-fun
@@ -261,10 +261,10 @@
 ;;;   ARGS: a list of INLINED-ARGs
 ;;;
 (defun call-unknown-global-fun (fname args)
-  `(CALL-INDIRECT (FDEFINITION ,fname) ,(coerce-locs args) ,fname t))
+  `(CALL-INDIRECT (FDEFINITION ,fname) ,(coerce-args args) ,fname t))
 
 #+ (or)
 ;;; This version is correct but unnecessarily slow - it goes through
 ;;; ecl_function_dispatch. wt-fdefinition handles all proper names.
 (defun call-unknown-global-fun (fname args)
-  `(CALL-INDIRECT ,(get-object fname) ,(coerce-locs args) ,fname nil))
+  `(CALL-INDIRECT ,(get-object fname) ,(coerce-args args) ,fname nil))
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp b/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp
index ab166ce36..b1f7d0181 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp
@@ -220,7 +220,7 @@
     (t
      (with-inline-blocks ()
        (let* ((nv (length forms))
-              (forms (nreverse (coerce-locs (inline-args forms)))))
+              (forms (nreverse (coerce-args (inline-args forms)))))
          ;; By inlining arguments we make sure that VL has no call to funct.
          ;; Reverse args to avoid clobbering VALUES(0)
          (wt-nl "cl_env_copy->nvalues = " nv ";")
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp
index 598b2fcd1..a9fbf1d6d 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp
@@ -300,7 +300,7 @@
         ;; environments, global environments, etc. If we use `(BIND var)
         ;; as destination, BIND might receive the wrong environment.
         (with-inline-blocks ()
-          (let ((locs (coerce-locs (inline-args (list form)))))
+          (let ((locs (coerce-args (inline-args (list form)))))
             (bind (first locs) var)
             ;; Notice that we do not need to update *UNWIND-EXIT* because BIND
             ;; does it for us.

From 73605c9ba9d167fc8c392dcc39fb18788bef9ea6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Wed, 6 Dec 2023 19:41:02 +0100
Subject: [PATCH 09/15] cmp: inl: rewrite c2psetq for consistency

This function is now written in the same spirit as EMIT-INLINE-FORM and uses
WITH-INLINE-BLOCKS.
---
 src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp |  1 -
 src/cmp/cmpbackend-cxx/cmpc-util.lsp    |  3 +-
 src/cmp/cmpbackend-cxx/cmppass2-var.lsp | 45 +++++++++----------------
 3 files changed, 18 insertions(+), 31 deletions(-)

diff --git a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
index 181563e96..1c0f523de 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
+++ b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
@@ -77,7 +77,6 @@
            :host-type (loc-host-type loc)))
 
 (defun make-inlined-temp-var (lisp-type host-type)
-  (declare (si::c-local))
   (if (eq host-type :object)
       (make-temp-var lisp-type)
       (let ((var (make-lcl-var :host-type host-type
diff --git a/src/cmp/cmpbackend-cxx/cmpc-util.lsp b/src/cmp/cmpbackend-cxx/cmpc-util.lsp
index b1a1b3c4b..16780fc56 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-util.lsp
+++ b/src/cmp/cmpbackend-cxx/cmpc-util.lsp
@@ -194,7 +194,8 @@
 ;;; for temporary variables that are bound to local evaluation results.
 (defmacro with-inline-blocks (() &body body)
   `(let ((*inline-blocks* 0)
-         (*temp* *temp*))
+         (*temp* *temp*)
+         (*lcl* *lcl*))
      ,@body
      (close-inline-blocks)))
 
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp
index a9fbf1d6d..e74509b8b 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp
@@ -212,37 +212,24 @@
         (wt-nl lcl " = ecl_progv(cl_env_copy, " sym-loc ", " val-loc ");")
         (c2expr body)))))
 
-(defun c2psetq (c1form vrefs forms
-                &aux (*lcl* *lcl*) (saves nil) (braces *opened-c-braces*))
+(defun c2psetq (c1form vrefs forms &aux (saves nil))
   (declare (ignore c1form))
   ;; similar to inline-args
-  (do ((vrefs vrefs (cdr vrefs))
-       (forms forms (cdr forms))
-       (var) (form))
-      ((null vrefs))
-    (setq var (first vrefs)
-          form (car forms))
-    (if (or (var-changed-in-form-list var (rest forms))
-            (var-referenced-in-form-list var (rest forms)))
-        (case (c1form-name form)
-          (LOCATION (push (cons var (c1form-arg 0 form)) saves))
-          (otherwise
-            (if (local-var-p var)
-                (let* ((host-type (var-host-type var))
-                       (host-type-c-name (host-type->c-name host-type))
-                       (temp (make-lcl-var :host-type host-type)))
-                  (wt-nl-open-brace)
-                  (wt-nl host-type-c-name " " *volatile* temp ";")
-                  (let ((*destination* temp)) (c2expr* form))
-                  (push (cons var temp) saves))
-                (let ((*destination* (make-temp-var)))
-                  (c2expr* form)
-                  (push (cons var *destination*) saves)))))
-        (let ((*destination* var))
-          (c2expr* form))))
-  (dolist (save saves)
-    (set-var (cdr save) (car save)))
-  (wt-nl-close-many-braces braces)
+  (with-inline-blocks ()
+    (loop for var in vrefs
+          for (form . rest-forms) on forms
+          do (if (or (var-changed-in-form-list var rest-forms)
+                     (var-referenced-in-form-list var rest-forms))
+                 (if (eq (c1form-name form) 'LOCATION)
+                     (push (cons var (c1form-arg 0 form)) saves)
+                     (let* ((typ (c1form-primary-type form))
+                            (rep (var-host-type var))
+                            (tmp (emit-inlined-temp-var form typ rep)))
+                       (push (cons var tmp) saves)))
+                 (let ((*destination* var))
+                   (c2expr* form))))
+    (dolist (save saves)
+      (set-var (cdr save) (car save))))
   (unwind-exit *vv-nil*))
 
 ;;; bind must be called for each variable in a lambda or let, once the value

From e97d3c621981df641902bc54312a333e3994ad5e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Thu, 7 Dec 2023 10:59:45 +0100
Subject: [PATCH 10/15] cmp: rework loc types and rename functions

loc-type -> loc-lisp-type (mirrors loc-host-type)
precise-loc-type -> precise-loc-lisp-type (consistency)

Introduce a new WT element in the table FRAME++, with this we don't need to
consider raw strings as locations.

LOC-LISP-TYPE and LOC-HOST-TYPE has tighter checks for types that bark on
unknown location types. When the location is a symbol, we check against all
known atomic locations (cons checks are more lax at the moment).
---
 src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp  |  8 +-
 src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp  |  2 +-
 src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp  | 12 +--
 src/cmp/cmpbackend-cxx/cmppass2-call.lsp |  2 +-
 src/cmp/cmpbackend-cxx/cmppass2-cont.lsp |  4 +-
 src/cmp/cmpbackend-cxx/cmppass2-loc.lsp  |  2 +-
 src/cmp/cmpbackend-cxx/cmppass2-var.lsp  |  4 +-
 src/cmp/cmplocs.lsp                      | 95 ++++++++++++++----------
 src/cmp/cmpprop.lsp                      |  4 +-
 src/cmp/cmptables.lsp                    |  1 +
 10 files changed, 76 insertions(+), 58 deletions(-)

diff --git a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
index 1c0f523de..3526c39b5 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
+++ b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
@@ -95,7 +95,7 @@
         (lisp-type (c1form-primary-type form)))
     (if (var-changed-in-form-list var rest-forms)
         (emit-inlined-temp-var form lisp-type (var-host-type var))
-        (precise-loc-type var lisp-type))))
+        (precise-loc-lisp-type var lisp-type))))
 
 (defun emit-inlined-setq (form rest-forms)
   (let ((var (c1form-arg 0 form))
@@ -105,9 +105,9 @@
       (c2expr* val-form))
     (cond
       ((eq (c1form-name val-form) 'LOCATION)
-       (precise-loc-type (c1form-arg 0 val-form) lisp-type))
+       (precise-loc-lisp-type (c1form-arg 0 val-form) lisp-type))
       ((not (var-changed-in-form-list var rest-forms))
-       (precise-loc-type var lisp-type))
+       (precise-loc-lisp-type var lisp-type))
       (t
        (let ((var-form (make-c1form 'VARIABLE form var nil)))
          (emit-inlined-temp-var var-form lisp-type (var-host-type var)))))))
@@ -134,7 +134,7 @@
   (with-c1form-env (form form)
     (case (c1form-name form)
       (LOCATION
-       (precise-loc-type (c1form-arg 0 form) (c1form-primary-type form)))
+       (precise-loc-lisp-type (c1form-arg 0 form) (c1form-primary-type form)))
       (VARIABLE
        (emit-inlined-variable form forms))
       (SETQ
diff --git a/src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp
index cdbde60e1..d63df6711 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-fun-inl.lsp
+++ b/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 #'loc-type inlined-args))
+  (let* ((arg-types (mapcar #'loc-lisp-type inlined-args))
          (ii (inline-function fname arg-types return-type)))
     (and ii (apply-inline-info ii inlined-args))))
 
diff --git a/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp b/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp
index bd2aa16d1..38bf77d1d 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp
+++ b/src/cmp/cmpbackend-cxx/cmpc-opt-num.lsp
@@ -18,7 +18,7 @@
 ;;; cases the compiler may do whatever it wants (and gcc does!)
 ;;;
 (define-c-inliner shift (return-type argument orig-shift)
-  (let* ((arg-type (loc-type argument))
+  (let* ((arg-type (loc-lisp-type argument))
          (arg-c-type (lisp-type->host-type arg-type))
          (return-c-type (lisp-type->host-type return-type))
          (shift (loc-immediate-value orig-shift)))
@@ -52,8 +52,8 @@
                        r1))))
 
 (defun inline-binop (expected-type arg1 arg2 consing non-consing)
-  (let ((arg1-type (loc-type arg1))
-        (arg2-type (loc-type arg2)))
+  (let ((arg1-type (loc-lisp-type arg1))
+        (arg2-type (loc-lisp-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 (loc-type arg1)))
+  (let ((arg1-type (loc-lisp-type arg1)))
     (if (and (policy-assume-right-type)
              (c-number-type-p expected-type)
              (c-number-type-p arg1-type))
@@ -133,8 +133,8 @@
   (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 (loc-type arg)))
-        (flt-c-type (and float (lisp-type->host-type (loc-type float)))))
+  (let ((arg-c-type (lisp-type->host-type (loc-lisp-type arg)))
+        (flt-c-type (and float (lisp-type->host-type (loc-lisp-type float)))))
     (if (member arg-c-type '(:float :double :long-double))
         (when (or (null float) (eq arg-c-type flt-c-type))
           arg)
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp b/src/cmp/cmpbackend-cxx/cmppass2-call.lsp
index 7cec2aad9..d8fca0361 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-call.lsp
@@ -70,7 +70,7 @@
     (unwind-exit (call-global-loc fname fun
                                   (inline-args args)
                                   (type-and (c1form-primary-type c1form)
-                                            (loc-type *destination*))))))
+                                            (loc-lisp-type *destination*))))))
 
 ;;;
 ;;; c2call-local:
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-cont.lsp b/src/cmp/cmpbackend-cxx/cmppass2-cont.lsp
index 22ad17d0c..f652e7058 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-cont.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-cont.lsp
@@ -31,7 +31,7 @@
             ;; var is referenced from a closure which may escape.
             (let ((env-lvl *env-lvl*))
               (wt-nl "cl_object " *volatile* "env" (incf *env-lvl*) " = env" env-lvl ";")))
-          (bind "ECL_NEW_FRAME_ID(cl_env_copy)" blk-var)
+          (bind 'FRAME++ blk-var)
           (with-unwind-frame (blk-var)
                              (unwind-exit 'VALUEZ)
             (c2expr body))
@@ -77,7 +77,7 @@
             (setf (var-loc tag-loc) (next-lcl))
             (maybe-open-inline-block)
             (wt-nl "cl_object " tag-loc ";"))
-          (bind "ECL_NEW_FRAME_ID(cl_env_copy)" tag-loc)
+          (bind 'FRAME++ tag-loc)
           (with-unwind-frame (tag-loc)
             (progn
               (do-tags (tag body nil)
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
index 3440e75d1..77b3f12c7 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
@@ -221,7 +221,7 @@
                                         ;(print dest-host-type)
                                         ;(print loc)
   (let* ((dest-type (host-type->lisp-type dest-host-type))
-         (loc-type (loc-type loc))
+         (loc-type (loc-lisp-type loc))
          (loc-host-type (loc-host-type loc)))
     (labels ((coercion-error (&optional (write-zero t))
                (cmpwarn "Unable to coerce lisp object from type (~S,~S)~%~
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp
index e74509b8b..13a22f429 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp
@@ -178,11 +178,11 @@
     (close-inline-blocks)))
 
 (defun c2location (c1form loc)
-  (unwind-exit (precise-loc-type loc (c1form-primary-type c1form))))
+  (unwind-exit (precise-loc-lisp-type loc (c1form-primary-type c1form))))
 
 ;;; When LOC is not NIL, then the variable is a constant.
 (defun c2variable (c1form var loc)
-  (unwind-exit (precise-loc-type
+  (unwind-exit (precise-loc-lisp-type
                 (if (and loc (not (numberp (vv-location loc))))
                     loc
                     (or (try-const-c-inliner var) var))
diff --git a/src/cmp/cmplocs.lsp b/src/cmp/cmplocs.lsp
index b1b824f96..29ad64f26 100644
--- a/src/cmp/cmplocs.lsp
+++ b/src/cmp/cmplocs.lsp
@@ -40,6 +40,60 @@
     (setf type (if (eq value *empty-loc*) t (type-of value))))
   (apply #'%make-vv :type type args))
 
+;;; TODO investigate where raw numbers are stemming from and change them to VV
+;;; TODO tighter checks for compound locations (cons)
+;;; TODO baboon on locations that are unknown (for now we signal a warning)
+;;;
+;;; -- jd 2023-12-07
+
+(defun loc-lisp-type (loc)
+  (typecase loc
+    (var    (var-type loc))
+    (vv     (vv-type loc))
+    (number (type-of loc))
+    (atom
+     (case loc
+       (FRAME++ 'FIXNUM)
+       ((TRASH LEAVE VALUE0 VA-ARG VALUEZ CL-VA-ARG) T)
+       (otherwise
+        (cmpwarn "LOC-LISP-TYPE: unknown location ~s." loc)
+        T)))
+    (otherwise
+     (case (first loc)
+       (FFI:C-INLINE (let ((type (first (second loc))))
+                       (cond ((and (consp type) (eq (first type) 'VALUES)) T)
+                             ((lisp-type-p type) type)
+                             (t (host-type->lisp-type type)))))
+       (BIND (var-type (second loc)))
+       (LCL (or (third loc) T))
+       (THE (second loc))
+       (CALL-NORMAL (fourth loc))
+       (otherwise T)))))
+
+(defun loc-host-type (loc)
+  (typecase loc
+    (var    (var-host-type loc))
+    (vv     (vv-host-type loc))
+    (number (lisp-type->host-type (type-of loc)))
+    (atom
+     (case loc
+       (TRASH :void)
+       ((FRAME++ LEAVE VALUE0 VA-ARG VALUEZ CL-VA-ARG) :object)
+       (otherwise
+        (cmpwarn "LOC-LISP-TYPE: unknown location ~s." loc)
+        :object)))
+    (otherwise
+     (case (first loc)
+       (FFI:C-INLINE (let ((type (first (second loc))))
+                       (cond ((and (consp type) (eq (first type) 'VALUES)) :object)
+                             ((lisp-type-p type) (lisp-type->host-type type))
+                             (t type))))
+       (BIND (var-host-type (second loc)))
+       (LCL (lisp-type->host-type (or (third loc) T)))
+       ((JUMP-TRUE JUMP-FALSE) :bool)
+       (THE (loc-host-type (third loc)))
+       (otherwise :object)))))
+
 (defun loc-movable-p (loc)
   (if (atom loc)
       t
@@ -48,43 +102,6 @@
         ((ffi:c-inline) (not (fifth loc))) ; side effects?
         (otherwise t))))
 
-(defun loc-type (loc)
-  (cond ((eq loc NIL) 'NULL)
-        ((var-p loc) (var-type loc))
-        ((vv-p loc) (vv-type loc))
-        ((numberp loc) (lisp-type->host-type (type-of loc)))
-        ((atom loc) 'T)
-        (t
-         (case (first loc)
-           (FFI:C-INLINE (let ((type (first (second loc))))
-                           (cond ((and (consp type) (eq (first type) 'VALUES)) T)
-                                 ((lisp-type-p type) type)
-                                 (t (host-type->lisp-type type)))))
-           (BIND (var-type (second loc)))
-           (LCL (or (third loc) T))
-           (THE (second loc))
-           (CALL-NORMAL (fourth loc))
-           (otherwise T)))))
-
-(defun loc-host-type (loc)
-  (cond ((member loc '(NIL T)) :object)
-        ((var-p loc) (var-host-type loc))
-        ((vv-p loc) (vv-host-type loc))
-        ((numberp loc) (lisp-type->host-type (type-of loc)))
-        ((eq loc 'TRASH) :void)
-        ((atom loc) :object)
-        (t
-         (case (first loc)
-           (FFI:C-INLINE (let ((type (first (second loc))))
-                           (cond ((and (consp type) (eq (first type) 'VALUES)) :object)
-                                 ((lisp-type-p type) (lisp-type->host-type type))
-                                 (t type))))
-           (BIND (var-host-type (second loc)))
-           (LCL (lisp-type->host-type (or (third loc) T)))
-           ((JUMP-TRUE JUMP-FALSE) :bool)
-           (THE (loc-host-type (third loc)))
-           (otherwise :object)))))
-
 (defun loc-with-side-effects-p (loc &aux name)
   (when (atom loc)
     (return-from loc-with-side-effects-p
@@ -137,8 +154,8 @@
 ;;;     VA-ARG
 ;;;     CL-VA-ARG
 
-(defun precise-loc-type (loc new-type)
-  (if (subtypep (loc-type loc) new-type)
+(defun precise-loc-lisp-type (loc new-type)
+  (if (subtypep (loc-lisp-type loc) new-type)
       loc
       `(the ,new-type ,loc)))
 
diff --git a/src/cmp/cmpprop.lsp b/src/cmp/cmpprop.lsp
index cf74a5a1c..b042eb091 100644
--- a/src/cmp/cmpprop.lsp
+++ b/src/cmp/cmpprop.lsp
@@ -53,8 +53,8 @@
 
 (defun p1var (form var loc)
   ;; Use the type of C1FORM because it might have been coerced by a THE form.
-  (let* ((loc-type (if loc (vv-type loc) t))
-         (var-type (var-type var))
+  (let* ((loc-type (if loc (loc-lisp-type loc) t))
+         (var-type (loc-lisp-type var))
          (type (type-and (type-and loc-type var-type)
                          (c1form-primary-type form))))
     (prop-message "~&;;; Querying variable ~A gives ~A" (var-name var) type)
diff --git a/src/cmp/cmptables.lsp b/src/cmp/cmptables.lsp
index c53dd7288..e0c7d7b65 100644
--- a/src/cmp/cmptables.lsp
+++ b/src/cmp/cmptables.lsp
@@ -179,6 +179,7 @@
 
     (ffi-data-ref . wt-ffi-data-ref)
 
+    (frame++ . "ECL_NEW_FRAME_ID(cl_env_copy)")
     (leave . "value0")
     (va-arg . "va_arg(args,cl_object)")
     (cl-va-arg . "ecl_va_arg(args)")

From 2690dde0d3d90138d6b23832bee08672ea182034 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Fri, 8 Dec 2023 20:43:29 +0100
Subject: [PATCH 11/15] cmp: inl: tighter type bounds for inlined arguments

Also improve PRECISE-LOC-LISP-TYPE to AND both types instead of picking the "new
type".
---
 src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp | 22 +++++++++-------------
 src/cmp/cmplocs.lsp                     |  7 ++++---
 2 files changed, 13 insertions(+), 16 deletions(-)

diff --git a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
index 3526c39b5..a4749e868 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
+++ b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
@@ -132,19 +132,15 @@
 
 (defun emit-inline-form (form forms)
   (with-c1form-env (form form)
-    (case (c1form-name form)
-      (LOCATION
-       (precise-loc-lisp-type (c1form-arg 0 form) (c1form-primary-type form)))
-      (VARIABLE
-       (emit-inlined-variable form forms))
-      (SETQ
-       (emit-inlined-setq form forms))
-      (PROGN
-       (emit-inlined-progn form forms))
-      (VALUES
-       (emit-inlined-values form forms))
-      (t
-       (emit-inlined-temp-var form (c1form-primary-type form) :object)))))
+    (precise-loc-lisp-type
+     (case (c1form-name form)
+       (LOCATION (c1form-arg 0 form) )
+       (VARIABLE (emit-inlined-variable form forms))
+       (SETQ     (emit-inlined-setq form forms))
+       (PROGN    (emit-inlined-progn form forms))
+       (VALUES   (emit-inlined-values form forms))
+       (t        (emit-inlined-temp-var form t :object)))
+     (c1form-primary-type form))))
 
 ;;;
 ;;; inline-args:
diff --git a/src/cmp/cmplocs.lsp b/src/cmp/cmplocs.lsp
index 29ad64f26..8bba6ceff 100644
--- a/src/cmp/cmplocs.lsp
+++ b/src/cmp/cmplocs.lsp
@@ -155,9 +155,10 @@
 ;;;     CL-VA-ARG
 
 (defun precise-loc-lisp-type (loc new-type)
-  (if (subtypep (loc-lisp-type loc) new-type)
-      loc
-      `(the ,new-type ,loc)))
+  (let ((loc-type (loc-lisp-type loc)))
+    (if (subtypep loc-type new-type)
+        loc
+        `(the ,(type-and loc-type new-type) ,loc))))
 
 (defun loc-in-c1form-movable-p (loc)
   "A location that is in a C1FORM and can be moved"

From c69963f47c1db1c9012b5b340898c64380562032 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Mon, 11 Dec 2023 10:46:33 +0100
Subject: [PATCH 12/15] cmp: add a function coerce-loc and don't call directly
 wt-coerce-loc

This allows to inline coerce-loc inside a wt statement:

    (wt "value0=" (coerce-loc loc :object) ";")
---
 src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp  | 38 +++++++++++-------------
 src/cmp/cmpbackend-cxx/cmppass2-data.lsp |  4 +--
 src/cmp/cmpbackend-cxx/cmppass2-exit.lsp |  6 ++--
 src/cmp/cmpbackend-cxx/cmppass2-loc.lsp  | 15 +++++-----
 src/cmp/cmpbackend-cxx/cmppass2-var.lsp  | 34 +++++++--------------
 5 files changed, 38 insertions(+), 59 deletions(-)

diff --git a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
index a4749e868..b1895808f 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
+++ b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
@@ -23,12 +23,13 @@
   (loop for i of-type fixnum from 0 below *inline-blocks*
         do (wt-nl-close-brace)))
 
+(defun coerce-loc (host-type location)
+  (if (eq (loc-host-type location) host-type)
+      location
+      `(COERCE-LOC ,host-type ,location)))
+
 (defun coerce-args (inlined-args)
-  (mapcar (lambda (loc)
-            (if (eq (loc-host-type loc) :object)
-                loc
-                `(COERCE-LOC :object ,LOC)))
-          inlined-args))
+  (mapcar (lambda (loc) (coerce-loc :object loc)) inlined-args))
 
 (defun coerce-locs (inlined-args types args-to-be-saved)
   ;; INLINED-ARGS is a list of INLINED-ARG produced by the argument inliner.
@@ -45,26 +46,21 @@
   ;;
   (loop with block-opened = nil
         for loc in inlined-args
-        for arg-host-type = (loc-host-type loc)
         for type in types
         for i from 0
         for host-type = (lisp-type->host-type type)
         collect
-        (cond ((and (member i args-to-be-saved :test #'eql)
-                    (not (loc-movable-p loc)))
-               (let ((lcl (make-lcl-var :host-type host-type)))
-                 (wt-nl)
-                 (unless block-opened
-                   (setf block-opened t)
-                   (open-inline-block))
-                 (wt (host-type->c-name host-type) " " lcl "= ")
-                 (wt-coerce-loc host-type loc)
-                 (wt ";")
-                 lcl))
-              ((equal host-type arg-host-type)
-               loc)
-              (t
-               `(COERCE-LOC ,host-type ,loc)))))
+        (if (and (member i args-to-be-saved :test #'eql)
+                 (not (loc-movable-p loc)))
+            (let ((lcl (make-lcl-var :host-type host-type)))
+              (wt-nl)
+              (unless block-opened
+                (setf block-opened t)
+                (open-inline-block))
+              (wt (host-type->c-name host-type) " " lcl "= "
+                  (coerce-loc host-type loc) ";")
+              lcl)
+            (coerce-loc host-type loc))))
 
 ;;; We could use VV to represent inlined args, but the most specific for our
 ;;; purposes is the location (THE LISP-TYPE LOCATION) which is created when
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-data.lsp b/src/cmp/cmpbackend-cxx/cmppass2-data.lsp
index 137fe5f13..df5ce4385 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-data.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-data.lsp
@@ -409,9 +409,7 @@
         (wt-vv-index index (vv-permanent-p vv-loc)))))
 
 (defun set-vv-index (loc index permanent-p)
-  (wt-nl) (wt-vv-index index permanent-p) (wt "= ")
-  (wt-coerce-loc :object loc)
-  (wt ";"))
+  (wt-nl) (wt-vv-index index permanent-p) (wt "=" (coerce-loc :object loc) ";"))
 
 (defun set-vv (loc vv-loc)
   (setf (vv-used-p vv-loc) t)
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-exit.lsp b/src/cmp/cmpbackend-cxx/cmppass2-exit.lsp
index 21300b52e..03397108c 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-exit.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-exit.lsp
@@ -214,16 +214,16 @@
        (case (loc-host-type loc)
          (:bool     (wt-nl "if (" loc ") "))
          (:object   (wt-nl "if (" loc "!=ECL_NIL) "))
-         (otherwise (wt-nl "if ((") (wt-coerce-loc :object loc) (wt ")!=ECL_NIL) ")))))
+         (otherwise (wt-nl "if ((" (coerce-loc :object loc) ")!=ECL_NIL) ")))))
     (:jump-f
      (destructuring-bind (loc) args
        (case (loc-host-type loc)
          (:bool     (wt-nl "if (!(" loc "))"))
          (:object   (wt-nl "if (Null(" loc "))"))
-         (otherwise (wt-nl "if (Null(") (wt-coerce-loc :object loc) (wt "))")))))
+         (otherwise (wt-nl "if (Null(" (coerce-loc :object loc) "))")))))
     (:jump-eq
      (destructuring-bind (x y) args
-       (wt-nl "if (" `(coerce-loc :object ,x) "==" `(coerce-loc :object ,y) ") "))))
+       (wt-nl "if (" (coerce-loc :object x) "==" (coerce-loc :object y) ") "))))
   (wt-open-brace)
   (multiple-value-bind (frs-bind bds-lcl bds-bind stack-frame ihs-p)
       (compute-unwind (label-denv exit) from)
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
index 77b3f12c7..0bc0e510c 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
@@ -402,9 +402,8 @@
            (apply fd loc (rest destination))
            (progn
              (wt-nl)
-             (wt-loc destination) (wt " = ")
-             (wt-coerce-loc (loc-host-type destination) loc)
-             (wt ";"))))))
+             (wt-loc destination)
+             (wt " = " (coerce-loc (loc-host-type destination) loc) ";"))))))
 
 (defun set-the-loc (loc type orig-loc)
   (declare (ignore type))
@@ -413,22 +412,22 @@
 (defun set-valuez-loc (loc)
   (cond ((eq loc 'VALUEZ))
         ((uses-values loc)
-         (wt-nl "cl_env_copy->values[0] = ") (wt-coerce-loc :object loc) (wt ";"))
+         (wt-nl "cl_env_copy->values[0] = " (coerce-loc :object loc) ";"))
         (t
-         (wt-nl "cl_env_copy->values[0] = ") (wt-coerce-loc :object loc) (wt ";")
+         (wt-nl "cl_env_copy->values[0] = " (coerce-loc :object loc) ";")
          (wt-nl "cl_env_copy->nvalues = 1;"))))
 
 (defun set-value0-loc (loc)
-  (wt-nl "value0 = ") (wt-coerce-loc :object loc) (wt ";"))
+  (wt-nl "value0 = " (coerce-loc :object loc) ";"))
 
 (defun set-leave-loc (loc)
   (cond ((or (eq loc 'VALUEZ) (uses-values loc))
-         (wt-nl "value0 = ") (wt-coerce-loc :object loc) (wt ";"))
+         (wt-nl "value0 = " (coerce-loc :object loc) ";"))
         ((eq loc 'VALUE0)
          (wt-nl "cl_env_copy->nvalues = 1;"))
         ((eq loc 'LEAVE))
         (t
-         (wt-nl "value0 = ") (wt-coerce-loc :object loc) (wt ";")
+         (wt-nl "value0 = " (coerce-loc :object loc) ";")
          (wt-nl "cl_env_copy->nvalues = 1;"))))
 
 (defun set-trash-loc (loc &rest args)
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp
index 13a22f429..b27d9b359 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp
@@ -248,9 +248,8 @@
          (setq var-loc (next-env))
          (setf (var-loc var) var-loc))
        (when (zerop var-loc) (wt-nl "env" *env-lvl* " = ECL_NIL;"))
-       (wt-nl "CLV" var-loc " = env" *env-lvl* " = CONS(")
-       (wt-coerce-loc :object loc)
-       (wt ",env" *env-lvl* ");")
+       (wt-nl "CLV" var-loc " = env" *env-lvl*
+              " = CONS(" (coerce-loc :object loc) ",env" *env-lvl* ");")
        (wt-comment (var-name var))))
     (LEXICAL
      (let ((var-loc (var-loc var)))
@@ -258,9 +257,7 @@
          ;; first binding: assign location
          (setq var-loc (next-lex))
          (setf (var-loc var) var-loc))
-       (wt-nl) (wt-lex var-loc) (wt " = ")
-       (wt-coerce-loc :object loc)
-       (wt ";"))
+       (wt-nl) (wt-lex var-loc) (wt " = " (coerce-loc :object loc) ";"))
      (wt-comment (var-name var)))
     ((SPECIAL GLOBAL)
      (bds-bind loc var))
@@ -269,9 +266,7 @@
             ;; already has location (e.g. optional in lambda list)
             ;; check they are not the same
             (unless (equal (var-loc var) loc)
-              (wt-nl var " = ")
-              (wt-coerce-loc (var-host-type var) loc)
-              (wt ";")))
+              (wt-nl var " = " (coerce-loc (var-host-type var) loc) ";")))
            ((and (consp loc) (eql (car loc) 'LCL))
             ;; set location for lambda list requireds
             (setf (var-loc var) loc))
@@ -303,9 +298,8 @@
               (eq (var-name loc) (var-name var)))
          (wt-nl "ecl_bds_push(cl_env_copy," (var-loc var) ");"))
         (t
-         (wt-nl "ecl_bds_bind(cl_env_copy," (var-loc var) ",")
-         (wt-coerce-loc :object loc)
-         (wt ");")))
+         (wt-nl "ecl_bds_bind(cl_env_copy," (var-loc var) ","
+                (coerce-loc :object loc) ");")))
   (push 'BDS-BIND *unwind-exit*)
   (wt-comment (var-name var)))
 
@@ -398,24 +392,16 @@
             :format-arguments (list var)))
   (case (var-kind var)
     (CLOSURE
-     (wt-nl)(wt-env var-loc)(wt " = ")
-     (wt-coerce-loc (var-host-type var) loc)
-     (wt #\;))
+     (wt-nl)(wt-env var-loc)(wt " = " (coerce-loc (var-host-type var) loc) ";"))
     (LEXICAL
-     (wt-nl)(wt-lex var-loc)(wt " = ")
-     (wt-coerce-loc (var-host-type var) loc)
-     (wt #\;))
+     (wt-nl)(wt-lex var-loc)(wt " = " (coerce-loc (var-host-type var) loc) ";"))
     ((SPECIAL GLOBAL)
      (if (safe-compile)
          (wt-nl "ecl_cmp_setq(cl_env_copy," var-loc ",")
          (wt-nl "ECL_SETQ(cl_env_copy," var-loc ","))
-     (wt-coerce-loc (var-host-type var) loc)
-     (wt ");"))
+     (wt (coerce-loc (var-host-type var) loc) ");"))
     (t
-     (wt-nl var-loc " = ")
-     (wt-coerce-loc (var-host-type var) loc)
-     (wt #\;))
-    ))
+     (wt-nl var-loc " = " (coerce-loc (var-host-type var) loc) ";"))))
 
 (defun wt-lcl (lcl)
   (unless (numberp lcl)

From 63ca129a79ec77c729e1fa53b3c63018f7f7bdc2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Mon, 11 Dec 2023 18:39:44 +0100
Subject: [PATCH 13/15] cmp: cleanup: use with-c1form-env in applicable places

c2expr, t2expr, t3function all uses the macro now. That yields gives better
introspection environment and more regular handling.

Additionally bind a new variable *CURRENT-C1FORM*.
---
 src/cmp/cmpbackend-cxx/cmppass2-eval.lsp |  4 +-
 src/cmp/cmpbackend-cxx/cmppass2-top.lsp  | 56 ++++++++++++------------
 src/cmp/cmpform.lsp                      |  1 +
 src/cmp/cmpglobals.lsp                   |  1 +
 4 files changed, 32 insertions(+), 30 deletions(-)

diff --git a/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp b/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp
index b1f7d0181..391a73310 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp
@@ -14,7 +14,9 @@
     (let* ((name (c1form-name form))
            (args (c1form-args form))
            (dispatch (gethash name *c2-dispatch-table*)))
-      (apply dispatch form args))))
+      (if dispatch
+          (apply dispatch form args)
+          (cmperr "Unhandled C2FORM found at the:~%~4I~A" form)))))
 
 (defun c2expr* (form)
   ;; C2EXPR* compiles the giving expression in a context in which
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-top.lsp b/src/cmp/cmpbackend-cxx/cmppass2-top.lsp
index 959c997d5..f61666228 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-top.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-top.lsp
@@ -35,14 +35,13 @@
 
 (defun t2expr (form)
   (check-type form c1form)
-  (ext:if-let ((def (gethash (c1form-name form) *t2-dispatch-table*)))
-    (let ((*compile-file-truename* (c1form-file form))
-          (*compile-file-position* (c1form-file-position form))
-          (*current-toplevel-form* (c1form-form form))
-          (*current-form* (c1form-form form))
-          (*cmp-env* (c1form-env form)))
-      (apply def form (c1form-args form)))
-    (cmperr "Unhandled T2FORM found at the toplevel:~%~4I~A" form)))
+  (with-c1form-env (form form)
+    (let* ((name (c1form-name form))
+           (args (c1form-args form))
+           (dispatch (gethash name *t2-dispatch-table*)))
+      (if dispatch
+          (apply dispatch form args)
+          (cmperr "Unhandled T2FORM found at the toplevel:~%~4I~A" form)))))
 
 (defun t2compiler-let (c1form symbols values body)
   (declare (ignore c1form))
@@ -314,27 +313,26 @@
   (when *compile-print*
     (ext:when-let ((name (or (fun-name fun) (fun-description fun))))
       (format t "~&;;; Emitting code for ~s.~%" name)))
-  (let* ((lambda-expr (fun-lambda fun))
-         (*cmp-env* (c1form-env lambda-expr))
-         (*tail-recursion-info* fun)
-         (*tail-recursion-mark* nil))
-    (with-bir-env (:env (fun-env fun)
-                   :level (fun-lexical-levels fun)
-                   :volatile (c1form-volatile* lambda-expr))
-      (t3function-declaration fun)
-      (wt-nl-open-brace)
-      (let ((body (t3function-body fun)))
-        (wt-function-locals (fun-closure fun))
-        (wt-nl "const cl_env_ptr cl_env_copy = ecl_process_env();")
-        (when (eq (fun-closure fun) 'CLOSURE)
-          (wt-nl "cl_object " *volatile* "env0 = cl_env_copy->function->cclosure.env;"))
-        (wt-nl "cl_object " *volatile* "value0;")
-        (when (policy-check-stack-overflow)
-          (wt-nl "ecl_cs_check(cl_env_copy,value0);"))
-        (when (eq (fun-closure fun) 'CLOSURE)
-          (t3function-closure-scan fun))
-        (write-sequence body *compiler-output1*)
-        (wt-nl-close-many-braces 0)))))
+  (with-c1form-env (lambda-expr (fun-lambda fun))
+    (let ((*tail-recursion-info* fun)
+          (*tail-recursion-mark* nil))
+      (with-bir-env (:env (fun-env fun)
+                     :level (fun-lexical-levels fun)
+                     :volatile (c1form-volatile* lambda-expr))
+        (t3function-declaration fun)
+        (wt-nl-open-brace)
+        (let ((body (t3function-body fun)))
+          (wt-function-locals (fun-closure fun))
+          (wt-nl "const cl_env_ptr cl_env_copy = ecl_process_env();")
+          (when (eq (fun-closure fun) 'CLOSURE)
+            (wt-nl "cl_object " *volatile* "env0 = cl_env_copy->function->cclosure.env;"))
+          (wt-nl "cl_object " *volatile* "value0;")
+          (when (policy-check-stack-overflow)
+            (wt-nl "ecl_cs_check(cl_env_copy,value0);"))
+          (when (eq (fun-closure fun) 'CLOSURE)
+            (t3function-closure-scan fun))
+          (write-sequence body *compiler-output1*)
+          (wt-nl-close-many-braces 0))))))
 
 (defun t3function-body (fun)
   (let ((string (make-array 2048 :element-type 'character
diff --git a/src/cmp/cmpform.lsp b/src/cmp/cmpform.lsp
index 613215e17..be945fc27 100644
--- a/src/cmp/cmpform.lsp
+++ b/src/cmp/cmpform.lsp
@@ -178,6 +178,7 @@
 
 (defmacro with-c1form-env ((form value) &rest body)
   `(let* ((,form ,value)
+          (*current-c1form* ,form)
           (*compile-file-truename* (c1form-file ,form))
           (*compile-file-position* (c1form-file-position ,form))
           (*current-toplevel-form* (c1form-toplevel-form ,form))
diff --git a/src/cmp/cmpglobals.lsp b/src/cmp/cmpglobals.lsp
index a00c76467..de1a0f49b 100644
--- a/src/cmp/cmpglobals.lsp
+++ b/src/cmp/cmpglobals.lsp
@@ -24,6 +24,7 @@
 ;;; Variables and constants for error handling
 ;;;
 (defvar *current-form* '|compiler preprocess|)
+(defvar *current-c1form*)
 (defvar *current-toplevel-form* '|compiler preprocess|)
 (defvar *compile-file-position* -1)
 (defvar *active-protection* nil)

From 3ae6fadac723bcb792ca0d097d332f8a3aced4a9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Thu, 14 Dec 2023 11:00:20 +0100
Subject: [PATCH 14/15] cmp: small changes to c1form-*-p

c1form-movable-p uses c1form-pure-p

  The predicate opencoded the exact body of the latter.

c1form-unmodified-p does not explicitly check for global-var-p

  The function VAR-CHANGED-IN-FORM-LIST takes care of special and global
  variables, so there is no need for an explicit check. When the variable is
  global and no form has sp-change, then it is still unmodified.
---
 src/cmp/cmpform.lsp | 43 +++++++++++++++++++++----------------------
 1 file changed, 21 insertions(+), 22 deletions(-)

diff --git a/src/cmp/cmpform.lsp b/src/cmp/cmpform.lsp
index be945fc27..49281d071 100644
--- a/src/cmp/cmpform.lsp
+++ b/src/cmp/cmpform.lsp
@@ -60,22 +60,22 @@
 
 (defun c1form-add-info-loop (form dependents)
   (loop with subform
-     while (consp dependents)
-     when (c1form-p (setf subform (pop dependents)))
-     do (progn
-          (when (c1form-sp-change subform)
-            (setf (c1form-sp-change form) t
-                  (c1form-side-effects form) t))
-          (when (c1form-side-effects subform)
-            (setf (c1form-side-effects form) t))
-          (unless (eq (c1form-name subform) 'LOCATION)
-            (when (rest (c1form-parents subform))
-              (error "Running twice through same form"))
-            (setf (c1form-parents subform)
-                  (nconc (c1form-parents subform)
-                         (c1form-parents form)))))
-     when (consp subform)
-     do (c1form-add-info-loop form subform)))
+        while (consp dependents)
+        when (c1form-p (setf subform (pop dependents)))
+          do (progn
+               (when (c1form-sp-change subform)
+                 (setf (c1form-sp-change form) t
+                       (c1form-side-effects form) t))
+               (when (c1form-side-effects subform)
+                 (setf (c1form-side-effects form) t))
+               (unless (eq (c1form-name subform) 'LOCATION)
+                 (when (rest (c1form-parents subform))
+                   (error "Running twice through same form"))
+                 (setf (c1form-parents subform)
+                       (nconc (c1form-parents subform)
+                              (c1form-parents form)))))
+        when (consp subform)
+          do (c1form-add-info-loop form subform)))
 
 (defun c1form-add-info (form dependents)
   (let ((record (gethash (c1form-name form) +c1-form-hash+)))
@@ -137,6 +137,9 @@
             do (traverse-c1form-tree f function))
          (funcall function tree))))
 
+(defun c1form-pure-p (form)
+  (third (gethash (c1form-name form) +c1-form-hash+)))
+
 (defun c1form-movable-p (form)
   (flet ((abort-on-not-pure (form)
            (let ((name (c1form-name form)))
@@ -146,20 +149,16 @@
                                 (var-set-nodes var))
                         (return-from c1form-movable-p nil))))
                    ((or (c1form-side-effects form)
-                        (not (third (gethash name +c1-form-hash+))))
+                        (not (c1form-pure-p form)))
                     (return-from c1form-movable-p nil))))))
     (abort-on-not-pure form)))
 
-(defun c1form-pure-p (form)
-  (third (gethash (c1form-name form) +c1-form-hash+)))
-
 (defun c1form-unmodified-p (form rest-form)
   (flet ((abort-on-not-pure (form)
            (let ((name (c1form-name form)))
              (cond ((eq name 'VARIABLE)
                     (let ((var (c1form-arg 0 form)))
-                      (when (or (global-var-p var)
-                                (var-changed-in-form-list var rest-form))
+                      (when (var-changed-in-form-list var rest-form)
                         (return-from c1form-unmodified-p nil))))
                    ((or (c1form-side-effects form)
                         (not (c1form-pure-p form)))

From 076d0d07ae2abc4089fd13f480d07e48887fc7da Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Fri, 26 Jan 2024 13:20:14 +0100
Subject: [PATCH 15/15] cmp: set-loc: explain how values are handled and remove
 INLINE-ARG0

---
 src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp  | 17 +++-----
 src/cmp/cmpbackend-cxx/cmppass2-call.lsp |  4 +-
 src/cmp/cmpbackend-cxx/cmppass2-loc.lsp  | 55 +++++++++++++++++-------
 3 files changed, 48 insertions(+), 28 deletions(-)

diff --git a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
index b1895808f..1354e3884 100644
--- a/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
+++ b/src/cmp/cmpbackend-cxx/cmpc-arg-inl.lsp
@@ -126,6 +126,13 @@
             for form in args
             do (c2expr* form)))))
 
+;;;
+;;; emit-inline-form:
+;;;   returns a location that contains a moveable argument
+;;;   side effects: emits code for a temporary variable
+;;;
+;;; Whoever calls this function must wrap the body in WITH-INLINE-BLOCKS.
+;;;
 (defun emit-inline-form (form forms)
   (with-c1form-env (form form)
     (precise-loc-lisp-type
@@ -149,13 +156,3 @@
   (loop for form-list on forms
         for form = (first form-list)
         collect (emit-inline-form form (rest form-list))))
-
-;;;
-;;; inline-arg0:
-;;;   returns a location that contains the function
-;;;   side effects: emits code for a temporary variable
-;;;
-;;; Whoever calls this function must wrap the body in WITH-INLINE-BLOCKS.
-;;;
-(defun inline-arg0 (value-form other-forms)
-  (emit-inline-form value-form other-forms))
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp b/src/cmp/cmpbackend-cxx/cmppass2-call.lsp
index d8fca0361..3e0e2674c 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp
+++ b/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 (inline-arg0 form args)))
+    (let ((loc (emit-inline-form 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 (inline-arg0 form args))
+         (loc (emit-inline-form form args))
          (args (inline-args args)))
     (unwind-exit (call-unknown-global-loc loc args function-p))))
 
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
index 0bc0e510c..64846c8aa 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
@@ -383,6 +383,29 @@
 ;;; SET-LOC
 ;;;
 
+;;; Setting the location requires some cooperation between the code that returns
+;;; the location and the code that assigns it. By default we treat all RVALs as
+;;; having a single value (that's how wt-loc dispatches all known locations).
+;;;
+;;; This "default" changes when the LVAL expects multiple values. In that case
+;;; the SET-LOC method checks whether the RVAL may return multiple values:
+;;;
+;;; - when it does, then we use these values and do nothing
+;;; - when unknown, then we update values[0] and leave nvalues as is
+;;; - otherwise we update values[0] and reset nvalues = 1
+;;;
+;;; The "unknown" requires some explanation. The predicate (USES-VALUES loc)
+;;; returns true for locations that possibly can return multiple values. The
+;;; most representative example are function calls - the number of returned
+;;; values may even change at runtime, because the function may be recompiled.
+;;;
+;;; The contract between the caller and the callee is that the callee will
+;;; ensure upon exit, that nvalues contains the correct value, and that the
+;;; returned value is the primary value. When the callee returns only a single
+;;; value then it does not update VALUES vector to avoid global memory writes.
+;;; This is why LVALs that accept multiple values must assign VALUES[0] when the
+;;; (USES-VALUES RVAL) returns T. -- jd 2023-12-14
+
 (defun set-unknown-loc (destination loc)
   (unknown-location 'set-loc destination))
 
@@ -405,21 +428,19 @@
              (wt-loc destination)
              (wt " = " (coerce-loc (loc-host-type destination) loc) ";"))))))
 
-(defun set-the-loc (loc type orig-loc)
-  (declare (ignore type))
-  (set-loc orig-loc loc))
-                 
-(defun set-valuez-loc (loc)
-  (cond ((eq loc 'VALUEZ))
-        ((uses-values loc)
-         (wt-nl "cl_env_copy->values[0] = " (coerce-loc :object loc) ";"))
-        (t
-         (wt-nl "cl_env_copy->values[0] = " (coerce-loc :object loc) ";")
-         (wt-nl "cl_env_copy->nvalues = 1;"))))
+(defun set-trash-loc (loc &rest args)
+  (declare (ignore args))
+  (when (loc-with-side-effects-p loc)
+    (wt-nl loc ";")
+    t))
 
 (defun set-value0-loc (loc)
   (wt-nl "value0 = " (coerce-loc :object loc) ";"))
 
+(defun set-the-loc (loc type orig-loc)
+  (declare (ignore type))
+  (set-loc orig-loc loc))
+
 (defun set-leave-loc (loc)
   (cond ((or (eq loc 'VALUEZ) (uses-values loc))
          (wt-nl "value0 = " (coerce-loc :object loc) ";"))
@@ -430,11 +451,13 @@
          (wt-nl "value0 = " (coerce-loc :object loc) ";")
          (wt-nl "cl_env_copy->nvalues = 1;"))))
 
-(defun set-trash-loc (loc &rest args)
-  (declare (ignore args))
-  (when (loc-with-side-effects-p loc)
-    (wt-nl loc ";")
-    t))
+(defun set-valuez-loc (loc)
+  (cond ((eq loc 'VALUEZ))
+        ((uses-values loc)
+         (wt-nl "cl_env_copy->values[0] = " (coerce-loc :object loc) ";"))
+        (t
+         (wt-nl "cl_env_copy->values[0] = " (coerce-loc :object loc) ";")
+         (wt-nl "cl_env_copy->nvalues = 1;"))))
 
 ;;;
 ;;; Foreign data