From 1ce4713804e704dd29a1c56bfabe3ea5a129a0f5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Thu, 7 Jul 2022 12:56:28 +0200 Subject: [PATCH] floats: add operators to convert between floats and bits (integers) The interface is in the system package (that is - not part of the official api). --- src/c/num_co.d | 28 ++++++++++++++++++++++++++++ src/c/symbols_list.h | 7 +++++++ src/cmp/proclamations.lsp | 7 +++++++ src/h/external.h | 4 ++++ src/lsp/numlib.lsp | 23 +++++++++++++++++++++++ src/tests/normal-tests/ieee-fp.lsp | 9 +++++++++ 6 files changed, 78 insertions(+) diff --git a/src/c/num_co.d b/src/c/num_co.d index 3dfbd41b3..3f1c120b5 100644 --- a/src/c/num_co.d +++ b/src/c/num_co.d @@ -476,3 +476,31 @@ cl_imagpart(cl_object x) } @(return x); } + +uint32_t +ecl_float_bits(float num) +{ + union { float f; uint32_t u; } fu = { .f = num }; + return fu.u; +} + +uint64_t +ecl_double_bits(double num) +{ + union { double f; uint64_t u; } fu = { .f = num }; + return fu.u; +} + +float +ecl_bits_float(uint32_t num) +{ + union { float f; uint32_t u; } fu = { .u = num }; + return fu.f; +} + +double +ecl_bits_double(uint64_t num) +{ + union { double f; uint64_t u; } fu = { .u = num }; + return fu.f; +} diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 9d0df5019..0c9907004 100755 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1992,6 +1992,13 @@ cl_symbols[] = { {EXT_ "FLOAT-NAN-STRING" ECL_FUN(NULL, NULL, 1) ECL_VAR(EXT_ORDINARY, OBJNULL)}, {EXT_ "FLOAT-INFINITY-STRING" ECL_FUN(NULL, NULL, 1) ECL_VAR(EXT_ORDINARY, OBJNULL)}, +{SYS_ "SINGLE-FLOAT-BITS" ECL_FUN(NULL, NULL, 1) ECL_VAR(SI_ORDINARY, OBJNULL)}, +{SYS_ "BITS-SINGLE-FLOAT" ECL_FUN(NULL, NULL, 1) ECL_VAR(SI_ORDINARY, OBJNULL)}, +{SYS_ "DOUBLE-FLOAT-BITS" ECL_FUN(NULL, NULL, 1) ECL_VAR(SI_ORDINARY, OBJNULL)}, +{SYS_ "BITS-DOUBLE-FLOAT" ECL_FUN(NULL, NULL, 1) ECL_VAR(SI_ORDINARY, OBJNULL)}, +{SYS_ "LONG-FLOAT-BITS" ECL_FUN(NULL, NULL, 1) ECL_VAR(SI_ORDINARY, OBJNULL)}, +{SYS_ "BITS-LONG-FLOAT" ECL_FUN(NULL, NULL, 1) ECL_VAR(SI_ORDINARY, OBJNULL)}, + {SYS_ "READ-OBJECT-OR-IGNORE" ECL_FUN("si_read_object_or_ignore", si_read_object_or_ignore, 2) ECL_VAR(EXT_ORDINARY, OBJNULL)}, {EXT_ "READTABLE-LOCK" ECL_FUN("si_readtable_lock", si_readtable_lock, -2) ECL_VAR(EXT_ORDINARY, OBJNULL)}, diff --git a/src/cmp/proclamations.lsp b/src/cmp/proclamations.lsp index 0224b5b88..97d663b0f 100644 --- a/src/cmp/proclamations.lsp +++ b/src/cmp/proclamations.lsp @@ -618,6 +618,13 @@ #+complex-float (proclamation si:complex-float (float float) si:complex-float :pure) #+complex-float (proclamation si:complex-float-p (t) gen-bool :pure) +(proclamation si:single-float-bits (single-float) integer :pure) +(proclamation si:bits-single-float (integer) single-float :pure) +(proclamation si:double-float-bits (double-float) integer :pure) +(proclamation si:bits-double-float (integer) double-float :pure) +(proclamation si:long-float-bits (long-float) integer :pure) +(proclamation si:bits-long-float (integer) long-float :pure) + ;; Virtual functions added by the compiler (proclamation shift>> (*) nil :pure) (proclamation shift<< (*) nil :pure) diff --git a/src/h/external.h b/src/h/external.h index e3bfc6eee..5eda7034f 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -1197,6 +1197,10 @@ extern ECL_API cl_object ecl_ceiling2(cl_object x, cl_object y); extern ECL_API cl_object ecl_truncate2(cl_object x, cl_object y); extern ECL_API cl_object ecl_round2(cl_object x, cl_object y); +extern ECL_API uint32_t ecl_float_bits(float num); +extern ECL_API float ecl_bits_float(uint32_t num); +extern ECL_API uint64_t ecl_double_bits(double num); +extern ECL_API double ecl_bits_double(uint64_t num); /* num_comp.c */ diff --git a/src/lsp/numlib.lsp b/src/lsp/numlib.lsp index 0c4e9fa9e..cb8a0e228 100644 --- a/src/lsp/numlib.lsp +++ b/src/lsp/numlib.lsp @@ -427,3 +427,26 @@ specified bits of INTEGER2 with the specified bits of INTEGER1." (mask (ash (lognot (ash -1 size)) pos))) (logior (logandc2 integer mask) (logand newbyte mask)))) + +(defun single-float-bits (num) + (ffi:c-inline (num) (:float) :uint32-t "ecl_float_bits(#0)" :one-liner t)) + +(defun bits-single-float (num) + (ffi:c-inline (num) (:uint32-t) :float "ecl_bits_float(#0)" :one-liner t)) + +(defun double-float-bits (num) + (ffi:c-inline (num) (:double) :uint64-t "ecl_double_bits(#0)" :one-liner t)) + +(defun bits-double-float (num) + (ffi:c-inline (num) (:uint64-t) :double "ecl_bits_double(#0)" :one-liner t)) + +;;; XXX long double may have 64, 80, 96 or 128 bits (possibly more). The layout +;;; in the memory is also an unknown, so we punt here. -- jd 2022-07-07 + +(defun long-float-bits (num) + #+long-float (error "Operation not supported.") + #-long-float (double-float-bits num)) + +(defun bits-long-float (num) + #+long-float (error "Operation not supported.") + #-long-float (bits-double-float num)) diff --git a/src/tests/normal-tests/ieee-fp.lsp b/src/tests/normal-tests/ieee-fp.lsp index 96bf3fa8f..b696d80ee 100644 --- a/src/tests/normal-tests/ieee-fp.lsp +++ b/src/tests/normal-tests/ieee-fp.lsp @@ -782,3 +782,12 @@ Common Lisp type contagion rules." (z-below (complex x -0.0))) (is (plusp (imagpart (sqrt z-above)))) (is (minusp (imagpart (sqrt z-below))))))) + +(test ieee-fp.0032.bit-conversion/smoke + (is (= 3.14 (si:bits-single-float (si:single-float-bits 3.14)))) + (is (= 3.14 (si:bits-double-float (si:double-float-bits 3.14)))) + #-long-float + (is (= 3.14 (si:bits-long-float (si:long-float-bits 3.14)))) + #+long-float + (progn (signals error (si:long-float-bits 3.14)) + (signals error (si:bits-long-float 3.14))))