mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-18 23:32:17 -08:00
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:
parent
3282f17b11
commit
d2cda52d26
5 changed files with 7 additions and 11 deletions
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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 "]"))
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue