From d2cda52d26fb9a0ee0d2036df05e05d14822ef55 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Mon, 26 Jun 2023 18:00:57 +0200
Subject: [PATCH] cmp: don't resolve characters in the first pass

We remove CHARACTER-VALUE location in favor of VV instances that does not have a
location.
---
 src/cmp/cmpbackend-cxx/cmppass2-data.lsp | 3 ++-
 src/cmp/cmpbackend-cxx/cmppass2-loc.lsp  | 2 +-
 src/cmp/cmplocs.lsp                      | 7 +------
 src/cmp/cmppass1-eval.lsp                | 5 +++--
 src/cmp/cmptables.lsp                    | 1 -
 5 files changed, 7 insertions(+), 11 deletions(-)

diff --git a/src/cmp/cmpbackend-cxx/cmppass2-data.lsp b/src/cmp/cmpbackend-cxx/cmppass2-data.lsp
index ffdce94ee..c1e3e6491 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-data.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-data.lsp
@@ -241,7 +241,8 @@
 
 (defun wt-vv-value (vv value)
   (etypecase value
-    (fixnum (wt-fixnum value vv))))
+    (fixnum (wt-fixnum value vv))
+    (character (wt-character value vv))))
 
 (defun wt-vv (vv-loc)
   (setf (vv-used-p vv-loc) t)
diff --git a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
index d2fb35b35..ac927a5cf 100644
--- a/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
+++ b/src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
@@ -79,7 +79,7 @@
   (declare (ignore vv))
   ;; We do not use the '...' format because this creates objects of type
   ;; 'char' which have sign problems
-  (wt value))
+  (wt (char-code value)))
 
 (defun wt-value (i)
   (wt "cl_env_copy->values[" i "]"))
diff --git a/src/cmp/cmplocs.lsp b/src/cmp/cmplocs.lsp
index a73715827..e4376edba 100644
--- a/src/cmp/cmplocs.lsp
+++ b/src/cmp/cmplocs.lsp
@@ -49,7 +49,6 @@
         ((atom loc) 'T)
         (t
          (case (first loc)
-           (CHARACTER-VALUE (type-of (code-char (second loc))))
            (DOUBLE-FLOAT-VALUE 'DOUBLE-FLOAT)
            (SINGLE-FLOAT-VALUE 'SINGLE-FLOAT)
            (LONG-FLOAT-VALUE 'LONG-FLOAT)
@@ -75,7 +74,6 @@
         ((atom loc) :object)
         (t
          (case (first loc)
-           (CHARACTER-VALUE (if (<= (second loc) 255) :unsigned-char :wchar))
            (DOUBLE-FLOAT-VALUE :double)
            (SINGLE-FLOAT-VALUE :float)
            (LONG-FLOAT-VALUE :long-double)
@@ -143,7 +141,6 @@
 ;;;     ( COERCE-LOC representation-type location)
 ;;;     ( FDEFINITION vv-index )
 ;;;     ( MAKE-CCLOSURE cfun )
-;;;     ( CHARACTER-VALUE character-code )
 ;;;     ( LONG-FLOAT-VALUE long-float-value vv )
 ;;;     ( DOUBLE-FLOAT-VALUE double-float-value vv )
 ;;;     ( SINGLE-FLOAT-VALUE single-float-value vv )
@@ -199,7 +196,7 @@
         ((eq (first loc) 'THE)
          (loc-in-c1form-movable-p (third loc)))
         ((member (setf loc (car loc))
-                 '(VV VV-TEMP CHARACTER-VALUE
+                 '(VV VV-TEMP
                    DOUBLE-FLOAT-VALUE SINGLE-FLOAT-VALUE LONG-FLOAT-VALUE
                    #+complex-float CSFLOAT-VALUE
                    #+complex-float CDFLOAT-VALUE
@@ -236,8 +233,6 @@
                  '(long-float-value double-float-value single-float-value
                    csfloat-value cdfloat-value clfloat-value))
          (values t (second loc)))
-        ((eq (first loc) 'character-value)
-         (values t (code-char (second loc))))
         (t
          (values nil nil))))
 
diff --git a/src/cmp/cmppass1-eval.lsp b/src/cmp/cmppass1-eval.lsp
index 36d204faf..0690d40c8 100644
--- a/src/cmp/cmppass1-eval.lsp
+++ b/src/cmp/cmppass1-eval.lsp
@@ -136,9 +136,10 @@
     ((eq val t) (c1t))
     ((ext:fixnump val)
      (make-c1form* 'LOCATION :type 'FIXNUM :args (make-vv :rep-type :fixnum :value val)))
+    ((si:base-char-p val)
+     (make-c1form* 'LOCATION :type 'BASE-CHAR :args (make-vv :rep-type :unsigned-char :value val)))
     ((characterp val)
-     (make-c1form* 'LOCATION :type 'CHARACTER
-                             :args (list 'CHARACTER-VALUE (char-code val))))
+     (make-c1form* 'LOCATION :type 'CHARACTER :args (make-vv :rep-type :wchar :value val)))
     ((typep val 'DOUBLE-FLOAT)
      (make-c1form* 'LOCATION :type 'DOUBLE-FLOAT
                              :args (list 'DOUBLE-FLOAT-VALUE val (add-object val))))
diff --git a/src/cmp/cmptables.lsp b/src/cmp/cmptables.lsp
index ba72444e2..a77b027e2 100644
--- a/src/cmp/cmptables.lsp
+++ b/src/cmp/cmptables.lsp
@@ -187,7 +187,6 @@
     (csfloat-value . wt-number)
     (cdfloat-value . wt-number)
     (clfloat-value . wt-number)
-    (character-value . wt-character)
     (value . wt-value)
     (keyvars . wt-keyvars)
     (cl:the . wt-the)