mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-08 18:40:23 +02:00
Code Activity

bytevectors: Fix IEEE-754 endianness conversion.

Browse source 
Fixes <http://bugs.gnu.org/11310>.
Reported by Klaus Stehle <klaus.stehle@uni-tuebingen.de>.

* libguile/ieee-754.h: Remove.
* libguile/Makefile.am (noinst_HEADERS): Remove `ieee-754.h'.

* libguile/bytevectors.c (scm_ieee754_float, scm_ieee754_double): New
  unions.
  (float_to_foreign_endianness, float_from_foreign_endianness,
  double_to_foreign_endianness, double_from_foreign_endianness): Rewrite
  in terms of the new unions.

* test-suite/tests/bytevectors.test ("2.8 Operations on IEEE-754
  Representations")["single, little endian", "single, big endian",
  "double, little endian", "double, big endian"]: New tests.
This commit is contained in:
Ludovic Courtès 2012-04-21 23:08:49 +02:00
parent fd07759b7d
commit 398446c742
4 changed files with 49 additions and 143 deletions
Download patch file Download diff file Expand all files Collapse all files

1
libguile/Makefile.am
View file

@ -448,7 +448,6 @@ install-exec-hook:
## Perhaps we can deal with them normally once the merge seems to be ## Perhaps we can deal with them normally once the merge seems to be
## working. ## working.
noinst_HEADERS = conv-integer.i.c conv-uinteger.i.c \ noinst_HEADERS = conv-integer.i.c conv-uinteger.i.c \
ieee-754.h \
srfi-14.i.c \ srfi-14.i.c \
quicksort.i.c \ quicksort.i.c \
win32-uname.h win32-socket.h \ win32-uname.h win32-socket.h \

71
libguile/bytevectors.c
View file

@ -31,7 +31,6 @@
#include "libguile/bytevectors.h" #include "libguile/bytevectors.h"
#include "libguile/strings.h" #include "libguile/strings.h"
#include "libguile/validate.h" #include "libguile/validate.h"
#include "libguile/ieee-754.h"
#include "libguile/arrays.h" #include "libguile/arrays.h"
#include "libguile/array-handle.h" #include "libguile/array-handle.h"
#include "libguile/uniform.h" #include "libguile/uniform.h"
@ -1567,6 +1566,18 @@ SCM_DEFINE (scm_bytevector_s64_native_set_x, "bytevector-s64-native-set!",
Section 2.1 of R6RS-lib (in response to Section 2.1 of R6RS-lib (in response to
http://www.r6rs.org/formal-comments/comment-187.txt). */ http://www.r6rs.org/formal-comments/comment-187.txt). */
union scm_ieee754_float
{
float f;
scm_t_uint32 i;
};
union scm_ieee754_double
{
double d;
scm_t_uint64 i;
};
/* Convert to/from a floating-point number with different endianness. This /* Convert to/from a floating-point number with different endianness. This
method is probably not the most efficient but it should be portable. */ method is probably not the most efficient but it should be portable. */
@ -1575,20 +1586,10 @@ static inline void
float_to_foreign_endianness (union scm_ieee754_float *target, float_to_foreign_endianness (union scm_ieee754_float *target,
float source) float source)
{ {
union scm_ieee754_float src; union scm_ieee754_float input;
src.f = source; input.f = source;
target->i = bswap_32 (input.i);
#ifdef WORDS_BIGENDIAN
/* Assuming little endian for both byte and word order. */
target->little_endian.negative = src.big_endian.negative;
target->little_endian.exponent = src.big_endian.exponent;
target->little_endian.mantissa = src.big_endian.mantissa;
#else
target->big_endian.negative = src.little_endian.negative;
target->big_endian.exponent = src.little_endian.exponent;
target->big_endian.mantissa = src.little_endian.mantissa;
#endif
} }
static inline float static inline float
@ -1596,16 +1597,7 @@ float_from_foreign_endianness (const union scm_ieee754_float *source)
{ {
union scm_ieee754_float result; union scm_ieee754_float result;
#ifdef WORDS_BIGENDIAN result.i = bswap_32 (source->i);
/* Assuming little endian for both byte and word order. */
result.big_endian.negative = source->little_endian.negative;
result.big_endian.exponent = source->little_endian.exponent;
result.big_endian.mantissa = source->little_endian.mantissa;
#else
result.little_endian.negative = source->big_endian.negative;
result.little_endian.exponent = source->big_endian.exponent;
result.little_endian.mantissa = source->big_endian.mantissa;
#endif
return (result.f); return (result.f);
} }
@ -1614,22 +1606,10 @@ static inline void
double_to_foreign_endianness (union scm_ieee754_double *target, double_to_foreign_endianness (union scm_ieee754_double *target,
double source) double source)
{ {
union scm_ieee754_double src; union scm_ieee754_double input;
src.d = source; input.d = source;
target->i = bswap_64 (input.i);
#ifdef WORDS_BIGENDIAN
/* Assuming little endian for both byte and word order. */
target->little_little_endian.negative = src.big_endian.negative;
target->little_little_endian.exponent = src.big_endian.exponent;
target->little_little_endian.mantissa0 = src.big_endian.mantissa0;
target->little_little_endian.mantissa1 = src.big_endian.mantissa1;
#else
target->big_endian.negative = src.little_little_endian.negative;
target->big_endian.exponent = src.little_little_endian.exponent;
target->big_endian.mantissa0 = src.little_little_endian.mantissa0;
target->big_endian.mantissa1 = src.little_little_endian.mantissa1;
#endif
} }
static inline double static inline double
@ -1637,18 +1617,7 @@ double_from_foreign_endianness (const union scm_ieee754_double *source)
{ {
union scm_ieee754_double result; union scm_ieee754_double result;
#ifdef WORDS_BIGENDIAN result.i = bswap_64 (source->i);
/* Assuming little endian for both byte and word order. */
result.big_endian.negative = source->little_little_endian.negative;
result.big_endian.exponent = source->little_little_endian.exponent;
result.big_endian.mantissa0 = source->little_little_endian.mantissa0;
result.big_endian.mantissa1 = source->little_little_endian.mantissa1;
#else
result.little_little_endian.negative = source->big_endian.negative;
result.little_little_endian.exponent = source->big_endian.exponent;
result.little_little_endian.mantissa0 = source->big_endian.mantissa0;
result.little_little_endian.mantissa1 = source->big_endian.mantissa1;
#endif
return (result.d); return (result.d);
} }

90
libguile/ieee-754.h
View file

@ -1,90 +0,0 @@
/* Copyright (C) 1992, 1995, 1996, 1999 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
The GNU C Library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with the GNU C Library; if not, write to the Free
Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
02111-1307 USA. */
#ifndef SCM_IEEE_754_H
#define SCM_IEEE_754_H 1
/* Based on glibc's <ieee754.h> and modified by Ludovic Courtès to include
all possible IEEE-754 double-precision representations. */
/* IEEE 754 simple-precision format (32-bit). */
union scm_ieee754_float
{
float f;
struct
{
unsigned int negative:1;
unsigned int exponent:8;
unsigned int mantissa:23;
} big_endian;
struct
{
unsigned int mantissa:23;
unsigned int exponent:8;
unsigned int negative:1;
} little_endian;
};
/* IEEE 754 double-precision format (64-bit). */
union scm_ieee754_double
{
double d;
struct
{
/* Big endian. */
unsigned int negative:1;
unsigned int exponent:11;
/* Together these comprise the mantissa. */
unsigned int mantissa0:20;
unsigned int mantissa1:32;
} big_endian;
struct
{
/* Both byte order and word order are little endian. */
/* Together these comprise the mantissa. */
unsigned int mantissa1:32;
unsigned int mantissa0:20;
unsigned int exponent:11;
unsigned int negative:1;
} little_little_endian;
struct
{
/* Byte order is little endian but word order is big endian. Not
sure this is very wide spread. */
unsigned int mantissa0:20;
unsigned int exponent:11;
unsigned int negative:1;
unsigned int mantissa1:32;
} little_big_endian;
};
#endif /* SCM_IEEE_754_H */

30
test-suite/tests/bytevectors.test
View file

@ -1,6 +1,6 @@
;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*- ;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*-
;;;; ;;;;
;;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. ;;;; Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
;;;; Ludovic Courtès ;;;; Ludovic Courtès
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
@ -325,6 +325,18 @@
(with-test-prefix/c&e "2.8 Operations on IEEE-754 Representations" (with-test-prefix/c&e "2.8 Operations on IEEE-754 Representations"
(pass-if "single, little endian"
;; http://bugs.gnu.org/11310
(let ((b (make-bytevector 4)))
(bytevector-ieee-single-set! b 0 1.0 (endianness little))
(equal? #vu8(0 0 128 63) b)))
(pass-if "single, big endian"
;; http://bugs.gnu.org/11310
(let ((b (make-bytevector 4)))
(bytevector-ieee-single-set! b 0 1.0 (endianness big))
(equal? #vu8(63 128 0 0) b)))
(pass-if "bytevector-ieee-single-native-{ref,set!}" (pass-if "bytevector-ieee-single-native-{ref,set!}"
(let ((b (make-bytevector 4)) (let ((b (make-bytevector 4))
(number 3.00)) (number 3.00))
@ -348,6 +360,18 @@
(equal? (bytevector-ieee-single-ref b 1 (endianness little)) (equal? (bytevector-ieee-single-ref b 1 (endianness little))
(bytevector-ieee-single-ref b 5 (endianness big))))) (bytevector-ieee-single-ref b 5 (endianness big)))))
(pass-if "double, little endian"
;; http://bugs.gnu.org/11310
(let ((b (make-bytevector 8)))
(bytevector-ieee-double-set! b 0 1.0 (endianness little))
(equal? #vu8(0 0 0 0 0 0 240 63) b)))
(pass-if "double, big endian"
;; http://bugs.gnu.org/11310
(let ((b (make-bytevector 8)))
(bytevector-ieee-double-set! b 0 1.0 (endianness big))
(equal? #vu8(63 240 0 0 0 0 0 0) b)))
(pass-if "bytevector-ieee-double-native-{ref,set!}" (pass-if "bytevector-ieee-double-native-{ref,set!}"
(let ((b (make-bytevector 8)) (let ((b (make-bytevector 8))
(number 3.14)) (number 3.14))
@ -653,3 +677,7 @@
(pass-if "bitvector > 8" (pass-if "bitvector > 8"
(let ((bv (uniform-array->bytevector (make-bitvector 9 #t)))) (let ((bv (uniform-array->bytevector (make-bitvector 9 #t))))
(= (bytevector-length bv) 2)))) (= (bytevector-length bv) 2))))
;;; Local Variables:
;;; eval: (put 'with-test-prefix/c&e 'scheme-indent-function 1)
;;; End: