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.
This commit is contained in:
Daniel Kochmański 2023-06-26 18:00:57 +02:00
parent 3282f17b11
commit d2cda52d26
5 changed files with 7 additions and 11 deletions

View file

@ -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)

View file

@ -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 "]"))

View file

@ -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))))

View file

@ -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))))

View file

@ -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)