From 8cc0ae7222e620b7452bd71ac6d044ae3d8bcb61 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Mon, 6 May 2019 19:34:17 +0200 Subject: [PATCH] complex float: add compiler optimizations and ffi definitions - add ffi implementation for long-float - add ffi implementation for (complex float) types - add compiler optimizations and definitions for complex float We do not add c?float common constants (long-float i.e has optimizer for 0.0 and -0.0), because we don't know if they are common at all and if we think about it each would have four entries counting signed zeros). Also add informative comment about global-entries. --- src/c/ffi.d | 44 ++++++++++++++++++++++++++++++++++++++++ src/c/symbols_list.h | 4 ++++ src/c/symbols_list2.h | 4 ++++ src/cmp/cmpc-machine.lsp | 8 +++++++- src/cmp/cmpcbk.lsp | 5 +++++ src/cmp/cmpct.lsp | 16 +++++++++------ src/cmp/cmpexit.lsp | 8 ++++++-- src/cmp/cmpffi.lsp | 22 +++++++++++++++++++- src/cmp/cmpglobals.lsp | 9 ++++++-- src/cmp/cmploc.lsp | 9 +++++++- src/cmp/cmptables.lsp | 3 +++ src/cmp/cmptop.lsp | 19 +++++++++-------- src/cmp/cmpwt.lsp | 27 ++++++++++++++++++++++++ src/h/ecl-cmp.h | 8 ++++++++ src/h/ecl-inl.h | 9 ++++++-- src/h/object.h | 16 +++++++++++++++ src/lsp/top.lsp | 24 ++++++++++++++++++++++ 17 files changed, 212 insertions(+), 23 deletions(-) diff --git a/src/c/ffi.d b/src/c/ffi.d index d795491a3..dbade3723 100644 --- a/src/c/ffi.d +++ b/src/c/ffi.d @@ -117,6 +117,14 @@ ecl_foreign_type_table[] = { FFI_DESC(@':object', cl_object), FFI_DESC(@':float', float), FFI_DESC(@':double', double), +#ifdef ECL_LONG_FLOAT + FFI_DESC(@':long-double', long double), +#endif +#ifdef ECL_COMPLEX_FLOAT + FFI_DESC(@':csfloat', _Complex float), + FFI_DESC(@':cdfloat', _Complex double), + FFI_DESC(@':clfloat', _Complex long double), +#endif {@':void', 0, 0} }; @@ -175,6 +183,14 @@ static ffi_type *ecl_type_to_libffi_type[] = { &ffi_type_pointer, /*@':object',*/ &ffi_type_float, /*@':float',*/ &ffi_type_double, /*@':double',*/ +#ifdef ECL_LONG_FLOAT + &ffi_type_longdouble, /*@':long-double',*/ +#endif +#ifdef ECL_COMPLEX_FLOAT + &ffi_type_complex_float, /*@':csfloat',*/ + &ffi_type_complex_double, /*@':cdfloat',*/ + &ffi_type_complex_longdouble, /*@':clfloat',*/ +#endif &ffi_type_void /*@':void'*/ }; #endif /* HAVE_LIBFFI */ @@ -500,6 +516,18 @@ ecl_foreign_data_ref_elt(void *p, enum ecl_ffi_tag tag) return ecl_make_single_float(*(float *)p); case ECL_FFI_DOUBLE: return ecl_make_double_float(*(double *)p); +#ifdef ECL_LONG_FLOAT + case ECL_FFI_LONG_DOUBLE: + return ecl_make_long_float(*(long double *)p); +#endif +#ifdef ECL_COMPLEX_FLOAT + case ECL_FFI_CSFLOAT: + return ecl_make_csfloat(*(_Complex float *)p); + case ECL_FFI_CDFLOAT: + return ecl_make_cdfloat(*(_Complex double *)p); + case ECL_FFI_CLFLOAT: + return ecl_make_clfloat(*(_Complex long double *)p); +#endif case ECL_FFI_VOID: return ECL_NIL; default: @@ -594,6 +622,22 @@ ecl_foreign_data_set_elt(void *p, enum ecl_ffi_tag tag, cl_object value) case ECL_FFI_DOUBLE: *(double *)p = ecl_to_double(value); break; +#ifdef ECL_LONG_FLOAT + case ECL_FFI_LONG_DOUBLE: + *(long double *)p = ecl_to_long_double(value); + break; +#endif +#ifdef ECL_COMPLEX_FLOAT + case ECL_FFI_CSFLOAT: + *(_Complex float *)p = ecl_to_csfloat(value); + break; + case ECL_FFI_CDFLOAT: + *(_Complex double *)p = ecl_to_cdfloat(value); + break; + case ECL_FFI_CLFLOAT: + *(_Complex long double *)p = ecl_to_clfloat(value); + break; +#endif case ECL_FFI_VOID: break; default: diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index f94236d89..f45f987dd 100755 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1497,6 +1497,9 @@ cl_symbols[] = { {SYS_ "ALIGNMENT-OF-FOREIGN-ELT-TYPE", SI_ORDINARY, si_alignment_of_foreign_elt_type, 1, OBJNULL}, {KEY_ "BYTE", KEYWORD, NULL, -1, OBJNULL}, {KEY_ "CHAR", KEYWORD, NULL, -1, OBJNULL}, +{KEY_ "CSFLOAT", KEYWORD, NULL, -1, OBJNULL}, +{KEY_ "CDFLOAT", KEYWORD, NULL, -1, OBJNULL}, +{KEY_ "CLFLOAT", KEYWORD, NULL, -1, OBJNULL}, {KEY_ "CSTRING", KEYWORD, NULL, -1, OBJNULL}, {KEY_ "DOUBLE", KEYWORD, NULL, -1, OBJNULL}, {KEY_ "FIXNUM", KEYWORD, NULL, -1, OBJNULL}, @@ -1507,6 +1510,7 @@ cl_symbols[] = { {KEY_ "INT32-T", KEYWORD, NULL, -1, OBJNULL}, {KEY_ "INT64-T", KEYWORD, NULL, -1, OBJNULL}, {KEY_ "LONG", KEYWORD, NULL, -1, OBJNULL}, +{KEY_ "LONG-DOUBLE", KEYWORD, NULL, -1, OBJNULL}, {KEY_ "LONG-LONG", KEYWORD, NULL, -1, OBJNULL}, {KEY_ "POINTER-SELF", KEYWORD, NULL, -1, OBJNULL}, {KEY_ "POINTER-VOID", KEYWORD, NULL, -1, OBJNULL}, diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index 4705192c3..90e62b3c5 100644 --- a/src/c/symbols_list2.h +++ b/src/c/symbols_list2.h @@ -1497,6 +1497,9 @@ cl_symbols[] = { {SYS_ "ALIGNMENT-OF-FOREIGN-ELT-TYPE","si_alignment_of_foreign_elt_type"}, {KEY_ "BYTE",NULL}, {KEY_ "CHAR",NULL}, +{KEY_ "CSFLOAT",NULL}, +{KEY_ "CDFLOAT",NULL}, +{KEY_ "CLFLOAT",NULL}, {KEY_ "CSTRING",NULL}, {KEY_ "DOUBLE",NULL}, {KEY_ "FIXNUM",NULL}, @@ -1507,6 +1510,7 @@ cl_symbols[] = { {KEY_ "INT32-T",NULL}, {KEY_ "INT64-T",NULL}, {KEY_ "LONG",NULL}, +{KEY_ "LONG-DOUBLE",NULL}, {KEY_ "LONG-LONG",NULL}, {KEY_ "POINTER-SELF",NULL}, {KEY_ "POINTER-VOID",NULL}, diff --git a/src/cmp/cmpc-machine.lsp b/src/cmp/cmpc-machine.lsp index 7f5b70249..fd9dc48be 100644 --- a/src/cmp/cmpc-machine.lsp +++ b/src/cmp/cmpc-machine.lsp @@ -19,6 +19,7 @@ (defconstant +representation-types+ '(;; These types can be used by ECL to unbox data ;; They are sorted from the most specific, to the least specific one. + ;; All functions must be declared in externa.h (not internal.h) header file. (:byte . #1=((signed-byte 8) "int8_t" "ecl_make_int8_t" "ecl_to_int8_t" "ecl_fixnum")) (:unsigned-byte . @@ -34,6 +35,9 @@ (:float single-float "float" "ecl_make_single_float" "ecl_to_float" "ecl_single_float") (:double double-float "double" "ecl_make_double_float" "ecl_to_double" "ecl_double_float") (:long-double long-float "long double" "ecl_make_long_float" "ecl_to_long_double" "ecl_long_float") + (:csfloat si::complex-single-float "_Complex float" "ecl_make_csfloat" "ecl_to_csfloat" "ecl_csfloat") + (:cdfloat si::complex-double-float "_Complex double" "ecl_make_cdfloat" "ecl_to_cdfloat" "ecl_cdfloat") + (:clfloat si::complex-long-float "_Complex long double" "ecl_make_clfloat" "ecl_to_clfloat" "ecl_clfloat") (:unsigned-char base-char "unsigned char" "CODE_CHAR" "ecl_base_char_code" "CHAR_CODE") (:char base-char "char" "CODE_CHAR" "ecl_base_char_code" "CHAR_CODE") (:wchar character "ecl_character" "CODE_CHAR" "ecl_char_code" "CHAR_CODE") @@ -96,7 +100,9 @@ #+:sse2 (:double-sse-pack . nil) #+:sse2 (:int-sse-pack . nil) #+:long-float (:long-double . nil) - )) + #+complex-float (:csfloat . nil) + #+complex-float (:cdfloat . nil) + #+complex-float (:clfloat . nil))) (defconstant +all-machines-c-types+ '((:object) diff --git a/src/cmp/cmpcbk.lsp b/src/cmp/cmpcbk.lsp index 4db7671bc..13910d7ba 100644 --- a/src/cmp/cmpcbk.lsp +++ b/src/cmp/cmpcbk.lsp @@ -73,6 +73,11 @@ (:object . "ECL_FFI_OBJECT") (:float . "ECL_FFI_FLOAT") (:double . "ECL_FFI_DOUBLE") + (:long-double . "ECL_FFI_LONG_DOUBLE") + ;; complex floats + (:csfloat . "ECL_FFI_CSFLOAT") + (:cdfloat . "ECL_FFI_CDFLOAT") + (:clfloat . "ECL_FFI_CLFLOAT") (:void . "ECL_FFI_VOID"))) (defun foreign-elt-type-code (type) diff --git a/src/cmp/cmpct.lsp b/src/cmp/cmpct.lsp index 1c9e29f15..cd1401f43 100644 --- a/src/cmp/cmpct.lsp +++ b/src/cmp/cmpct.lsp @@ -21,11 +21,12 @@ (cond ((let ((x (assoc val *optimizable-constants*))) (when x - (pushnew "#include " *clines-string-list*) - (setf x (cdr x)) - (if (listp x) - (c1expr x) - x)))) + (pushnew "#include " *clines-string-list*) + (pushnew "#include " *clines-string-list*) + (setf x (cdr x)) + (if (listp x) + (c1expr x) + x)))) ((eq val nil) (c1nil)) ((eq val t) (c1t)) ((sys::fixnump val) @@ -88,7 +89,10 @@ (loc-type (case type (single-float 'single-float-value) (double-float 'double-float-value) - (long-float 'long-float-value))) + (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))))) diff --git a/src/cmp/cmpexit.lsp b/src/cmp/cmpexit.lsp index 251c8e8b3..f531f044d 100644 --- a/src/cmp/cmpexit.lsp +++ b/src/cmp/cmpexit.lsp @@ -127,8 +127,9 @@ (unwind-bds bds-lcl bds-bind stack-frame ihs-p) (wt-nl "return value0;"))) (return)) - ((RETURN-FIXNUM RETURN-CHARACTER RETURN-DOUBLE-FLOAT - RETURN-SINGLE-FLOAT RETURN-OBJECT) + ((RETURN-FIXNUM RETURN-CHARACTER RETURN-OBJECT + RETURN-DOUBLE-FLOAT RETURN-SINGLE-FLOAT RETURN-LONG-FLOAT + RETURN-CSFLOAT RETURN-CSFLOAT RETURN-CSFLOAT) (when (eq *exit* ue) ;; *destination* must be RETURN-FIXNUM (setq loc (list 'COERCE-LOC @@ -136,6 +137,9 @@ RETURN-CHARACTER :char RETURN-SINGLE-FLOAT :float RETURN-DOUBLE-FLOAT :double + RETURN-CSFLOAT :csfloat + RETURN-CDFLOAT :cdfloat + RETURN-CLFLOAT :clfloat RETURN-OBJECT :object) ue) loc)) diff --git a/src/cmp/cmpffi.lsp b/src/cmp/cmpffi.lsp index 4d5f0677e..88f7bffa1 100755 --- a/src/cmp/cmpffi.lsp +++ b/src/cmp/cmpffi.lsp @@ -79,7 +79,10 @@ (when (and (consp loc) (member (first loc) '(single-float-value double-float-value - long-float-value))) + long-float-value + csfloat-value + cdfloat-value + clfloat-value))) (wt (third loc)) ;; VV index (return-from wt-to-object-conversion)) (let ((record (rep-type-record loc-rep-type))) @@ -127,6 +130,9 @@ (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) (C-INLINE (let ((type (first (second loc)))) (cond ((and (consp type) (eq (first type) 'VALUES)) T) ((lisp-type-p type) type) @@ -151,6 +157,9 @@ (DOUBLE-FLOAT-VALUE :double) (SINGLE-FLOAT-VALUE :float) (LONG-FLOAT-VALUE :long-double) + (CSFLOAT-VALUE :csfloat) + (CDFLOAT-VALUE :cdfloat) + (CLFLOAT-VALUE :clfloat) (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)) @@ -199,6 +208,17 @@ (wt-from-object-conversion dest-type loc-type dest-rep-type loc)) (t (coercion-error)))) + ((:csfloat :cdfloat :clfloat) + (cond + ((c-number-rep-type-p loc-rep-type) + (wt "(" (rep-type->c-name dest-rep-type) ")(" loc ")")) + ((eq loc-rep-type :object) + ;; We relax the check a bit, because it is valid in C to coerce + ;; between COMPLEX floats of different types. + (ensure-valid-object-type 'SI:COMPLEX-FLOAT) + (wt-from-object-conversion dest-type loc-type dest-rep-type loc)) + (t + (coercion-error)))) ((:bool) (cond ((c-number-rep-type-p loc-rep-type) diff --git a/src/cmp/cmpglobals.lsp b/src/cmp/cmpglobals.lsp index 31f4e89ad..3337625e2 100644 --- a/src/cmp/cmpglobals.lsp +++ b/src/cmp/cmpglobals.lsp @@ -142,8 +142,8 @@ running the compiler. It may be updated by running ") ;;; *last-label* holds the label# of the last used label. ;;; *exit* holds an 'exit', which is ;; ( label# . ref-flag ) or one of RETURNs (i.e. RETURN, RETURN-FIXNUM, -;; RETURN-CHARACTER, RETURN-DOUBLE-FLOAT, RETURN-SINGLE-FLOAT, or -;; RETURN-OBJECT). +;; RETURN-CHARACTER, RETURN-LONG-FLOAT, RETURN-DOUBLE-FLOAT, RETURN-SINGLE-FLOAT, +;; RETURN-CSFLOAT, RETURN-CDFLOAT, RETURN-CLFLOAT or RETURN-OBJECT). ;;; *unwind-exit* holds a list consisting of: ;; ( label# . ref-flag ), one of RETURNs, TAIL-RECURSION-MARK, FRAME, ;; JUMP, BDS-BIND (each pushed for a single special binding), or a @@ -281,6 +281,11 @@ lines are inserted, but the order is preserved") ;;; | ( 'LOAD-TIME-VALUE' vv ) ;;; *global-entries* holds (... ( fname cfun return-types arg-type ) ...). + +;;; FIXME: global-entries mechanism seems to be completely abandoned +;;; (always NIL). Either remove compiler code which uses it and remove +;;; variable itself or properly document it and use where +;;; applicable. -- jd 2019-05-07 (defvar *global-entries* nil) (defvar *global-macros* nil) diff --git a/src/cmp/cmploc.lsp b/src/cmp/cmploc.lsp index 54078ff14..f52ff27e6 100644 --- a/src/cmp/cmploc.lsp +++ b/src/cmp/cmploc.lsp @@ -41,6 +41,9 @@ ;;; ( 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 ) @@ -92,6 +95,9 @@ ((member (setf loc (car loc)) '(VV VV-TEMP FIXNUM-VALUE CHARACTER-VALUE DOUBLE-FLOAT-VALUE SINGLE-FLOAT-VALUE #+long-float LONG-FLOAT-VALUE + #+complex-float CSFLOAT-VALUE + #+complex-float CDFLOAT-VALUE + #+complex-float CLFLOAT-VALUE KEYVARS)) t) (t @@ -122,7 +128,8 @@ (loc-immediate-value-p (third loc))) ((member (first loc) '(fixnum-value long-float-value - double-float-value single-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)))) diff --git a/src/cmp/cmptables.lsp b/src/cmp/cmptables.lsp index f1bf4a625..0c87a3cde 100644 --- a/src/cmp/cmptables.lsp +++ b/src/cmp/cmptables.lsp @@ -187,6 +187,9 @@ (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) (character-value . wt-character) (value . wt-value) (keyvars . wt-keyvars) diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp index f1c908ee0..c849a2497 100644 --- a/src/cmp/cmptop.lsp +++ b/src/cmp/cmptop.lsp @@ -476,14 +476,13 @@ (when (compiler-check-args) (wt-nl "_ecl_check_narg(" (length arg-types) ");")) (wt-nl "cl_env_copy->nvalues = 1;") - (wt-nl "return " (case return-type - (FIXNUM "ecl_make_fixnum") - (CHARACTER "CODE_CHAR") - (DOUBLE-FLOAT "ecl_make_double_float") - (SINGLE-FLOAT "ecl_make_single_float") - #+long-float - (LONG-FLOAT "ecl_make_long_float") - (otherwise "")) + (wt-nl "return " (ecase return-type + (FIXNUM "ecl_make_fixnum") + (CHARACTER "CODE_CHAR") + (DOUBLE-FLOAT "ecl_make_double_float") + (SINGLE-FLOAT "ecl_make_single_float") + #+long-float + (LONG-FLOAT "ecl_make_long_float")) "(LI" cfun "(") (do ((types arg-types (cdr types)) (n 1 (1+ n))) @@ -610,6 +609,10 @@ (:char . "_ecl_base_char_loc") (:float . "_ecl_float_loc") (:double . "_ecl_double_loc") + #+long-float (:long-double . "_ecl_long_double_loc") + #+complex-float (:csfloat . "_ecl_csfloat_loc") + #+complex-float (:cdfloat . "_ecl_cdfloat_loc") + #+complex-float (:clfloat . "_ecl_clfloat_loc") #+sse2 (:int-sse-pack . "_ecl_int_sse_pack_loc") #+sse2 (:float-sse-pack . "_ecl_float_sse_pack_loc") #+sse2 (:double-sse-pack . "_ecl_double_sse_pack_loc") diff --git a/src/cmp/cmpwt.lsp b/src/cmp/cmpwt.lsp index 1404e84a5..41e293b84 100644 --- a/src/cmp/cmpwt.lsp +++ b/src/cmp/cmpwt.lsp @@ -283,6 +283,27 @@ "ecl_def_ct_complex(~A,&~A_data,&~A_data,static,const);" name name-real name-imag))) +#+complex-float +(defun static-csfloat-builder (name value stream) + (let* ((*read-default-float-format* 'single-float) + (*print-readably* t)) + (format stream "ecl_def_ct_csfloat(~A,(~S + I*~S),static,const);" + name (realpart value) (imagpart value) stream))) + +#+complex-float +(defun static-cdfloat-builder (name value stream) + (let* ((*read-default-float-format* 'double-float) + (*print-readably* t)) + (format stream "ecl_def_ct_cdfloat(~A,(~S + I*~S),static,const);" + name (realpart value) (imagpart value) stream))) + +#+complex-float +(defun static-clfloat-builder (name value stream) + (let* ((*read-default-float-format* 'long-float) + (*print-readably* t)) + (format stream "ecl_def_ct_clfloat(~A,(~SL + I*~SL),static,const);" + name (realpart value) (imagpart value) stream))) + #+sse2 (defun static-sse-pack-builder (name value stream) (let* ((bytes (ext:sse-pack-to-vector value '(unsigned-byte 8))) @@ -311,6 +332,12 @@ (long-float (and (not (ext:float-nan-p object)) (not (ext:float-infinity-p object)) #'static-long-float-builder)) + #+complex-float + (si:complex-single-float #'static-csfloat-builder) + #+complex-float + (si:complex-double-float #'static-cdfloat-builder) + #+complex-float + (si:complex-long-float #'static-clfloat-builder) (complex (and (static-constant-expression (realpart object)) (static-constant-expression (imagpart object)) #'static-complex-builder)) diff --git a/src/h/ecl-cmp.h b/src/h/ecl-cmp.h index 092350e7f..90640f77a 100755 --- a/src/h/ecl-cmp.h +++ b/src/h/ecl-cmp.h @@ -45,6 +45,14 @@ enum ecl_locative_type { _ecl_uni_char_loc, _ecl_float_loc, _ecl_double_loc +#ifdef ECL_LONG_FLOAT + , _ecl_long_double_loc +#endif +#ifdef ECL_COMPLEX_FLOAT + , _ecl_csfloat_loc + , _ecl_cdfloat_loc + , _ecl_clfloat_loc +#endif #ifdef ECL_SSE2 , _ecl_int_sse_pack_loc , _ecl_float_sse_pack_loc diff --git a/src/h/ecl-inl.h b/src/h/ecl-inl.h index 307c1fb26..20ad1c3ca 100644 --- a/src/h/ecl-inl.h +++ b/src/h/ecl-inl.h @@ -5,6 +5,11 @@ #ifndef ECL_ECL_INL_H #define ECL_ECL_INL_H +#ifdef ECL_COMPLEX_FLOAT +/* We need this include for the constant I. */ +#include +#endif + /* * Loops over a proper list. Complains on circularity */ @@ -139,9 +144,9 @@ #endif #define ecl_def_ct_vector(name,type,raw,len,static,const) \ - static const struct ecl_vector name ## _data = { \ + static const struct ecl_vector name ## _data = { \ (int8_t)t_vector, 0, (type), 0, \ - ECL_NIL, (cl_index)(len), (cl_index)(len), \ + ECL_NIL, (cl_index)(len), (cl_index)(len), \ ecl_cast_ptr(cl_object*,raw), 0 }; \ static const cl_object name = (cl_object)(& name ## _data) diff --git a/src/h/object.h b/src/h/object.h index 40b947369..822b4eb96 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -813,6 +813,14 @@ enum ecl_ffi_tag { ECL_FFI_OBJECT, ECL_FFI_FLOAT, ECL_FFI_DOUBLE, +#ifdef ECL_LONG_FLOAT + ECL_FFI_LONG_DOUBLE, +#endif +#ifdef ECL_COMPLEX_FLOAT + ECL_FFI_CSFLOAT, + ECL_FFI_CDFLOAT, + ECL_FFI_CLFLOAT, +#endif ECL_FFI_VOID }; @@ -853,6 +861,14 @@ union ecl_ffi_values { cl_object o; float f; double d; +#ifdef ECL_LONG_FLOAT + long double lf; +#endif +#ifdef ECL_COMPLEX_FLOAT + float _Complex csf; + double _Complex cdf; + long double _Complex clf; +#endif }; enum ecl_ffi_calling_convention { diff --git a/src/lsp/top.lsp b/src/lsp/top.lsp index 24d8c10c5..88e7da148 100644 --- a/src/lsp/top.lsp +++ b/src/lsp/top.lsp @@ -911,6 +911,30 @@ Use special code 0 to cancel this operation.") output = ecl_make_double_float(*p); break; } +#ifdef ECL_LONG_FLOAT + case _ecl_long_double_loc: { + long double *p = (long double*)value; + output = ecl_make_long_float(*p); + break; + } +#endif +#ifdef ECL_COMPLEX_FLOAT + case _ecl_csfloat_loc: { + _Complex float *p = (_Complex float*)value; + output = ecl_make_csfloat(*p); + break; + } + case _ecl_cdfloat_loc: { + _Complex double *p = (_Complex double*)value; + output = ecl_make_cdfloat(*p); + break; + } + case _ecl_clfloat_loc: { + _Complex long double *p = (_Complex long double*)value; + output = ecl_make_clfloat(*p); + break; + } +#endif #ifdef ECL_SSE2 case _ecl_int_sse_pack_loc: { __m128i *p = (__m128i*)value;