Re: Doc organization (Re: Around again, and docs lead role)

[Thien-Thi Nguyen]

   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 */