[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Doc organization (Re: Around again, and docs lead role)
From: |
Thien-Thi Nguyen |
Subject: |
Re: Doc organization (Re: Around again, and docs lead role) |
Date: |
Tue, 28 Oct 2003 17:09:29 +0100 |
From: address@hidden
Date: Thu, 8 May 2003 19:50:58 +0200
Right now i'm looking for _the_ Guile way of converting a SCM real
number to a C IEEE float (any help?).
below is one way (floating point stuff near the end).
see autoconf info pages for WORDS_BIGENDIAN.
improvements welcome (see "TODO").
thi
[cc trimmed]
__________________________________________________
/* binconv.c */
/* Copyright (C) 2003 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */
#include <stdio.h>
#include <string.h>
#include "libguile/_scm.h"
#include "libguile/validate.h"
#include "libguile/numbers.h"
#include "libguile/strings.h"
#include "libguile/modsup.h"
/* Forward declarations on this page. */
static void correct_strncpy (int cbep, unsigned char *dest,
unsigned char *source, size_t n);
static SCM system_big_endian_p (void);
extern void scm_init_database_binconv_module (void);
/* Support macros. */
#ifdef WORDS_BIGENDIAN
#define BEP SCM_BOOL_T
#define CBEP 1
#else
#define BEP SCM_BOOL_F
#define CBEP 0
#endif
#define SET_CBEP_MAYBE(cvar,scmvar) \
cvar = SCM_UNBNDP (scmvar) ? CBEP : SCM_NFALSEP (scmvar)
/* Support funcs. */
static
void
correct_strncpy (int cbep,
unsigned char *dest, unsigned char *source,
size_t n)
{
if (cbep == CBEP)
strncpy (dest, source, n);
else
{
int i;
unsigned char *p = source + n - 1;
for (i = 0; i < n; i++)
*dest++ = *p--;
}
}
/* TODO:
- Replace (ash 1 {16,32,64}) w/ small-table lookup.
- Reduce scm_* usage; manipulate actual number representation. */
MDEFLOCEXP (system_big_endian_p, "system-big-endian?", 0, 0, 0, (),
"Return @code{#t} if the native encoding of numbers is\n"
"big-endian for the machine running Guile, @code{#f} if\n"
"the native encoding is little-endian.")
#define FUNC_NAME s_system_big_endian_p
{
return BEP;
}
#undef FUNC_NAME
MDEFLOCEXP (ibs2integer, "integer-byte-string->integer", 2, 1, 0,
(SCM s, SCM signed_p, SCM big_endian_p),
"Convert the machine-format number encoded in string @var{s}\n"
"to an exact integer. The string must contain either 2, 4, or\n"
"8 characters. If @var{signed?} is true, then the string is\n"
"decoded as a two's-complement number, otherwise it is decoded\n"
"as an unsigned integer. If @var{big-endian?} is true, then\n"
"the first character's ASCII value provides the most significant\n"
"eight bits of the number, otherwise the first character provides\n"
"the least-significant eight bits, and so on. The default value\n"
"of big-endian? is the result of @code{system-big-endian?}.")
#define FUNC_NAME s_ibs2integer
{
int len, i, cbep;
SCM ans, tem;
unsigned char *p;
SCM_VALIDATE_ROSTRING (1, s);
SET_CBEP_MAYBE (cbep, big_endian_p);
len = SCM_ROLENGTH (s);
if (! (2 == len || 4 == len || 8 == len))
scm_misc_error (FUNC_NAME, "string length not 2, 4 or 8: ~S",
scm_listify (s, SCM_UNDEFINED));
ans = SCM_INUM0;
p = SCM_CHARS (s);
if (! cbep) /* little endian */
for (i = 0; i < len; i += 2)
{
tem = scm_ash (SCM_MAKINUM (((unsigned int) p[i]) +
((unsigned int) p[1+i] << 8)),
SCM_MAKINUM (i * 8));
ans = scm_sum (ans, tem);
}
else /* big endian */
for (i = 0; i < len; i += 2)
{
tem = scm_ash (SCM_MAKINUM (((unsigned int) p[1+i]) +
((unsigned int) p[i] << 8)),
SCM_MAKINUM ((len - i - 2) * 8));
ans = scm_sum (ans, tem);
}
if (SCM_NFALSEP (signed_p))
{
int opg = 8 * len; /* "one position greater" than msb */
if (SCM_NFALSEP (scm_logbit_p (SCM_MAKINUM (opg - 1), ans)))
{
/* For 4-bit signed, 0xF <=> -1 <=> (- 0xF 0x10). */
tem = scm_ash (SCM_MAKINUM (1), SCM_MAKINUM (opg));
ans = scm_difference (ans, tem);
}
}
return ans;
}
#undef FUNC_NAME
MDEFLOCEXP (integer2ibs, "integer->integer-byte-string", 3, 2, 0,
(SCM n, SCM size, SCM signed_p, SCM big_endian_p, SCM dest),
"Convert the exact integer @var{n} to a machine-format number\n"
"encoded in a string of length @var{size}, which must be 2, 4,\n"
"or 8. If @var{signed?} is true, then the number is encoded with\n"
"two's complement, otherwise it is encoded as an unsigned bit\n"
"stream. If @var{big-endian?} is true, then the most significant\n"
"eight bits of the number are encoded in the first character of\n"
"the resulting string, otherwise the least-significant bits are\n"
"encoded in the first character, and so on. The default value of\n"
"@var{big-endian?} is the result of @code{system-big-endian?}.\n\n"
"If @var{dest} is provided, it must be a mutable string of\n"
"length @var{size}; in that case, the encoding of @var{n} is\n"
"written into @var{dest}, and @var{dest} is returned as the\n"
"result. If @var{dest} is not provided, the result is a newly\n"
"allocated string. If @var{n} cannot be encoded in a string of\n"
"the requested size and format, an error is thrown. If
@var{dest}\n"
"is provided and it is not of length @var{size}, an error is\n"
"thrown.")
#define FUNC_NAME s_integer2ibs
{
int len, i, cbep, cs, cnegp;
SCM tem;
unsigned char *p;
cs = SCM_NFALSEP (signed_p);
cnegp = SCM_NFALSEP (scm_negative_p (n));
if (cnegp && ! cs)
scm_misc_error (FUNC_NAME,
"cannot encode negative number unsigned: ~S",
scm_listify (n, SCM_UNDEFINED));
SET_CBEP_MAYBE (cbep, big_endian_p);
if (SCM_UNBNDP (dest))
dest = scm_make_string (size, SCM_UNDEFINED);
SCM_VALIDATE_RWSTRING (5, dest);
len = SCM_ROLENGTH (dest);
if (! (2 == len || 4 == len || 8 == len))
scm_misc_error (FUNC_NAME, "string length not 2, 4 or 8: ~S",
scm_listify (dest, SCM_UNDEFINED));
if (SCM_INUM (size) > SCM_ROLENGTH (dest))
scm_misc_error (FUNC_NAME, "size and dest mismatch: ~S",
scm_listify (dest, SCM_UNDEFINED));
if (cnegp)
{
/* For 4-bit signed, -1 <=> 0xF <=> (+ 0x10 -1). */
tem = scm_ash (SCM_MAKINUM (1), SCM_MAKINUM (8 * len));
tem = scm_sum (tem, n);
}
else
tem = n;
/* Endian-specific (start and direction) fill. */
for (i = 0, p = SCM_CHARS (dest) + (cbep ? len - 1 : 0);
i < len;
i++, p += (cbep ? -1 : 1))
{
*p = (unsigned char) SCM_INUM (scm_logand (tem, SCM_MAKINUM (0xff)));
tem = scm_ash (tem, SCM_MAKINUM (-8));
}
if (SCM_FALSEP (scm_num_eq_p (tem, SCM_INUM0)))
scm_misc_error (FUNC_NAME, "number too big for ~S-byte string: ~S",
scm_listify (size, n, SCM_UNDEFINED));
return dest;
}
#undef FUNC_NAME
MDEFLOCEXP (fpbs2real, "floating-point-byte-string->real", 1, 1, 0,
(SCM s, SCM big_endian_p),
"Convert the IEEE floating-point number encoded in string\n"
"@var{s} to an inexact real number. The string must contain\n"
"either 4 or 8 characters. If @var{big-endian?} is true,\n"
"then the first character's ASCII value provides the most\n"
"siginficant eight bits of the IEEE representation,\n"
"otherwise the first character provides the\n"
"least-significant eight bits, and so on. The default value\n"
"of @var{big-endian?} is the result of @code{system-big-endian?}.")
#define FUNC_NAME s_fpbs2real
{
int len, cbep;
double d;
float f;
SCM_VALIDATE_ROSTRING (1, s);
SET_CBEP_MAYBE (cbep, big_endian_p);
len = SCM_ROLENGTH (s);
if (! (4 == len || 8 == len))
scm_misc_error (FUNC_NAME, "string length not 4 or 8: ~S",
scm_listify (s, SCM_UNDEFINED));
correct_strncpy (cbep, ((4 == len)
? (unsigned char *)(&f)
: (unsigned char *)(&d)),
SCM_CHARS (s),
len);
return scm_make_real ((4 == len) ? ((double) f) : d);
}
#undef FUNC_NAME
MDEFLOCEXP (real2fpbs, "real->floating-point-byte-string", 2, 2, 0,
(SCM x, SCM size, SCM big_endian_p, SCM dest),
"Convert the real number @var{x} to its IEEE representation in a\n"
"string of length @var{size}, which must be 4 or 8. If\n"
"@var{big-endian?} is true, then the most significant eight\n"
"bits of the number are encoded in the first character of the\n"
"resulting string, otherwise the least-significant bits are\n"
"encoded in the first character, and so on. The default value\n"
"of @var{big-endian?} is the result of @code{system-big-endian?}.\n"
"If @var{dest} is provided, it must be a mutable string of\n"
"length @var{size}; in that case, the encoding of @var{x} is
written\n"
"into @var{dest}, and @var{dest} is returned as the result. If\n"
"@var{dest} is not provided, the result is a newly allocated\n"
"string. If @var{dest} is provided and it is not of length\n"
"@var{size}, an error is thrown.")
#define FUNC_NAME s_real2fpbs
{
int len, cbep;
double cdx;
float cfx;
if (SCM_REALP (x))
cdx = SCM_REAL_VALUE (x);
else
scm_misc_error (FUNC_NAME, "not a real number: ~S",
scm_listify (x, SCM_UNDEFINED));
SET_CBEP_MAYBE (cbep, big_endian_p);
if (SCM_UNBNDP (dest))
dest = scm_make_string (size, SCM_UNDEFINED);
SCM_VALIDATE_RWSTRING (4, dest);
len = SCM_ROLENGTH (dest);
if (! (4 == len || 8 == len))
scm_misc_error (FUNC_NAME, "string length not 4 or 8: ~S",
scm_listify (dest, SCM_UNDEFINED));
if (4 == len)
cfx = (float) cdx;
correct_strncpy (cbep, SCM_CHARS (dest),
((4 == len)
? (unsigned char *)(&cfx)
: (unsigned char *)(&cdx)),
len);
return dest;
}
#undef FUNC_NAME
static
void
init_module (void)
{
#include "binconv.x"
}
MDEFLINKFUNC ("database binconv", database_binconv, init_module)
/* binconv.c ends here */
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- Re: Doc organization (Re: Around again, and docs lead role),
Thien-Thi Nguyen <=