mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-13 12:52:08 -08:00
Code Issues Projects Releases Packages Wiki Activity

Activated the use of statically defined floating point constants in compiled code

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-06-04 15:21:39 +02:00
parent 21e1ab0455
commit 2c68c6f008
1 changed files with 12 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

18
src/cmp/cmpwt.lsp
View file

@ -170,13 +170,15 @@
(defun static-single-float-builder (name value stream)
(let* ((*read-default-float-format* 'single-float)
(*print-readably* t))
(format stream "ecl_def_ct_single_float(~A,~S,static,const);" name value stream)))
(*print-readably* t))
(format stream "ecl_def_ct_single_float(~A,~S,static,const);"
name value stream)))
(defun static-double-float-builder (name value stream)
(let* ((*read-default-float-format* 'double-float)
(*print-readably* t))
(format stream "ecl_def_ct_single_float(~A,~S,static,const);" name value stream)))
(*print-readably* t))
(format stream "ecl_def_ct_double_float(~A,~S,static,const);"
name value stream)))
(defun static-constant-builder (format value)
(lambda (name stream)
@ -185,8 +187,12 @@
(defun static-constant-expression (object)
(typecase object
(base-string #'static-base-string-builder)
;;(single-float #'static-single-float-builder)
;;(double-float #'static-double-float-builder)
(single-float (and (not (si:float-nan-p object))
(not (si:float-infinity-p object))
#'static-single-float-builder))
(double-float (and (not (si:float-nan-p object))
(not (si:float-infinity-p object))
#'static-double-float-builder))
(t nil)))
(defun add-static-constant (object)