mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00
Code Activity

Make things compile neatly under Sun's C compiler.

Browse source 
* dynl.c (scm_dynamic_func): Cast return value from sysdep_dynl_func.
* extchrs.c (xmbtowc): Make the second arg a normal char, not
unsigned, because that's what the ANSI function takes.
* extchrs.h (xmbtowc): Corresponding change to prototype.
* genio.c (scm_gen_getc): Make buf plain chars.  Nobody wants
uchars here.
* mbstrings.c (scm_mb_ilength): Use ANSI arg syntax.  Make DATA
argument plain char *.
* strings.c (scm_string): Use SCM_ROCHARS, since c is a plain
char.
* tag.c (scm_tag): Remove unreachable statement.
* unif.c (scm_array_to_list): If we want to shift a 1 bit to the
top of the word, it should be unsigned.
This commit is contained in:
Jim Blandy 1997-06-21 05:53:39 +00:00
parent e3173f937c
commit cdbadcacc1
9 changed files with 11 additions and 800 deletions
Download patch file Download diff file Expand all files Collapse all files

4
libguile/dynl.c
View file

@ -59,7 +59,6 @@ maybe_drag_in_eprintf ()
}
#include <stdio.h>
#include "_scm.h"
#include "dynl.h"
#include "genio.h"
@ -401,7 +400,8 @@ scm_dynamic_func (SCM symb, SCM dobj)
d = get_dynl_obj (dobj, s_dynamic_func, SCM_ARG2);
SCM_DEFER_INTS;
func = sysdep_dynl_func (SCM_CHARS (symb), d->handle, s_dynamic_func);
func = (void (*) ()) sysdep_dynl_func (SCM_CHARS (symb), d->handle,
s_dynamic_func);
SCM_ALLOW_INTS;
return scm_ulong2num ((unsigned long)func);

134
libguile/extchrs.c
View file

@ -1,134 +0,0 @@
/* Copyright (C) 1995,1996 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, 675 Mass Ave, Cambridge, MA 02139, 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 "extchrs.h"
#ifdef SCM_FAKE_EXT_CHARS
int
xmblen (str, size)
const char * str;
size_t size;
{
if (!str)
return 0;
if (*(unsigned char *)str > 127)
return ((size < 4)
? -1
: 4);
else if (!*str)
return 0;
else
return 1;
}
int
xwctomb (_str, c)
char * _str;
int c;
{
unsigned char * str;
str = (unsigned char *)_str;
if (!str)
return 0;
if (!c)
{
*str = 0;
return 0;
}
if (c < 127)
{
*str = c;
return 1;
}
str[0] = 255;
str[1] = 0x80 | ((c >> 10) & 0x3f);
str[2] = 0x80 | ((c >> 4) & 0x3f);
str[3] = 0x80 | (c & 0xf);
return 4;
}
int
xmbtowc (result, _str, size)
xwchar_t * result;
const unsigned char * _str;
size_t size;
{
const unsigned char * str;
str = (const unsigned char *)_str;
if (!str)
return 0;
if ((size == 0) || !*str)
{
*result = 0;
return 0;
}
if (*str < 128)
{
*result = *str;
return 1;
}
if ( (*str != 255)
|| (size < 4))
return -1;
*result = ( ((str[1] & 0x3f) << 10)
| ((str[2] & 0x3f) << 4)
| (str[3] & 0xf));
return 4;
}
#endif /* SCM_FAKE_EXT_CHARS */

74
libguile/extchrs.h
View file

@ -1,74 +0,0 @@
/* classes: h_files */
#ifndef EXTCHRSH
#define EXTCHRSH
/* Copyright (C) 1995,1996 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 <stdlib.h>
#include "libguile/__scm.h"
#define SCM_FAKE_EXT_CHARS 1
#if !defined(SCM_FAKE_EXT_CHARS)
#define xmblen mblen
#define xwctomb wctomb
#define xmbtowc mbtowc
#define XMB_CUR_MAX MB_CUR_MAX
typedef wchar_t xwchar_t;
#else
typedef unsigned short xwchar_t;
#define XMB_CUR_MAX 4
#endif
extern int xmblen SCM_P ((const char * str, size_t size));
extern int xwctomb SCM_P ((char * _str, int c));
extern int xmbtowc SCM_P ((xwchar_t * result, const unsigned char * _str, size_t size));
#endif /* EXTCHRSH */

5
libguile/genio.c
View file

@ -204,7 +204,8 @@ scm_gen_puts (rep, str_data, port)
while (size)
{
len = xmbtowc (&output, str_data, size);
SCM_ASSERT ((len > 0), SCM_MAKINUM (*str_data), "bogus character", "scm_gen_puts");
SCM_ASSERT ((len > 0), SCM_MAKINUM (*str_data),
"bogus character", "scm_gen_puts");
scm_putc ((output >> 8) & 0xff, port);
scm_putc (output & 0xff, port);
size -= len;
@ -437,7 +438,7 @@ scm_gen_getc (port)
case scm_mb_port:
{
int x;
unsigned char buf[256];
char buf[256];
SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_BOOL_F,
"huge translation", "scm_gen_puts");

505
libguile/mbstrings.c
View file

@ -1,505 +0,0 @@
/* Copyright (C) 1995, 1996 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 "extchrs.h"
#include <stdio.h>
#include "_scm.h"
#include "chars.h"
#include "unif.h"
#include "genio.h"
#include "read.h"
#include "mbstrings.h"
SCM_PROC(s_multi_byte_string_p, "multi-byte-string?", 1, 0, 0, scm_multi_byte_string_p);
SCM
scm_multi_byte_string_p (obj)
SCM obj;
{
return (SCM_MB_STRINGP (obj)
? SCM_BOOL_T
: SCM_BOOL_F);
}
SCM
scm_regular_string_p (obj)
SCM obj;
{
return (SCM_REGULAR_STRINGP (obj)
? SCM_BOOL_T
: SCM_BOOL_F);
}
SCM_PROC(s_list_to_multi_byte_string, "list->multi-byte-string", 1, 0, 0, scm_multi_byte_string);
SCM_PROC(s_multi_byte_string, "multi-byte-string", 0, 0, 1, scm_multi_byte_string);
SCM
scm_multi_byte_string (chrs)
SCM chrs;
{
SCM res;
register char *data;
long i;
long byte_len;
i = scm_ilength (chrs);
SCM_ASSERT (i >= 0, chrs, SCM_ARG1, s_multi_byte_string);
i = i * XMB_CUR_MAX;
res = scm_makstr (i, 0);
SCM_SETLENGTH (res, SCM_LENGTH (res), scm_tc7_mb_string);
data = SCM_CHARS (res);
byte_len = 0;
xwctomb (0, 0);
while (i && SCM_NNULLP (chrs))
{
int used;
SCM ch;
ch = SCM_CAR (chrs);
SCM_ASSERT (SCM_ICHRP (ch), chrs, SCM_ARG1, s_multi_byte_string);
used = xwctomb (data + byte_len, SCM_ICHR (ch));
SCM_ASSERT (used >= 0, chrs, SCM_ARG1, s_multi_byte_string);
byte_len += (used ? used : 1);
chrs = SCM_CDR (chrs);
--i;
}
res = scm_vector_set_length_x (res, SCM_MAKINUM (byte_len));
return res;
}
int
scm_mb_ilength (data, size)
unsigned char * data;
int size;
{
int pos;
int len;
len = 0;
pos = 0;
xmblen (0, 0);
while (pos < size)
{
int inc;
inc = xmblen (data + pos, size - pos);
if (inc == 0)
++inc;
if (inc < 0)
return -1;
++len;
pos += inc;
}
return len;
}
SCM_PROC(s_multi_byte_string_length, "multi-byte-string-length", 1, 0, 0, scm_multi_byte_string_length);
SCM
scm_multi_byte_string_length (str)
SCM str;
{
int size;
int len;
unsigned char * data;
SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1, s_multi_byte_string_length);
data = SCM_ROCHARS (str);
size = SCM_ROLENGTH (str);
len = scm_mb_ilength (data, size);
SCM_ASSERT (len >= 0, str, SCM_ARG1, s_multi_byte_string_length);
return SCM_MAKINUM (len);
}
SCM_PROC(s_symbol_multi_byte_p, "symbol-multi-byte?", 1, 0, 0, scm_symbol_multi_byte_p);
SCM
scm_symbol_multi_byte_p (symbol)
SCM symbol;
{
return SCM_SYMBOL_MULTI_BYTE_STRINGP(symbol);
}
SCM_PROC(s_set_symbol_multi_byte_x, "set-symbol-multi-byte!", 2, 0, 0, scm_set_symbol_multi_byte_x);
SCM
scm_set_symbol_multi_byte_x (symbol, val)
SCM symbol;
SCM val;
{
if (SCM_TYP7 (symbol) == scm_tc7_msymbol)
{
SCM_SYMBOL_MULTI_BYTE_STRINGP(symbol) = (SCM_FALSEP (val)
? SCM_BOOL_F
: SCM_BOOL_T);
}
return SCM_UNSPECIFIED;
}
SCM_PROC(s_regular_port_p, "regular-port?", 1, 0, 0, scm_regular_port_p);
SCM
scm_regular_port_p (p)
SCM p;
{
return (SCM_PORT_REPRESENTATION(p) == scm_regular_port
? SCM_BOOL_T
: SCM_BOOL_F);
}
SCM_PROC(s_regular_port_x, "regular-port!", 1, 0, 0, scm_regular_port_x);
SCM
scm_regular_port_x (p)
SCM p;
{
SCM_PORT_REPRESENTATION(p) = scm_regular_port;
return SCM_UNSPECIFIED;
}
SCM_PROC(s_multi_byte_port_p, "multi-byte-port?", 1, 0, 0, scm_multi_byte_port_p);
SCM
scm_multi_byte_port_p (p)
SCM p;
{
return (SCM_PORT_REPRESENTATION(p) == scm_mb_port
? SCM_BOOL_T
: SCM_BOOL_F);
}
SCM_PROC(s_multi_byte_port_x, "multi-byte-port!", 1, 0, 0, scm_multi_byte_port_x);
SCM
scm_multi_byte_port_x (p)
SCM p;
{
SCM_PORT_REPRESENTATION(p) = scm_mb_port;
return SCM_UNSPECIFIED;
}
SCM_PROC(s_wide_character_port_p, "wide-character-port?", 1, 0, 0, scm_wide_character_port_p);
SCM
scm_wide_character_port_p (p)
SCM p;
{
return (SCM_PORT_REPRESENTATION(p) == scm_wchar_port
? SCM_BOOL_T
: SCM_BOOL_F);
}
SCM_PROC(s_wide_character_port_x, "wide-character-port!", 1, 0, 0, scm_wide_character_port_x);
SCM
scm_wide_character_port_x (p)
SCM p;
{
SCM_PORT_REPRESENTATION(p) = scm_wchar_port;
return SCM_UNSPECIFIED;
}
void
scm_put_wchar (c, port, writing)
int c;
SCM port;
int writing;
{
if (writing)
scm_gen_puts (scm_regular_string, "#\\", port);
switch (SCM_PORT_REPRESENTATION (port))
{
case scm_regular_port:
{
if (c < 256)
{
if (!writing)
scm_gen_putc ((unsigned char)c, port);
else if ((c <= ' ') && scm_charnames[c])
scm_gen_puts (scm_regular_string, scm_charnames[c], port);
else if (c > '\177')
scm_intprint (c, 8, port);
else
scm_gen_putc ((int) c, port);
}
else
{
print_octal:
if (!writing)
scm_gen_putc ('\\', port);
scm_intprint (c, 8, port);
}
break;
}
case scm_mb_port:
{
char buf[256];
int len;
if (XMB_CUR_MAX > sizeof (buf))
goto print_octal;
len = xwctomb (buf, c);
if (len < 0)
goto print_octal;
if (len == 0)
scm_gen_putc (0, port);
else
scm_gen_putc (c, port);
break;
}
case scm_wchar_port:
{
scm_gen_putc (c, port);
break;
}
}
}
void
scm_print_mb_string (exp, port, writing)
SCM exp;
SCM port;
int writing;
{
if (writing)
{
int i;
int len;
char * data;
scm_gen_putc ('\"', port);
i = 0;
len = SCM_ROLENGTH (exp);
data = SCM_ROCHARS (exp);
while (i < len)
{
xwchar_t c;
int inc;
inc = xmbtowc (&c, data + i, len - i);
if (inc == 0)
inc = 1;
if (inc < 0)
{
inc = 1;
c = data[i];
}
i += inc;
switch (c)
{
case '\"':
case '\\':
scm_gen_putc ('\\', port);
default:
scm_gen_putc (c, port);
}
}
scm_gen_putc ('\"', port);
}
else
scm_gen_write (scm_mb_string, SCM_ROCHARS (exp), SCM_ROLENGTH (exp), port);
}
void
scm_print_mb_symbol (exp, port)
SCM exp;
SCM port;
{
int pos;
int end;
int len;
char * str;
int weird;
int maybe_weird;
int mw_pos = 0; /* initialized to placate compiler */
int inc = 0; /* same */
xwchar_t c;
len = SCM_LENGTH (exp);
str = SCM_CHARS (exp);
scm_remember (&exp);
pos = 0;
weird = 0;
maybe_weird = 0;
for (end = pos; end < len; end += inc)
{
inc = xmbtowc (&c, str + end, len - end);
if (inc < 0)
{
inc = 1;
c = str[end];
goto weird_handler;
}
if (inc == 0)
{
inc = 1;
goto weird_handler;
}
switch (c)
{
#ifdef BRACKETS_AS_PARENS
case '[':
case ']':
#endif
case '(':
case ')':
case '\"':
case ';':
case SCM_WHITE_SPACES:
case SCM_LINE_INCREMENTORS:
weird_handler:
if (maybe_weird)
{
end = mw_pos;
maybe_weird = 0;
}
if (!weird)
{
scm_gen_write (scm_regular_string, "#{", 2, port);
weird = 1;
}
if (pos < end)
{
int q;
int qinc;
q = pos;
while (q < end)
{
qinc = xmbtowc (&c, str + q, end - q);
if (inc <= 0)
{
inc = 1;
c = str[q];
}
scm_gen_putc (c, port);
q += qinc;
}
}
{
char buf[2];
buf[0] = '\\';
buf[1] = str[end];
scm_gen_write (scm_regular_string, buf, 2, port);
}
pos = end + 1;
break;
case '\\':
if (weird)
goto weird_handler;
if (!maybe_weird)
{
maybe_weird = 1;
mw_pos = pos;
}
break;
case '}':
case '#':
if (weird)
goto weird_handler;
break;
default:
break;
}
}
if (pos < end)
{
int q;
int qinc;
q = pos;
while (q < end)
{
qinc = xmbtowc (&c, str + q, end - q);
if (inc <= 0)
inc = 1;
scm_gen_putc (c, port);
q += qinc;
}
}
if (weird)
scm_gen_write (scm_regular_string, "}#", 2, port);
}
void
scm_init_mbstrings ()
{
#include "mbstrings.x"
}

78
libguile/mbstrings.h
View file

@ -1,78 +0,0 @@
/* classes: h_files */
#ifndef MBSTRINGSH
#define MBSTRINGSH
/* Copyright (C) 1995,1996 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 "libguile/__scm.h"
#include "libguile/symbols.h"
#define SCM_MB_STRINGP(x) ( (SCM_TYP7(x)==scm_tc7_mb_string) \
|| ( (SCM_TYP7(x) == scm_tc7_msymbol) \
&& (SCM_SYMBOL_MULTI_BYTE_STRINGP (x) != SCM_BOOL_F)))
#define SCM_REGULAR_STRINGP(x) (SCM_TYP7D(x)==scm_tc7_string)
extern SCM scm_multi_byte_string_p SCM_P ((SCM obj));
extern SCM scm_regular_string_p SCM_P ((SCM obj));
extern SCM scm_multi_byte_string SCM_P ((SCM chrs));
extern int scm_mb_ilength SCM_P ((unsigned char * data, int size));
extern SCM scm_multi_byte_string_length SCM_P ((SCM str));
extern SCM scm_symbol_multi_byte_p SCM_P ((SCM symbol));
extern SCM scm_set_symbol_multi_byte_x SCM_P ((SCM symbol, SCM val));
extern SCM scm_regular_port_p SCM_P ((SCM p));
extern SCM scm_regular_port_x SCM_P ((SCM p));
extern SCM scm_multi_byte_port_p SCM_P ((SCM p));
extern SCM scm_multi_byte_port_x SCM_P ((SCM p));
extern SCM scm_wide_character_port_p SCM_P ((SCM p));
extern SCM scm_wide_character_port_x SCM_P ((SCM p));
extern void scm_put_wchar SCM_P ((int c, SCM port, int writing));
extern void scm_print_mb_string SCM_P ((SCM exp, SCM port, int writing));
extern void scm_print_mb_symbol SCM_P ((SCM exp, SCM port));
extern void scm_init_mbstrings SCM_P ((void));
#endif /* MBSTRINGSH */

2
libguile/strings.c
View file

@ -116,7 +116,7 @@ scm_string (chrs)
int l;
char * c;
l = SCM_ROLENGTH (SCM_CAR (chrs));
c = SCM_ROUCHARS (SCM_CAR (chrs));
c = SCM_ROCHARS (SCM_CAR (chrs));
while (l)
{
--l;

7
libguile/tag.c
View file

@ -175,16 +175,17 @@ scm_tag (x)
{
int tag;
tag = (SCM_TYP16 (x) >> 8) & 0xff;
return SCM_MAKINUM (SCM_INUM (SCM_CDR (scm_utag_smob_base)) | (tag << 8));
return SCM_MAKINUM (SCM_INUM (SCM_CDR (scm_utag_smob_base))
| (tag << 8));
}
case scm_tcs_cons_gloc:
/* must be a struct */
{
int tag;
tag = SCM_STRUCT_VTABLE_DATA (x)[scm_struct_i_tag];
return SCM_MAKINUM (SCM_INUM (SCM_CDR (scm_utag_struct_base)) | (tag << 8));
return SCM_MAKINUM (SCM_INUM (SCM_CDR (scm_utag_struct_base))
| (tag << 8));
}
return SCM_CDR (scm_utag_struct_base) ;
default:
if (SCM_CONSP (x))

2
libguile/unif.c
View file

@ -2021,7 +2021,7 @@ scm_array_to_list (v)
long *data = (long *) SCM_VELTS (v);
register unsigned long mask;
for (k = (SCM_LENGTH (v) - 1) / SCM_LONG_BIT; k > 0; k--)
for (mask = 1L << (SCM_LONG_BIT - 1); mask; mask >>= 1)
for (mask = 1UL << (SCM_LONG_BIT - 1); mask; mask >>= 1)
res = scm_cons (((long *) data)[k] & mask ? SCM_BOOL_T : SCM_BOOL_F, res);
for (mask = 1L << ((SCM_LENGTH (v) % SCM_LONG_BIT) - 1); mask; mask >>= 1)
res = scm_cons (((long *) data)[k] & mask ? SCM_BOOL_T : SCM_BOOL_F, res);