mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-04-25 02:50:24 -07:00
Code Issues Projects Releases Packages Wiki Activity

cmp: don't resolve floats and complex floats in the first pass

Browse source 
We remove *-VALUE location in favor of VV instances.
This commit is contained in:
Daniel Kochmański 2023-06-26 18:18:10 +02:00
parent d2cda52d26
commit 5427ba657b
6 changed files with 21 additions and 64 deletions
Download patch file Download diff file Expand all files Collapse all files

21
src/cmp/cmpbackend-cxx/cmpc-opt-ct.lsp
View file

@ -25,20 +25,19 @@
((floatp name)
(let* ((value name)
(type (type-of value))
#+ (or) ;; FIXME see WT-TO-OBJECT-CONVERSION
(loc-type (case type
(cl:single-float 'single-float-value)
(cl:double-float 'double-float-value)
(cl:long-float 'long-float-value)
(si:complex-single-float 'csfloat-value)
(si:complex-double-float 'cdfloat-value)
(si:complex-long-float 'clfloat-value)))
(location (make-vv :location c-value :value value)))
(cons value (make-c1form* 'LOCATION :type type
:args (list loc-type value location)))))
(cl:single-float :float)
(cl:double-float :double)
(cl:long-float ':long-double)
(si:complex-single-float :csfloat)
(si:complex-double-float :cdfloat)
(si:complex-long-float :clfloat)))
(location (make-vv :location c-value :value value :rep-type :object)))
(cons value (make-c1form* 'LOCATION :type type :args location))))
(t
(cons name (make-c1form* 'LOCATION :type (type-of name)
:args (make-vv :location c-value
:value name))))))
:args (make-vv :location c-value :value name))))))
(defun make-optimizable-constants (machine)
(loop for (value name) in (optimizable-constants-list machine)

6
src/cmp/cmpbackend-cxx/cmppass2-data.lsp
View file

@ -241,8 +241,10 @@
(defun wt-vv-value (vv value)
(etypecase value
(fixnum (wt-fixnum value vv))
(character (wt-character value vv))))
(fixnum (wt-fixnum value vv))
(character (wt-character value vv))
(float (wt-number value vv))
((complex float) (wt-number value vv))))
(defun wt-vv (vv-loc)
(setf (vv-used-p vv-loc) t)

10
src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
View file

@ -222,15 +222,7 @@
;;;
(defun wt-to-object-conversion (loc-rep-type loc)
(when (and (consp loc) (member (first loc)
'(single-float-value
double-float-value
long-float-value
csfloat-value
cdfloat-value
clfloat-value)))
(wt (third loc)) ;; VV index
(return-from wt-to-object-conversion))
;; FIXME we can do better for constant locations.
(let* ((record (rep-type-record loc-rep-type))
(coercer (and record (rep-type-to-lisp record))))
(unless coercer

29
src/cmp/cmplocs.lsp
View file

@ -49,12 +49,6 @@
((atom loc) 'T)
(t
(case (first loc)
(DOUBLE-FLOAT-VALUE 'DOUBLE-FLOAT)
(SINGLE-FLOAT-VALUE 'SINGLE-FLOAT)
(LONG-FLOAT-VALUE 'LONG-FLOAT)
(CSFLOAT-VALUE 'SI:COMPLEX-SINGLE-FLOAT)
(CDFLOAT-VALUE 'SI:COMPLEX-DOUBLE-FLOAT)
(CLFLOAT-VALUE 'SI:COMPLEX-LONG-FLOAT)
(FFI:C-INLINE (let ((type (first (second loc))))
(cond ((and (consp type) (eq (first type) 'VALUES)) T)
((lisp-type-p type) type)
@ -74,12 +68,6 @@
((atom loc) :object)
(t
(case (first loc)
(DOUBLE-FLOAT-VALUE :double)
(SINGLE-FLOAT-VALUE :float)
(LONG-FLOAT-VALUE :long-double)
(CSFLOAT-VALUE :csfloat)
(CDFLOAT-VALUE :cdfloat)
(CLFLOAT-VALUE :clfloat)
(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))
@ -141,12 +129,6 @@
;;; ( COERCE-LOC representation-type location)
;;; ( FDEFINITION vv-index )
;;; ( MAKE-CCLOSURE cfun )
;;; ( LONG-FLOAT-VALUE long-float-value vv )
;;; ( DOUBLE-FLOAT-VALUE double-float-value vv )
;;; ( SINGLE-FLOAT-VALUE single-float-value vv )
;;; ( CSFLOAT-VALUE csfloat-value vv )
;;; ( CDFLOAT-VALUE cdfloat-value vv )
;;; ( CLFLOAT-VALUE clfloat-value vv )
;;; ( STACK-POINTER index ) retrieve a value from the stack
;;; ( SYS:STRUCTURE-REF loc slot-name-vv slot-index )
;;; ( THE type location )
@ -196,12 +178,7 @@
((eq (first loc) 'THE)
(loc-in-c1form-movable-p (third loc)))
((member (setf loc (car loc))
'(VV VV-TEMP
DOUBLE-FLOAT-VALUE SINGLE-FLOAT-VALUE LONG-FLOAT-VALUE
#+complex-float CSFLOAT-VALUE
#+complex-float CDFLOAT-VALUE
#+complex-float CLFLOAT-VALUE
KEYVARS))
'(VV VV-TEMP KEYVARS))
t)
(t
(baboon :format-control "Unknown location ~A found in C1FORM"
@ -229,10 +206,6 @@
(values nil nil))
((eq (first loc) 'THE)
(loc-immediate-value-p (third loc)))
((member (first loc)
'(long-float-value double-float-value single-float-value
csfloat-value cdfloat-value clfloat-value))
(values t (second loc)))
(t
(values nil nil))))

12
src/cmp/cmppass1-eval.lsp
View file

@ -140,15 +140,13 @@
(make-c1form* 'LOCATION :type 'BASE-CHAR :args (make-vv :rep-type :unsigned-char :value val)))
((characterp 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))))
((typep val 'SINGLE-FLOAT)
(make-c1form* 'LOCATION :type 'SINGLE-FLOAT
:args (list 'SINGLE-FLOAT-VALUE val (add-object val))))
(make-c1form* 'LOCATION :type 'SINGLE-FLOAT :args (make-vv :rep-type :float :value val)))
((typep val 'DOUBLE-FLOAT)
(make-c1form* 'LOCATION :type 'DOUBLE-FLOAT :args (make-vv :rep-type :double :value val)))
((typep val 'LONG-FLOAT)
(make-c1form* 'LOCATION :type 'LONG-FLOAT
:args (list 'LONG-FLOAT-VALUE val (add-object val))))
(make-c1form* 'LOCATION :type 'LONG-FLOAT :args (make-vv :rep-type :long-double :value val)))
;; FIXME C?FLOAT
#+sse2
((typep val 'EXT:SSE-PACK)
(c1constant-value/sse val))

7
src/cmp/cmptables.lsp
View file

@ -180,13 +180,6 @@
(temp . wt-temp)
(lcl . wt-lcl-loc)
(long-float-value . wt-number)
(double-float-value . wt-number)
(single-float-value . wt-number)
(short-float-value . wt-number)
(csfloat-value . wt-number)
(cdfloat-value . wt-number)
(clfloat-value . wt-number)
(value . wt-value)
(keyvars . wt-keyvars)
(cl:the . wt-the)