* binary representation of numbers
@ 2003-02-06 8:29 Rohan Drape
2003-03-07 15:13 ` Marius Vollmer
0 siblings, 1 reply; 2+ messages in thread
From: Rohan Drape @ 2003-02-06 8:29 UTC (permalink / raw)
Hello All,
After a brief discussion on guile-user I am submitting a module for
consideration for inclusion in guile.
The module, numberbytestring, implements the mzsheme API for
converting between Scheme numbers and common machine byte
representations. There does not seem to be any primitives in Guile
with equivalent functionality and the mzscheme API seems to me to
be well designed.
These procedures are very useful in implementing byte protocols, the
files submitted have been used to implement the OpenSoundControl
protocol and appear to be correct (a recognized server parses
packets correctly). There is also a test file included with the
module.
This version is derived from the mzscheme sources, with various
changes. There are notes in the opening comments of the file
numberbytestring.c.
The shell archive contains the files:
numberbytestring.c
numberbytestring.scm
numberbytestring.test
config.h
The test file may need editing to find the required modules.
I hope this submission is considered useful,
Thanks for all the work,
Rohan
--- SHELL ARCHIVE ---
#!/bin/sh
# This is a shell archive (produced by GNU sharutils 4.2.1).
# To extract the files from this archive, save it to some FILE,
remove
# everything before the `!/bin/sh' line above, then type `sh FILE'.
#
# Made on 2003-02-06 18:58 EST by <rohan@localhost.localdomain>.
# Source directory was `/home/rohan/src/numberbytestring'.
#
# Existing files will *not* be overwritten unless `-c' is specified.
#
# This shar contains:
# length mode name
# ------ ---------- ------------------------------------------
# 13096 -rw-rw-r-- numberbytestring.c
# 1585 -rw-rw-r-- numberbytestring.scm
# 7816 -rw-rw-r-- numberbytestring.test
# 372 -rw-rw-r-- config.h
#
save_IFS="${IFS}"
IFS="${IFS}:"
gettext_dir=FAILED
locale_dir=FAILED
first_param="$1"
for dir in $PATH
do
if test "$gettext_dir" = FAILED && test -f $dir/gettext \
&& ($dir/gettext --version >/dev/null 2>&1)
then
set `$dir/gettext --version 2>&1`
if test "$3" = GNU
then
gettext_dir=$dir
fi
fi
if test "$locale_dir" = FAILED && test -f $dir/shar \
&& ($dir/shar --print-text-domain-dir >/dev/null 2>&1)
then
locale_dir=`$dir/shar --print-text-domain-dir`
fi
done
IFS="$save_IFS"
if test "$locale_dir" = FAILED || test "$gettext_dir" = FAILED
then
echo=echo
else
TEXTDOMAINDIR=$locale_dir
export TEXTDOMAINDIR
TEXTDOMAIN=sharutils
export TEXTDOMAIN
echo="$gettext_dir/gettext -s"
fi
if touch -am -t 200112312359.59 $$.touch >/dev/null 2>&1 && test !
-f 200112312359.59 -a -f $$.touch; then
shar_touch='touch -am -t $1$2$3$4$5$6.$7 "$8"'
elif touch -am 123123592001.59 $$.touch >/dev/null 2>&1 && test ! -f
123123592001.59 -a ! -f 123123592001.5 -a -f $$.touch; then
shar_touch='touch -am $3$4$5$6$1$2.$7 "$8"'
elif touch -am 1231235901 $$.touch >/dev/null 2>&1 && test ! -f
1231235901 -a -f $$.touch; then
shar_touch='touch -am $3$4$5$6$2 "$8"'
else
shar_touch=:
echo
$echo 'WARNING: not restoring timestamps. Consider getting and'
$echo "installing GNU \`touch', distributed in GNU File
Utilities..."
echo
fi
rm -f 200112312359.59 123123592001.59 123123592001.5 1231235901
$$.touch
#
if mkdir _sh01342; then
$echo 'x -' 'creating lock directory'
else
$echo 'failed to create lock directory'
exit 1
fi
# ============= numberbytestring.c ==============
if test -f 'numberbytestring.c' && test "$first_param" != -c; then
$echo 'x -' SKIPPING 'numberbytestring.c' '(file already exists)'
else
$echo 'x -' extracting 'numberbytestring.c' '(text)'
sed 's/^X//' << 'SHAR_EOF' > 'numberbytestring.c' &&
/*
X
numberbytestring.c
X
A port of the Mzscheme number<->byte-string procedures to Guile.
X
Copyright (c) 2003 Rohan Drape. This file is released under the
GPL.
X
The mzscheme file 'numstr.c' from which this file is derived is
released under the GPL and has the following copyright notices:
X
X MzScheme
X Copyright (c) 2000-2001 Matthew Flatt
X
and
X
X libscheme
X Copyright (c) 1994 Brent Benson
X All rights reserved.
X
NOTES:
X
1. Support for default/optional arguments is not implemented in the
X primitives. There is an implementation of the mzscheme behavior
at
X scheme.
X
2. Integer types are named using the typedefs from 'stdint.h', and a
X 64 bit integer type is required to exist. There are
configuration
X tests that enforce this. Importantly this requirement is met by
X the GNU system (GCC/Glibc).
X
3. This implementation inherits from mzscheme the assumption that
X sizeof(float)==32 and sizeof(double)==64.
X
4. There is a module definition file at numberbytestring.scm. This
X file defines the module 'numberbytestring', loads the shared
X library 'libguile-numberbytestring', and defines the optioned
X versions of the procedures.
X
5. There is a test file at numberbytestring.test. This file
requires
X the Guile test suite library. The expected results are
consistent
X with the mzscheme implementation.
X
COMPILATION:
X
X gcc -Wall -c numberbytestring.c -o numberbytestring.o
X ld -shared numberbytestring.o -o libguile-numberbytestring.so
X
DOCUMENTAION:
X
The following is adapted from the documentation from the mzscheme
manual. Note that default values are not provided by this
implementation, all arguments are required.
X
X (integer-byte-string->integer string signed? big-endian?)
converts
X the machine-format number encoded in string to an exact
X integer. The string must contain either 2, 4, or 8 characters.
If
X signed? is true, then the string is decoded as a
two's-complement
X number, otherwise it is decoded as an unsigned integer. If
X big-endian? is true, then the first character's ASCII value
X provides the most siginficant eight bits of the number,
otherwise
X the first character provides the least-significant eight bits,
and
X so on.
X
X (integer->integer-byte-string n size-n signed? big-endian?
X to-string) converts the exact integer n to a machine-format
number
X encoded in a string of length size-n, which must be 2, 4, or 8.
If
X signed? is true, then the number is encoded with two's
complement,
X otherwise it is encoded as an unsigned bit stream. If
big-endian?
X is true, then the most significant eight bits of the number are
X encoded in the first character of the resulting string,
otherwise
X the least-significant bits are encoded in the first character,
and
X so on. to-string must be a mutable string of length size-n, the
X encoding of n is written into to-string, and to-string is
returned
X as the result. If n cannot be encoded in a string of the
requested
X size and format, an error is raised. If to-string is not of
length
X size-n, an error is raised.
X
X (floating-point-byte-string->real string big-endian?) converts
the
X IEEE floating-point number encoded in string to an inexact real
X number. The string must contain either 4 or 8 characters. If
X big-endian? is true, then the first character's ASCII value
X provides the most siginficant eight bits of the IEEE
X representation, otherwise the first character provides the
X least-significant eight bits, and so on.
X
X (real->floating-point-byte-string x size-n big-endian?
to-string)
X converts the real number x to its IEEE reprsentation in a string
of
X length size-n, which must be 4 or 8. If big-endian? is true,
then
X the most significant eight bits of the number are encoded in the
X first character of the resulting string, otherwise the
X least-significant bits are encoded in the first character, and
so
X on. to-string must be a mutable string of length size-n, the
X encoding of n is written into to-string, and to-string is
returned
X as the result. If to-string is not of length size-n, an error
is
X raised.
X
*/
X
#include "config.h"
#include <string.h>
#include <libguile.h>
X
/* It appears that all strings in Guile are mutable? */
X
#define SCM_STRING_MUTABLE_P(s) 1
X
/* WORDS_BIGENDIAN in config.h is only defined if true, we need a
X value that is also defined if false. */
X
#ifdef WORDS_BIGENDIAN
#define NUMBERBYTESTRING_BIGENDIAN 1
#else
#define NUMBERBYTESTRING_BIGENDIAN 0
#endif
X
/* If stdint.h is missing or there is no long long type, the module
X init procedure does not export any procedures and instead raises
an
X error. */
X
#if (HAVE_STDINT_H && HAVE_LONG_LONGS)
X
static SCM
bytes_to_integer (SCM a_string, SCM a_signed, SCM a_bigend)
{
X int slen, sgned;
X char *str;
X int buf[2], i;
X int bigend = NUMBERBYTESTRING_BIGENDIAN;
X
X slen = !SCM_STRINGP (a_string) ? 0 : SCM_STRING_LENGTH
(a_string);
X
X if ((slen != 2) && (slen != 4) && (slen != 8)) {
X scm_wrong_type_arg_msg ("integer-byte-string->integer", 0,
a_string,
X "string must be 2, 4 or 8 bytes");
X }
X
X str = SCM_STRING_CHARS (a_string);
X
X sgned = SCM_NFALSEP (a_signed);
X
X bigend = SCM_NFALSEP (a_bigend);
X
X if (bigend != NUMBERBYTESTRING_BIGENDIAN) {
X for (i = 0; i < slen; i++) {
X ((char *) buf)[slen - i - 1] = str[i];
X }
X str = (char *) buf;
X }
X
X switch (slen) {
X case 2:
X if (sgned) {
X return SCM_MAKINUM (((int16_t *) str)[0]);
X } else {
X return SCM_MAKINUM (((uint16_t *) str)[0]);
X }
X break;
X case 4:
X if (sgned) {
X return scm_long2num (((int32_t *) str)[0]);
X } else {
X return scm_ulong2num (((uint32_t *) str)[0]);
X }
X break;
X default:
X if (sgned) {
X return scm_long_long2num (((int64_t *) str)[0]);
X } else {
X return scm_ulong_long2num (((uint64_t *) str)[0]);
X }
X break;
X }
}
X
static SCM
integer_to_bytes (SCM n, SCM a_size, SCM a_signed, SCM a_bigend, SCM
s)
{
X char *str;
X int size, sgned;
X int64_t val = 0;
X int bigend = NUMBERBYTESTRING_BIGENDIAN, bad;
X
X if (!SCM_INUMP (n) && !SCM_BIGP (n)) {
X scm_wrong_type_arg_msg ("integer->integer-byte-string", 0, n,
X "input must be a number");
X }
X
X size = SCM_INUMP (a_size) ? SCM_INUM (a_size) : 0;
X
X if ((size != 2) && (size != 4) && (size != 8)) {
X scm_wrong_type_arg_msg ("integer->integer-byte-string", 1,
a_size,
X "size must be 2, 4 or 8");
X }
X
X sgned = SCM_NFALSEP (a_signed);
X
X bigend = SCM_NFALSEP (a_bigend);
X
X if (!SCM_STRINGP (s) || !SCM_STRING_MUTABLE_P (s)) {
X scm_wrong_type_arg_msg ("integer->integer-byte-string", 4, s,
X "string must be a mutable string");
X }
X
X /* Check for mismatch: number doesn't fit */
X
X if (size == 2) {
X if (SCM_BIGP (n)) {
X bad = 1;
X } else {
X val = SCM_INUM (n);
X if (sgned) {
X bad = ((val < -32768) || (val > 32767));
X } else {
X bad = ((val < 0) || (val > 65535));
X }
X }
X } else if (size == 4) {
X if (sgned) {
X val = scm_num2long_long (n, 0,
"integer->integer-byte-string");
X bad = 0;
X } else {
X (uint64_t) val =
X scm_num2ulong_long (n, 0, "integer->integer-byte-string");
X bad = 0;
X }
X if (!bad) {
X if (sgned)
X bad = ((val > (int64_t) 0x7fffffff)
X || (val < -(int64_t) 0x80000000));
X else
X bad = (val > (int64_t) 0xffffffff);
X }
X } else {
X if (sgned) {
X val = scm_num2long_long (n, 0,
"integer->integer-byte-string");
X bad = 0;
X } else {
X (uint64_t) val =
X scm_num2ulong_long (n, 0, "integer->integer-byte-string");
X bad = 0;
X }
X }
X
X if (bad) {
X scm_wrong_type_arg_msg ("integer->integer-byte-string", 0, n,
X "input value out of range for destination string");
X return SCM_UNSPECIFIED;
X }
X
X /* Check for mismatch: string wrong size */
X
X if (size != SCM_STRING_LENGTH (s)) {
X scm_wrong_type_arg_msg ("integer->integer-byte-string",
X 4, s,
X "string size does not match indicated byte length");
X return SCM_UNSPECIFIED;
X }
X
X /* Finally, do the work */
X
X str = SCM_STRING_CHARS (s);
X
X switch (size) {
X case 2:
X {
X if (sgned) {
X uint16_t sv = val;
X *(uint16_t *) str = sv;
X } else {
X int16_t sv = val;
X *(int16_t *) str = sv;
X }
X }
X break;
X case 4:
X if (sgned) {
X uint32_t sv = val;
X *(uint32_t *) str = sv;
X } else {
X int32_t sv = val;
X *(int32_t *) str = sv;
X }
X break;
X default:
X *(int64_t *) str = val;
X break;
X }
X
X if (bigend != NUMBERBYTESTRING_BIGENDIAN) {
X int i;
X char buf[8];
X
X for (i = 0; i < size; i++) {
X buf[size - i - 1] = str[i];
X }
X for (i = 0; i < size; i++) {
X str[i] = buf[i];
X }
X }
X
X return s;
}
X
static SCM
bytes_to_real (SCM a_string, SCM a_bigend)
{
X int slen;
X char *str, buf[8];
X int bigend = NUMBERBYTESTRING_BIGENDIAN;
X
X slen = !SCM_STRINGP (a_string) ? 0 : SCM_STRING_LENGTH
(a_string);
X
X if ((slen != 4) && (slen != 8)) {
X scm_wrong_type_arg_msg ("floating-point-byte-string->real", 0,
X a_string, "string must be 4 or 8 bytes");
X }
X
X str = SCM_STRING_CHARS (a_string);
X
X bigend = SCM_NFALSEP (a_bigend);
X
X if (bigend != NUMBERBYTESTRING_BIGENDIAN) {
X int i;
X for (i = 0; i < slen; i++) {
X buf[slen - i - 1] = str[i];
X }
X str = (char *) buf;
X }
X
X switch (slen) {
X case 4:
X {
X float f;
X f = *(float *) str;
X return scm_make_real (f);
X }
X break;
X default:
X {
X double d;
X /* Don't use `double' cast, due to possible alignment
problems... */
X memcpy (&d, str, sizeof (double));
X return scm_make_real (d);
X }
X break;
X }
}
X
static SCM
real_to_bytes (SCM n, SCM a_size, SCM a_bigend, SCM s)
{
X int size;
X int bigend = NUMBERBYTESTRING_BIGENDIAN;
X double d;
X
X if (!SCM_REALP (n)) {
X scm_wrong_type_arg_msg ("real->floating-point-byte-string", 0,
n,
X "input must be a real number");
X }
X
X size = SCM_INUMP (a_size) ? SCM_INUM (a_size) : 0;
X
X if ((size != 2) && (size != 4) && (size != 8)) {
X scm_wrong_type_arg_msg ("real->floating-point-byte-string", 1,
a_size,
X "size must be 2, 4 or 8 bytes");
X }
X
X bigend = SCM_NFALSEP (a_bigend);
X
X if (!SCM_STRINGP (s) || !SCM_STRING_MUTABLE_P (s)) {
X scm_wrong_type_arg_msg ("real->floating-point-byte-string", 4,
s,
X "string must be a mutable string");
X }
X
X if (size != SCM_STRING_LENGTH (s)) {
X scm_wrong_type_arg_msg ("real->floating-point-byte-string",
X 4, s,
X "string size does not match indicated byte length");
X return SCM_UNSPECIFIED;
X }
X
X d = scm_num2dbl (n, "real->floating-point-byte-string");
X
X if (size == 4) {
X *(float *) (SCM_STRING_CHARS (s)) = d;
X } else {
X /* Don't use `double' cast, due to alignment concerns... */
X memcpy (SCM_STRING_CHARS (s), &d, sizeof (double));
X }
X
X if (bigend != NUMBERBYTESTRING_BIGENDIAN) {
X int i;
X char buf[8], *str;
X
X str = SCM_STRING_CHARS (s);
X
X for (i = 0; i < size; i++) {
X buf[size - i - 1] = str[i];
X }
X for (i = 0; i < size; i++) {
X str[i] = buf[i];
X }
X }
X
X return s;
}
X
void
numberbytestring_init ()
{
X scm_c_define_gsubr ("integer-byte-string->integer", 3, 0, 0,
X bytes_to_integer);
X scm_c_define_gsubr ("integer->integer-byte-string", 5, 0, 0,
X integer_to_bytes);
X scm_c_define_gsubr ("floating-point-byte-string->real", 2, 0, 0,
X bytes_to_real);
X scm_c_define_gsubr ("real->floating-point-byte-string", 4, 0, 0,
X real_to_bytes);
}
X
#else
X
void
numberbytestring_init ()
{
X scm_misc_error ("numberbytestring module",
X "Host lacks support for either stdint.h or 64bit integers",
X SCM_BOOL_F);
}
X
#endif /* (HAVE_STDINT_H && HAVE_LONG_LONG) */
X
/*
X
The following is a table relating the original mzscheme names to the
respective Guile names for types, macros and procedures.
X
========================================================================
Mzscheme Name Guile Name
========================================================================
Scheme_Object SCM
scheme_wrong_type scm_wrong_type_arg_msg
SCHEME_TRUEP SCM_NFALSEP
SCHEME_INTP SCM_INUMP
SCHEME_BIGNUMP SCM_BIGP
SCHEME_INT_VAL SCM_INUM
scheme_make_integer SCM_MAKINUM
scheme_make_integer_value scm_long_long2num
scheme_make_integer_value_from_unsigned scm_ulong_long2num
scheme_get_int_val scm_num2long_long
scheme_get_unsigned_int_val scm_num2ulong_long
SCHEME_MUTABLE_STRINGP
SCHEME_STRINGP SCM_STRINGP
SCHEME_STRLEN_VAL SCM_STRING_LENGTH
SCHEME_STR_VAL SCM_STRING_CHARS
SCHEME_REALP SCM_REALP
scheme_make_real scm_make_real
scheme_get_val_as_double scm_num2dbl
========================================================================
X
*/
SHAR_EOF
(set 20 03 02 06 18 51 10 'numberbytestring.c'; eval
"$shar_touch") &&
chmod 0664 'numberbytestring.c' ||
$echo 'restore of' 'numberbytestring.c' 'failed'
if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1
\
&& ( md5sum --version 2>&1 | grep -v 'textutils 1.12' )
>/dev/null; then
md5sum -c << SHAR_EOF >/dev/null 2>&1 \
|| $echo 'numberbytestring.c:' 'MD5 check failed'
92444aef3413438bffd5fc51fcf63007 numberbytestring.c
SHAR_EOF
else
shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c <
'numberbytestring.c'`"
test 13096 -eq "$shar_count" ||
$echo 'numberbytestring.c:' 'original size' '13096,' 'current
size' "$shar_count!"
fi
fi
# ============= numberbytestring.scm ==============
if test -f 'numberbytestring.scm' && test "$first_param" != -c; then
$echo 'x -' SKIPPING 'numberbytestring.scm' '(file already
exists)'
else
$echo 'x -' extracting 'numberbytestring.scm' '(text)'
sed 's/^X//' << 'SHAR_EOF' > 'numberbytestring.scm' &&
;; numberbytestring.scm
;; Copyright (c) 2003 Rohan Drape. This file is released under the
GPL.
X
(define-module (numberbytestring)
X :export (integer-byte-string->integer
X integer->integer-byte-string
X floating-point-byte-string->real
X real->floating-point-byte-string
X integer-byte-string->integer:opt
X integer->integer-byte-string:opt
X floating-point-byte-string->real:opt
X real->floating-point-byte-string:opt))
X
(load-extension "libguile-numberbytestring" "numberbytestring_init")
X
(define (integer-byte-string->integer:opt string signed? .
bigendian?)
X (integer-byte-string->integer string
X signed?
X (if (null? bigendian?) #t bigendian?)))
X
(define (integer->integer-byte-string:opt n size-n signed? .
big-endian?+to-string)
X (integer->integer-byte-string n
X size-n
X signed?
X (if (null? big-endian?+to-string)
X #t
X (car big-endian?+to-string))
X (if (or (null? big-endian?+to-string)
X (null? (cdr big-endian?+to-string)))
X (make-string size-n)
X (cadr big-endian?+to-string))))
X
(define (floating-point-byte-string->real:opt string . bigendian?)
X (floating-point-byte-string->real string (if (null? bigendian?)
#t bigendian?)))
X
(define (real->floating-point-byte-string:opt x size-n .
big-endian?+to-string)
X (real->floating-point-byte-string x
X size-n
X (if (null? big-endian?+to-string)
X #t
X (car big-endian?+to-string))
X (if (or (null? big-endian?+to-string)
X (null? (cdr big-endian?+to-string)))
X (make-string size-n)
X (cadr big-endian?+to-string))))
SHAR_EOF
(set 20 03 02 06 18 47 23 'numberbytestring.scm'; eval
"$shar_touch") &&
chmod 0664 'numberbytestring.scm' ||
$echo 'restore of' 'numberbytestring.scm' 'failed'
if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1
\
&& ( md5sum --version 2>&1 | grep -v 'textutils 1.12' )
>/dev/null; then
md5sum -c << SHAR_EOF >/dev/null 2>&1 \
|| $echo 'numberbytestring.scm:' 'MD5 check failed'
eb8c1a47bef74ee67e15d91221df0936 numberbytestring.scm
SHAR_EOF
else
shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c <
'numberbytestring.scm'`"
test 1585 -eq "$shar_count" ||
$echo 'numberbytestring.scm:' 'original size' '1585,' 'current
size' "$shar_count!"
fi
fi
# ============= numberbytestring.test ==============
if test -f 'numberbytestring.test' && test "$first_param" != -c;
then
$echo 'x -' SKIPPING 'numberbytestring.test' '(file already
exists)'
else
$echo 'x -' extracting 'numberbytestring.test' '(text)'
sed 's/^X//' << 'SHAR_EOF' > 'numberbytestring.test' &&
;; numberbytestring.test -*- scheme
-*-
;; Copyright (c) 2003 Rohan Drape. This file is released under the
GPL.
X
; (load "/usr/local/src/guile-1.6.3/test-suite/lib.scm")
(use-modules (test-suite lib))
X
; (load "/home/rohan/src/numberbytestring/numberbytestring.scm")
(use-modules (numberbytestring))
X
(define (run-pass-if-tests name-proc test-proc arg-sets)
X (for-each
X (lambda (arg-set)
X (pass-if (apply name-proc arg-set)
X (apply test-proc arg-set)))
X arg-sets))
X
(with-test-prefix
X "number-bytestring"
X
X ;; byte string to integer
X (run-pass-if-tests
X (lambda (bytes signed bigendian result)
X (format #f
X "byte string to integer: BYTES=~s SIGNED=~s BIGENDIAN=~s"
X (length bytes) signed bigendian))
X (lambda (bytes signed bigendian result)
X (= (integer-byte-string->integer (list->string (map
integer->char bytes))
X signed
X bigendian)
X result))
X (list
X (list (list 0 0 0 5) #t #t 5)
X (list (list 255 0 0 5) #t #t -16777211)
X (list (list 0 0 0 5) #f #t 5)
X (list (list 255 0 0 5) #f #t 4278190085)
X (list (list 5 0 0 0) #t #f 5)
X (list (list 5 0 0 255) #t #f -16777211)
X (list (list 5 0 0 0) #f #f 5)
X (list (list 5 0 0 255) #f #f 4278190085)
X (list (list 0 0 0 0 0 0 0 5) #t #t 5)
X (list (list 255 0 0 0 0 0 0 5) #t #t -72057594037927931)
X (list (list 0 0 0 0 0 0 0 5) #f #t 5)
X (list (list 255 0 0 0 0 0 0 5) #f #t 18374686479671623685)
X (list (list 5 0 0 0 0 0 0 0) #t #f 5)
X (list (list 5 0 0 0 0 0 0 255) #t #f -72057594037927931)
X (list (list 5 0 0 0 0 0 0 0) #f #f 5)
X (list (list 0 0 0 0 0 0 0 255) #f #f 18374686479671623680)))
X
X ;; integer to byte string
X (run-pass-if-tests
X (lambda (n size signed bigendian result)
X (format #f
X "integer to byte string: SIZE=~s SIGNED=~s BIGENDIAN=~s"
X size signed bigendian))
X (lambda (n size signed bigendian result)
X (equal? (map char->integer
X (string->list
X (integer->integer-byte-string n
X size
X signed
X bigendian
X (make-string size))))
X result))
X (list
X (list 5 4 #t #t (list 0 0 0 5))
X (list -16777211 4 #t #t (list 255 0 0 5))
X (list 5 4 #f #t (list 0 0 0 5))
X (list (- (expt 2 32) 1) 4 #f #t (list 255 255 255 255))
X (list 5 4 #t #f (list 5 0 0 0))
X (list -16777211 4 #t #f (list 5 0 0 255))
X (list 5 4 #f #f (list 5 0 0 0))
X (list (- (expt 2 32) 1) 4 #f #f (list 255 255 255 255))
X (list 5 8 #t #t (list 0 0 0 0 0 0 0 5))
X (list -72057594037927931 8 #t #t (list 255 0 0 0 0 0 0 5))
X (list 5 8 #f #t (list 0 0 0 0 0 0 0 5))
X (list (- (expt 2 64) 1) 8 #f #t (list 255 255 255 255 255 255
255 255))
X (list 5 8 #t #f (list 5 0 0 0 0 0 0 0))
X (list -72057594037927931 8 #t #f (list 5 0 0 0 0 0 0 255))
X (list 5 8 #f #f (list 5 0 0 0 0 0 0 0))
X (list (- (expt 2 64) 1) 8 #f #f (list 255 255 255 255 255 255
255 255))))
X
X ;; byte string real
X (run-pass-if-tests
X (lambda (bytes bigendian result)
X (format #f
X "byte string real: BYTES=~s BIGENDIAN=~s"
X (length bytes) bigendian))
X (lambda (bytes bigendian result)
X (= (floating-point-byte-string->real (list->string (map
integer->char bytes))
X bigendian)
X result))
X (list
X (list (list 64 214 102 32) #t 6.6999664306640625)
X (list (list 32 102 214 64) #f 6.6999664306640625)
X (list (list 64 214 102 32 16 98 72 128) #t 22936.50099999504)
X (list (list 128 72 98 16 32 102 214 64) #f 22936.50099999504)))
X
X ;; real to byte string
X (run-pass-if-tests
X (lambda (n size bigendian result)
X (format #f
X "real to byte string: SIZE=~s BIGENDIAN=~s"
X size bigendian))
X (lambda (n size bigendian result)
X (equal? (map char->integer
X (string->list
X (real->floating-point-byte-string n
X size
X bigendian
X (make-string size))))
X result))
X (list
X (list 6.6999664306640625 4 #t (list 64 214 102 32))
X (list 6.6999664306640625 4 #f (list 32 102 214 64))
X (list 22936.50099999504 8 #t (list 64 214 102 32 16 98 72 128))
X (list 22936.50099999504 8 #f (list 128 72 98 16 32 102 214
64))))
X
X ;; exception:wrong-num-args
X (pass-if-exception "integer->integer-byte-string"
X exception:wrong-num-args
X (integer->integer-byte-string 5 2 #t #t))
X (pass-if-exception "integer->integer-byte-string"
X exception:wrong-num-args
X (integer->integer-byte-string 5 2 #t #t (make-string 2)
'extra))
X (pass-if-exception "real->floating-point-byte-string"
X exception:wrong-num-args
X (real->floating-point-byte-string 5 4 #t))
X (pass-if-exception "real->floating-point-byte-string"
X exception:wrong-num-args
X (real->floating-point-byte-string 5 4 #t (make-string 4)
'extra))
X (pass-if-exception "integer-byte-string->integer"
X exception:wrong-num-args
X (integer-byte-string->integer "1234" #t))
X (pass-if-exception "integer-byte-string->integer"
X exception:wrong-num-args
X (integer-byte-string->integer "1234" #t #t 'extra))
X (pass-if-exception "floating-point-byte-string->real"
X exception:wrong-num-args
X (floating-point-byte-string->real "1234"))
X (pass-if-exception "floating-point-byte-string->real"
X exception:wrong-num-args
X (floating-point-byte-string->real "1234" #t 'extra))
X
X ;; wrong-type-arg: invalid string argument
X (pass-if-exception "integer->integer-byte-string"
X exception:wrong-type-arg
X (integer->integer-byte-string 5 2 #t #t 0))
X (pass-if-exception "real->floating-point-byte-string"
X exception:wrong-type-arg
X (real->floating-point-byte-string 5.0 2 #t 0))
X
X ;; wrong-type-arg: wrong string-length/byte-count
X (pass-if-exception "integer->integer-byte-string"
X exception:wrong-type-arg
X (integer->integer-byte-string 5 1 #t #t (make-string 2)))
X (pass-if-exception "integer->integer-byte-string"
X exception:wrong-type-arg
X (integer->integer-byte-string 5 2 #t #t (make-string 4)))
X (pass-if-exception "real->floating-point-byte-string"
X exception:wrong-type-arg
X (real->floating-point-byte-string 0.1 6 #t (make-string 4)))
X (pass-if-exception "real->floating-point-byte-string"
X exception:wrong-type-arg
X (real->floating-point-byte-string 0.1 8 #t (make-string 4)))
X
X ;; optioned versions
X (pass-if
X "real->floating-point-byte-string:opt"
X (and
X (equal?
X (real->floating-point-byte-string:opt 6.6999664306640625 4)
X (real->floating-point-byte-string 6.6999664306640625 4 #t
(make-string 4)))
X (equal?
X (real->floating-point-byte-string:opt 6.6999664306640625 4 #t)
X (real->floating-point-byte-string 6.6999664306640625 4 #t
(make-string 4)))
X (equal?
X (real->floating-point-byte-string:opt 6.6999664306640625 4 #t
(make-string 4))
X (real->floating-point-byte-string 6.6999664306640625 4 #t
(make-string 4)))))
X (pass-if
X "floating-point-byte-string->real:opt"
X (and
X (equal?
X (floating-point-byte-string->real:opt "1234")
X (floating-point-byte-string->real "1234" #t))
X (equal?
X (floating-point-byte-string->real:opt "1234" #t)
X (floating-point-byte-string->real "1234" #t))))
X (pass-if
X "integer->integer-byte-string:opt"
X (and
X (equal?
X (integer->integer-byte-string:opt 12345 4 #t)
X (integer->integer-byte-string 12345 4 #t #t (make-string 4)))
X (equal?
X (integer->integer-byte-string:opt 12345 4 #t)
X (integer->integer-byte-string 12345 4 #t #t (make-string 4)))
X (equal?
X (integer->integer-byte-string:opt 12345 4 #t (make-string 4))
X (integer->integer-byte-string 12345 4 #t #t (make-string 4)))))
X (pass-if
X "integer-byte-string->integer:opt"
X (and
X (equal?
X (integer-byte-string->integer:opt "1234" #t)
X (integer-byte-string->integer "1234" #t #t))
X (equal?
X (integer-byte-string->integer:opt "1234" #t #t)
X (integer-byte-string->integer "1234" #t #t)))))
SHAR_EOF
(set 20 03 02 06 18 47 39 'numberbytestring.test'; eval
"$shar_touch") &&
chmod 0664 'numberbytestring.test' ||
$echo 'restore of' 'numberbytestring.test' 'failed'
if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1
\
&& ( md5sum --version 2>&1 | grep -v 'textutils 1.12' )
>/dev/null; then
md5sum -c << SHAR_EOF >/dev/null 2>&1 \
|| $echo 'numberbytestring.test:' 'MD5 check failed'
f1a7130f4bdc61d18bfdc013ae6d07d3 numberbytestring.test
SHAR_EOF
else
shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c <
'numberbytestring.test'`"
test 7816 -eq "$shar_count" ||
$echo 'numberbytestring.test:' 'original size' '7816,' 'current
size' "$shar_count!"
fi
fi
# ============= config.h ==============
if test -f 'config.h' && test "$first_param" != -c; then
$echo 'x -' SKIPPING 'config.h' '(file already exists)'
else
$echo 'x -' extracting 'config.h' '(text)'
sed 's/^X//' << 'SHAR_EOF' > 'config.h' &&
X
/* Relevant parts of a config.h file. */
X
/* Define to 1 if your processor stores words with the most
significant byte
X first (like Motorola and SPARC, unlike Intel and VAX). */
/*#define WORDS_BIGENDIAN 1*/
X
/* Define if the compiler supports long longs. */
#define HAVE_LONG_LONGS 1
X
/* Define to 1 if you have the <stdint.h> header file. */
#define HAVE_STDINT_H 1
X
SHAR_EOF
(set 20 03 02 06 18 21 39 'config.h'; eval "$shar_touch") &&
chmod 0664 'config.h' ||
$echo 'restore of' 'config.h' 'failed'
if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1
\
&& ( md5sum --version 2>&1 | grep -v 'textutils 1.12' )
>/dev/null; then
md5sum -c << SHAR_EOF >/dev/null 2>&1 \
|| $echo 'config.h:' 'MD5 check failed'
2442b9b5dcd66702d01358a83ccdd3f3 config.h
SHAR_EOF
else
shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'config.h'`"
test 372 -eq "$shar_count" ||
$echo 'config.h:' 'original size' '372,' 'current size'
"$shar_count!"
fi
fi
rm -fr _sh01342
exit 0
_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-devel
^ permalink raw reply [flat|nested] 2+ messages in thread
* Re: binary representation of numbers
2003-02-06 8:29 binary representation of numbers Rohan Drape
@ 2003-03-07 15:13 ` Marius Vollmer
0 siblings, 0 replies; 2+ messages in thread
From: Marius Vollmer @ 2003-03-07 15:13 UTC (permalink / raw)
Cc: guile-devel
Rohan Drape <rd@alphalink.com.au> writes:
> I hope this submission is considered useful,
It is! Thanks!
However, the shar file seems to be broken, at least on my end. (Some
lines are wrapped, appearantly, and I don't want to fix them all...)
Could you send the files again or put them up for http or ftp?
Thanks!
The biggest obstacle on the way of including your code into Guile is
the legal paper work. Since your code seems to derivative of
MzScheme, there might be some problems getting it into the core of
Guile without having the original authors sign some forms. In any
case, we help you distribute your code as a add-on module for Guile.
--
GPG: D5D4E405 - 2F9B BCCC 8527 692A 04E3 331E FAF8 226A D5D4 E405
_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-devel
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2003-03-07 15:13 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2003-02-06 8:29 binary representation of numbers Rohan Drape
2003-03-07 15:13 ` Marius Vollmer
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).