dmbcs/guile
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* validate.h

Browse source 
(SCM_NUM2{SIZE,PTRDIFF,SHORT,USHORT,BITS,UBITS,INT,UINT}[_DEF]):
new macros.

* unif.h: type renaming:
scm_array -> scm_array_t
scm_array_dim -> scm_array_dim_t
the old names are deprecated, all in-Guile uses changed.

* tags.h (scm_ubits_t): new typedef, representing unsigned
scm_bits_t.

* stacks.h: type renaming:
scm_info_frame -> scm_info_frame_t
scm_stack -> scm_stack_t
the old names are deprecated, all in-Guile uses changed.

* srcprop.h: type renaming:
scm_srcprops -> scm_srcprops_t
scm_srcprops_chunk -> scm_srcprops_chunk_t
the old names are deprecated, all in-Guile uses changed.

* gsubr.c, procs.c, print.c, ports.c, read.c, rdelim.c, ramap.c,
rw.c, smob.c, sort.c, srcprop.c, stacks.c, strings.c, strop.c,
strorder.c, strports.c, struct.c, symbols.c, unif.c, values.c,
vectors.c, vports.c, weaks.c:
various int/size_t -> size_t/scm_bits_t changes.

* random.h: type renaming:
scm_rstate -> scm_rstate_t
scm_rng -> scm_rng_t
scm_i_rstate -> scm_i_rstate_t
the old names are deprecated, all in-Guile uses changed.

* procs.h: type renaming:
scm_subr_entry -> scm_subr_entry_t
the old name is deprecated, all in-Guile uses changed.

* options.h (scm_option_t.val): unsigned long -> scm_bits_t.
type renaming:
scm_option -> scm_option_t
the old name is deprecated, all in-Guile uses changed.

* objects.c: various long -> scm_bits_t changes.
(scm_i_make_class_object): flags: unsigned long -> scm_ubits_t

* numbers.h (SCM_FIXNUM_BIT): deprecated, renamed to
SCM_I_FIXNUM_BIT.

* num2integral.i.c: new file, multiply included by numbers.c, used
to "templatize" the various integral <-> num conversion routines.

* numbers.c (scm_mkbig, scm_big2num, scm_adjbig, scm_normbig,
scm_copybig, scm_2ulong2big, scm_dbl2big, scm_big2dbl):
deprecated.
(scm_i_mkbig, scm_i_big2inum, scm_i_adjbig, scm_i_normbig,
scm_i_copybig, scm_i_short2big, scm_i_ushort2big, scm_i_int2big,
scm_i_uint2big, scm_i_long2big, scm_i_ulong2big, scm_i_bits2big,
scm_i_ubits2big, scm_i_size2big, scm_i_ptrdiff2big,
scm_i_long_long2big, scm_i_ulong_long2big, scm_i_dbl2big,
scm_i_big2dbl, scm_short2num, scm_ushort2num, scm_int2num,
scm_uint2num, scm_bits2num, scm_ubits2num, scm_size2num,
scm_ptrdiff2num, scm_num2short, scm_num2ushort, scm_num2int,
scm_num2uint, scm_num2bits, scm_num2ubits, scm_num2ptrdiff,
scm_num2size): new functions.

* modules.c (scm_module_reverse_lookup): i, n: int -> scm_bits_t.x

* load.c: change int -> size_t in various places (where the
variable is used to store a string length).
(search-path): call scm_done_free, not scm_done_malloc.

* list.c (scm_ilength): return a scm_bits_t, not long.
some other {int,long} -> scm_bits_t changes.

* hashtab.c: various [u]int -> scm_bits_t changes.
scm_ihashx_closure -> scm_ihashx_closure_t (and made a typedef).
(scm_ihashx): n: uint -> scm_bits_t
use scm_bits2num instead of scm_ulong2num.

* gsubr.c: various int -> scm_bits_t changes.

* gh_data.c (gh_scm2double): no loss of precision any more.

* gh.h (gh_str2scm): len: int -> size_t
(gh_{get,set}_substr): start: int -> scm_bits_t,
len: int -> size_t
(gh_<num>2scm): n: int -> scm_bits_t
(gh_*vector_length): return scm_[u]size_t, not unsigned long.
(gh_length): return scm_bits_t, not unsigned long.

* fports.h: type renaming:
scm_fport -> scm_fport_t
the old name is deprecated, all in-Guile uses changed.

* fports.c (fport_fill_input): count: int -> scm_bits_t
(fport_flush): init_size, remaining, count: int -> scm_bits_t

* debug.h (scm_lookup_cstr, scm_lookup_soft, scm_evstr): removed
those prototypes, as the functions they prototype don't exist.

* fports.c (default_buffer_size): int -> size_t
(scm_fport_buffer_add): read_size, write_size: int -> scm_bits_t
default_size: int -> size_t
(scm_setvbuf): csize: int -> scm_bits_t

* fluids.c (n_fluids): int -> scm_bits_t
(grow_fluids): old_length, i: int -> scm_bits_t
(next_fluid_num, scm_fluid_ref, scm_fluid_set_x): n: int ->
scm_bits_t
(scm_c_with_fluids): flen, vlen: int -> scm_bits_t

* filesys.c (s_scm_open_fdes): changed calls to SCM_NUM2LONG to
the new and shiny SCM_NUM2INT.

* extensions.c: extension -> extension_t (and made a typedef).

* eval.h (SCM_IFRAME): cast to scm_bits_t, not int.  just so
there are no nasty surprises if/when the various deeply magic tag
bits move somewhere else.

* eval.c: changed the locals used to store results of SCM_IFRAME,
scm_ilength and such to be of type scm_bits_t (and not int/long).
(iqq): depth, edepth: int -> scm_bits_t
(scm_eval_stack): int -> scm_bits_t
(SCM_CEVAL): various vars are not scm_bits_t instead of int.
(check_map_args, scm_map, scm_for_each): len: long -> scm_bits_t
i: int -> scm_bits_t

* environments.c: changed the many calls to scm_ulong2num to
scm_ubits2num.
(import_environment_fold): proc_as_ul: ulong -> scm_ubits_t

* dynwind.c (scm_dowinds): delta: long -> scm_bits_t

* debug.h: type renaming:
scm_debug_info -> scm_debug_info_t
scm_debug_frame -> scm_debug_frame_t
the old names are deprecated, all in-Guile uses changed.
(scm_debug_eframe_size): int -> scm_bits_t

* debug.c (scm_init_debug): use scm_c_define instead of the
deprecated scm_define.

* continuations.h: type renaming:
scm_contregs -> scm_contregs_t
the old name is deprecated, all in-Guile uses changed.
(scm_contregs_t.num_stack_items): size_t -> scm_bits_t
(scm_contregs_t.num_stack_items): ulong -> scm_ubits_t

* continuations.c (scm_make_continuation): change the type of
stack_size form long to scm_bits_t.

* ports.h: type renaming:
scm_port_rw_active -> scm_port_rw_active_t (and made a typedef)
scm_port -> scm_port_t
scm_ptob_descriptor -> scm_ptob_descriptor_t
the old names are deprecated, all in-Guile uses changed.
(scm_port_t.entry): int -> scm_bits_t.
(scm_port_t.line_number): int -> long.
(scm_port_t.putback_buf_size): int -> size_t.

* __scm.h (long_long, ulong_long): deprecated (they pollute the
global namespace and have little value besides that).
(SCM_BITS_LENGTH): new, is the bit size of scm_bits_t (i.e. of an
SCM handle).
(ifdef spaghetti): include sys/types.h and sys/stdtypes.h, if they
exist (for size_t & ptrdiff_t)
(scm_sizet): deprecated.

* Makefile.am (noinst_HEADERS): add num2integral.i.c
This commit is contained in:
Michael Livshin 2001-05-24 00:50:51 +00:00
commit 1be6b49ccb
112 changed files with 2577 additions and 1894 deletions
Download patch file Download diff file Expand all files Collapse all files

9
ChangeLog
View file

@ -1,3 +1,12 @@
2001-05-23 Michael Livshin <mlivshin@bigfoot.com>
* configure.in: configury for SCM_[U]BITS_T, some more sizeofs.
also, make sure that the integral type choosen to represent an SCM
has exactly the same size as a void pointer.
* acconfig.h: add undefs for SCM_BITS_T, SCM_UBITS_T,
SCM_SIZEOF_BITS_T, ptrdiff_t.
2001-05-16 Rob Browning <rlb@cs.utexas.edu>
* configure.in: add AC_SUBST for GUILE_MICRO_VERSION.

43
NEWS
View file

@ -940,6 +940,49 @@ scm_internal_with_fluids is available as a deprecated function.
Just like scm_c_with_fluids, but takes one fluid and one value instead
of lists of same.
** Deprecated typedefs: long_long, ulong_long.
They are of questionable utility and they pollute the global
namespace.
** New macro: SCM_BITS_LENGTH.
The bit size of an SCM.
** Deprecated typedef: scm_sizet
It is of questionable utility now that Guile requires ANSI C, and is
oddly named.
** Deprecated typedefs: scm_port_rw_active, scm_port,
scm_ptob_descriptor, scm_debug_info, scm_debug_frame, scm_fport,
scm_option, scm_rstate, scm_rng, scm_array, scm_array_dim.
Made more compliant with the naming policy by adding a _t at the end.
** Deprecated functions: scm_mkbig, scm_big2num, scm_adjbig,
scm_normbig, scm_copybig, scm_2ulong2big, scm_dbl2big, scm_big2dbl
With the exception of the misterious scm_2ulong2big, they are still
available under new names (scm_i_mkbig etc). These functions are not
intended to be used in user code. You should avoid dealing with
bignums directly, and should deal with numbers in general (which can
be bignums).
** New functions: scm_short2num, scm_ushort2num, scm_int2num,
scm_uint2num, scm_bits2num, scm_ubits2num, scm_size2num,
scm_ptrdiff2num, scm_num2short, scm_num2ushort, scm_num2int,
scm_num2uint, scm_num2bits, scm_num2ubits, scm_num2ptrdiff,
scm_num2size.
These are conversion functions between the various ANSI C integral
types and Scheme numbers.
** New number validation macros:
SCM_NUM2{SIZE,PTRDIFF,SHORT,USHORT,BITS,UBITS,INT,UINT}[_DEF]
See above.
Changes since Guile 1.3.4:

8
RELEASE
View file

@ -99,6 +99,14 @@ After signal handling and threading have been fixed:
- remove scm_strprint_obj
- remove SCM_CONST_LONG
- remove scm_wta
- remove deprecated typedefs: long_long, ulong_long, scm_sizet
- remove deprecated macros: scm_contregs, scm_port_rw_active,
scm_port, scm_ptob_descriptor, scm_debug_info, scm_debug_frame,
scm_fport, SCM_FIXNUM_BIT, scm_option, scm_subr_entry, scm_rstate,
scm_rng, scm_i_rstate, scm_srcprops, scm_srcprops_chunk,
scm_info_frame, scm_stack, scm_array, scm_array_dim.
- remove deprecated functions: scm_mkbig, scm_big2num, scm_adjbig,
scm_normbig, scm_copybig, scm_2ulong2big, scm_dbl2big, scm_big2dbl.
Modules sort.c and random.c should be factored out into separate
modules (but still be distributed with guile-core) when we get a new

8
acconfig.h
View file

@ -166,3 +166,11 @@
/* Define if the compiler supports long longs. */
#undef HAVE_LONG_LONGS
/* SCM will actually be represented by this type. */
#undef SCM_BITS_T
#undef SCM_UBITS_T
#undef SCM_SIZEOF_BITS_T
/* defined to signed long if doesn't exist: */
#undef ptrdiff_t

27
configure.in
View file

@ -161,6 +161,12 @@ AC_C_BIGENDIAN
AC_CHECK_SIZEOF(int)
AC_CHECK_SIZEOF(long)
dnl by the pre C9X ANSI C standards, size_t & ptrdiff_t have to be
dnl representable by a standard integral type. since the largest
dnl integer type in the pre-C9X ANSI C standards is long...
AC_CHECK_TYPE(ptrdiff_t, long)
AC_CACHE_CHECK([for long longs], scm_cv_long_longs,
AC_TRY_COMPILE(,
[long long a],
@ -168,13 +174,32 @@ AC_CACHE_CHECK([for long longs], scm_cv_long_longs,
scm_cv_long_longs=no))
if test "$scm_cv_long_longs" = yes; then
AC_DEFINE(HAVE_LONG_LONGS)
AC_CHECK_SIZEOF(long long)
fi
AC_CHECK_SIZEOF(void *)
if test "$ac_cv_sizeof_long" -eq "$ac_cv_sizeof_void_p"; then
AC_DEFINE(SCM_BITS_T, long)
AC_DEFINE(SCM_UBITS_T, unsigned long)
AC_DEFINE(SCM_SIZEOF_BITS_T, SIZEOF_LONG)
elif test \( "$scm_cv_long_longs" = yes \) -a \( "$ac_cv_sizeof_long_long" -eq "$ac_cv_sizeof_void_p" \); then
AC_DEFINE(SCM_BITS_T, long long)
AC_DEFINE(SCM_UBITS_T, unsigned long long)
AC_DEFINE(SCM_SIZEOF_BITS_T, SIZEOF_LONG_LONG)
elif test "$ac_cv_sizeof_int" -eq "$ac_cv_sizeof_void_p"; then
AC_DEFINE(SCM_BITS_T, int)
AC_DEFINE(SCM_UBITS_T, unsigned int)
AC_DEFINE(SCM_SIZEOF_BITS_T, SIZEOF_INT)
else
AC_MSG_ERROR(cannot find an integral type capable of storing a pointer: "$ac_cv_sizeof_void_p" bytes)
fi
AC_HEADER_STDC
AC_HEADER_DIRENT
AC_HEADER_TIME
AC_HEADER_SYS_WAIT
AC_CHECK_HEADERS(io.h libc.h limits.h malloc.h memory.h string.h regex.h rxposix.h rx/rxposix.h sys/ioctl.h sys/select.h sys/time.h sys/timeb.h sys/times.h sys/types.h sys/utime.h time.h unistd.h utime.h)
AC_CHECK_HEADERS(io.h libc.h limits.h malloc.h memory.h string.h regex.h rxposix.h rx/rxposix.h sys/ioctl.h sys/select.h sys/time.h sys/timeb.h sys/times.h sys/stdtypes.h sys/types.h sys/utime.h time.h unistd.h utime.h)
GUILE_HEADER_LIBC_WITH_UNISTD
AC_TYPE_GETGROUPS

2
doc/scheme-data.texi
View file

@ -4143,7 +4143,7 @@ length. If @var{bool} is @code{#t}, uve is OR'ed into
@var{bv}; If @var{bool} is @code{#f}, the inversion of uve is
AND'ed into @var{bv}.
If uve is a unsigned integer vector all the elements of uve
If uve is a unsigned long integer vector all the elements of uve
must be between 0 and the @code{length} of @var{bv}. The bits
of @var{bv} corresponding to the indexes in uve are set to
@var{bool}. The return value is unspecified.

4
guile-readline/ChangeLog
View file

@ -1,3 +1,7 @@
2001-05-23 Michael Livshin <mlivshin@bigfoot.com>
* readline.c (strdup): make `len' a size_t.
2001-05-10 Marius Vollmer <mvo@zagadka.ping.de>
* readline.c (completion_function): Use SCM_VARIABLE_REF to access

2
guile-readline/readline.c
View file

@ -71,7 +71,7 @@ SCM_DEFINE (scm_readline_options, "readline-options-interface", 0, 1, 0,
static char *
strdup (char *s)
{
int len = strlen (s);
size_t len = strlen (s);
char *new = malloc (len + 1);
strcpy (new, s);
return new;

189
libguile/ChangeLog
View file

@ -1,3 +1,192 @@
2001-05-24 Michael Livshin <mlivshin@bigfoot.com>
The purpose of this set of changes is to regularize Guile's usage
of ANSI C integral types, with the following ideas in mind:
- SCM does not nesessarily has to be long.
- long is not nesessarily the same size as int.
The changes are incomplete and possibly buggy. Please test on
something exotic.
* validate.h
(SCM_NUM2{SIZE,PTRDIFF,SHORT,USHORT,BITS,UBITS,INT,UINT}[_DEF]):
new macros.
* unif.h: type renaming:
scm_array -> scm_array_t
scm_array_dim -> scm_array_dim_t
the old names are deprecated, all in-Guile uses changed.
* tags.h (scm_ubits_t): new typedef, representing unsigned
scm_bits_t.
* stacks.h: type renaming:
scm_info_frame -> scm_info_frame_t
scm_stack -> scm_stack_t
the old names are deprecated, all in-Guile uses changed.
* srcprop.h: type renaming:
scm_srcprops -> scm_srcprops_t
scm_srcprops_chunk -> scm_srcprops_chunk_t
the old names are deprecated, all in-Guile uses changed.
* gsubr.c, procs.c, print.c, ports.c, read.c, rdelim.c, ramap.c,
rw.c, smob.c, sort.c, srcprop.c, stacks.c, strings.c, strop.c,
strorder.c, strports.c, struct.c, symbols.c, unif.c, values.c,
vectors.c, vports.c, weaks.c:
various int/size_t -> size_t/scm_bits_t changes.
* random.h: type renaming:
scm_rstate -> scm_rstate_t
scm_rng -> scm_rng_t
scm_i_rstate -> scm_i_rstate_t
the old names are deprecated, all in-Guile uses changed.
* procs.h: type renaming:
scm_subr_entry -> scm_subr_entry_t
the old name is deprecated, all in-Guile uses changed.
* options.h (scm_option_t.val): unsigned long -> scm_bits_t.
type renaming:
scm_option -> scm_option_t
the old name is deprecated, all in-Guile uses changed.
* objects.c: various long -> scm_bits_t changes.
(scm_i_make_class_object): flags: unsigned long -> scm_ubits_t
* numbers.h (SCM_FIXNUM_BIT): deprecated, renamed to
SCM_I_FIXNUM_BIT.
* num2integral.i.c: new file, multiply included by numbers.c, used
to "templatize" the various integral <-> num conversion routines.
* numbers.c (scm_mkbig, scm_big2num, scm_adjbig, scm_normbig,
scm_copybig, scm_2ulong2big, scm_dbl2big, scm_big2dbl):
deprecated.
(scm_i_mkbig, scm_i_big2inum, scm_i_adjbig, scm_i_normbig,
scm_i_copybig, scm_i_short2big, scm_i_ushort2big, scm_i_int2big,
scm_i_uint2big, scm_i_long2big, scm_i_ulong2big, scm_i_bits2big,
scm_i_ubits2big, scm_i_size2big, scm_i_ptrdiff2big,
scm_i_long_long2big, scm_i_ulong_long2big, scm_i_dbl2big,
scm_i_big2dbl, scm_short2num, scm_ushort2num, scm_int2num,
scm_uint2num, scm_bits2num, scm_ubits2num, scm_size2num,
scm_ptrdiff2num, scm_num2short, scm_num2ushort, scm_num2int,
scm_num2uint, scm_num2bits, scm_num2ubits, scm_num2ptrdiff,
scm_num2size): new functions.
* modules.c (scm_module_reverse_lookup): i, n: int -> scm_bits_t.x
* load.c: change int -> size_t in various places (where the
variable is used to store a string length).
(search-path): call scm_done_free, not scm_done_malloc.
* list.c (scm_ilength): return a scm_bits_t, not long.
some other {int,long} -> scm_bits_t changes.
* hashtab.c: various [u]int -> scm_bits_t changes.
scm_ihashx_closure -> scm_ihashx_closure_t (and made a typedef).
(scm_ihashx): n: uint -> scm_bits_t
use scm_bits2num instead of scm_ulong2num.
* gsubr.c: various int -> scm_bits_t changes.
* goops.[hc]: various {int,long} -> scm_bits_t changes.
* gh_data.c (gh_scm2double): no loss of precision any more.
* gh.h (gh_str2scm): len: int -> size_t
(gh_{get,set}_substr): start: int -> scm_bits_t,
len: int -> size_t
(gh_<num>2scm): n: int -> scm_bits_t
(gh_*vector_length): return scm_[u]size_t, not unsigned long.
(gh_length): return scm_bits_t, not unsigned long.
* gc.[hc]: various small changes relating to many things stopping
being long and starting being scm_[u]bits_t instead.
scm_mallocated should no longer wrap around.
* fports.h: type renaming:
scm_fport -> scm_fport_t
the old name is deprecated, all in-Guile uses changed.
* fports.c (fport_fill_input): count: int -> scm_bits_t
(fport_flush): init_size, remaining, count: int -> scm_bits_t
* debug.h (scm_lookup_cstr, scm_lookup_soft, scm_evstr): removed
those prototypes, as the functions they prototype don't exist.
* fports.c (default_buffer_size): int -> size_t
(scm_fport_buffer_add): read_size, write_size: int -> scm_bits_t
default_size: int -> size_t
(scm_setvbuf): csize: int -> scm_bits_t
* fluids.c (n_fluids): int -> scm_bits_t
(grow_fluids): old_length, i: int -> scm_bits_t
(next_fluid_num, scm_fluid_ref, scm_fluid_set_x): n: int ->
scm_bits_t
(scm_c_with_fluids): flen, vlen: int -> scm_bits_t
* filesys.c (s_scm_open_fdes): changed calls to SCM_NUM2LONG to
the new and shiny SCM_NUM2INT.
* extensions.c: extension -> extension_t (and made a typedef).
* eval.h (SCM_IFRAME): cast to scm_bits_t, not int. just so
there are no nasty surprises if/when the various deeply magic tag
bits move somewhere else.
* eval.c: changed the locals used to store results of SCM_IFRAME,
scm_ilength and such to be of type scm_bits_t (and not int/long).
(iqq): depth, edepth: int -> scm_bits_t
(scm_eval_stack): int -> scm_bits_t
(SCM_CEVAL): various vars are not scm_bits_t instead of int.
(check_map_args, scm_map, scm_for_each): len: long -> scm_bits_t
i: int -> scm_bits_t
* environments.c: changed the many calls to scm_ulong2num to
scm_ubits2num.
(import_environment_fold): proc_as_ul: ulong -> scm_ubits_t
* dynwind.c (scm_dowinds): delta: long -> scm_bits_t
* debug.h: type renaming:
scm_debug_info -> scm_debug_info_t
scm_debug_frame -> scm_debug_frame_t
the old names are deprecated, all in-Guile uses changed.
(scm_debug_eframe_size): int -> scm_bits_t
* debug.c (scm_init_debug): use scm_c_define instead of the
deprecated scm_define.
* continuations.h: type renaming:
scm_contregs -> scm_contregs_t
the old name is deprecated, all in-Guile uses changed.
(scm_contregs_t.num_stack_items): size_t -> scm_bits_t
(scm_contregs_t.num_stack_items): ulong -> scm_ubits_t
* continuations.c (scm_make_continuation): change the type of
stack_size form long to scm_bits_t.
* ports.h: type renaming:
scm_port_rw_active -> scm_port_rw_active_t (and made a typedef)
scm_port -> scm_port_t
scm_ptob_descriptor -> scm_ptob_descriptor_t
the old names are deprecated, all in-Guile uses changed.
(scm_port_t.entry): int -> scm_bits_t.
(scm_port_t.line_number): int -> long.
(scm_port_t.putback_buf_size): int -> size_t.
* __scm.h (long_long, ulong_long): deprecated (they pollute the
global namespace and have little value besides that).
(SCM_BITS_LENGTH): new, is the bit size of scm_bits_t (i.e. of an
SCM handle).
(ifdef spaghetti): include sys/types.h and sys/stdtypes.h, if they
exist (for size_t & ptrdiff_t)
(scm_sizet): deprecated.
* Makefile.am (noinst_HEADERS): add num2integral.i.c
2001-05-23 Marius Vollmer <mvo@zagadka.ping.de>
* snarf.h (SCM_CONST_LONG): Use SCM_VCELL_INIT instead of

8
libguile/Makefile.am
View file

@ -101,10 +101,10 @@ OMIT_DEPENDENCIES = libguile.h ltdl.h \
axp.h hppa.h i386.h ksr.h m88k.h mips.h sparc.h vax.h
## This is kind of nasty... there are ".c" files that we don't want to
## compile, since they are #included in threads.c. So instead we list
## them here. Perhaps we can deal with them normally once the merge
## seems to be working.
noinst_HEADERS = coop-threads.c coop-threads.h coop.c
## compile, since they are #included. So instead we list them here.
## Perhaps we can deal with them normally once the merge seems to be
## working.
noinst_HEADERS = coop-threads.c coop-threads.h coop.c num2integral.i.c
libguile_la_DEPENDENCIES = @LIBLOBJS@
libguile_la_LIBADD = @LIBLOBJS@ $(LIBLTDL)

24
libguile/__scm.h
View file

@ -211,8 +211,11 @@
/* Some auto-generated .h files contain unused prototypes
* that need these typedefs.
*/
#if (SCM_DEBUG_DEPRECATED == 0)
typedef long long long_long;
typedef unsigned long long ulong_long;
#endif
#endif /* HAVE_LONG_LONGS */
@ -252,6 +255,8 @@ typedef unsigned long long ulong_long;
# define SCM_LONG_BIT (SCM_CHAR_BIT * sizeof (long) / sizeof (char))
#endif
#define SCM_BITS_LENGTH (SCM_CHAR_BIT * SCM_SIZEOF_BITS_T)
#ifdef UCHAR_MAX
# define SCM_CHAR_CODE_LIMIT (UCHAR_MAX + 1L)
#else
@ -262,18 +267,19 @@ typedef unsigned long long ulong_long;
#ifdef STDC_HEADERS
# include <stdlib.h>
# ifdef AMIGA
# if HAVE_SYS_TYPES_H
# include <sys/types.h>
# endif
# if HAVE_SYS_STDTYPES_H
# include <sys/stdtypes.h>
# endif
# include <stddef.h>
# endif /* def AMIGA */
# define scm_sizet size_t
#else
# ifdef _SIZE_T
# define scm_sizet size_t
# else
# define scm_sizet unsigned int
# endif /* def _SIZE_T */
#endif /* def STDC_HEADERS */
#if (SCM_DEBUG_DEPRECATED == 0)
# define scm_sizet size_t
#endif
#include "libguile/tags.h"

2
libguile/backtrace.c
View file

@ -338,7 +338,7 @@ display_frame_expr (char *hdr,SCM exp,char *tlr,int indentation,SCM sport,SCM po
{
SCM string;
int i = 0, n;
scm_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (sport);
scm_ptob_descriptor_t *ptob = scm_ptobs + SCM_PTOBNUM (sport);
do
{
pstate->length = print_params[i].length;

28
libguile/continuations.c
View file

@ -71,22 +71,22 @@ scm_bits_t scm_tc16_continuation;
static SCM
continuation_mark (SCM obj)
{
scm_contregs *continuation = SCM_CONTREGS (obj);
scm_contregs_t *continuation = SCM_CONTREGS (obj);
scm_gc_mark (continuation->throw_value);
scm_mark_locations (continuation->stack, continuation->num_stack_items);
return continuation->dynenv;
}
static scm_sizet
static size_t
continuation_free (SCM obj)
{
scm_contregs *continuation = SCM_CONTREGS (obj);
scm_contregs_t *continuation = SCM_CONTREGS (obj);
/* stack array size is 1 if num_stack_items is 0 (rootcont). */
scm_sizet extra_items = (continuation->num_stack_items > 0)
size_t extra_items = (continuation->num_stack_items > 0)
? (continuation->num_stack_items - 1)
: 0;
scm_sizet bytes_free = sizeof (scm_contregs)
size_t bytes_free = sizeof (scm_contregs_t)
+ extra_items * sizeof (SCM_STACKITEM);
scm_must_free (continuation);
@ -96,7 +96,7 @@ continuation_free (SCM obj)
static int
continuation_print (SCM obj, SCM port, scm_print_state *state)
{
scm_contregs *continuation = SCM_CONTREGS (obj);
scm_contregs_t *continuation = SCM_CONTREGS (obj);
scm_puts ("#<continuation ", port);
scm_intprint (continuation->num_stack_items, 10, port);
@ -114,15 +114,15 @@ SCM
scm_make_continuation (int *first)
{
volatile SCM cont;
scm_contregs *continuation;
scm_contregs *rootcont = SCM_CONTREGS (scm_rootcont);
long stack_size;
scm_contregs_t *continuation;
scm_contregs_t *rootcont = SCM_CONTREGS (scm_rootcont);
scm_bits_t stack_size;
SCM_STACKITEM * src;
SCM_ENTER_A_SECTION;
SCM_FLUSH_REGISTER_WINDOWS;
stack_size = scm_stack_size (rootcont->base);
continuation = scm_must_malloc (sizeof (scm_contregs)
continuation = scm_must_malloc (sizeof (scm_contregs_t)
+ (stack_size - 1) * sizeof (SCM_STACKITEM),
FUNC_NAME);
continuation->num_stack_items = stack_size;
@ -180,7 +180,7 @@ grow_stack (SCM cont, SCM val)
* own frame are overwritten. Thus, memcpy can be used for best performance.
*/
static void
copy_stack_and_call (scm_contregs *continuation, SCM val,
copy_stack_and_call (scm_contregs_t *continuation, SCM val,
SCM_STACKITEM * dst)
{
memcpy (dst, continuation->stack,
@ -202,7 +202,7 @@ copy_stack_and_call (scm_contregs *continuation, SCM val,
static void
scm_dynthrow (SCM cont, SCM val)
{
scm_contregs *continuation = SCM_CONTREGS (cont);
scm_contregs_t *continuation = SCM_CONTREGS (cont);
SCM_STACKITEM * dst = SCM_BASE (scm_rootcont);
SCM_STACKITEM stack_top_element;
@ -224,8 +224,8 @@ static SCM
continuation_apply (SCM cont, SCM args)
#define FUNC_NAME "continuation_apply"
{
scm_contregs *continuation = SCM_CONTREGS (cont);
scm_contregs *rootcont = SCM_CONTREGS (scm_rootcont);
scm_contregs_t *continuation = SCM_CONTREGS (cont);
scm_contregs_t *rootcont = SCM_CONTREGS (scm_rootcont);
if (continuation->seq != rootcont->seq
/* this base comparison isn't needed */

16
libguile/continuations.h
View file

@ -50,7 +50,7 @@
/* a continuation SCM is a non-immediate pointing to a heap cell with:
word 0: bits 0-15: unused.
bits 16-31: smob type tag: scm_tc16_continuation.
word 1: malloc block containing an scm_contregs structure with a
word 1: malloc block containing an scm_contregs_t structure with a
tail array of SCM_STACKITEM. the size of the array is stored
in the num_stack_items field of the structure.
*/
@ -63,20 +63,24 @@ typedef struct
jmp_buf jmpbuf;
SCM dynenv;
SCM_STACKITEM *base; /* base of the live stack, before it was saved. */
scm_sizet num_stack_items; /* size of the saved stack. */
unsigned long seq; /* dynamic root identifier. */
scm_bits_t num_stack_items; /* size of the saved stack. */
scm_ubits_t seq; /* dynamic root identifier. */
#ifdef DEBUG_EXTENSIONS
/* the most recently created debug frame on the live stack, before
it was saved. */
struct scm_debug_frame *dframe;
struct scm_debug_frame_t *dframe;
#endif
SCM_STACKITEM stack[1]; /* copied stack of size num_stack_items. */
} scm_contregs;
} scm_contregs_t;
#if (SCM_DEBUG_DEPRECATED == 0)
# define scm_contregs scm_contregs_t
#endif
#define SCM_CONTINUATIONP(x) SCM_TYP16_PREDICATE (scm_tc16_continuation, x)
#define SCM_CONTREGS(x) ((scm_contregs *) SCM_CELL_WORD_1 (x))
#define SCM_CONTREGS(x) ((scm_contregs_t *) SCM_CELL_WORD_1 (x))
#define SCM_CONTINUATION_LENGTH(x) (SCM_CONTREGS (x)->num_stack_items)
#define SCM_SET_CONTINUATION_LENGTH(x,n)\

4
libguile/coop-threads.c
View file

@ -109,7 +109,7 @@ scm_threads_mark_stacks (void)
/* This assumes that all registers are saved into the jmp_buf */
setjmp (scm_save_regs_gc_mark);
scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark,
((scm_sizet) sizeof scm_save_regs_gc_mark
((size_t) sizeof scm_save_regs_gc_mark
/ sizeof (SCM_STACKITEM)));
scm_mark_locations (((size_t) thread->base,
@ -130,7 +130,7 @@ scm_threads_mark_stacks (void)
/* This assumes that all registers are saved into the jmp_buf */
setjmp (scm_save_regs_gc_mark);
scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark,
((scm_sizet) sizeof scm_save_regs_gc_mark
((size_t) sizeof scm_save_regs_gc_mark
/ sizeof (SCM_STACKITEM)));
scm_mark_locations ((SCM_STACKITEM *) &thread,

40
libguile/debug.c
View file

@ -521,8 +521,8 @@ SCM
scm_start_stack (SCM id, SCM exp, SCM env)
{
SCM answer;
scm_debug_frame vframe;
scm_debug_info vframe_vect_body;
scm_debug_frame_t vframe;
scm_debug_info_t vframe_vect_body;
vframe.prev = scm_last_debug_frame;
vframe.status = SCM_VOIDFRAME;
vframe.vect = &vframe_vect_body;
@ -576,7 +576,7 @@ SCM_DEFINE (scm_debug_object_p, "debug-object?", 1, 0, 0,
SCM
scm_make_debugobj (scm_debug_frame *frame)
scm_make_debugobj (scm_debug_frame_t *frame)
{
register SCM z;
SCM_NEWCELL (z);
@ -619,23 +619,23 @@ scm_init_debug ()
scm_set_smob_print (scm_tc16_debugobj, debugobj_print);
#ifdef GUILE_DEBUG
scm_define ("SCM_IM_AND", SCM_IM_AND);
scm_define ("SCM_IM_BEGIN", SCM_IM_BEGIN);
scm_define ("SCM_IM_CASE", SCM_IM_CASE);
scm_define ("SCM_IM_COND", SCM_IM_COND);
scm_define ("SCM_IM_DO", SCM_IM_DO);
scm_define ("SCM_IM_IF", SCM_IM_IF);
scm_define ("SCM_IM_LAMBDA", SCM_IM_LAMBDA);
scm_define ("SCM_IM_LET", SCM_IM_LET);
scm_define ("SCM_IM_LETSTAR", SCM_IM_LETSTAR);
scm_define ("SCM_IM_LETREC", SCM_IM_LETREC);
scm_define ("SCM_IM_OR", SCM_IM_OR);
scm_define ("SCM_IM_QUOTE", SCM_IM_QUOTE);
scm_define ("SCM_IM_SET_X", SCM_IM_SET_X);
scm_define ("SCM_IM_DEFINE", SCM_IM_DEFINE);
scm_define ("SCM_IM_APPLY", SCM_IM_APPLY);
scm_define ("SCM_IM_CONT", SCM_IM_CONT);
scm_define ("SCM_IM_DISPATCH", SCM_IM_DISPATCH);
scm_c_define ("SCM_IM_AND", SCM_IM_AND);
scm_c_define ("SCM_IM_BEGIN", SCM_IM_BEGIN);
scm_c_define ("SCM_IM_CASE", SCM_IM_CASE);
scm_c_define ("SCM_IM_COND", SCM_IM_COND);
scm_c_define ("SCM_IM_DO", SCM_IM_DO);
scm_c_define ("SCM_IM_IF", SCM_IM_IF);
scm_c_define ("SCM_IM_LAMBDA", SCM_IM_LAMBDA);
scm_c_define ("SCM_IM_LET", SCM_IM_LET);
scm_c_define ("SCM_IM_LETSTAR", SCM_IM_LETSTAR);
scm_c_define ("SCM_IM_LETREC", SCM_IM_LETREC);
scm_c_define ("SCM_IM_OR", SCM_IM_OR);
scm_c_define ("SCM_IM_QUOTE", SCM_IM_QUOTE);
scm_c_define ("SCM_IM_SET_X", SCM_IM_SET_X);
scm_c_define ("SCM_IM_DEFINE", SCM_IM_DEFINE);
scm_c_define ("SCM_IM_APPLY", SCM_IM_APPLY);
scm_c_define ("SCM_IM_CONT", SCM_IM_CONT);
scm_c_define ("SCM_IM_DISPATCH", SCM_IM_DISPATCH);
#endif
scm_add_feature ("debug-extensions");

27
libguile/debug.h
View file

@ -69,7 +69,7 @@
/* scm_debug_opts is defined in eval.c.
*/
extern scm_option scm_debug_opts[];
extern scm_option_t scm_debug_opts[];
#define SCM_CHEAPTRAPS_P scm_debug_opts[0].val
#define SCM_BREAKPOINTS_P scm_debug_opts[1].val
@ -108,25 +108,30 @@ do {\
/* {Evaluator}
*/
typedef union scm_debug_info
typedef union scm_debug_info_t
{
struct { SCM exp, env; } e;
struct { SCM proc, args; } a;
SCM id;
} scm_debug_info;
} scm_debug_info_t;
extern int scm_debug_eframe_size;
extern scm_bits_t scm_debug_eframe_size;
typedef struct scm_debug_frame
typedef struct scm_debug_frame_t
{
struct scm_debug_frame *prev;
struct scm_debug_frame_t *prev;
long status;
scm_debug_info *vect;
scm_debug_info *info;
} scm_debug_frame;
scm_debug_info_t *vect;
scm_debug_info_t *info;
} scm_debug_frame_t;
#if (SCM_DEBUG_DEPRECATED == 0)
# define scm_debug_info scm_debug_info_t
# define scm_debug_frame scm_debug_frame_t
#endif
#ifndef USE_THREADS
extern scm_debug_frame *scm_last_debug_frame;
extern scm_debug_frame_t *scm_last_debug_frame;
#endif
#define SCM_EVALFRAME (0L << 11)
@ -201,7 +206,7 @@ extern SCM scm_with_traps (SCM thunk);
extern SCM scm_evaluator_traps (SCM setting);
extern SCM scm_debug_options (SCM setting);
extern SCM scm_unmemoize (SCM memoized);
extern SCM scm_make_debugobj (scm_debug_frame* debug);
extern SCM scm_make_debugobj (scm_debug_frame_t *debug);
extern void scm_init_debug (void);
#ifdef GUILE_DEBUG

2
libguile/dynl.c
View file

@ -101,7 +101,7 @@ scm_make_argv_from_stringlist (SCM args,int *argcp,const char *subr,int argn)
argv = (char **) scm_must_malloc ((argc + 1) * sizeof (char *), subr);
for (i = 0; !SCM_NULLP (args); args = SCM_CDR (args), ++i) {
SCM arg = SCM_CAR (args);
scm_sizet len;
size_t len;
char *dst;
char *src;

4
libguile/dynwind.c
View file

@ -201,11 +201,11 @@ scm_swap_bindings (SCM glocs, SCM vals)
}
void
scm_dowinds (SCM to, long delta)
scm_dowinds (SCM to, scm_bits_t delta)
{
tail:
if (SCM_EQ_P (to, scm_dynwinds));
else if (0 > delta)
else if (delta < 0)
{
SCM wind_elt;
SCM wind_key;

2
libguile/dynwind.h
View file

@ -56,7 +56,7 @@ extern SCM scm_internal_dynamic_wind (scm_guard_t before,
scm_guard_t after,
void *inner_data,
void *guard_data);
extern void scm_dowinds (SCM to, long delta);
extern void scm_dowinds (SCM to, scm_bits_t delta);
extern void scm_init_dynwind (void);
#ifdef GUILE_DEBUG

48
libguile/environments.c
View file

@ -479,7 +479,7 @@ environment_mark (SCM env)
}
static scm_sizet
static size_t
environment_free (SCM env)
{
return (*(SCM_ENVIRONMENT_FUNCS (env)->free)) (env);
@ -508,7 +508,7 @@ observer_mark (SCM observer)
static int
observer_print (SCM type, SCM port, scm_print_state *pstate)
{
SCM address = scm_ulong2num (SCM_UNPACK (type));
SCM address = scm_ubits2num (SCM_UNPACK (type));
SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16));
scm_puts ("#<observer ", port);
@ -535,7 +535,7 @@ observer_print (SCM type, SCM port, scm_print_state *pstate)
static SCM
obarray_enter (SCM obarray, SCM symbol, SCM data)
{
scm_sizet hash = SCM_SYMBOL_HASH (symbol) % SCM_VECTOR_LENGTH (obarray);
size_t hash = SCM_SYMBOL_HASH (symbol) % SCM_VECTOR_LENGTH (obarray);
SCM entry = scm_cons (symbol, data);
SCM slot = scm_cons (entry, SCM_VELTS (obarray)[hash]);
SCM_VELTS (obarray)[hash] = slot;
@ -551,7 +551,7 @@ obarray_enter (SCM obarray, SCM symbol, SCM data)
static SCM
obarray_replace (SCM obarray, SCM symbol, SCM data)
{
scm_sizet hash = SCM_SYMBOL_HASH (symbol) % SCM_VECTOR_LENGTH (obarray);
size_t hash = SCM_SYMBOL_HASH (symbol) % SCM_VECTOR_LENGTH (obarray);
SCM new_entry = scm_cons (symbol, data);
SCM lsym;
SCM slot;
@ -579,7 +579,7 @@ obarray_replace (SCM obarray, SCM symbol, SCM data)
static SCM
obarray_retrieve (SCM obarray, SCM sym)
{
scm_sizet hash = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (obarray);
size_t hash = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (obarray);
SCM lsym;
for (lsym = SCM_VELTS (obarray)[hash]; !SCM_NULLP (lsym); lsym = SCM_CDR (lsym))
@ -600,7 +600,7 @@ obarray_retrieve (SCM obarray, SCM sym)
static SCM
obarray_remove (SCM obarray, SCM sym)
{
scm_sizet hash = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (obarray);
size_t hash = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (obarray);
SCM lsym;
SCM *lsymp;
@ -623,8 +623,8 @@ obarray_remove (SCM obarray, SCM sym)
static void
obarray_remove_all (SCM obarray)
{
scm_sizet size = SCM_VECTOR_LENGTH (obarray);
scm_sizet i;
size_t size = SCM_VECTOR_LENGTH (obarray);
size_t i;
for (i = 0; i < size; i++)
{
@ -906,7 +906,7 @@ leaf_environment_ref (SCM env, SCM sym)
static SCM
leaf_environment_fold (SCM env, scm_environment_folder proc, SCM data, SCM init)
{
scm_sizet i;
size_t i;
SCM result = init;
SCM obarray = LEAF_ENVIRONMENT (env)->obarray;
@ -991,7 +991,7 @@ leaf_environment_mark (SCM env)
}
static scm_sizet
static size_t
leaf_environment_free (SCM env)
{
core_environments_finalize (env);
@ -1004,7 +1004,7 @@ leaf_environment_free (SCM env)
static int
leaf_environment_print (SCM type, SCM port, scm_print_state *pstate)
{
SCM address = scm_ulong2num (SCM_UNPACK (type));
SCM address = scm_ubits2num (SCM_UNPACK (type));
SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16));
scm_puts ("#<leaf environment ", port);
@ -1040,7 +1040,7 @@ SCM_DEFINE (scm_make_leaf_environment, "make-leaf-environment", 0, 0, 0,
"will be mutable.")
#define FUNC_NAME s_scm_make_leaf_environment
{
scm_sizet size = sizeof (struct leaf_environment);
size_t size = sizeof (struct leaf_environment);
struct leaf_environment *body = scm_must_malloc (size, FUNC_NAME);
SCM env;
@ -1246,7 +1246,7 @@ eval_environment_folder (SCM extended_data, SCM symbol, SCM value, SCM tail)
if (!SCM_ENVIRONMENT_BOUND_P (local, symbol))
{
SCM proc_as_nr = SCM_CADR (extended_data);
unsigned long int proc_as_ul = scm_num2ulong (proc_as_nr, 0, NULL);
scm_ubits_t proc_as_ul = scm_num2ubits (proc_as_nr, 0, NULL);
scm_environment_folder proc = (scm_environment_folder) proc_as_ul;
SCM data = SCM_CDDR (extended_data);
@ -1264,7 +1264,7 @@ eval_environment_fold (SCM env, scm_environment_folder proc, SCM data, SCM init)
{
SCM local = EVAL_ENVIRONMENT (env)->local;
SCM imported = EVAL_ENVIRONMENT (env)->imported;
SCM proc_as_nr = scm_ulong2num ((unsigned long int) proc);
SCM proc_as_nr = scm_ubits2num ((scm_ubits_t) proc);
SCM extended_data = scm_cons2 (local, proc_as_nr, data);
SCM tmp_result = scm_c_environment_fold (imported, eval_environment_folder, extended_data, init);
@ -1352,7 +1352,7 @@ eval_environment_mark (SCM env)
}
static scm_sizet
static size_t
eval_environment_free (SCM env)
{
core_environments_finalize (env);
@ -1365,7 +1365,7 @@ eval_environment_free (SCM env)
static int
eval_environment_print (SCM type, SCM port, scm_print_state *pstate)
{
SCM address = scm_ulong2num (SCM_UNPACK (type));
SCM address = scm_ubits2num (SCM_UNPACK (type));
SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16));
scm_puts ("#<eval environment ", port);
@ -1652,7 +1652,7 @@ import_environment_folder (SCM extended_data, SCM symbol, SCM value, SCM tail)
SCM imported_env = SCM_CADR (extended_data);
SCM owner = import_environment_lookup (import_env, symbol);
SCM proc_as_nr = SCM_CADDR (extended_data);
unsigned long int proc_as_ul = scm_num2ulong (proc_as_nr, 0, NULL);
scm_ubits_t proc_as_ul = scm_num2ubits (proc_as_nr, 0, NULL);
scm_environment_folder proc = (scm_environment_folder) proc_as_ul;
SCM data = SCM_CDDDR (extended_data);
@ -1670,7 +1670,7 @@ import_environment_folder (SCM extended_data, SCM symbol, SCM value, SCM tail)
static SCM
import_environment_fold (SCM env, scm_environment_folder proc, SCM data, SCM init)
{
SCM proc_as_nr = scm_ulong2num ((unsigned long int) proc);
SCM proc_as_nr = scm_ubits2num ((scm_ubits_t) proc);
SCM result = init;
SCM l;
@ -1768,7 +1768,7 @@ import_environment_mark (SCM env)
}
static scm_sizet
static size_t
import_environment_free (SCM env)
{
core_environments_finalize (env);
@ -1781,7 +1781,7 @@ import_environment_free (SCM env)
static int
import_environment_print (SCM type, SCM port, scm_print_state *pstate)
{
SCM address = scm_ulong2num (SCM_UNPACK (type));
SCM address = scm_ubits2num (SCM_UNPACK (type));
SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16));
scm_puts ("#<import environment ", port);
@ -1846,7 +1846,7 @@ SCM_DEFINE (scm_make_import_environment, "make-import-environment", 2, 0, 0,
"if one of its imported environments changes.")
#define FUNC_NAME s_scm_make_import_environment
{
scm_sizet size = sizeof (struct import_environment);
size_t size = sizeof (struct import_environment);
struct import_environment *body = scm_must_malloc (size, FUNC_NAME);
SCM env;
@ -2071,7 +2071,7 @@ export_environment_mark (SCM env)
}
static scm_sizet
static size_t
export_environment_free (SCM env)
{
core_environments_finalize (env);
@ -2084,7 +2084,7 @@ export_environment_free (SCM env)
static int
export_environment_print (SCM type, SCM port, scm_print_state *pstate)
{
SCM address = scm_ulong2num (SCM_UNPACK (type));
SCM address = scm_ubits2num (SCM_UNPACK (type));
SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16));
scm_puts ("#<export environment ", port);
@ -2164,7 +2164,7 @@ SCM_DEFINE (scm_make_export_environment, "make-export-environment", 2, 0, 0,
"if the bindings in private change.")
#define FUNC_NAME s_scm_make_export_environment
{
scm_sizet size;
size_t size;
struct export_environment *body;
SCM env;

2
libguile/environments.h
View file

@ -74,7 +74,7 @@ struct scm_environment_funcs {
void (*unobserve) (SCM self, SCM token);
SCM (*mark) (SCM self);
scm_sizet (*free) (SCM self);
size_t (*free) (SCM self);
int (*print) (SCM self, SCM port, scm_print_state *pstate);
};

2
libguile/error.c
View file

@ -305,7 +305,7 @@ scm_wta (SCM arg, const char *pos, const char *s_subr)
else
{
/* numerical error code. */
int error = (long) pos;
int error = (int) pos;
switch (error)
{

76
libguile/eval.c
View file

@ -162,7 +162,7 @@ char *alloca ();
SCM *
scm_ilookup (SCM iloc, SCM env)
{
register int ir = SCM_IFRAME (iloc);
register scm_bits_t ir = SCM_IFRAME (iloc);
register SCM er = env;
for (; 0 != ir; --ir)
er = SCM_CDR (er);
@ -419,7 +419,7 @@ scm_unmemocar (SCM form, SCM env)
#ifdef DEBUG_EXTENSIONS
else if (SCM_ILOCP (c))
{
int ir;
scm_bits_t ir;
for (ir = SCM_IFRAME (c); ir != 0; --ir)
env = SCM_CDR (env);
@ -536,7 +536,7 @@ SCM_GLOBAL_SYMBOL(scm_sym_if, s_if);
SCM
scm_m_if (SCM xorig, SCM env)
{
int len = scm_ilength (SCM_CDR (xorig));
scm_bits_t len = scm_ilength (SCM_CDR (xorig));
SCM_ASSYNT (len >= 2 && len <= 3, scm_s_expression, "if");
return scm_cons (SCM_IM_IF, SCM_CDR (xorig));
}
@ -563,7 +563,7 @@ SCM_GLOBAL_SYMBOL(scm_sym_and, s_and);
SCM
scm_m_and (SCM xorig, SCM env)
{
int len = scm_ilength (SCM_CDR (xorig));
scm_bits_t len = scm_ilength (SCM_CDR (xorig));
SCM_ASSYNT (len >= 0, scm_s_test, s_and);
if (len >= 1)
return scm_cons (SCM_IM_AND, SCM_CDR (xorig));
@ -577,7 +577,7 @@ SCM_GLOBAL_SYMBOL(scm_sym_or,s_or);
SCM
scm_m_or (SCM xorig, SCM env)
{
int len = scm_ilength (SCM_CDR (xorig));
scm_bits_t len = scm_ilength (SCM_CDR (xorig));
SCM_ASSYNT (len >= 0, scm_s_test, s_or);
if (len >= 1)
return scm_cons (SCM_IM_OR, SCM_CDR (xorig));
@ -615,7 +615,7 @@ SCM
scm_m_cond (SCM xorig, SCM env)
{
SCM arg1, cdrx = scm_list_copy (SCM_CDR (xorig)), x = cdrx;
int len = scm_ilength (x);
scm_bits_t len = scm_ilength (x);
SCM_ASSYNT (len >= 1, scm_s_clauses, s_cond);
while (SCM_NIMP (x))
{
@ -705,7 +705,7 @@ SCM
scm_m_letstar (SCM xorig, SCM env)
{
SCM x = SCM_CDR (xorig), arg1, proc, vars = SCM_EOL, *varloc = &vars;
int len = scm_ilength (x);
scm_bits_t len = scm_ilength (x);
SCM_ASSYNT (len >= 2, scm_s_body, s_letstar);
proc = SCM_CAR (x);
SCM_ASSYNT (scm_ilength (proc) >= 0, scm_s_bindings, s_letstar);
@ -747,7 +747,7 @@ scm_m_do (SCM xorig, SCM env)
SCM x = SCM_CDR (xorig), arg1, proc;
SCM vars = SCM_EOL, inits = SCM_EOL, steps = SCM_EOL;
SCM *initloc = &inits, *steploc = &steps;
int len = scm_ilength (x);
scm_bits_t len = scm_ilength (x);
SCM_ASSYNT (len >= 2, scm_s_test, "do");
proc = SCM_CAR (x);
SCM_ASSYNT (scm_ilength (proc) >= 0, scm_s_bindings, "do");
@ -780,7 +780,7 @@ scm_m_do (SCM xorig, SCM env)
#define evalcar scm_eval_car
static SCM iqq (SCM form, SCM env, int depth);
static SCM iqq (SCM form, SCM env, scm_bits_t depth);
SCM_SYNTAX(s_quasiquote, "quasiquote", scm_makacro, scm_m_quasiquote);
SCM_GLOBAL_SYMBOL(scm_sym_quasiquote, s_quasiquote);
@ -795,15 +795,15 @@ scm_m_quasiquote (SCM xorig, SCM env)
static SCM
iqq (SCM form, SCM env, int depth)
iqq (SCM form, SCM env, scm_bits_t depth)
{
SCM tmp;
int edepth = depth;
scm_bits_t edepth = depth;
if (SCM_IMP (form))
return form;
if (SCM_VECTORP (form))
{
long i = SCM_VECTOR_LENGTH (form);
scm_bits_t i = SCM_VECTOR_LENGTH (form);
SCM *data = SCM_VELTS (form);
tmp = SCM_EOL;
for (; --i >= 0;)
@ -1043,7 +1043,7 @@ SCM_SYNTAX (s_nil_cond, "nil-cond", scm_makmmacro, scm_m_nil_cond);
SCM
scm_m_nil_cond (SCM xorig, SCM env)
{
int len = scm_ilength (SCM_CDR (xorig));
scm_bits_t len = scm_ilength (SCM_CDR (xorig));
SCM_ASSYNT (len >= 1 && (len & 1) == 1, scm_s_expression, "nil-cond");
return scm_cons (SCM_IM_NIL_COND, SCM_CDR (xorig));
}
@ -1071,7 +1071,7 @@ SCM_SYNTAX (s_0_cond, "0-cond", scm_makmmacro, scm_m_0_cond);
SCM
scm_m_0_cond (SCM xorig, SCM env)
{
int len = scm_ilength (SCM_CDR (xorig));
scm_bits_t len = scm_ilength (SCM_CDR (xorig));
SCM_ASSYNT (len >= 1 && (len & 1) == 1, scm_s_expression, "0-cond");
return scm_cons (SCM_IM_0_COND, SCM_CDR (xorig));
}
@ -1651,24 +1651,24 @@ SCM (*scm_ceval_ptr) (SCM x, SCM env);
*/
#ifndef USE_THREADS
scm_debug_frame *scm_last_debug_frame;
scm_debug_frame_t *scm_last_debug_frame;
#endif
/* scm_debug_eframe_size is the number of slots available for pseudo
* stack frames at each real stack frame.
*/
int scm_debug_eframe_size;
scm_bits_t scm_debug_eframe_size;
int scm_debug_mode, scm_check_entry_p, scm_check_apply_p, scm_check_exit_p;
int scm_eval_stack;
scm_bits_t scm_eval_stack;
scm_option scm_eval_opts[] = {
scm_option_t scm_eval_opts[] = {
{ SCM_OPTION_INTEGER, "stack", 22000, "Size of thread stacks (in machine words)." }
};
scm_option scm_debug_opts[] = {
scm_option_t scm_debug_opts[] = {
{ SCM_OPTION_BOOLEAN, "cheap", 1,
"*Flyweight representation of the stack at traps." },
{ SCM_OPTION_BOOLEAN, "breakpoints", 0, "*Check for breakpoints." },
@ -1689,7 +1689,7 @@ scm_option scm_debug_opts[] = {
{ SCM_OPTION_INTEGER, "stack", 20000, "Stack size limit (measured in words; 0 = no check)." }
};
scm_option scm_evaluator_trap_table[] = {
scm_option_t scm_evaluator_trap_table[] = {
{ SCM_OPTION_BOOLEAN, "traps", 0, "Enable evaluator traps." },
{ SCM_OPTION_BOOLEAN, "enter-frame", 0, "Trap when eval enters new frame." },
{ SCM_OPTION_BOOLEAN, "apply-frame", 0, "Trap when entering apply." },
@ -1823,17 +1823,17 @@ SCM_CEVAL (SCM x, SCM env)
} t;
SCM proc, arg2, orig_sym;
#ifdef DEVAL
scm_debug_frame debug;
scm_debug_info *debug_info_end;
scm_debug_frame_t debug;
scm_debug_info_t *debug_info_end;
debug.prev = scm_last_debug_frame;
debug.status = scm_debug_eframe_size;
/*
* The debug.vect contains twice as much scm_debug_info frames as the
* The debug.vect contains twice as much scm_debug_info_t frames as the
* user has specified with (debug-set! frames <n>).
*
* Even frames are eval frames, odd frames are apply frames.
*/
debug.vect = (scm_debug_info *) alloca (scm_debug_eframe_size
debug.vect = (scm_debug_info_t *) alloca (scm_debug_eframe_size
* sizeof (debug.vect[0]));
debug.info = debug.vect;
debug_info_end = debug.vect + scm_debug_eframe_size;
@ -2303,7 +2303,7 @@ dispatch:
* cuts down execution time for type dispatch to 50%.
*/
{
int i, n, end, mask;
scm_bits_t i, n, end, mask;
SCM z = SCM_CDDR (x);
n = SCM_INUM (SCM_CAR (z)); /* maximum number of specializers */
proc = SCM_CADR (z);
@ -2318,8 +2318,8 @@ dispatch:
else
{
/* Compute a hash value */
int hashset = SCM_INUM (proc);
int j = n;
scm_bits_t hashset = SCM_INUM (proc);
scm_bits_t j = n;
mask = SCM_INUM (SCM_CAR (z = SCM_CDDR (z)));
proc = SCM_CADR (z);
i = 0;
@ -2339,7 +2339,7 @@ dispatch:
/* Search for match */
do
{
int j = n;
scm_bits_t j = n;
z = SCM_VELTS (proc)[i];
t.arg1 = arg2; /* list of arguments */
if (SCM_NIMP (t.arg1))
@ -2797,7 +2797,7 @@ evapply:
#ifdef SCM_BIGDIG
if (SCM_BIGP (t.arg1))
{
RETURN (scm_make_real (SCM_DSUBRF (proc) (scm_big2dbl (t.arg1))));
RETURN (scm_make_real (SCM_DSUBRF (proc) (scm_i_big2dbl (t.arg1))));
}
#endif
floerr:
@ -3313,8 +3313,8 @@ SCM_APPLY (SCM proc, SCM arg1, SCM args)
{
#ifdef DEBUG_EXTENSIONS
#ifdef DEVAL
scm_debug_frame debug;
scm_debug_info debug_vect_body;
scm_debug_frame_t debug;
scm_debug_info_t debug_vect_body;
debug.prev = scm_last_debug_frame;
debug.status = SCM_APPLYFRAME;
debug.vect = &debug_vect_body;
@ -3419,7 +3419,7 @@ tail:
}
#ifdef SCM_BIGDIG
if (SCM_BIGP (arg1))
RETURN (scm_make_real (SCM_DSUBRF (proc) (scm_big2dbl (arg1))))
RETURN (scm_make_real (SCM_DSUBRF (proc) (scm_i_big2dbl (arg1))))
#endif
floerr:
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
@ -3631,18 +3631,18 @@ ret:
and claim that the i'th element of ARGV is WHO's i+2'th argument. */
static inline void
check_map_args (SCM argv,
long len,
scm_bits_t len,
SCM gf,
SCM proc,
SCM args,
const char *who)
{
SCM *ve = SCM_VELTS (argv);
int i;
scm_bits_t i;
for (i = SCM_VECTOR_LENGTH (argv) - 1; i >= 1; i--)
{
int elt_len = scm_ilength (ve[i]);
scm_bits_t elt_len = scm_ilength (ve[i]);
if (elt_len < 0)
{
@ -3673,7 +3673,7 @@ SCM
scm_map (SCM proc, SCM arg1, SCM args)
#define FUNC_NAME s_map
{
long i, len;
scm_bits_t i, len;
SCM res = SCM_EOL;
SCM *pres = &res;
SCM *ve = &args; /* Keep args from being optimized away. */
@ -3722,7 +3722,7 @@ scm_for_each (SCM proc, SCM arg1, SCM args)
#define FUNC_NAME s_for_each
{
SCM *ve = &args; /* Keep args from being optimized away. */
long i, len;
scm_bits_t i, len;
len = scm_ilength (arg1);
SCM_GASSERTn (len >= 0, g_for_each, scm_cons2 (proc, arg1, args),
SCM_ARG2, s_for_each);
@ -3861,7 +3861,7 @@ SCM_DEFINE (scm_copy_tree, "copy-tree", 1, 0, 0,
return obj;
if (SCM_VECTORP (obj))
{
scm_sizet i = SCM_VECTOR_LENGTH (obj);
size_t i = SCM_VECTOR_LENGTH (obj);
ans = scm_c_make_vector (i, SCM_UNSPECIFIED);
while (i--)
SCM_VELTS (ans)[i] = scm_copy_tree (SCM_VELTS (obj)[i]);

10
libguile/eval.h
View file

@ -53,14 +53,14 @@
/* {Options}
*/
extern scm_option scm_eval_opts[];
extern scm_option_t scm_eval_opts[];
#define SCM_EVAL_STACK scm_eval_opts[0].val
#define SCM_N_EVAL_OPTIONS 1
extern int scm_eval_stack;
extern scm_bits_t scm_eval_stack;
extern scm_option scm_evaluator_trap_table[];
extern scm_option_t scm_evaluator_trap_table[];
extern SCM scm_eval_options_interface (SCM setting);
@ -83,8 +83,8 @@ extern SCM scm_eval_options_interface (SCM setting);
#define SCM_ICDR (0x00080000L)
#define SCM_IFRINC (0x00000100L)
#define SCM_IDSTMSK (-SCM_IDINC)
#define SCM_IFRAME(n) ((int)((SCM_ICDR-SCM_IFRINC)>>8) \
& (SCM_UNPACK (n) >> 8))
#define SCM_IFRAME(n) ((scm_bits_t)((SCM_ICDR-SCM_IFRINC)>>8) \
& (SCM_UNPACK (n)) >> 8)
#define SCM_IDIST(n) (SCM_UNPACK (n) >> 20)
#define SCM_ICDRP(n) (SCM_ICDR & SCM_UNPACK (n))

13
libguile/extensions.c
View file

@ -48,21 +48,22 @@
#include "libguile/extensions.h"
struct extension {
struct extension *next;
typedef struct extension_t
{
struct extension_t *next;
const char *lib;
const char *init;
void (*func)(void *);
void *data;
};
} extension_t;
static struct extension *registered_extensions;
static extension_t *registered_extensions;
void
scm_c_register_extension (const char *lib, const char *init,
void (*func) (void *), void *data)
{
struct extension *ext = scm_must_malloc (sizeof(struct extension),
extension_t *ext = scm_must_malloc (sizeof(extension_t),
"scm_register_extension");
ext->lib = scm_must_strdup (lib);
ext->init = scm_must_strdup (init);
@ -78,7 +79,7 @@ load_extension (SCM lib, SCM init)
{
/* Search the registry. */
{
struct extension *ext;
extension_t *ext;
for (ext = registered_extensions; ext; ext = ext->next)
if (!strcmp (ext->lib, SCM_STRING_CHARS (lib))

14
libguile/filesys.c
View file

@ -243,8 +243,8 @@ SCM_DEFINE (scm_open_fdes, "open-fdes", 2, 1, 0,
SCM_VALIDATE_STRING (1, path);
SCM_STRING_COERCE_0TERMINATION_X (path);
iflags = SCM_NUM2LONG (2, flags);
imode = SCM_NUM2LONG_DEF (3, mode, 0666);
iflags = SCM_NUM2INT (2, flags);
imode = SCM_NUM2INT_DEF (3, mode, 0666);
SCM_SYSCALL (fd = open (SCM_STRING_CHARS (path), iflags, imode));
if (fd == -1)
SCM_SYSERROR;
@ -286,7 +286,7 @@ SCM_DEFINE (scm_open, "open", 2, 1, 0,
int iflags;
fd = SCM_INUM (scm_open_fdes (path, flags, mode));
iflags = SCM_NUM2LONG (2, flags);
iflags = SCM_NUM2INT (2, flags);
if (iflags & O_RDWR)
{
if (iflags & O_APPEND)
@ -795,7 +795,7 @@ scm_dir_print (SCM exp, SCM port, scm_print_state *pstate)
}
static scm_sizet
static size_t
scm_dir_free (SCM p)
{
if (SCM_DIR_OPEN_P (p))
@ -832,7 +832,7 @@ SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0,
#define FUNC_NAME s_scm_getcwd
{
char *rv;
scm_sizet size = 100;
size_t size = 100;
char *wd;
SCM result;
@ -879,7 +879,7 @@ set_element (SELECT_TYPE *set, SCM *ports_ready, SCM element, int pos)
if (pos == SCM_ARG1)
{
/* check whether port has buffered input. */
scm_port *pt = SCM_PTAB_ENTRY (element);
scm_port_t *pt = SCM_PTAB_ENTRY (element);
if (pt->read_pos < pt->read_end)
use_buf = 1;
@ -887,7 +887,7 @@ set_element (SELECT_TYPE *set, SCM *ports_ready, SCM element, int pos)
else if (pos == SCM_ARG2)
{
/* check whether port's output buffer has room. */
scm_port *pt = SCM_PTAB_ENTRY (element);
scm_port_t *pt = SCM_PTAB_ENTRY (element);
/* > 1 since writing the last byte in the buffer causes flush. */
if (pt->write_end - pt->write_pos > 1)

16
libguile/fluids.c
View file

@ -56,7 +56,7 @@
#define INITIAL_FLUIDS 10
#include "libguile/validate.h"
static volatile int n_fluids;
static volatile scm_bits_t n_fluids;
scm_bits_t scm_tc16_fluid;
SCM
@ -69,7 +69,7 @@ static void
grow_fluids (scm_root_state *root_state, int new_length)
{
SCM old_fluids, new_fluids;
int old_length, i;
scm_bits_t old_length, i;
old_fluids = root_state->fluids;
old_length = SCM_VECTOR_LENGTH (old_fluids);
@ -104,10 +104,10 @@ fluid_print (SCM exp, SCM port, scm_print_state *pstate)
return 1;
}
static int
static scm_bits_t
next_fluid_num ()
{
int n;
scm_bits_t n;
SCM_CRITICAL_SECTION_START;
n = n_fluids++;
SCM_CRITICAL_SECTION_END;
@ -125,7 +125,7 @@ SCM_DEFINE (scm_make_fluid, "make-fluid", 0, 0, 0,
"in its own dynamic root, you can use fluids for thread local storage.")
#define FUNC_NAME s_scm_make_fluid
{
int n;
scm_bits_t n;
n = next_fluid_num ();
SCM_RETURN_NEWSMOB (scm_tc16_fluid, n);
@ -149,7 +149,7 @@ SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0,
"@code{#f}.")
#define FUNC_NAME s_scm_fluid_ref
{
int n;
scm_bits_t n;
SCM_VALIDATE_FLUID (1, fluid);
@ -166,7 +166,7 @@ SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0,
"Set the value associated with @var{fluid} in the current dynamic root.")
#define FUNC_NAME s_scm_fluid_set_x
{
int n;
scm_bits_t n;
SCM_VALIDATE_FLUID (1, fluid);
n = SCM_FLUID_NUM (fluid);
@ -234,7 +234,7 @@ scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata)
#define FUNC_NAME "scm_c_with_fluids"
{
SCM ans;
int flen, vlen;
scm_bits_t flen, vlen;
SCM_VALIDATE_LIST_COPYLEN (1, fluids, flen);
SCM_VALIDATE_LIST_COPYLEN (2, values, vlen);

63
libguile/fports.c
View file

@ -59,7 +59,7 @@
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#else
scm_sizet fwrite ();
size_t fwrite ();
#endif
#ifdef HAVE_ST_BLKSIZE
#include <sys/stat.h>
@ -74,20 +74,20 @@ scm_bits_t scm_tc16_fport;
/* default buffer size, used if the O/S won't supply a value. */
static const int default_buffer_size = 1024;
static const size_t default_buffer_size = 1024;
/* create FPORT buffer with specified sizes (or -1 to use default size or
0 for no buffer. */
static void
scm_fport_buffer_add (SCM port, int read_size, int write_size)
scm_fport_buffer_add (SCM port, scm_bits_t read_size, scm_bits_t write_size)
#define FUNC_NAME "scm_fport_buffer_add"
{
struct scm_fport *fp = SCM_FSTREAM (port);
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_fport_t *fp = SCM_FSTREAM (port);
scm_port_t *pt = SCM_PTAB_ENTRY (port);
if (read_size == -1 || write_size == -1)
{
int default_size;
size_t default_size;
#ifdef HAVE_ST_BLKSIZE
struct stat st;
@ -148,8 +148,9 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
"@end table")
#define FUNC_NAME s_scm_setvbuf
{
int cmode, csize;
scm_port *pt;
int cmode;
scm_bits_t csize;
scm_port_t *pt;
port = SCM_COERCE_OUTPORT (port);
@ -202,7 +203,7 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
void
scm_evict_ports (int fd)
{
int i;
scm_bits_t i;
for (i = 0; i < scm_port_table_size; i++)
{
@ -210,7 +211,7 @@ scm_evict_ports (int fd)
if (SCM_FPORTP (port))
{
struct scm_fport *fp = SCM_FSTREAM (port);
scm_fport_t *fp = SCM_FSTREAM (port);
if (fp->fdes == fd)
{
@ -361,7 +362,7 @@ scm_fdes_to_port (int fdes, char *mode, SCM name)
{
long mode_bits = scm_mode_bits (mode);
SCM port;
scm_port *pt;
scm_port_t *pt;
int flags;
/* test that fdes is valid. */
@ -383,8 +384,8 @@ scm_fdes_to_port (int fdes, char *mode, SCM name)
SCM_SET_CELL_TYPE (port, (scm_tc16_fport | mode_bits));
{
struct scm_fport *fp
= (struct scm_fport *) scm_must_malloc (sizeof (struct scm_fport),
scm_fport_t *fp
= (scm_fport_t *) scm_must_malloc (sizeof (scm_fport_t),
FUNC_NAME);
fp->fdes = fdes;
@ -504,9 +505,9 @@ static void fport_flush (SCM port);
static int
fport_fill_input (SCM port)
{
int count;
scm_port *pt = SCM_PTAB_ENTRY (port);
struct scm_fport *fp = SCM_FSTREAM (port);
scm_bits_t count;
scm_port_t *pt = SCM_PTAB_ENTRY (port);
scm_fport_t *fp = SCM_FSTREAM (port);
#ifdef GUILE_ISELECT
fport_wait_for_input (port);
@ -527,8 +528,8 @@ fport_fill_input (SCM port)
static off_t
fport_seek (SCM port, off_t offset, int whence)
{
scm_port *pt = SCM_PTAB_ENTRY (port);
struct scm_fport *fp = SCM_FSTREAM (port);
scm_port_t *pt = SCM_PTAB_ENTRY (port);
scm_fport_t *fp = SCM_FSTREAM (port);
off_t rv;
off_t result;
@ -579,7 +580,7 @@ fport_seek (SCM port, off_t offset, int whence)
static void
fport_truncate (SCM port, off_t length)
{
struct scm_fport *fp = SCM_FSTREAM (port);
scm_fport_t *fp = SCM_FSTREAM (port);
if (ftruncate (fp->fdes, length) == -1)
scm_syserror ("ftruncate");
@ -610,7 +611,7 @@ static void
fport_write (SCM port, const void *data, size_t size)
{
/* this procedure tries to minimize the number of writes/flushes. */
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_port_t *pt = SCM_PTAB_ENTRY (port);
if (pt->write_buf == &pt->shortbuf
|| (pt->write_pos == pt->write_buf && size >= pt->write_buf_size))
@ -671,22 +672,22 @@ extern int terminating;
static void
fport_flush (SCM port)
{
scm_port *pt = SCM_PTAB_ENTRY (port);
struct scm_fport *fp = SCM_FSTREAM (port);
scm_port_t *pt = SCM_PTAB_ENTRY (port);
scm_fport_t *fp = SCM_FSTREAM (port);
unsigned char *ptr = pt->write_buf;
int init_size = pt->write_pos - pt->write_buf;
int remaining = init_size;
scm_bits_t init_size = pt->write_pos - pt->write_buf;
scm_bits_t remaining = init_size;
while (remaining > 0)
{
int count;
scm_bits_t count;
SCM_SYSCALL (count = write (fp->fdes, ptr, remaining));
if (count < 0)
{
/* error. assume nothing was written this call, but
fix up the buffer for any previous successful writes. */
int done = init_size - remaining;
scm_bits_t done = init_size - remaining;
if (done > 0)
{
@ -729,8 +730,8 @@ fport_flush (SCM port)
static void
fport_end_input (SCM port, int offset)
{
struct scm_fport *fp = SCM_FSTREAM (port);
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_fport_t *fp = SCM_FSTREAM (port);
scm_port_t *pt = SCM_PTAB_ENTRY (port);
offset += pt->read_end - pt->read_pos;
@ -748,8 +749,8 @@ fport_end_input (SCM port, int offset)
static int
fport_close (SCM port)
{
struct scm_fport *fp = SCM_FSTREAM (port);
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_fport_t *fp = SCM_FSTREAM (port);
scm_port_t *pt = SCM_PTAB_ENTRY (port);
int rv;
fport_flush (port);
@ -773,7 +774,7 @@ fport_close (SCM port)
return rv;
}
static scm_sizet
static size_t
fport_free (SCM port)
{
fport_close (port);

10
libguile/fports.h
View file

@ -54,13 +54,17 @@
/* struct allocated for each buffered FPORT. */
struct scm_fport {
typedef struct scm_fport_t {
int fdes; /* file descriptor. */
};
} scm_fport_t;
#if (SCM_DEBUG_DEPRECATED == 0)
# define scm_fport scm_fport_t
#endif
extern scm_bits_t scm_tc16_fport;
#define SCM_FSTREAM(x) ((struct scm_fport *) SCM_STREAM (x))
#define SCM_FSTREAM(x) ((scm_fport_t *) SCM_STREAM (x))
#define SCM_FPORT_FDES(x) (SCM_FSTREAM (x)->fdes)
#define SCM_FPORTP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_fport))

420
libguile/gc.c
View file

@ -71,6 +71,7 @@
#include "libguile/tags.h"
#include "libguile/validate.h"
#include "libguile/deprecation.h"
#include "libguile/gc.h"
#ifdef GUILE_DEBUG_MALLOC
@ -124,7 +125,8 @@ scm_assert_cell_valid (SCM cell)
if (!scm_cellp (cell))
{
fprintf (stderr, "scm_assert_cell_valid: Not a cell object: %lx\n", SCM_UNPACK (cell));
fprintf (stderr, "scm_assert_cell_valid: Not a cell object: %lux\n",
(unsigned long) SCM_UNPACK (cell));
abort ();
}
else if (!scm_gc_running_p)
@ -140,7 +142,8 @@ scm_assert_cell_valid (SCM cell)
*/
if (SCM_FREE_CELL_P (cell))
{
fprintf (stderr, "scm_assert_cell_valid: Accessing free cell: %lx\n", SCM_UNPACK (cell));
fprintf (stderr, "scm_assert_cell_valid: Accessing free cell: %lux\n",
(unsigned long) SCM_UNPACK (cell));
abort ();
}
}
@ -187,7 +190,7 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0,
*
* If SCM_INIT_HEAP_SIZE heap cannot be allocated initially, SCM_HEAP_SEG_SIZE
* will be used, and the heap will grow by SCM_HEAP_SEG_SIZE when more
* heap is needed. SCM_HEAP_SEG_SIZE must fit into type scm_sizet. This code
* heap is needed. SCM_HEAP_SEG_SIZE must fit into type size_t. This code
* is in scm_init_storage() and alloc_some_heap() in sys.c
*
* If SCM_INIT_HEAP_SIZE can be allocated initially, the heap will grow by
@ -216,19 +219,19 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0,
#define SCM_DATA_CELLS2CARDS(n) (((n) + SCM_GC_CARD_N_DATA_CELLS - 1) / SCM_GC_CARD_N_DATA_CELLS)
#define SCM_CARDS_PER_CLUSTER SCM_DATA_CELLS2CARDS (2000L)
#define SCM_CLUSTER_SIZE_1 (SCM_CARDS_PER_CLUSTER * SCM_GC_CARD_N_DATA_CELLS)
int scm_default_init_heap_size_1 = (((SCM_DATA_CELLS2CARDS (45000L) + SCM_CARDS_PER_CLUSTER - 1)
size_t scm_default_init_heap_size_1 = (((SCM_DATA_CELLS2CARDS (45000L) + SCM_CARDS_PER_CLUSTER - 1)
/ SCM_CARDS_PER_CLUSTER) * SCM_GC_CARD_SIZE);
int scm_default_min_yield_1 = 40;
#define SCM_CLUSTER_SIZE_2 (SCM_CARDS_PER_CLUSTER * (SCM_GC_CARD_N_DATA_CELLS / 2))
int scm_default_init_heap_size_2 = (((SCM_DATA_CELLS2CARDS (2500L * 2) + SCM_CARDS_PER_CLUSTER - 1)
size_t scm_default_init_heap_size_2 = (((SCM_DATA_CELLS2CARDS (2500L * 2) + SCM_CARDS_PER_CLUSTER - 1)
/ SCM_CARDS_PER_CLUSTER) * SCM_GC_CARD_SIZE);
/* The following value may seem large, but note that if we get to GC at
* all, this means that we have a numerically intensive application
*/
int scm_default_min_yield_2 = 40;
int scm_default_max_segment_size = 2097000L;/* a little less (adm) than 2 Mb */
size_t scm_default_max_segment_size = 2097000L;/* a little less (adm) than 2 Mb */
#define SCM_MIN_HEAP_SEG_SIZE (8 * SCM_GC_CARD_SIZE)
#ifdef _QC
@ -254,11 +257,11 @@ int scm_default_max_segment_size = 2097000L;/* a little less (adm) than 2 Mb */
# define CELL_DN(p, span) MK_FP(FP_SEG(p), ~(8*(span)-1)&FP_OFF(p))
#else
# ifdef _UNICOS
# define CELL_UP(p, span) (SCM_CELLPTR)(~(span) & ((long)(p)+(span)))
# define CELL_DN(p, span) (SCM_CELLPTR)(~(span) & (long)(p))
# define CELL_UP(p, span) (SCM_CELLPTR)(~(span) & ((scm_ubits_t)(p)+(span)))
# define CELL_DN(p, span) (SCM_CELLPTR)(~(span) & (scm_ubits_t)(p))
# else
# define CELL_UP(p, span) (SCM_CELLPTR)(~(sizeof(scm_cell)*(span)-1L) & ((long)(p)+sizeof(scm_cell)*(span)-1L))
# define CELL_DN(p, span) (SCM_CELLPTR)(~(sizeof(scm_cell)*(span)-1L) & (long)(p))
# define CELL_UP(p, span) (SCM_CELLPTR)(~(sizeof(scm_cell)*(span)-1L) & ((scm_ubits_t)(p)+sizeof(scm_cell)*(span)-1L))
# define CELL_DN(p, span) (SCM_CELLPTR)(~(sizeof(scm_cell)*(span)-1L) & (scm_ubits_t)(p))
# endif /* UNICOS */
#endif /* PROT386 */
@ -285,7 +288,7 @@ typedef struct scm_freelist_t {
SCM clusters;
SCM *clustertail;
/* this is the number of objects in each cluster, including the spine cell */
int cluster_size;
unsigned int cluster_size;
/* indicates that we should grow heap instead of GC:ing
*/
int grow_heap_p;
@ -298,13 +301,13 @@ typedef struct scm_freelist_t {
/* number of cells per object on this list */
int span;
/* number of collected cells during last GC */
long collected;
scm_ubits_t collected;
/* number of collected cells during penultimate GC */
long collected_1;
scm_ubits_t collected_1;
/* total number of cells in heap segments
* belonging to this list.
*/
long heap_size;
scm_ubits_t heap_size;
} scm_freelist_t;
SCM scm_freelist = SCM_EOL;
@ -319,7 +322,7 @@ scm_freelist_t scm_master_freelist2 = {
/* scm_mtrigger
* is the number of bytes of must_malloc allocation needed to trigger gc.
*/
unsigned long scm_mtrigger;
scm_ubits_t scm_mtrigger;
/* scm_gc_heap_lock
* If set, don't expand the heap. Set only during gc, during which no allocation
@ -344,20 +347,20 @@ SCM scm_structs_to_free;
/* GC Statistics Keeping
*/
unsigned long scm_cells_allocated = 0;
long scm_mallocated = 0;
unsigned long scm_gc_cells_collected;
unsigned long scm_gc_yield;
static unsigned long scm_gc_yield_1 = 0; /* previous GC yield */
unsigned long scm_gc_malloc_collected;
unsigned long scm_gc_ports_collected;
scm_ubits_t scm_cells_allocated = 0;
scm_ubits_t scm_mallocated = 0;
scm_ubits_t scm_gc_cells_collected;
scm_ubits_t scm_gc_yield;
static scm_ubits_t scm_gc_yield_1 = 0; /* previous GC yield */
scm_ubits_t scm_gc_malloc_collected;
scm_ubits_t scm_gc_ports_collected;
unsigned long scm_gc_time_taken = 0;
static unsigned long t_before_gc;
static unsigned long t_before_sweep;
static scm_ubits_t t_before_gc;
static scm_ubits_t t_before_sweep;
unsigned long scm_gc_mark_time_taken = 0;
unsigned long scm_gc_sweep_time_taken = 0;
unsigned long scm_gc_times = 0;
unsigned long scm_gc_cells_swept = 0;
scm_ubits_t scm_gc_times = 0;
scm_ubits_t scm_gc_cells_swept = 0;
double scm_gc_cells_marked_acc = 0.;
double scm_gc_cells_swept_acc = 0.;
@ -388,7 +391,7 @@ typedef struct scm_heap_seg_data_t
static scm_sizet init_heap_seg (SCM_CELLPTR, scm_sizet, scm_freelist_t *);
static size_t init_heap_seg (SCM_CELLPTR, size_t, scm_freelist_t *);
typedef enum { return_on_error, abort_on_error } policy_on_error;
static void alloc_some_heap (scm_freelist_t *, policy_on_error);
@ -412,7 +415,7 @@ typedef struct scm_mark_space_t
static scm_mark_space_t *current_mark_space;
static scm_mark_space_t **mark_space_ptr;
static int current_mark_space_offset;
static ptrdiff_t current_mark_space_offset;
static scm_mark_space_t *mark_space_head;
static scm_c_bvec_limb_t *
@ -479,17 +482,17 @@ clear_mark_space ()
#if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST)
/* Return the number of the heap segment containing CELL. */
static int
static scm_bits_t
which_seg (SCM cell)
{
int i;
scm_bits_t i;
for (i = 0; i < scm_n_heap_segs; i++)
if (SCM_PTR_LE (scm_heap_table[i].bounds[0], SCM2PTR (cell))
&& SCM_PTR_GT (scm_heap_table[i].bounds[1], SCM2PTR (cell)))
return i;
fprintf (stderr, "which_seg: can't find segment containing cell %lx\n",
SCM_UNPACK (cell));
fprintf (stderr, "which_seg: can't find segment containing cell %lux\n",
(unsigned long) SCM_UNPACK (cell));
abort ();
}
@ -497,26 +500,26 @@ which_seg (SCM cell)
static void
map_free_list (scm_freelist_t *master, SCM freelist)
{
int last_seg = -1, count = 0;
scm_bits_t last_seg = -1, count = 0;
SCM f;
for (f = freelist; !SCM_NULLP (f); f = SCM_FREE_CELL_CDR (f))
{
int this_seg = which_seg (f);
scm_bits_t this_seg = which_seg (f);
if (this_seg != last_seg)
{
if (last_seg != -1)
fprintf (stderr, " %5d %d-cells in segment %d\n",
count, master->span, last_seg);
fprintf (stderr, " %5ld %d-cells in segment %ld\n",
(long) count, master->span, (long) last_seg);
last_seg = this_seg;
count = 0;
}
count++;
}
if (last_seg != -1)
fprintf (stderr, " %5d %d-cells in segment %d\n",
count, master->span, last_seg);
fprintf (stderr, " %5ld %d-cells in segment %ld\n",
(long) count, master->span, (long) last_seg);
}
SCM_DEFINE (scm_map_free_list, "map-free-list", 0, 0, 0,
@ -526,15 +529,15 @@ SCM_DEFINE (scm_map_free_list, "map-free-list", 0, 0, 0,
"@code{--enable-guile-debug} builds of Guile.")
#define FUNC_NAME s_scm_map_free_list
{
int i;
fprintf (stderr, "%d segments total (%d:%d",
scm_n_heap_segs,
scm_bits_t i;
fprintf (stderr, "%ld segments total (%d:%ld",
(long) scm_n_heap_segs,
scm_heap_table[0].span,
scm_heap_table[0].bounds[1] - scm_heap_table[0].bounds[0]);
(long) (scm_heap_table[0].bounds[1] - scm_heap_table[0].bounds[0]));
for (i = 1; i < scm_n_heap_segs; i++)
fprintf (stderr, ", %d:%d",
fprintf (stderr, ", %d:%ld",
scm_heap_table[i].span,
scm_heap_table[i].bounds[1] - scm_heap_table[i].bounds[0]);
(long) (scm_heap_table[i].bounds[1] - scm_heap_table[i].bounds[0]));
fprintf (stderr, ")\n");
map_free_list (&scm_master_freelist, scm_freelist);
map_free_list (&scm_master_freelist2, scm_freelist2);
@ -544,20 +547,20 @@ SCM_DEFINE (scm_map_free_list, "map-free-list", 0, 0, 0,
}
#undef FUNC_NAME
static int last_cluster;
static int last_size;
static scm_bits_t last_cluster;
static scm_bits_t last_size;
static int
free_list_length (char *title, int i, SCM freelist)
static scm_bits_t
free_list_length (char *title, scm_bits_t i, SCM freelist)
{
SCM ls;
int n = 0;
scm_bits_t n = 0;
for (ls = freelist; !SCM_NULLP (ls); ls = SCM_FREE_CELL_CDR (ls))
if (SCM_FREE_CELL_P (ls))
++n;
else
{
fprintf (stderr, "bad cell in %s at position %d\n", title, n);
fprintf (stderr, "bad cell in %s at position %ld\n", title, (long) n);
abort ();
}
if (n != last_size)
@ -565,14 +568,14 @@ free_list_length (char *title, int i, SCM freelist)
if (i > 0)
{
if (last_cluster == i - 1)
fprintf (stderr, "\t%d\n", last_size);
fprintf (stderr, "\t%ld\n", (long) last_size);
else
fprintf (stderr, "-%d\t%d\n", i - 1, last_size);
fprintf (stderr, "-%ld\t%ld\n", (long) (i - 1), (long) last_size);
}
if (i >= 0)
fprintf (stderr, "%s %d", title, i);
fprintf (stderr, "%s %ld", title, (long) i);
else
fprintf (stderr, "%s\t%d\n", title, n);
fprintf (stderr, "%s\t%ld\n", title, (long) n);
last_cluster = i;
last_size = n;
}
@ -583,7 +586,7 @@ static void
free_list_lengths (char *title, scm_freelist_t *master, SCM freelist)
{
SCM clusters;
int i = 0, len, n = 0;
scm_bits_t i = 0, len, n = 0;
fprintf (stderr, "%s\n\n", title);
n += free_list_length ("free list", -1, freelist);
for (clusters = master->clusters;
@ -594,10 +597,10 @@ free_list_lengths (char *title, scm_freelist_t *master, SCM freelist)
n += len;
}
if (last_cluster == i - 1)
fprintf (stderr, "\t%d\n", last_size);
fprintf (stderr, "\t%ld\n", (long) last_size);
else
fprintf (stderr, "-%d\t%d\n", i - 1, last_size);
fprintf (stderr, "\ntotal %d objects\n\n", n);
fprintf (stderr, "-%ld\t%ld\n", (long) (i - 1), (long) last_size);
fprintf (stderr, "\ntotal %ld objects\n\n", (long) n);
}
SCM_DEFINE (scm_free_list_length, "free-list-length", 0, 0, 0,
@ -622,8 +625,8 @@ SCM_DEFINE (scm_free_list_length, "free-list-length", 0, 0, 0,
static int scm_debug_check_freelist = 0;
/* Number of calls to SCM_NEWCELL since startup. */
static unsigned long scm_newcell_count;
static unsigned long scm_newcell2_count;
static scm_ubits_t scm_newcell_count;
static scm_ubits_t scm_newcell2_count;
/* Search freelist for anything that isn't marked as a free cell.
Abort if we find something. */
@ -631,13 +634,13 @@ static void
scm_check_freelist (SCM freelist)
{
SCM f;
int i = 0;
scm_bits_t i = 0;
for (f = freelist; !SCM_NULLP (f); f = SCM_FREE_CELL_CDR (f), i++)
if (!SCM_FREE_CELL_P (f))
{
fprintf (stderr, "Bad cell in freelist on newcell %lu: %d'th elt\n",
scm_newcell_count, i);
fprintf (stderr, "Bad cell in freelist on newcell %lu: %lu'th elt\n",
(long) scm_newcell_count, (long) i);
abort ();
}
}
@ -719,26 +722,26 @@ scm_debug_newcell2 (void)
static unsigned long
static scm_ubits_t
master_cells_allocated (scm_freelist_t *master)
{
/* the '- 1' below is to ignore the cluster spine cells. */
int objects = master->clusters_allocated * (master->cluster_size - 1);
scm_bits_t objects = master->clusters_allocated * (master->cluster_size - 1);
if (SCM_NULLP (master->clusters))
objects -= master->left_to_collect;
return master->span * objects;
}
static unsigned long
static scm_ubits_t
freelist_length (SCM freelist)
{
int n;
scm_bits_t n;
for (n = 0; !SCM_NULLP (freelist); freelist = SCM_FREE_CELL_CDR (freelist))
++n;
return n;
}
static unsigned long
static scm_ubits_t
compute_cells_allocated ()
{
return (scm_cells_allocated
@ -757,17 +760,17 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
"use of storage.")
#define FUNC_NAME s_scm_gc_stats
{
int i;
int n;
scm_bits_t i;
scm_bits_t n;
SCM heap_segs;
long int local_scm_mtrigger;
long int local_scm_mallocated;
long int local_scm_heap_size;
long int local_scm_cells_allocated;
long int local_scm_gc_time_taken;
long int local_scm_gc_times;
long int local_scm_gc_mark_time_taken;
long int local_scm_gc_sweep_time_taken;
scm_ubits_t local_scm_mtrigger;
scm_ubits_t local_scm_mallocated;
scm_ubits_t local_scm_heap_size;
scm_ubits_t local_scm_cells_allocated;
unsigned long local_scm_gc_time_taken;
scm_ubits_t local_scm_gc_times;
unsigned long local_scm_gc_mark_time_taken;
unsigned long local_scm_gc_sweep_time_taken;
double local_scm_gc_cells_swept;
double local_scm_gc_cells_marked;
SCM answer;
@ -780,8 +783,8 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
heap_segs = SCM_EOL;
n = scm_n_heap_segs;
for (i = scm_n_heap_segs; i--; )
heap_segs = scm_cons (scm_cons (scm_ulong2num ((unsigned long)scm_heap_table[i].bounds[1]),
scm_ulong2num ((unsigned long)scm_heap_table[i].bounds[0])),
heap_segs = scm_cons (scm_cons (scm_ubits2num ((scm_ubits_t)scm_heap_table[i].bounds[1]),
scm_ubits2num ((scm_ubits_t)scm_heap_table[i].bounds[0])),
heap_segs);
if (scm_n_heap_segs != n)
goto retry;
@ -803,15 +806,15 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
local_scm_gc_cells_marked = scm_gc_cells_marked_acc;
answer = scm_listify (scm_cons (sym_gc_time_taken, scm_ulong2num (local_scm_gc_time_taken)),
scm_cons (sym_cells_allocated, scm_ulong2num (local_scm_cells_allocated)),
scm_cons (sym_heap_size, scm_ulong2num (local_scm_heap_size)),
scm_cons (sym_mallocated, scm_ulong2num (local_scm_mallocated)),
scm_cons (sym_mtrigger, scm_ulong2num (local_scm_mtrigger)),
scm_cons (sym_times, scm_ulong2num (local_scm_gc_times)),
scm_cons (sym_cells_allocated, scm_ubits2num (local_scm_cells_allocated)),
scm_cons (sym_heap_size, scm_ubits2num (local_scm_heap_size)),
scm_cons (sym_mallocated, scm_ubits2num (local_scm_mallocated)),
scm_cons (sym_mtrigger, scm_ubits2num (local_scm_mtrigger)),
scm_cons (sym_times, scm_ubits2num (local_scm_gc_times)),
scm_cons (sym_gc_mark_time_taken, scm_ulong2num (local_scm_gc_mark_time_taken)),
scm_cons (sym_gc_sweep_time_taken, scm_ulong2num (local_scm_gc_sweep_time_taken)),
scm_cons (sym_cells_marked, scm_dbl2big (local_scm_gc_cells_marked)),
scm_cons (sym_cells_swept, scm_dbl2big (local_scm_gc_cells_swept)),
scm_cons (sym_cells_marked, scm_i_dbl2big (local_scm_gc_cells_marked)),
scm_cons (sym_cells_swept, scm_i_dbl2big (local_scm_gc_cells_swept)),
scm_cons (sym_heap_segments, heap_segs),
SCM_UNDEFINED);
SCM_ALLOW_INTS;
@ -854,7 +857,7 @@ SCM_DEFINE (scm_object_address, "object-address", 1, 0, 0,
"returned by this function for @var{obj}")
#define FUNC_NAME s_scm_object_address
{
return scm_ulong2num ((unsigned long) SCM_UNPACK (obj));
return scm_ubits2num (SCM_UNPACK (obj));
}
#undef FUNC_NAME
@ -897,12 +900,12 @@ adjust_min_yield (scm_freelist_t *freelist)
if (freelist->min_yield_fraction)
{
/* Pick largest of last two yields. */
int delta = ((SCM_HEAP_SIZE * freelist->min_yield_fraction / 100)
long delta = ((SCM_HEAP_SIZE * freelist->min_yield_fraction / 100)
- (long) SCM_MAX (scm_gc_yield_1, scm_gc_yield));
#ifdef DEBUGINFO
fprintf (stderr, " after GC = %d, delta = %d\n",
scm_cells_allocated,
delta);
fprintf (stderr, " after GC = %lu, delta = %ld\n",
(long) scm_cells_allocated,
(long) delta);
#endif
if (delta > 0)
freelist->min_yield += delta;
@ -939,10 +942,10 @@ scm_gc_for_newcell (scm_freelist_t *master, SCM *freelist)
* both cases we have to try gc to get some free cells.
*/
#ifdef DEBUGINFO
fprintf (stderr, "allocated = %d, ",
scm_cells_allocated
fprintf (stderr, "allocated = %lu, ",
(long) (scm_cells_allocated
+ master_cells_allocated (&scm_master_freelist)
+ master_cells_allocated (&scm_master_freelist2));
+ master_cells_allocated (&scm_master_freelist2)));
#endif
scm_igc ("cells");
adjust_min_yield (master);
@ -999,7 +1002,7 @@ scm_c_hook_t scm_after_gc_c_hook;
void
scm_igc (const char *what)
{
int j;
scm_bits_t j;
++scm_gc_running_p;
scm_c_hook_run (&scm_before_gc_c_hook, 0);
@ -1022,14 +1025,6 @@ scm_igc (const char *what)
gc_start_stats (what);
if (scm_mallocated < 0)
/* The byte count of allocated objects has underflowed. This is
probably because you forgot to report the sizes of objects you
have allocated, by calling scm_done_malloc or some such. When
the GC freed them, it subtracted their size from
scm_mallocated, which underflowed. */
abort ();
if (scm_gc_heap_lock)
/* We've invoked the collector while a GC is already in progress.
That should never happen. */
@ -1039,8 +1034,8 @@ scm_igc (const char *what)
/* flush dead entries from the continuation stack */
{
int x;
int bound;
scm_bits_t x;
scm_bits_t bound;
SCM * elts;
elts = SCM_VELTS (scm_continuation_stack);
bound = SCM_VECTOR_LENGTH (scm_continuation_stack);
@ -1063,12 +1058,12 @@ scm_igc (const char *what)
/* This assumes that all registers are saved into the jmp_buf */
setjmp (scm_save_regs_gc_mark);
scm_mark_locations ((SCM_STACKITEM *) scm_save_regs_gc_mark,
( (scm_sizet) (sizeof (SCM_STACKITEM) - 1 +
( (size_t) (sizeof (SCM_STACKITEM) - 1 +
sizeof scm_save_regs_gc_mark)
/ sizeof (SCM_STACKITEM)));
{
scm_sizet stack_len = scm_stack_size (scm_stack_base);
size_t stack_len = scm_stack_size (scm_stack_base);
#ifdef SCM_STACK_GROWS_UP
scm_mark_locations (scm_stack_base, stack_len);
#else
@ -1129,7 +1124,7 @@ void
MARK (SCM p)
#define FUNC_NAME FNAME
{
register long i;
register scm_bits_t i;
register SCM ptr;
scm_bits_t cell_type;
@ -1238,7 +1233,7 @@ gc_mark_loop_first_time:
{
/* ptr is a struct */
SCM layout = SCM_PACK (vtable_data [scm_vtable_index_layout]);
int len = SCM_SYMBOL_LENGTH (layout);
scm_bits_t len = SCM_SYMBOL_LENGTH (layout);
char * fields_desc = SCM_SYMBOL_CHARS (layout);
scm_bits_t * struct_data = (scm_bits_t *) SCM_STRUCT_DATA (ptr);
@ -1249,7 +1244,7 @@ gc_mark_loop_first_time:
}
if (len)
{
int x;
scm_bits_t x;
for (x = 0; x < len - 2; x += 2, ++struct_data)
if (fields_desc[x] == 'p')
@ -1290,8 +1285,8 @@ gc_mark_loop_first_time:
#ifdef CCLO
case scm_tc7_cclo:
{
unsigned long int i = SCM_CCLO_LENGTH (ptr);
unsigned long int j;
size_t i = SCM_CCLO_LENGTH (ptr);
size_t j;
for (j = 1; j != i; ++j)
{
SCM obj = SCM_CCLO_REF (ptr, j);
@ -1327,8 +1322,8 @@ gc_mark_loop_first_time:
scm_weak_vectors = ptr;
if (SCM_IS_WHVEC_ANY (ptr))
{
int x;
int len;
scm_bits_t x;
scm_bits_t len;
int weak_keys;
int weak_values;
@ -1454,9 +1449,9 @@ gc_mark_loop_first_time:
*/
void
scm_mark_locations (SCM_STACKITEM x[], scm_sizet n)
scm_mark_locations (SCM_STACKITEM x[], scm_ubits_t n)
{
unsigned long m;
scm_ubits_t m;
for (m = 0; m < n; ++m)
{
@ -1464,14 +1459,14 @@ scm_mark_locations (SCM_STACKITEM x[], scm_sizet n)
if (SCM_CELLP (obj))
{
SCM_CELLPTR ptr = SCM2PTR (obj);
int i = 0;
int j = scm_n_heap_segs - 1;
scm_bits_t i = 0;
scm_bits_t j = scm_n_heap_segs - 1;
if (SCM_PTR_LE (scm_heap_table[i].bounds[0], ptr)
&& SCM_PTR_GT (scm_heap_table[j].bounds[1], ptr))
{
while (i <= j)
{
int seg_id;
scm_bits_t seg_id;
seg_id = -1;
if ((i == j)
|| SCM_PTR_GT (scm_heap_table[i].bounds[1], ptr))
@ -1480,7 +1475,7 @@ scm_mark_locations (SCM_STACKITEM x[], scm_sizet n)
seg_id = j;
else
{
int k;
scm_bits_t k;
k = (i + j) / 2;
if (k == i)
break;
@ -1528,14 +1523,14 @@ scm_cellp (SCM value)
{
if (SCM_CELLP (value)) {
scm_cell * ptr = SCM2PTR (value);
unsigned int i = 0;
unsigned int j = scm_n_heap_segs - 1;
scm_bits_t i = 0;
scm_bits_t j = scm_n_heap_segs - 1;
if (SCM_GC_IN_CARD_HEADERP (ptr))
return 0;
while (i < j) {
int k = (i + j) / 2;
scm_bits_t k = (i + j) / 2;
if (SCM_PTR_GT (scm_heap_table[k].bounds[1], ptr)) {
j = k;
} else if (SCM_PTR_LE (scm_heap_table[k].bounds[0], ptr)) {
@ -1571,7 +1566,7 @@ gc_sweep_freelist_start (scm_freelist_t *freelist)
static void
gc_sweep_freelist_finish (scm_freelist_t *freelist)
{
int collected;
scm_bits_t collected;
*freelist->clustertail = freelist->cells;
if (!SCM_NULLP (freelist->cells))
{
@ -1609,10 +1604,10 @@ scm_gc_sweep ()
register SCM_CELLPTR ptr;
register SCM nfreelist;
register scm_freelist_t *freelist;
register long m;
register scm_ubits_t m;
register int span;
long i;
scm_sizet seg_size;
scm_bits_t i;
size_t seg_size;
m = 0;
@ -1621,8 +1616,8 @@ scm_gc_sweep ()
for (i = 0; i < scm_n_heap_segs; i++)
{
register unsigned int left_to_collect;
register scm_sizet j;
register scm_bits_t left_to_collect;
register size_t j;
/* Unmarked cells go onto the front of the freelist this heap
segment points to. Rather than updating the real freelist
@ -1700,7 +1695,7 @@ scm_gc_sweep ()
break;
case scm_tc7_vector:
{
unsigned long int length = SCM_VECTOR_LENGTH (scmptr);
scm_ubits_t length = SCM_VECTOR_LENGTH (scmptr);
if (length > 0)
{
m += length * sizeof (scm_bits_t);
@ -1717,10 +1712,10 @@ scm_gc_sweep ()
#ifdef HAVE_ARRAYS
case scm_tc7_bvect:
{
unsigned long int length = SCM_BITVECTOR_LENGTH (scmptr);
size_t length = SCM_BITVECTOR_LENGTH (scmptr);
if (length > 0)
{
m += sizeof (long) * ((length + SCM_LONG_BIT - 1) / SCM_LONG_BIT);
m += sizeof (long) * ((length + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH);
scm_must_free (SCM_BITVECTOR_BASE (scmptr));
}
}
@ -1832,7 +1827,7 @@ scm_gc_sweep ()
#ifdef GC_FREE_SEGMENTS
if (n == seg_size)
{
register long j;
register scm_bits_t j;
freelist->heap_size -= seg_size;
free ((char *) scm_heap_table[i].bounds[0]);
@ -1866,6 +1861,15 @@ scm_gc_sweep ()
scm_cells_allocated = (SCM_HEAP_SIZE - scm_gc_cells_collected);
scm_gc_yield -= scm_cells_allocated;
if (scm_mallocated < m)
/* The byte count of allocated objects has underflowed. This is
probably because you forgot to report the sizes of objects you
have allocated, by calling scm_done_malloc or some such. When
the GC freed them, it subtracted their size from
scm_mallocated, which underflowed. */
abort ();
scm_mallocated -= m;
scm_gc_malloc_collected = m;
}
@ -1896,10 +1900,16 @@ scm_gc_sweep ()
* The limit scm_mtrigger may be raised by this allocation.
*/
void *
scm_must_malloc (scm_sizet size, const char *what)
scm_must_malloc (size_t size, const char *what)
{
void *ptr;
unsigned long nm = scm_mallocated + size;
scm_ubits_t nm = scm_mallocated + size;
if (nm < size)
/* The byte count of allocated objects has overflowed. This is
probably because you forgot to report the correct size of freed
memory in some of your smob free methods. */
abort ();
if (nm <= scm_mtrigger)
{
@ -1917,6 +1927,13 @@ scm_must_malloc (scm_sizet size, const char *what)
scm_igc (what);
nm = scm_mallocated + size;
if (nm < size)
/* The byte count of allocated objects has overflowed. This is
probably because you forgot to report the correct size of freed
memory in some of your smob free methods. */
abort ();
SCM_SYSCALL (ptr = malloc (size));
if (NULL != ptr)
{
@ -1943,12 +1960,23 @@ scm_must_malloc (scm_sizet size, const char *what)
*/
void *
scm_must_realloc (void *where,
scm_sizet old_size,
scm_sizet size,
size_t old_size,
size_t size,
const char *what)
{
void *ptr;
scm_sizet nm = scm_mallocated + size - old_size;
scm_ubits_t nm;
if (size <= old_size)
return where;
nm = scm_mallocated + size - old_size;
if (nm < (size - old_size))
/* The byte count of allocated objects has overflowed. This is
probably because you forgot to report the correct size of freed
memory in some of your smob free methods. */
abort ();
if (nm <= scm_mtrigger)
{
@ -1966,6 +1994,13 @@ scm_must_realloc (void *where,
scm_igc (what);
nm = scm_mallocated + size - old_size;
if (nm < (size - old_size))
/* The byte count of allocated objects has overflowed. This is
probably because you forgot to report the correct size of freed
memory in some of your smob free methods. */
abort ();
SCM_SYSCALL (ptr = realloc (where, size));
if (NULL != ptr)
{
@ -1986,7 +2021,7 @@ scm_must_realloc (void *where,
}
char *
scm_must_strndup (const char *str, unsigned long length)
scm_must_strndup (const char *str, size_t length)
{
char * dst = scm_must_malloc (length + 1, "scm_must_strndup");
memcpy (dst, str, length);
@ -2030,8 +2065,25 @@ scm_must_free (void *obj)
* eh? Or even better, call scm_done_free. */
void
scm_done_malloc (long size)
scm_done_malloc (scm_bits_t size)
{
if (size < 0) {
if (scm_mallocated < size)
/* The byte count of allocated objects has underflowed. This is
probably because you forgot to report the sizes of objects you
have allocated, by calling scm_done_malloc or some such. When
the GC freed them, it subtracted their size from
scm_mallocated, which underflowed. */
abort ();
} else {
scm_ubits_t nm = scm_mallocated + size;
if (nm < size)
/* The byte count of allocated objects has overflowed. This is
probably because you forgot to report the correct size of freed
memory in some of your smob free methods. */
abort ();
}
scm_mallocated += size;
if (scm_mallocated > scm_mtrigger)
@ -2048,8 +2100,25 @@ scm_done_malloc (long size)
}
void
scm_done_free (long size)
scm_done_free (scm_bits_t size)
{
if (size >= 0) {
if (scm_mallocated < size)
/* The byte count of allocated objects has underflowed. This is
probably because you forgot to report the sizes of objects you
have allocated, by calling scm_done_malloc or some such. When
the GC freed them, it subtracted their size from
scm_mallocated, which underflowed. */
abort ();
} else {
scm_ubits_t nm = scm_mallocated + size;
if (nm < size)
/* The byte count of allocated objects has overflowed. This is
probably because you forgot to report the correct size of freed
memory in some of your smob free methods. */
abort ();
}
scm_mallocated -= size;
}
@ -2071,7 +2140,7 @@ scm_done_free (long size)
*/
int scm_expmem = 0;
scm_sizet scm_max_segment_size;
size_t scm_max_segment_size;
/* scm_heap_org
* is the lowest base address of any heap segment.
@ -2079,8 +2148,8 @@ scm_sizet scm_max_segment_size;
SCM_CELLPTR scm_heap_org;
scm_heap_seg_data_t * scm_heap_table = 0;
static unsigned int heap_segment_table_size = 0;
int scm_n_heap_segs = 0;
static size_t heap_segment_table_size = 0;
size_t scm_n_heap_segs = 0;
/* init_heap_seg
* initializes a new heap segment and returns the number of objects it contains.
@ -2100,13 +2169,13 @@ int scm_n_heap_segs = 0;
SCM_GC_SET_CARD_DOUBLECELL (card); \
} while (0)
static scm_sizet
init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, scm_freelist_t *freelist)
static size_t
init_heap_seg (SCM_CELLPTR seg_org, size_t size, scm_freelist_t *freelist)
{
register SCM_CELLPTR ptr;
SCM_CELLPTR seg_end;
int new_seg_index;
int n_new_cells;
scm_bits_t new_seg_index;
ptrdiff_t n_new_cells;
int span = freelist->span;
if (seg_org == NULL)
@ -2214,10 +2283,10 @@ init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, scm_freelist_t *freelist)
return size;
}
static scm_sizet
round_to_cluster_size (scm_freelist_t *freelist, scm_sizet len)
static size_t
round_to_cluster_size (scm_freelist_t *freelist, size_t len)
{
scm_sizet cluster_size_in_bytes = CLUSTER_SIZE_IN_BYTES (freelist);
size_t cluster_size_in_bytes = CLUSTER_SIZE_IN_BYTES (freelist);
return
(len + cluster_size_in_bytes - 1) / cluster_size_in_bytes * cluster_size_in_bytes
@ -2229,7 +2298,7 @@ alloc_some_heap (scm_freelist_t *freelist, policy_on_error error_policy)
#define FUNC_NAME "alloc_some_heap"
{
SCM_CELLPTR ptr;
long len;
size_t len;
if (scm_gc_heap_lock)
{
@ -2246,9 +2315,9 @@ alloc_some_heap (scm_freelist_t *freelist, policy_on_error error_policy)
* segment. Do not yet increment scm_n_heap_segs -- that is done by
* init_heap_seg only if the allocation of the segment itself succeeds.
*/
unsigned int new_table_size = scm_n_heap_segs + 1;
size_t new_table_size = scm_n_heap_segs + 1;
size_t size = new_table_size * sizeof (scm_heap_seg_data_t);
scm_heap_seg_data_t * new_heap_table;
scm_heap_seg_data_t *new_heap_table;
SCM_SYSCALL (new_heap_table = ((scm_heap_seg_data_t *)
realloc ((char *)scm_heap_table, size)));
@ -2290,11 +2359,11 @@ alloc_some_heap (scm_freelist_t *freelist, policy_on_error error_policy)
* This gives dh > (f * h - y) / (1 - f)
*/
int f = freelist->min_yield_fraction;
long h = SCM_HEAP_SIZE;
long min_cells = (f * h - 100 * (long) scm_gc_yield) / (99 - f);
scm_ubits_t h = SCM_HEAP_SIZE;
size_t min_cells = (f * h - 100 * (long) scm_gc_yield) / (99 - f);
len = SCM_EXPHEAP (freelist->heap_size);
#ifdef DEBUGINFO
fprintf (stderr, "(%d < %d)", len, min_cells);
fprintf (stderr, "(%ld < %ld)", (long) len, (long) min_cells);
#endif
if (len < min_cells)
len = min_cells + freelist->cluster_size;
@ -2307,7 +2376,7 @@ alloc_some_heap (scm_freelist_t *freelist, policy_on_error error_policy)
len = scm_max_segment_size;
{
scm_sizet smallest;
size_t smallest;
smallest = CLUSTER_SIZE_IN_BYTES (freelist);
@ -2318,7 +2387,7 @@ alloc_some_heap (scm_freelist_t *freelist, policy_on_error error_policy)
while ((len >= SCM_MIN_HEAP_SEG_SIZE)
&& (len >= smallest))
{
scm_sizet rounded_len = round_to_cluster_size (freelist, len);
size_t rounded_len = round_to_cluster_size (freelist, len);
SCM_SYSCALL (ptr = (SCM_CELLPTR) malloc (rounded_len));
if (ptr)
{
@ -2391,7 +2460,8 @@ scm_remember_upto_here (SCM obj, ...)
void
scm_remember (SCM *ptr)
{
/* empty */
scm_c_issue_deprecation_warning ("`scm_remember' is deprecated. "
"Use the `scm_remember_upto_here*' family of functions instead.");
}
#endif /* SCM_DEBUG_DEPRECATED == 0 */
@ -2450,7 +2520,7 @@ scm_protect_object (SCM obj)
SCM_REDEFER_INTS;
handle = scm_hashq_create_handle_x (scm_protects, obj, SCM_MAKINUM (0));
SCM_SETCDR (handle, SCM_MAKINUM (SCM_INUM (SCM_CDR (handle)) + 1));
SCM_SETCDR (handle, scm_sum (SCM_CDR (handle), SCM_MAKINUM (1)));
SCM_REALLOW_INTS;
@ -2479,11 +2549,11 @@ scm_unprotect_object (SCM obj)
}
else
{
unsigned long int count = SCM_INUM (SCM_CDR (handle)) - 1;
if (count == 0)
SCM count = scm_difference (SCM_CDR (handle), SCM_MAKINUM (1));
if (SCM_EQ_P (count, SCM_MAKINUM (0)))
scm_hashq_remove_x (scm_protects, obj);
else
SCM_SETCDR (handle, SCM_MAKINUM (count));
SCM_SETCDR (handle, count);
}
SCM_REALLOW_INTS;
@ -2514,9 +2584,9 @@ cleanup (int status, void *arg)
static int
make_initial_segment (scm_sizet init_heap_size, scm_freelist_t *freelist)
make_initial_segment (size_t init_heap_size, scm_freelist_t *freelist)
{
scm_sizet rounded_size = round_to_cluster_size (freelist, init_heap_size);
size_t rounded_size = round_to_cluster_size (freelist, init_heap_size);
if (!init_heap_seg ((SCM_CELLPTR) malloc (rounded_size),
rounded_size,
@ -2543,7 +2613,7 @@ make_initial_segment (scm_sizet init_heap_size, scm_freelist_t *freelist)
static void
init_freelist (scm_freelist_t *freelist,
int span,
int cluster_size,
scm_bits_t cluster_size,
int min_yield)
{
freelist->clusters = SCM_EOL;
@ -2577,11 +2647,11 @@ scm_i_getenv_int (const char *var, int def)
int
scm_init_storage ()
{
scm_sizet gc_trigger_1;
scm_sizet gc_trigger_2;
scm_sizet init_heap_size_1;
scm_sizet init_heap_size_2;
scm_sizet j;
unsigned long gc_trigger_1;
unsigned long gc_trigger_2;
size_t init_heap_size_1;
size_t init_heap_size_2;
size_t j;
#if (SCM_DEBUG_CELL_ACCESSES == 1)
scm_tc16_allocated = scm_make_smob_type ("allocated cell", 0);
@ -2626,8 +2696,8 @@ scm_init_storage ()
scm_c_hook_init (&scm_after_gc_c_hook, 0, SCM_C_HOOK_NORMAL);
/* Initialise the list of ports. */
scm_port_table = (scm_port **)
malloc (sizeof (scm_port *) * scm_port_table_room);
scm_port_table = (scm_port_t **)
malloc (sizeof (scm_port_t *) * scm_port_table_room);
if (!scm_port_table)
return 1;

42
libguile/gc.h
View file

@ -97,7 +97,7 @@ typedef scm_cell * SCM_CELLPTR;
#define SCM_GC_SET_CARD_BVEC(card, bvec) \
((card)->word_0 = (scm_bits_t) (bvec))
#define SCM_GC_GET_CARD_FLAGS(card) ((long) ((card)->word_1))
#define SCM_GC_GET_CARD_FLAGS(card) ((scm_ubits_t) ((card)->word_1))
#define SCM_GC_SET_CARD_FLAGS(card, flags) \
((card)->word_1 = (scm_bits_t) (flags))
#define SCM_GC_CLR_CARD_FLAGS(card) (SCM_GC_SET_CARD_FLAGS (card, 0L))
@ -119,9 +119,9 @@ typedef scm_cell * SCM_CELLPTR;
#define SCM_GC_CARD_SIZE_MASK (SCM_GC_CARD_SIZE - 1)
#define SCM_GC_CARD_ADDR_MASK (~SCM_GC_CARD_SIZE_MASK)
#define SCM_GC_CELL_CARD(x) ((SCM_CELLPTR) ((long) (x) & SCM_GC_CARD_ADDR_MASK))
#define SCM_GC_CELL_CARD(x) ((SCM_CELLPTR) ((scm_bits_t) (x) & SCM_GC_CARD_ADDR_MASK))
#define SCM_GC_CELL_SPAN(x) ((SCM_GC_CARD_DOUBLECELLP (SCM_GC_CELL_CARD (x))) ? 2 : 1)
#define SCM_GC_CELL_OFFSET(x) (((long) (x) & SCM_GC_CARD_SIZE_MASK) >> SCM_CELL_SIZE_SHIFT)
#define SCM_GC_CELL_OFFSET(x) (((scm_bits_t) (x) & SCM_GC_CARD_SIZE_MASK) >> SCM_CELL_SIZE_SHIFT)
#define SCM_GC_CELL_BVEC(x) SCM_GC_CARD_BVEC (SCM_GC_CELL_CARD (x))
#define SCM_GC_CELL_GET_BIT(x) SCM_C_BVEC_GET (SCM_GC_CELL_BVEC (x), SCM_GC_CELL_OFFSET (x))
#define SCM_GC_CELL_SET_BIT(x) SCM_C_BVEC_SET (SCM_GC_CELL_BVEC (x), SCM_GC_CELL_OFFSET (x))
@ -301,31 +301,31 @@ extern unsigned int scm_debug_cell_accesses_p;
#endif
extern struct scm_heap_seg_data_t *scm_heap_table;
extern int scm_n_heap_segs;
extern size_t scm_n_heap_segs;
extern int scm_block_gc;
extern int scm_gc_heap_lock;
extern unsigned int scm_gc_running_p;
extern int scm_default_init_heap_size_1;
extern size_t scm_default_init_heap_size_1;
extern int scm_default_min_yield_1;
extern int scm_default_init_heap_size_2;
extern size_t scm_default_init_heap_size_2;
extern int scm_default_min_yield_2;
extern int scm_default_max_segment_size;
extern size_t scm_default_max_segment_size;
extern scm_sizet scm_max_segment_size;
extern size_t scm_max_segment_size;
extern SCM_CELLPTR scm_heap_org;
extern SCM scm_freelist;
extern struct scm_freelist_t scm_master_freelist;
extern SCM scm_freelist2;
extern struct scm_freelist_t scm_master_freelist2;
extern unsigned long scm_gc_cells_collected;
extern unsigned long scm_gc_yield;
extern unsigned long scm_gc_malloc_collected;
extern unsigned long scm_gc_ports_collected;
extern unsigned long scm_cells_allocated;
extern long scm_mallocated;
extern unsigned long scm_mtrigger;
extern scm_ubits_t scm_gc_cells_collected;
extern scm_ubits_t scm_gc_yield;
extern scm_ubits_t scm_gc_malloc_collected;
extern scm_ubits_t scm_gc_ports_collected;
extern scm_ubits_t scm_cells_allocated;
extern scm_ubits_t scm_mallocated;
extern scm_ubits_t scm_mtrigger;
extern SCM scm_after_gc_hook;
@ -363,17 +363,17 @@ extern void scm_alloc_cluster (struct scm_freelist_t *master);
extern void scm_igc (const char *what);
extern void scm_gc_mark (SCM p);
extern void scm_gc_mark_dependencies (SCM p);
extern void scm_mark_locations (SCM_STACKITEM x[], scm_sizet n);
extern void scm_mark_locations (SCM_STACKITEM x[], scm_ubits_t n);
extern int scm_cellp (SCM value);
extern void scm_gc_sweep (void);
extern void * scm_must_malloc (scm_sizet len, const char *what);
extern void * scm_must_malloc (size_t len, const char *what);
extern void * scm_must_realloc (void *where,
scm_sizet olen, scm_sizet len,
size_t olen, size_t len,
const char *what);
extern void scm_done_malloc (scm_bits_t size);
extern void scm_done_free (scm_bits_t size);
extern char *scm_must_strdup (const char *str);
extern char *scm_must_strndup (const char *str, unsigned long n);
extern void scm_done_malloc (long size);
extern void scm_done_free (long size);
extern char *scm_must_strndup (const char *str, size_t n);
extern void scm_must_free (void *obj);
extern void scm_remember_upto_here_1 (SCM obj);
extern void scm_remember_upto_here_2 (SCM obj1, SCM obj2);

2
libguile/gdbint.c
View file

@ -277,7 +277,7 @@ gdb_print (SCM obj)
scm_write (obj, gdb_output_port);
scm_truncate_file (gdb_output_port, SCM_UNDEFINED);
{
scm_port *pt = SCM_PTAB_ENTRY (gdb_output_port);
scm_port_t *pt = SCM_PTAB_ENTRY (gdb_output_port);
scm_flush (gdb_output_port);
*(pt->write_buf + pt->read_buf_size) = 0;

32
libguile/gh.h
View file

@ -101,22 +101,22 @@ SCM gh_ulong2scm(unsigned long x);
SCM gh_long2scm(long x);
SCM gh_double2scm(double x);
SCM gh_char2scm(char c);
SCM gh_str2scm(const char *s, int len);
SCM gh_str2scm(const char *s, size_t len);
SCM gh_str02scm(const char *s);
void gh_set_substr(char *src, SCM dst, int start, int len);
void gh_set_substr(char *src, SCM dst, scm_bits_t start, size_t len);
SCM gh_symbol2scm(const char *symbol_str);
SCM gh_ints2scm(const int *d, int n);
SCM gh_ints2scm(const int *d, scm_bits_t n);
#ifdef HAVE_ARRAYS
SCM gh_chars2byvect(const char *d, int n);
SCM gh_shorts2svect(const short *d, int n);
SCM gh_longs2ivect(const long *d, int n);
SCM gh_ulongs2uvect(const unsigned long *d, int n);
SCM gh_floats2fvect(const float *d, int n);
SCM gh_doubles2dvect(const double *d, int n);
SCM gh_chars2byvect(const char *d, scm_bits_t n);
SCM gh_shorts2svect(const short *d, scm_bits_t n);
SCM gh_longs2ivect(const long *d, scm_bits_t n);
SCM gh_ulongs2uvect(const unsigned long *d, scm_bits_t n);
SCM gh_floats2fvect(const float *d, scm_bits_t n);
SCM gh_doubles2dvect(const double *d, scm_bits_t n);
#endif
SCM gh_doubles2scm(const double *d, int n);
SCM gh_doubles2scm(const double *d, scm_bits_t n);
/* Scheme to C conversion */
int gh_scm2bool(SCM obj);
@ -125,9 +125,9 @@ unsigned long gh_scm2ulong(SCM obj);
long gh_scm2long(SCM obj);
char gh_scm2char(SCM obj);
double gh_scm2double(SCM obj);
char *gh_scm2newstr(SCM str, int *lenp);
void gh_get_substr(SCM src, char *dst, int start, int len);
char *gh_symbol2newstr(SCM sym, int *lenp);
char *gh_scm2newstr(SCM str, size_t *lenp);
void gh_get_substr(SCM src, char *dst, scm_bits_t start, size_t len);
char *gh_symbol2newstr(SCM sym, size_t *lenp);
char *gh_scm2chars(SCM vector, char *result);
short *gh_scm2shorts(SCM vector, short *result);
long *gh_scm2longs(SCM vector, long *result);
@ -178,8 +178,8 @@ SCM gh_define(const char *name, SCM val);
SCM gh_make_vector(SCM length, SCM val);
SCM gh_vector_set_x(SCM vec, SCM pos, SCM val);
SCM gh_vector_ref(SCM vec, SCM pos);
unsigned long gh_vector_length (SCM v);
unsigned long gh_uniform_vector_length (SCM v);
scm_bits_t gh_vector_length (SCM v);
scm_ubits_t gh_uniform_vector_length (SCM v);
SCM gh_uniform_vector_ref (SCM v, SCM ilist);
#define gh_list_to_vector(ls) scm_vector(ls)
#define gh_vector_to_list(v) scm_vector_to_list(v)
@ -189,7 +189,7 @@ SCM gh_module_lookup (SCM module, const char *sname);
SCM gh_cons(SCM x, SCM y);
#define gh_list scm_listify
unsigned long gh_length(SCM l);
scm_bits_t gh_length(SCM l);
SCM gh_append(SCM args);
SCM gh_append2(SCM l1, SCM l2);
SCM gh_append3(SCM l1, SCM l2, SCM l3);

73
libguile/gh_data.c
View file

@ -79,7 +79,7 @@ gh_char2scm (char c)
return SCM_MAKE_CHAR (c);
}
SCM
gh_str2scm (const char *s, int len)
gh_str2scm (const char *s, size_t len)
{
return scm_makfromstr (s, len, 0);
}
@ -95,20 +95,20 @@ gh_str02scm (const char *s)
If START + LEN is off the end of DST, signal an out-of-range
error. */
void
gh_set_substr (char *src, SCM dst, int start, int len)
gh_set_substr (char *src, SCM dst, scm_bits_t start, size_t len)
{
char *dst_ptr;
unsigned long dst_len;
unsigned long effective_length;
size_t dst_len;
size_t effective_length;
SCM_ASSERT (SCM_STRINGP (dst), dst, SCM_ARG3, "gh_set_substr");
dst_ptr = SCM_STRING_CHARS (dst);
dst_len = SCM_STRING_LENGTH (dst);
SCM_ASSERT (len >= 0 && (unsigned) len <= dst_len,
SCM_ASSERT (len >= 0 && len <= dst_len,
dst, SCM_ARG4, "gh_set_substr");
effective_length = ((unsigned) len < dst_len) ? len : dst_len;
effective_length = (len < dst_len) ? len : dst_len;
memmove (dst_ptr + start, src, effective_length);
scm_remember_upto_here_1 (dst);
}
@ -121,22 +121,22 @@ gh_symbol2scm (const char *symbol_str)
}
SCM
gh_ints2scm (const int *d, int n)
gh_ints2scm (const int *d, scm_bits_t n)
{
int i;
scm_bits_t i;
SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED);
SCM *velts = SCM_VELTS(v);
for (i = 0; i < n; ++i)
velts[i] = (SCM_FIXABLE (d[i]) ? SCM_MAKINUM (d[i]) : scm_long2big (d[i]));
velts[i] = (SCM_FIXABLE (d[i]) ? SCM_MAKINUM (d[i]) : scm_i_long2big (d[i]));
return v;
}
SCM
gh_doubles2scm (const double *d, int n)
gh_doubles2scm (const double *d, scm_bits_t n)
{
int i;
scm_bits_t i;
SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED);
SCM *velts = SCM_VELTS(v);
@ -150,7 +150,7 @@ gh_doubles2scm (const double *d, int n)
you arrange for the elements to be protected from GC while you
initialize the vector. */
static SCM
makvect (char* m, int len, int type)
makvect (char *m, size_t len, int type)
{
SCM ans;
SCM_NEWCELL (ans);
@ -162,7 +162,7 @@ makvect (char* m, int len, int type)
}
SCM
gh_chars2byvect (const char *d, int n)
gh_chars2byvect (const char *d, scm_bits_t n)
{
char *m = scm_must_malloc (n * sizeof (char), "vector");
memcpy (m, d, n * sizeof (char));
@ -170,7 +170,7 @@ gh_chars2byvect (const char *d, int n)
}
SCM
gh_shorts2svect (const short *d, int n)
gh_shorts2svect (const short *d, scm_bits_t n)
{
char *m = scm_must_malloc (n * sizeof (short), "vector");
memcpy (m, d, n * sizeof (short));
@ -178,7 +178,7 @@ gh_shorts2svect (const short *d, int n)
}
SCM
gh_longs2ivect (const long *d, int n)
gh_longs2ivect (const long *d, scm_bits_t n)
{
char *m = scm_must_malloc (n * sizeof (long), "vector");
memcpy (m, d, n * sizeof (long));
@ -186,7 +186,7 @@ gh_longs2ivect (const long *d, int n)
}
SCM
gh_ulongs2uvect (const unsigned long *d, int n)
gh_ulongs2uvect (const unsigned long *d, scm_bits_t n)
{
char *m = scm_must_malloc (n * sizeof (unsigned long), "vector");
memcpy (m, d, n * sizeof (unsigned long));
@ -194,7 +194,7 @@ gh_ulongs2uvect (const unsigned long *d, int n)
}
SCM
gh_floats2fvect (const float *d, int n)
gh_floats2fvect (const float *d, scm_bits_t n)
{
char *m = scm_must_malloc (n * sizeof (float), "vector");
memcpy (m, d, n * sizeof (float));
@ -202,7 +202,7 @@ gh_floats2fvect (const float *d, int n)
}
SCM
gh_doubles2dvect (const double *d, int n)
gh_doubles2dvect (const double *d, scm_bits_t n)
{
char *m = scm_must_malloc (n * sizeof (double), "vector");
memcpy (m, d, n * sizeof (double));
@ -229,8 +229,7 @@ gh_scm2long (SCM obj)
int
gh_scm2int (SCM obj)
{
/* NOTE: possible loss of precision here */
return (int) scm_num2long (obj, SCM_ARG1, "gh_scm2int");
return (int) scm_num2int (obj, SCM_ARG1, "gh_scm2int");
}
double
gh_scm2double (SCM obj)
@ -252,8 +251,8 @@ gh_scm2char (SCM obj)
char *
gh_scm2chars (SCM obj, char *m)
{
int i, n;
long v;
scm_bits_t i, n;
scm_bits_t v;
SCM val;
if (SCM_IMP (obj))
scm_wrong_type_arg (0, 0, obj);
@ -312,8 +311,8 @@ gh_scm2chars (SCM obj, char *m)
short *
gh_scm2shorts (SCM obj, short *m)
{
int i, n;
long v;
scm_bits_t i, n;
scm_bits_t v;
SCM val;
if (SCM_IMP (obj))
scm_wrong_type_arg (0, 0, obj);
@ -363,7 +362,7 @@ gh_scm2shorts (SCM obj, short *m)
long *
gh_scm2longs (SCM obj, long *m)
{
int i, n;
scm_bits_t i, n;
SCM val;
if (SCM_IMP (obj))
scm_wrong_type_arg (0, 0, obj);
@ -413,7 +412,7 @@ gh_scm2longs (SCM obj, long *m)
float *
gh_scm2floats (SCM obj, float *m)
{
int i, n;
scm_bits_t i, n;
SCM val;
if (SCM_IMP (obj))
scm_wrong_type_arg (0, 0, obj);
@ -476,7 +475,7 @@ gh_scm2floats (SCM obj, float *m)
double *
gh_scm2doubles (SCM obj, double *m)
{
int i, n;
scm_bits_t i, n;
SCM val;
if (SCM_IMP (obj))
scm_wrong_type_arg (0, 0, obj);
@ -549,10 +548,10 @@ gh_scm2doubles (SCM obj, double *m)
function always copies the complete contents of STR, and sets
*LEN_P to the true length of the string (when LEN_P is non-null). */
char *
gh_scm2newstr (SCM str, int *lenp)
gh_scm2newstr (SCM str, size_t *lenp)
{
char *ret_str;
int len;
size_t len;
SCM_ASSERT (SCM_STRINGP (str), str, SCM_ARG3, "gh_scm2newstr");
@ -584,9 +583,9 @@ gh_scm2newstr (SCM str, int *lenp)
region to fit the string. If truncation occurs, the corresponding
area of DST is left unchanged. */
void
gh_get_substr (SCM src, char *dst, int start, int len)
gh_get_substr (SCM src, char *dst, scm_bits_t start, size_t len)
{
int src_len, effective_length;
size_t src_len, effective_length;
SCM_ASSERT (SCM_STRINGP (src), src, SCM_ARG3, "gh_get_substr");
src_len = SCM_STRING_LENGTH (src);
@ -606,10 +605,10 @@ gh_get_substr (SCM src, char *dst, int start, int len)
caller is responsible for freeing it. If out of memory, NULL is
returned.*/
char *
gh_symbol2newstr (SCM sym, int *lenp)
gh_symbol2newstr (SCM sym, size_t *lenp)
{
char *ret_str;
int len;
size_t len;
SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG3, "gh_scm2newsymbol");
@ -656,20 +655,20 @@ gh_vector_ref (SCM vec, SCM pos)
}
/* returns the length of the given vector */
unsigned long
scm_bits_t
gh_vector_length (SCM v)
{
return gh_scm2ulong (scm_vector_length (v));
return (size_t) SCM_VECTOR_LENGTH (v);
}
#ifdef HAVE_ARRAYS
/* uniform vector support */
/* returns the length as a C unsigned long integer */
unsigned long
scm_ubits_t
gh_uniform_vector_length (SCM v)
{
return gh_scm2ulong (scm_uniform_vector_length (v));
return SCM_UVECTOR_LENGTH (v);
}
/* gets the given element from a uniform vector; ilist is a list (or

14
libguile/gh_list.c
View file

@ -45,7 +45,7 @@
#include "libguile/gh.h"
/* returns the length of a list */
unsigned long
scm_bits_t
gh_length (SCM l)
{
return gh_scm2ulong (scm_length (l));
@ -58,22 +58,26 @@ gh_length (SCM l)
/* gh_append() takes a args, which is a list of lists, and appends
them all together into a single list, which is returned. This is
equivalent to the Scheme procedure (append list1 list2 ...) */
SCM gh_append(SCM args)
SCM
gh_append(SCM args)
{
return scm_append(args);
}
SCM gh_append2(SCM l1, SCM l2)
SCM
gh_append2(SCM l1, SCM l2)
{
return scm_append(scm_listify(l1, l2, SCM_UNDEFINED));
}
SCM gh_append3(SCM l1, SCM l2, SCM l3)
SCM
gh_append3(SCM l1, SCM l2, SCM l3)
{
return scm_append(scm_listify(l1, l2, l3, SCM_UNDEFINED));
}
SCM gh_append4(SCM l1, SCM l2, SCM l3, SCM l4)
SCM
gh_append4(SCM l1, SCM l2, SCM l3, SCM l4)
{
return scm_append(scm_listify(l1, l2, l3, l4, SCM_UNDEFINED));
}

74
libguile/goops.c
View file

@ -131,7 +131,7 @@
#define SCM_GOOPS_UNBOUNDP(x) ((x) == SCM_GOOPS_UNBOUND)
static int goops_loaded_p = 0;
static scm_rstate *goops_rstate;
static scm_rstate_t *goops_rstate;
static SCM scm_goops_lookup_closure;
@ -314,7 +314,7 @@ compute_getters_n_setters (SCM slots)
{
SCM res = SCM_EOL;
SCM *cdrloc = &res;
long i = 0;
scm_bits_t i = 0;
for ( ; SCM_NNULLP(slots); slots = SCM_CDR(slots))
{
@ -345,9 +345,9 @@ compute_getters_n_setters (SCM slots)
/*fixme* Manufacture keywords in advance */
SCM
scm_i_get_keyword (SCM key, SCM l, int len, SCM default_value, const char *subr)
scm_i_get_keyword (SCM key, SCM l, scm_bits_t len, SCM default_value, const char *subr)
{
unsigned int i;
scm_bits_t i;
for (i = 0; i != len; i += 2)
{
@ -375,7 +375,7 @@ SCM_DEFINE (scm_get_keyword, "get-keyword", 3, 0, 0,
"@var{default_value} is returned.")
#define FUNC_NAME s_scm_get_keyword
{
int len;
scm_bits_t len;
SCM_ASSERT (SCM_KEYWORDP (key), key, SCM_ARG1, FUNC_NAME);
len = scm_ilength (l);
@ -400,7 +400,7 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0,
{
SCM tmp, get_n_set, slots;
SCM class = SCM_CLASS_OF (obj);
int n_initargs;
scm_bits_t n_initargs;
SCM_VALIDATE_INSTANCE (1, obj);
n_initargs = scm_ilength (initargs);
@ -420,7 +420,7 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0,
if (SCM_NIMP (SCM_CDR (slot_name)))
{
/* This slot admits (perhaps) to be initialized at creation time */
int n = scm_ilength (SCM_CDR (slot_name));
scm_bits_t n = scm_ilength (SCM_CDR (slot_name));
if (n & 1) /* odd or -1 */
SCM_MISC_ERROR ("class contains bogus slot definition: ~S",
SCM_LIST1 (slot_name));
@ -479,7 +479,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0,
"")
#define FUNC_NAME s_scm_sys_prep_layout_x
{
int i, n, len;
scm_bits_t i, n, len;
char *s, p, a;
SCM nfields, slots, type;
@ -543,7 +543,7 @@ SCM_DEFINE (scm_sys_inherit_magic_x, "%inherit-magic!", 2, 0, 0,
#define FUNC_NAME s_scm_sys_inherit_magic_x
{
SCM ls = dsupers;
long flags = 0;
scm_bits_t flags = 0;
SCM_VALIDATE_INSTANCE (1, class);
while (SCM_NNULLP (ls))
{
@ -560,7 +560,7 @@ SCM_DEFINE (scm_sys_inherit_magic_x, "%inherit-magic!", 2, 0, 0,
SCM_SET_CLASS_DESTRUCTOR (class, scm_struct_free_entity);
else
{
int n = SCM_INUM (SCM_SLOT (class, scm_si_nfields));
scm_bits_t n = SCM_INUM (SCM_SLOT (class, scm_si_nfields));
#if 0
/*
* We could avoid calling scm_must_malloc in the allocation code
@ -998,7 +998,7 @@ SCM_DEFINE (scm_sys_fast_slot_ref, "%fast-slot-ref", 2, 0, 0,
"Return the slot value with index @var{index} from @var{obj}.")
#define FUNC_NAME s_scm_sys_fast_slot_ref
{
register long i;
register scm_bits_t i;
SCM_VALIDATE_INSTANCE (1, obj);
SCM_VALIDATE_INUM (2, index);
@ -1015,7 +1015,7 @@ SCM_DEFINE (scm_sys_fast_slot_set_x, "%fast-slot-set!", 3, 0, 0,
"@var{value}.")
#define FUNC_NAME s_scm_sys_fast_slot_set_x
{
register long i;
register scm_bits_t i;
SCM_VALIDATE_INSTANCE (1, obj);
SCM_VALIDATE_INUM (2, index);
@ -1279,10 +1279,10 @@ SCM_DEFINE (scm_slots_exists_p, "slot-exists?", 2, 0, 0,
static void clear_method_cache (SCM);
static SCM
wrap_init (SCM class, SCM *m, int n)
wrap_init (SCM class, SCM *m, scm_bits_t n)
{
SCM z;
int i;
scm_bits_t i;
/* Set all slots to unbound */
for (i = 0; i < n; i++)
@ -1303,7 +1303,7 @@ SCM_DEFINE (scm_sys_allocate_instance, "%allocate-instance", 2, 0, 0,
#define FUNC_NAME s_scm_sys_allocate_instance
{
SCM *m;
int n;
scm_bits_t n;
SCM_VALIDATE_CLASS (1, class);
@ -1343,7 +1343,7 @@ SCM_DEFINE (scm_sys_allocate_instance, "%allocate-instance", 2, 0, 0,
/* Class objects */
if (SCM_CLASS_FLAGS (class) & SCM_CLASSF_METACLASS)
{
int i;
scm_bits_t i;
/* allocate class object */
SCM z = scm_make_struct (class, SCM_INUM0, SCM_EOL);
@ -1463,16 +1463,16 @@ SCM_DEFINE (scm_sys_invalidate_class, "%invalidate-class", 1, 0, 0,
*/
static SCM **hell;
static int n_hell = 1; /* one place for the evil one himself */
static int hell_size = 4;
static scm_bits_t n_hell = 1; /* one place for the evil one himself */
static scm_bits_t hell_size = 4;
#ifdef USE_THREADS
static scm_mutex_t hell_mutex;
#endif
static int
static scm_bits_t
burnin (SCM o)
{
int i;
scm_bits_t i;
for (i = 1; i < n_hell; ++i)
if (SCM_INST (o) == hell[i])
return i;
@ -1488,7 +1488,7 @@ go_to_hell (void *o)
#endif
if (n_hell == hell_size)
{
int new_size = 2 * hell_size;
scm_bits_t new_size = 2 * hell_size;
hell = scm_must_realloc (hell, hell_size, new_size, "hell");
hell_size = new_size;
}
@ -1668,7 +1668,7 @@ static int
more_specificp (SCM m1, SCM m2, SCM *targs)
{
register SCM s1, s2;
register int i;
register scm_bits_t i;
/*
* Note:
* m1 and m2 can have != length (i.e. one can be one element longer than the
@ -1706,9 +1706,9 @@ more_specificp (SCM m1, SCM m2, SCM *targs)
#define BUFFSIZE 32 /* big enough for most uses */
static SCM
scm_i_vector2list (SCM l, int len)
scm_i_vector2list (SCM l, scm_bits_t len)
{
int j;
size_t j;
SCM z = scm_c_make_vector (len, SCM_UNDEFINED);
for (j = 0; j < len; j++, l = SCM_CDR (l)) {
@ -1718,9 +1718,9 @@ scm_i_vector2list (SCM l, int len)
}
static SCM
sort_applicable_methods (SCM method_list, int size, SCM *targs)
sort_applicable_methods (SCM method_list, scm_bits_t size, SCM *targs)
{
int i, j, incr;
scm_bits_t i, j, incr;
SCM *v, vector = SCM_EOL;
SCM buffer[BUFFSIZE];
SCM save = method_list;
@ -1782,10 +1782,10 @@ sort_applicable_methods (SCM method_list, int size, SCM *targs)
}
SCM
scm_compute_applicable_methods (SCM gf, SCM args, int len, int find_method_p)
scm_compute_applicable_methods (SCM gf, SCM args, scm_bits_t len, int find_method_p)
{
register int i;
int count = 0;
register scm_bits_t i;
scm_bits_t count = 0;
SCM l, fl, applicable = SCM_EOL;
SCM save = args;
SCM buffer[BUFFSIZE], *types, *p;
@ -1853,7 +1853,7 @@ SCM
scm_sys_compute_applicable_methods (SCM gf, SCM args)
#define FUNC_NAME s_sys_compute_applicable_methods
{
int n;
scm_bits_t n;
SCM_VALIDATE_GENERIC (1, gf);
n = scm_ilength (args);
SCM_ASSERT (n >= 0, args, SCM_ARG2, FUNC_NAME);
@ -1991,7 +1991,7 @@ SCM_DEFINE (scm_make, "make", 0, 0, 1,
#define FUNC_NAME s_scm_make
{
SCM class, z;
int len = scm_ilength (args);
scm_bits_t len = scm_ilength (args);
if (len <= 0 || (len & 1) == 0)
SCM_WRONG_NUM_ARGS ();
@ -2084,7 +2084,7 @@ SCM_DEFINE (scm_find_method, "find-method", 0, 0, 1,
#define FUNC_NAME s_scm_find_method
{
SCM gf;
int len = scm_ilength (l);
scm_bits_t len = scm_ilength (l);
if (len == 0)
SCM_WRONG_NUM_ARGS ();
@ -2104,7 +2104,7 @@ SCM_DEFINE (scm_sys_method_more_specific_p, "%method-more-specific?", 3, 0, 0,
#define FUNC_NAME s_scm_sys_method_more_specific_p
{
SCM l, v;
int i, len;
scm_bits_t i, len;
SCM_VALIDATE_METHOD (1, m1);
SCM_VALIDATE_METHOD (2, m2);
@ -2357,7 +2357,7 @@ scm_make_extended_class (char *type_name)
static void
create_smob_classes (void)
{
int i;
scm_bits_t i;
scm_smob_class = (SCM *) malloc (255 * sizeof (SCM));
for (i = 0; i < 255; ++i)
@ -2374,7 +2374,7 @@ create_smob_classes (void)
}
void
scm_make_port_classes (int ptobnum, char *type_name)
scm_make_port_classes (scm_bits_t ptobnum, char *type_name)
{
SCM c, class = make_class_from_template ("<%s-port>",
type_name,
@ -2401,7 +2401,7 @@ scm_make_port_classes (int ptobnum, char *type_name)
static void
create_port_classes (void)
{
int i;
scm_bits_t i;
scm_port_class = (SCM *) malloc (3 * 256 * sizeof (SCM));
for (i = 0; i < 3 * 256; ++i)
@ -2551,7 +2551,7 @@ scm_add_slot (SCM class, char *slot_name, SCM slot_class,
}
}
{
int n = SCM_INUM (SCM_SLOT (class, scm_si_nfields));
scm_bits_t n = SCM_INUM (SCM_SLOT (class, scm_si_nfields));
SCM_SLOT (class, scm_si_nfields)
= SCM_MAKINUM (n + 1);

4
libguile/goops.h
View file

@ -229,7 +229,7 @@ SCM scm_sys_set_object_setter_x (SCM obj, SCM setter);
SCM scm_slot_ref (SCM obj, SCM slot_name);
SCM scm_slot_set_x (SCM obj, SCM slot_name, SCM value);
SCM scm_compute_applicable_methods (SCM gf, SCM args, int len, int scm_find_method);
SCM scm_compute_applicable_methods (SCM gf, SCM args, scm_bits_t len, int scm_find_method);
SCM scm_sys_compute_applicable_methods (SCM gf, SCM args);
SCM scm_m_atslot_ref (SCM xorig, SCM env);
SCM scm_m_atslot_set_x (SCM xorig, SCM env);
@ -239,7 +239,7 @@ SCM scm_pure_generic_p (SCM obj);
#endif
SCM scm_sys_compute_slots (SCM c);
SCM scm_i_get_keyword (SCM key, SCM l, int len, SCM default_value, const char *subr);
SCM scm_i_get_keyword (SCM key, SCM l, scm_bits_t len, SCM default_value, const char *subr);
SCM scm_get_keyword (SCM key, SCM l, SCM default_value);
SCM scm_sys_initialize_object (SCM obj, SCM initargs);
SCM scm_sys_prep_layout_x (SCM c);

19
libguile/gsubr.c
View file

@ -50,6 +50,7 @@
#include "libguile/root.h"
#include "libguile/gsubr.h"
#include "libguile/deprecation.h"
/*
* gsubr.c
@ -210,19 +211,19 @@ SCM
scm_gsubr_apply (SCM args)
#define FUNC_NAME "scm_gsubr_apply"
{
SCM self = SCM_CAR(args);
SCM (*fcn)() = SCM_SUBRF(SCM_GSUBR_PROC(self));
SCM self = SCM_CAR (args);
SCM (*fcn)() = SCM_SUBRF (SCM_GSUBR_PROC (self));
SCM v[SCM_GSUBR_MAX];
int typ = SCM_INUM(SCM_GSUBR_TYPE(self));
int i, n = SCM_GSUBR_REQ(typ) + SCM_GSUBR_OPT(typ) + SCM_GSUBR_REST(typ);
scm_bits_t typ = SCM_INUM (SCM_GSUBR_TYPE (self));
scm_bits_t i, n = SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ) + SCM_GSUBR_REST (typ);
#if 0
if (n > SCM_GSUBR_MAX)
scm_misc_error (FUNC_NAME,
"Function ~S has illegal arity ~S.",
SCM_LIST2 (self, SCM_MAKINUM (n)));
#endif
args = SCM_CDR(args);
for (i = 0; i < SCM_GSUBR_REQ(typ); i++) {
args = SCM_CDR (args);
for (i = 0; i < SCM_GSUBR_REQ (typ); i++) {
#ifndef SCM_RECKLESS
if (SCM_NULLP (args))
scm_wrong_num_args (SCM_SNAME (SCM_GSUBR_PROC (self)));
@ -230,9 +231,9 @@ scm_gsubr_apply (SCM args)
v[i] = SCM_CAR(args);
args = SCM_CDR(args);
}
for (; i < SCM_GSUBR_REQ(typ) + SCM_GSUBR_OPT(typ); i++) {
if (SCM_NIMP(args)) {
v[i] = SCM_CAR(args);
for (; i < SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ); i++) {
if (SCM_NIMP (args)) {
v[i] = SCM_CAR (args);
args = SCM_CDR(args);
}
else

6
libguile/gsubr.h
View file

@ -49,9 +49,9 @@
#define SCM_GSUBR_MAKTYPE(req, opt, rst) ((req)|((opt)<<4)|((rst)<<8))
#define SCM_GSUBR_REQ(x) ((int)(x)&0xf)
#define SCM_GSUBR_OPT(x) (((int)(x)&0xf0)>>4)
#define SCM_GSUBR_REST(x) ((int)(x)>>8)
#define SCM_GSUBR_REQ(x) ((scm_bits_t)(x)&0xf)
#define SCM_GSUBR_OPT(x) (((scm_bits_t)(x)&0xf0)>>4)
#define SCM_GSUBR_REST(x) ((scm_bits_t)(x)>>8)
#define SCM_GSUBR_MAX 10
#define SCM_GSUBR_TYPE(cclo) (SCM_CCLO_REF ((cclo), 1))

2
libguile/guardians.c
View file

@ -175,7 +175,7 @@ guardian_mark (SCM ptr)
}
static scm_sizet
static size_t
guardian_free (SCM ptr)
{
scm_must_free (GUARDIAN (ptr));

69
libguile/hash.c
View file

@ -60,21 +60,21 @@ extern double floor();
#endif
unsigned long
scm_string_hash (const unsigned char *str, scm_sizet len)
scm_bits_t
scm_string_hash (const unsigned char *str, size_t len)
{
if (len > 5)
{
scm_sizet i = 5;
unsigned long h = 264;
size_t i = 5;
scm_bits_t h = 264;
while (i--)
h = (h << 8) + (unsigned) str[h % len];
return h;
}
else
{
scm_sizet i = len;
unsigned long h = 0;
size_t i = len;
scm_bits_t h = 0;
while (i)
h = (h << 8) + (unsigned) str[--i];
return h;
@ -86,8 +86,8 @@ scm_string_hash (const unsigned char *str, scm_sizet len)
/* Dirk:FIXME:: scm_hasher could be made static. */
unsigned long
scm_hasher(SCM obj, unsigned long n, scm_sizet d)
scm_bits_t
scm_hasher (SCM obj, scm_bits_t n, size_t d)
{
switch (SCM_ITAG3 (obj)) {
case scm_tc3_int_1:
@ -95,7 +95,7 @@ scm_hasher(SCM obj, unsigned long n, scm_sizet d)
return SCM_INUM(obj) % n; /* SCM_INUMP(obj) */
case scm_tc3_imm24:
if (SCM_CHARP(obj))
return (unsigned)(scm_downcase(SCM_CHAR(obj))) % n;
return (scm_ubits_t) (scm_downcase(SCM_CHAR(obj))) % n;
switch (SCM_UNPACK (obj)) {
#ifndef SICP
case SCM_EOL:
@ -122,22 +122,22 @@ scm_hasher(SCM obj, unsigned long n, scm_sizet d)
default:
return 263 % n;
case scm_tc7_smob:
switch SCM_TYP16(obj) {
switch SCM_TYP16 (obj) {
case scm_tc16_big:
return SCM_INUM(scm_modulo(obj, SCM_MAKINUM(n)));
return SCM_INUM (scm_modulo (obj, SCM_MAKINUM (n)));
default:
return 263 % n;
case scm_tc16_real:
{
double r = SCM_REAL_VALUE(obj);
if (floor(r)==r) {
double r = SCM_REAL_VALUE (obj);
if (floor (r) == r) {
obj = scm_inexact_to_exact (obj);
if SCM_IMP(obj) return SCM_INUM(obj) % n;
return SCM_INUM(scm_modulo(obj, SCM_MAKINUM(n)));
if SCM_IMP (obj) return SCM_INUM (obj) % n;
return SCM_INUM (scm_modulo (obj, SCM_MAKINUM (n)));
}
}
case scm_tc16_complex:
obj = scm_number_to_string(obj, SCM_MAKINUM(10));
obj = scm_number_to_string (obj, SCM_MAKINUM (10));
}
case scm_tc7_string:
case scm_tc7_substring:
@ -147,26 +147,27 @@ scm_hasher(SCM obj, unsigned long n, scm_sizet d)
case scm_tc7_wvect:
case scm_tc7_vector:
{
scm_sizet len = SCM_VECTOR_LENGTH(obj);
size_t len = SCM_VECTOR_LENGTH(obj);
SCM *data = SCM_VELTS(obj);
if (len>5)
if (len > 5)
{
scm_sizet i = d/2;
unsigned long h = 1;
while (i--) h = ((h<<8) + (scm_hasher(data[h % len], n, 2))) % n;
size_t i = d/2;
scm_bits_t h = 1;
while (i--) h = ((h << 8) + (scm_hasher (data[h % len], n, 2))) % n;
return h;
}
else
{
scm_sizet i = len;
unsigned long h = (n)-1;
while (i--) h = ((h<<8) + (scm_hasher(data[i], n, d/len))) % n;
size_t i = len;
scm_bits_t h = (n)-1;
while (i--) h = ((h << 8) + (scm_hasher (data[i], n, d/len))) % n;
return h;
}
}
case scm_tcs_cons_imcar:
case scm_tcs_cons_nimcar:
if (d) return (scm_hasher(SCM_CAR(obj), n, d/2)+scm_hasher(SCM_CDR(obj), n, d/2)) % n;
if (d) return (scm_hasher (SCM_CAR (obj), n, d/2)
+ scm_hasher (SCM_CDR (obj), n, d/2)) % n;
else return 1;
case scm_tc7_port:
return ((SCM_RDNG & SCM_CELL_WORD_0 (obj)) ? 260 : 261) % n;
@ -181,8 +182,8 @@ scm_hasher(SCM obj, unsigned long n, scm_sizet d)
unsigned int
scm_ihashq (SCM obj, unsigned int n)
scm_bits_t
scm_ihashq (SCM obj, scm_bits_t n)
{
return (SCM_UNPACK (obj) >> 1) % n;
}
@ -211,14 +212,14 @@ SCM_DEFINE (scm_hashq, "hashq", 2, 0, 0,
unsigned int
scm_ihashv (SCM obj, unsigned int n)
scm_bits_t
scm_ihashv (SCM obj, scm_bits_t n)
{
if (SCM_CHARP(obj))
return ((unsigned int)(scm_downcase(SCM_CHAR(obj)))) % n; /* downcase!?!! */
return ((scm_ubits_t)(scm_downcase(SCM_CHAR(obj)))) % n; /* downcase!?!! */
if (SCM_NUMP(obj))
return (unsigned int) scm_hasher(obj, n, 10);
return (scm_bits_t) scm_hasher(obj, n, 10);
else
return SCM_UNPACK (obj) % n;
}
@ -247,10 +248,10 @@ SCM_DEFINE (scm_hashv, "hashv", 2, 0, 0,
unsigned int
scm_ihash (SCM obj, unsigned int n)
scm_bits_t
scm_ihash (SCM obj, scm_bits_t n)
{
return (unsigned int)scm_hasher (obj, n, 10);
return (scm_bits_t) scm_hasher (obj, n, 10);
}
SCM_DEFINE (scm_hash, "hash", 2, 0, 0,

10
libguile/hash.h
View file

@ -48,13 +48,13 @@
extern unsigned long scm_string_hash (const unsigned char *str, scm_sizet len);
extern unsigned long scm_hasher (SCM obj, unsigned long n, scm_sizet d);
extern unsigned int scm_ihashq (SCM obj, unsigned int n);
extern scm_bits_t scm_string_hash (const unsigned char *str, size_t len);
extern scm_bits_t scm_hasher (SCM obj, scm_bits_t n, size_t d);
extern scm_bits_t scm_ihashq (SCM obj, scm_bits_t n);
extern SCM scm_hashq (SCM obj, SCM n);
extern unsigned int scm_ihashv (SCM obj, unsigned int n);
extern scm_bits_t scm_ihashv (SCM obj, scm_bits_t n);
extern SCM scm_hashv (SCM obj, SCM n);
extern unsigned int scm_ihash (SCM obj, unsigned int n);
extern scm_bits_t scm_ihash (SCM obj, scm_bits_t n);
extern SCM scm_hash (SCM obj, SCM n);
extern void scm_init_hash (void);

66
libguile/hashtab.c
View file

@ -55,17 +55,20 @@
SCM
scm_c_make_hash_table (unsigned long k)
scm_c_make_hash_table (scm_bits_t k)
{
return scm_c_make_vector (k, SCM_EOL);
}
SCM
scm_hash_fn_get_handle (SCM table,SCM obj,unsigned int (*hash_fn)(),SCM (*assoc_fn)(),void * closure)
scm_hash_fn_get_handle (SCM table, SCM obj,
scm_bits_t (*hash_fn) (),
SCM (*assoc_fn) (),
void *closure)
#define FUNC_NAME "scm_hash_fn_get_handle"
{
unsigned int k;
scm_bits_t k;
SCM h;
SCM_VALIDATE_VECTOR (1, table);
@ -81,11 +84,13 @@ scm_hash_fn_get_handle (SCM table,SCM obj,unsigned int (*hash_fn)(),SCM (*assoc_
SCM
scm_hash_fn_create_handle_x (SCM table,SCM obj,SCM init,unsigned int (*hash_fn)(),
SCM (*assoc_fn)(),void * closure)
scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init,
scm_bits_t (*hash_fn) (),
SCM (*assoc_fn) (),
void *closure)
#define FUNC_NAME "scm_hash_fn_create_handle_x"
{
unsigned int k;
scm_bits_t k;
SCM it;
SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_create_handle_x");
@ -116,8 +121,10 @@ scm_hash_fn_create_handle_x (SCM table,SCM obj,SCM init,unsigned int (*hash_fn)(
SCM
scm_hash_fn_ref (SCM table,SCM obj,SCM dflt,unsigned int (*hash_fn)(),
SCM (*assoc_fn)(),void * closure)
scm_hash_fn_ref (SCM table, SCM obj, SCM dflt,
scm_bits_t (*hash_fn) (),
SCM (*assoc_fn) (),
void *closure)
{
SCM it = scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure);
if (SCM_CONSP (it))
@ -130,8 +137,10 @@ scm_hash_fn_ref (SCM table,SCM obj,SCM dflt,unsigned int (*hash_fn)(),
SCM
scm_hash_fn_set_x (SCM table,SCM obj,SCM val,unsigned int (*hash_fn)(),
SCM (*assoc_fn)(),void * closure)
scm_hash_fn_set_x (SCM table, SCM obj, SCM val,
scm_bits_t (*hash_fn) (),
SCM (*assoc_fn) (),
void * closure)
{
SCM it;
@ -145,10 +154,13 @@ scm_hash_fn_set_x (SCM table,SCM obj,SCM val,unsigned int (*hash_fn)(),
SCM
scm_hash_fn_remove_x (SCM table,SCM obj,unsigned int (*hash_fn)(),SCM (*assoc_fn)(),
SCM (*delete_fn)(),void * closure)
scm_hash_fn_remove_x (SCM table, SCM obj,
scm_bits_t (*hash_fn) (),
SCM (*assoc_fn) (),
SCM (*delete_fn) (),
void *closure)
{
unsigned int k;
scm_bits_t k;
SCM h;
SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_remove_x");
@ -366,22 +378,22 @@ SCM_DEFINE (scm_hash_remove_x, "hash-remove!", 2, 0, 0,
struct scm_ihashx_closure
typedef struct scm_ihashx_closure_t
{
SCM hash;
SCM assoc;
SCM delete;
};
} scm_ihashx_closure_t;
static unsigned int
scm_ihashx (SCM obj,unsigned int n,struct scm_ihashx_closure * closure)
static scm_bits_t
scm_ihashx (SCM obj, scm_bits_t n, scm_ihashx_closure_t *closure)
{
SCM answer;
SCM_DEFER_INTS;
answer = scm_apply (closure->hash,
SCM_LIST2 (obj, scm_ulong2num ((unsigned long)n)),
SCM_LIST2 (obj, scm_bits2num (n)),
SCM_EOL);
SCM_ALLOW_INTS;
return SCM_INUM (answer);
@ -390,7 +402,7 @@ scm_ihashx (SCM obj,unsigned int n,struct scm_ihashx_closure * closure)
static SCM
scm_sloppy_assx (SCM obj,SCM alist,struct scm_ihashx_closure * closure)
scm_sloppy_assx (SCM obj, SCM alist, scm_ihashx_closure_t *closure)
{
SCM answer;
SCM_DEFER_INTS;
@ -405,7 +417,7 @@ scm_sloppy_assx (SCM obj,SCM alist,struct scm_ihashx_closure * closure)
static SCM
scm_delx_x (SCM obj,SCM alist,struct scm_ihashx_closure * closure)
scm_delx_x (SCM obj, SCM alist, scm_ihashx_closure_t *closure)
{
SCM answer;
SCM_DEFER_INTS;
@ -428,7 +440,7 @@ SCM_DEFINE (scm_hashx_get_handle, "hashx-get-handle", 4, 0, 0,
"@code{assoc}, @code{assq} or @code{assv}.")
#define FUNC_NAME s_scm_hashx_get_handle
{
struct scm_ihashx_closure closure;
scm_ihashx_closure_t closure;
closure.hash = hash;
closure.assoc = assoc;
return scm_hash_fn_get_handle (table, key, scm_ihashx, scm_sloppy_assx,
@ -447,7 +459,7 @@ SCM_DEFINE (scm_hashx_create_handle_x, "hashx-create-handle!", 5, 0, 0,
"@code{assoc}, @code{assq} or @code{assv}.")
#define FUNC_NAME s_scm_hashx_create_handle_x
{
struct scm_ihashx_closure closure;
scm_ihashx_closure_t closure;
closure.hash = hash;
closure.assoc = assoc;
return scm_hash_fn_create_handle_x (table, key, init, scm_ihashx,
@ -470,7 +482,7 @@ SCM_DEFINE (scm_hashx_ref, "hashx-ref", 4, 1, 0,
"equivalent to @code{hashx-ref hashq assq table key}.")
#define FUNC_NAME s_scm_hashx_ref
{
struct scm_ihashx_closure closure;
scm_ihashx_closure_t closure;
if (SCM_UNBNDP (dflt))
dflt = SCM_BOOL_F;
closure.hash = hash;
@ -496,7 +508,7 @@ SCM_DEFINE (scm_hashx_set_x, "hashx-set!", 5, 0, 0,
"equivalent to @code{hashx-set! hashq assq table key}.")
#define FUNC_NAME s_scm_hashx_set_x
{
struct scm_ihashx_closure closure;
scm_ihashx_closure_t closure;
closure.hash = hash;
closure.assoc = assoc;
return scm_hash_fn_set_x (table, key, val, scm_ihashx, scm_sloppy_assx,
@ -507,9 +519,9 @@ SCM_DEFINE (scm_hashx_set_x, "hashx-set!", 5, 0, 0,
SCM
scm_hashx_remove_x (SCM hash,SCM assoc,SCM delete,SCM table,SCM obj)
scm_hashx_remove_x (SCM hash, SCM assoc, SCM delete, SCM table, SCM obj)
{
struct scm_ihashx_closure closure;
scm_ihashx_closure_t closure;
closure.hash = hash;
closure.assoc = assoc;
closure.delete = delete;
@ -543,7 +555,7 @@ SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0,
SCM
scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table)
{
int i, n = SCM_VECTOR_LENGTH (table);
scm_bits_t i, n = SCM_VECTOR_LENGTH (table);
SCM result = init;
for (i = 0; i < n; ++i)
{

12
libguile/hashtab.h
View file

@ -53,13 +53,13 @@ typedef SCM scm_assoc_fn_t (SCM key, SCM alist, void *closure);
typedef SCM scm_delete_fn_t (SCM elt, SCM list);
#endif
extern SCM scm_c_make_hash_table (unsigned long k);
extern SCM scm_c_make_hash_table (scm_bits_t k);
extern SCM scm_hash_fn_get_handle (SCM table, SCM obj, unsigned int (*hash_fn) (), SCM (*assoc_fn) (), void * closure);
extern SCM scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, unsigned int (*hash_fn) (), SCM (*assoc_fn) (), void * closure);
extern SCM scm_hash_fn_ref (SCM table, SCM obj, SCM dflt, unsigned int (*hash_fn) (), SCM (*assoc_fn) (), void * closure);
extern SCM scm_hash_fn_set_x (SCM table, SCM obj, SCM val, unsigned int (*hash_fn) (), SCM (*assoc_fn) (), void * closure);
extern SCM scm_hash_fn_remove_x (SCM table, SCM obj, unsigned int (*hash_fn) (), SCM (*assoc_fn) (), SCM (*delete_fn) (), void * closure);
extern SCM scm_hash_fn_get_handle (SCM table, SCM obj, scm_bits_t (*hash_fn) (), SCM (*assoc_fn) (), void * closure);
extern SCM scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, scm_bits_t (*hash_fn) (), SCM (*assoc_fn) (), void * closure);
extern SCM scm_hash_fn_ref (SCM table, SCM obj, SCM dflt, scm_bits_t (*hash_fn) (), SCM (*assoc_fn) (), void * closure);
extern SCM scm_hash_fn_set_x (SCM table, SCM obj, SCM val, scm_bits_t (*hash_fn) (), SCM (*assoc_fn) (), void * closure);
extern SCM scm_hash_fn_remove_x (SCM table, SCM obj, scm_bits_t (*hash_fn) (), SCM (*assoc_fn) (), SCM (*delete_fn) (), void * closure);
extern SCM scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table);
extern SCM scm_hashq_get_handle (SCM table, SCM obj);

2
libguile/hooks.c
View file

@ -195,7 +195,7 @@ hook_print (SCM hook, SCM port, scm_print_state *pstate)
SCM
scm_create_hook (const char* name, int n_args)
scm_create_hook (const char *name, int n_args)
{
SCM hook = make_hook (SCM_MAKINUM (n_args), "scm_create_hook");
scm_c_define (name, hook);

5
libguile/init.c
View file

@ -142,6 +142,7 @@
#include "libguile/vports.h"
#include "libguile/weaks.h"
#include "libguile/guardians.h"
#include "libguile/extensions.h"
#include "libguile/init.h"
@ -188,7 +189,7 @@ start_stack (void *base)
/* Create an object to hold the root continuation.
*/
{
scm_contregs *contregs = scm_must_malloc (sizeof (scm_contregs),
scm_contregs_t *contregs = scm_must_malloc (sizeof (scm_contregs_t),
"continuation");
contregs->num_stack_items = 0;
contregs->seq = 0;
@ -228,7 +229,7 @@ fixconfig (char *s1,char *s2,int s)
static void
check_config (void)
{
scm_sizet j;
size_t j;
j = HEAP_SEG_SIZE;
if (HEAP_SEG_SIZE != j)

20
libguile/ioext.c
View file

@ -90,7 +90,7 @@ SCM_DEFINE (scm_redirect_port, "redirect-port", 2, 0, 0,
#define FUNC_NAME s_scm_redirect_port
{
int ans, oldfd, newfd;
struct scm_fport *fp;
scm_fport_t *fp;
old = SCM_COERCE_OUTPORT (old);
new = SCM_COERCE_OUTPORT (new);
@ -102,9 +102,9 @@ SCM_DEFINE (scm_redirect_port, "redirect-port", 2, 0, 0,
newfd = fp->fdes;
if (oldfd != newfd)
{
scm_port *pt = SCM_PTAB_ENTRY (new);
scm_port *old_pt = SCM_PTAB_ENTRY (old);
scm_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (new)];
scm_port_t *pt = SCM_PTAB_ENTRY (new);
scm_port_t *old_pt = SCM_PTAB_ENTRY (old);
scm_ptob_descriptor_t *ptob = &scm_ptobs[SCM_PTOBNUM (new)];
/* must flush to old fdes. */
if (pt->rw_active == SCM_PORT_WRITE)
@ -203,7 +203,11 @@ SCM_DEFINE (scm_fileno, "fileno", 1, 0, 0,
/* GJB:FIXME:: why does this not throw
an error if the arg is not a port?
This proc as is would be better names isattyport?
if it is not going to assume that the arg is a port */
if it is not going to assume that the arg is a port
[cmm] I don't see any problem with the above. why should a type
predicate assume _anything_ about its argument?
*/
SCM_DEFINE (scm_isatty_p, "isatty?", 1, 0, 0,
(SCM port),
"Return @code{#t} if @var{port} is using a serial non--file\n"
@ -257,7 +261,7 @@ SCM_DEFINE (scm_primitive_move_to_fdes, "primitive-move->fdes", 2, 0, 0,
"required value or @code{#t} if it was moved.")
#define FUNC_NAME s_scm_primitive_move_to_fdes
{
struct scm_fport *stream;
scm_fport_t *stream;
int old_fd;
int new_fd;
int rv;
@ -293,14 +297,14 @@ SCM_DEFINE (scm_fdes_to_ports, "fdes->ports", 1, 0, 0,
{
SCM result = SCM_EOL;
int int_fd;
int i;
scm_bits_t i;
SCM_VALIDATE_INUM_COPY (1,fd,int_fd);
for (i = 0; i < scm_port_table_size; i++)
{
if (SCM_OPFPORTP (scm_port_table[i]->port)
&& ((struct scm_fport *) scm_port_table[i]->stream)->fdes == int_fd)
&& ((scm_fport_t *) scm_port_table[i]->stream)->fdes == int_fd)
result = scm_cons (scm_port_table[i]->port, result);
}
return result;

18
libguile/list.c
View file

@ -148,10 +148,10 @@ SCM_DEFINE (scm_list_p, "list?", 1, 0, 0,
This uses the "tortoise and hare" algorithm to detect "infinitely
long" lists (i.e. lists with cycles in their cdrs), and returns -1
if it does find one. */
long
scm_ilength(SCM sx)
scm_bits_t
scm_ilength (SCM sx)
{
long i = 0;
scm_bits_t i = 0;
SCM tortoise = sx;
SCM hare = sx;
@ -180,7 +180,7 @@ SCM_DEFINE (scm_length, "length", 1, 0, 0,
"Return the number of elements in list @var{lst}.")
#define FUNC_NAME s_scm_length
{
int i;
scm_bits_t i;
SCM_VALIDATE_LIST_COPYLEN (1,lst,i);
return SCM_MAKINUM (i);
}
@ -360,7 +360,7 @@ SCM_DEFINE (scm_list_ref, "list-ref", 2, 0, 0,
#define FUNC_NAME s_scm_list_ref
{
SCM lst = list;
unsigned long int i;
register scm_bits_t i;
SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
while (SCM_CONSP (lst)) {
if (i == 0)
@ -384,7 +384,7 @@ SCM_DEFINE (scm_list_set_x, "list-set!", 3, 0, 0,
#define FUNC_NAME s_scm_list_set_x
{
SCM lst = list;
unsigned long int i;
register scm_bits_t i;
SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
while (SCM_CONSP (lst)) {
if (i == 0) {
@ -415,7 +415,7 @@ SCM_DEFINE (scm_list_tail, "list-tail", 2, 0, 0,
"or returning the results of cdring @var{k} times down @var{lst}.")
#define FUNC_NAME s_scm_list_tail
{
register long i;
register scm_bits_t i;
SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
while (i-- > 0) {
SCM_VALIDATE_CONS (1,lst);
@ -432,7 +432,7 @@ SCM_DEFINE (scm_list_cdr_set_x, "list-cdr-set!", 3, 0, 0,
#define FUNC_NAME s_scm_list_cdr_set_x
{
SCM lst = list;
unsigned long int i;
scm_bits_t i;
SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
while (SCM_CONSP (lst)) {
if (i == 0) {
@ -462,7 +462,7 @@ SCM_DEFINE (scm_list_head, "list-head", 2, 0, 0,
{
SCM answer;
SCM * pos;
register long i;
register scm_bits_t i;
SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
answer = SCM_EOL;

2
libguile/list.h
View file

@ -72,7 +72,7 @@ extern SCM scm_list (SCM objs);
extern SCM scm_cons_star (SCM arg, SCM objs);
extern SCM scm_null_p (SCM x);
extern SCM scm_list_p (SCM x);
extern long scm_ilength (SCM sx);
extern scm_bits_t scm_ilength (SCM sx);
extern SCM scm_length (SCM x);
extern SCM scm_append (SCM args);
extern SCM scm_append_x (SCM args);

12
libguile/load.c
View file

@ -124,7 +124,7 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
{ /* scope */
SCM port, save_port;
port = scm_open_file (filename,
scm_makfromstr ("r", (scm_sizet) sizeof (char), 0));
scm_makfromstr ("r", (size_t) sizeof (char), 0));
save_port = port;
scm_internal_dynamic_wind (swap_port,
load,
@ -349,7 +349,7 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
{ /* scope */
SCM result = SCM_BOOL_F;
int buf_size = max_path_len + 1 + filename_len + max_ext_len + 1;
size_t buf_size = max_path_len + 1 + filename_len + max_ext_len + 1;
char *buf = SCM_MUST_MALLOC (buf_size);
/* This simplifies the loop below a bit. */
@ -360,7 +360,7 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
proper list of strings. */
for (; !SCM_NULLP (path); path = SCM_CDR (path))
{
int len;
size_t len;
SCM dir = SCM_CAR (path);
SCM exts;
@ -377,7 +377,7 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
for (exts = extensions; !SCM_NULLP (exts); exts = SCM_CDR (exts))
{
SCM ext = SCM_CAR (exts);
int ext_len = SCM_STRING_LENGTH (ext);
size_t ext_len = SCM_STRING_LENGTH (ext);
struct stat mode;
/* Concatenate the extension. */
@ -397,7 +397,7 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
end:
scm_must_free (buf);
scm_done_malloc (- buf_size);
scm_done_free (buf_size);
SCM_ALLOW_INTS;
return result;
}
@ -495,7 +495,7 @@ init_build_info ()
{
static struct { char *name; char *value; } info[] = SCM_BUILD_INFO;
SCM *loc = SCM_VARIABLE_LOC (scm_c_define ("%guile-build-info", SCM_EOL));
unsigned int i;
scm_bits_t i;
for (i = 0; i < (sizeof (info) / sizeof (info[0])); i++)
*loc = scm_acons (scm_str2symbol (info[i].name),

4
libguile/mallocs.c
View file

@ -40,7 +40,7 @@
scm_bits_t scm_tc16_malloc;
static scm_sizet
static size_t
malloc_free (SCM ptr)
{
if (SCM_MALLOCDATA (ptr))
@ -60,7 +60,7 @@ malloc_print (SCM exp, SCM port, scm_print_state *pstate)
SCM
scm_malloc_obj (scm_sizet n)
scm_malloc_obj (size_t n)
{
scm_bits_t mem = n ? (scm_bits_t) malloc (n) : 0;
if (n && !mem)

2
libguile/mallocs.h
View file

@ -54,7 +54,7 @@ extern scm_bits_t scm_tc16_malloc;
extern SCM scm_malloc_obj (scm_sizet n);
extern SCM scm_malloc_obj (size_t n);
extern void scm_init_mallocs (void);
#endif /* MALLOCSH */

2
libguile/modules.c
View file

@ -526,7 +526,7 @@ scm_module_reverse_lookup (SCM module, SCM variable)
#define FUNC_NAME "module-reverse-lookup"
{
SCM obarray;
int i, n;
scm_bits_t i, n;
if (module == SCM_BOOL_F)
obarray = scm_pre_modules_obarray;

10
libguile/net_db.c
View file

@ -185,7 +185,7 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
scm_resolv_error (FUNC_NAME, host);
ve[0] = scm_makfromstr (entry->h_name,
(scm_sizet) strlen (entry->h_name), 0);
(size_t) strlen (entry->h_name), 0);
ve[1] = scm_makfromstrs (-1, entry->h_aliases);
ve[2] = SCM_MAKINUM (entry->h_addrtype + 0L);
ve[3] = SCM_MAKINUM (entry->h_length + 0L);
@ -257,7 +257,7 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0,
}
if (!entry)
SCM_SYSERROR_MSG ("no such network ~A", SCM_LIST1 (net), errno);
ve[0] = scm_makfromstr (entry->n_name, (scm_sizet) strlen (entry->n_name), 0);
ve[0] = scm_makfromstr (entry->n_name, (size_t) strlen (entry->n_name), 0);
ve[1] = scm_makfromstrs (-1, entry->n_aliases);
ve[2] = SCM_MAKINUM (entry->n_addrtype + 0L);
ve[3] = scm_ulong2num (entry->n_net + 0L);
@ -307,7 +307,7 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
}
if (!entry)
SCM_SYSERROR_MSG ("no such protocol ~A", SCM_LIST1 (protocol), errno);
ve[0] = scm_makfromstr (entry->p_name, (scm_sizet) strlen (entry->p_name), 0);
ve[0] = scm_makfromstr (entry->p_name, (size_t) strlen (entry->p_name), 0);
ve[1] = scm_makfromstrs (-1, entry->p_aliases);
ve[2] = SCM_MAKINUM (entry->p_proto + 0L);
return ans;
@ -323,10 +323,10 @@ scm_return_entry (struct servent *entry)
ans = scm_c_make_vector (4, SCM_UNSPECIFIED);
ve = SCM_VELTS (ans);
ve[0] = scm_makfromstr (entry->s_name, (scm_sizet) strlen (entry->s_name), 0);
ve[0] = scm_makfromstr (entry->s_name, (size_t) strlen (entry->s_name), 0);
ve[1] = scm_makfromstrs (-1, entry->s_aliases);
ve[2] = SCM_MAKINUM (ntohs (entry->s_port) + 0L);
ve[3] = scm_makfromstr (entry->s_proto, (scm_sizet) strlen (entry->s_proto), 0);
ve[3] = scm_makfromstr (entry->s_proto, (size_t) strlen (entry->s_proto), 0);
return ans;
}

165
libguile/num2integral.i.c Normal file
View file

@ -0,0 +1,165 @@
/* this file is #include'd (many times) by numbers.c */
ITYPE
NUM2INTEGRAL (SCM num, unsigned long int pos, const char *s_caller)
{
if (SCM_INUMP (num))
{ /* immediate */
scm_bits_t n = SCM_INUM (num);
#ifdef UNSIGNED
if (n < 0)
scm_out_of_range (s_caller, num);
#endif
if (sizeof (ITYPE) >= sizeof (scm_bits_t))
/* can't fit anything too big for this type in an inum
anyway */
return (ITYPE) n;
else
{ /* an inum can be out of range, so check */
if (n > (scm_bits_t)MAX_VALUE
#ifndef UNSIGNED
|| n < (scm_bits_t)MIN_VALUE
#endif
)
scm_out_of_range (s_caller, num);
else
return (ITYPE) n;
}
}
else if (SCM_BIGP (num))
{ /* bignum */
ITYPE res = 0;
size_t l;
for (l = SCM_NUMDIGS (num); l--;)
{
ITYPE new = SCM_I_BIGUP (ITYPE, res) + SCM_BDIGITS (num)[l];
if (new < res
#ifndef UNSIGNED
&& !(new == MIN_VALUE && l == 0)
#endif
)
scm_out_of_range (s_caller, num);
res = new;
}
#ifndef UNSIGNED
if (SCM_BIGSIGN (num))
{
res = -res;
if (res <= 0)
return res;
else
scm_out_of_range (s_caller, num);
}
else
{
if (res >= 0)
return res;
else
scm_out_of_range (s_caller, num);
}
#endif
return res;
}
else if (SCM_REALP (num))
{ /* inexact */
double u = SCM_REAL_VALUE (num);
ITYPE res = u;
if ((double) res == u)
return res;
else
scm_out_of_range (s_caller, num);
}
else
scm_wrong_type_arg (s_caller, pos, num);
}
SCM
INTEGRAL2NUM (ITYPE n)
{
if (sizeof (ITYPE) < sizeof (scm_bits_t)
||
#ifndef UNSIGNED
SCM_FIXABLE (n)
#else
SCM_POSFIXABLE (n)
#endif
)
return SCM_MAKINUM (n);
#ifdef SCM_BIGDIG
return INTEGRAL2BIG (n);
#else
return scm_make_real ((double) n);
#endif
}
#ifdef SCM_BIGDIG
SCM
INTEGRAL2BIG (ITYPE n)
{
SCM res;
int neg_p;
int n_digits;
size_t i;
SCM_BIGDIG *digits;
#ifndef UNSIGNED
neg_p = (n < 0);
if (neg_p) n = -n;
#else
neg_p = 0;
#endif
#ifndef UNSIGNED
if (n == MIN_VALUE)
/* special case */
n_digits =
(sizeof (ITYPE) + sizeof (SCM_BIGDIG) - 1) / sizeof (SCM_BIGDIG);
else
#endif
{
ITYPE tn;
for (tn = n, n_digits = 0;
tn;
++n_digits, tn = SCM_BIGDN (tn))
;
}
i = 0;
res = scm_i_mkbig (n_digits, neg_p);
digits = SCM_BDIGITS (res);
while (i < n_digits)
{
digits[i++] = SCM_BIGLO (n);
n = SCM_BIGDN (n);
}
return res;
}
#endif
/* clean up */
#undef INTEGRAL2NUM
#undef INTEGRAL2BIG
#undef NUM2INTEGRAL
#undef UNSIGNED
#undef ITYPE
#undef MIN_VALUE
#undef MAX_VALUE
/*
Local Variables:
c-file-style: "gnu"
End:
*/

848
libguile/numbers.c
View file

File diff suppressed because it is too large Load diff

116
libguile/numbers.h
View file

@ -62,8 +62,8 @@
* SCM_INUMP (SCM_CAR (x)) can give wrong answers.
*/
#define SCM_FIXNUM_BIT (SCM_LONG_BIT - 2)
#define SCM_MOST_POSITIVE_FIXNUM ((1L << (SCM_FIXNUM_BIT - 1)) - 1)
#define SCM_I_FIXNUM_BIT (SCM_BITS_LENGTH - 2)
#define SCM_MOST_POSITIVE_FIXNUM ((1L << (SCM_I_FIXNUM_BIT - 1)) - 1)
#define SCM_MOST_NEGATIVE_FIXNUM (-SCM_MOST_POSITIVE_FIXNUM - 1)
@ -115,7 +115,7 @@
/* SCM_INTBUFLEN is the maximum number of characters neccessary for the
* printed or scm_string representation of an exact immediate.
*/
#define SCM_INTBUFLEN (5 + SCM_LONG_BIT)
#define SCM_INTBUFLEN (5 + SCM_BITS_LENGTH)
@ -154,9 +154,10 @@
# endif /* def _UNICOS */
# define SCM_BIGRAD (1L << SCM_BITSPERDIG)
# define SCM_DIGSPERLONG ((scm_sizet)((sizeof(long)*SCM_CHAR_BIT+SCM_BITSPERDIG-1)/SCM_BITSPERDIG))
# define SCM_BIGUP(x) ((unsigned long)(x) << SCM_BITSPERDIG)
# define SCM_LONGLONGBIGUP(x) ((ulong_long)(x) << SCM_BITSPERDIG)
# define SCM_DIGSPERLONG ((size_t)((sizeof(long)*SCM_CHAR_BIT+SCM_BITSPERDIG-1)/SCM_BITSPERDIG))
# define SCM_I_BIGUP(type, x) ((type)(x) << SCM_BITSPERDIG)
# define SCM_BIGUP(x) SCM_I_BIGUP (unsigned long, x)
# define SCM_LONGLONGBIGUP(x) SCM_I_BIGUP (unsigned long long, x)
# define SCM_BIGDN(x) ((x) >> SCM_BITSPERDIG)
# define SCM_BIGLO(x) ((x) & (SCM_BIGRAD-1))
#endif /* def BIGNUMS */
@ -176,7 +177,7 @@
#define SCM_BIGSIGN(x) (SCM_CELL_WORD_0 (x) & SCM_BIGSIGNFLAG)
#define SCM_BDIGITS(x) ((SCM_BIGDIG *) (SCM_CELL_WORD_1 (x)))
#define SCM_SET_BIGNUM_BASE(n, b) (SCM_SET_CELL_WORD_1 ((n), (b)))
#define SCM_NUMDIGS(x) ((scm_sizet) (SCM_CELL_WORD_0 (x) >> SCM_BIGSIZEFIELD))
#define SCM_NUMDIGS(x) ((size_t) ((scm_ubits_t) SCM_CELL_WORD_0 (x) >> SCM_BIGSIZEFIELD))
#define SCM_SETNUMDIGS(x, v, sign) \
SCM_SET_CELL_WORD_0 (x, \
scm_tc16_big \
@ -220,24 +221,49 @@ extern SCM scm_ash (SCM n, SCM cnt);
extern SCM scm_bit_extract (SCM n, SCM start, SCM end);
extern SCM scm_logcount (SCM n);
extern SCM scm_integer_length (SCM n);
extern SCM scm_mkbig (scm_sizet nlen, int sign);
extern SCM scm_big2inum (SCM b, scm_sizet l);
extern SCM scm_adjbig (SCM b, scm_sizet nlen);
extern SCM scm_i_mkbig (size_t nlen, int sign);
extern SCM scm_i_big2inum (SCM b, size_t l);
extern SCM scm_i_adjbig (SCM b, size_t nlen);
extern SCM scm_i_normbig (SCM b);
extern SCM scm_i_copybig (SCM b, int sign);
extern SCM scm_i_short2big (short n);
extern SCM scm_i_ushort2big (unsigned short n);
extern SCM scm_i_int2big (int n);
extern SCM scm_i_uint2big (unsigned int n);
extern SCM scm_i_long2big (long n);
extern SCM scm_i_ulong2big (unsigned long n);
extern SCM scm_i_bits2big (scm_bits_t n);
extern SCM scm_i_ubits2big (scm_ubits_t n);
extern SCM scm_i_size2big (size_t n);
extern SCM scm_i_ptrdiff2big (ptrdiff_t n);
#if (SCM_DEBUG_DEPRECATED == 0)
extern SCM scm_big2inum (SCM b, size_t l);
extern SCM scm_mkbig (size_t nlen, int sign);
extern SCM scm_adjbig (SCM b, size_t len);
extern SCM scm_normbig (SCM b);
extern SCM scm_copybig (SCM b, int sign);
extern SCM scm_long2big (long n);
#ifdef HAVE_LONG_LONGS
extern SCM scm_long_long2big (long_long n);
#define SCM_FIXNUM_BIT SCM_I_FIXNUM_BIT
#endif
#ifdef HAVE_LONG_LONGS
extern SCM scm_i_long_long2big (long long n);
extern SCM scm_i_ulong_long2big (unsigned long long n);
#endif
#if (SCM_DEBUG_DEPRECATED == 0)
extern SCM scm_2ulong2big (unsigned long * np);
extern SCM scm_ulong2big (unsigned long n);
#endif
extern int scm_bigcomp (SCM x, SCM y);
extern long scm_pseudolong (long x);
extern void scm_longdigs (long x, SCM_BIGDIG digs[]);
extern SCM scm_addbig (SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy, int sgny);
extern SCM scm_mulbig (SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn);
extern unsigned int scm_divbigdig (SCM_BIGDIG *ds, scm_sizet h, SCM_BIGDIG div);
extern scm_sizet scm_iint2str (long num, int rad, char *p);
extern SCM scm_addbig (SCM_BIGDIG *x, size_t nx, int xsgn, SCM bigy, int sgny);
extern SCM scm_mulbig (SCM_BIGDIG *x, size_t nx, SCM_BIGDIG *y, size_t ny, int sgn);
extern unsigned int scm_divbigdig (SCM_BIGDIG *ds, size_t h, SCM_BIGDIG div);
extern size_t scm_iint2str (long num, int rad, char *p);
extern SCM scm_number_to_string (SCM x, SCM radix);
extern int scm_print_real (SCM sexp, SCM port, scm_print_state *pstate);
extern int scm_print_complex (SCM sexp, SCM port, scm_print_state *pstate);
@ -286,21 +312,57 @@ extern SCM scm_magnitude (SCM z);
extern SCM scm_angle (SCM z);
extern SCM scm_inexact_to_exact (SCM z);
extern SCM scm_trunc (SCM x);
extern SCM scm_i_dbl2big (double d);
#if (SCM_DEBUG_DEPRECATED == 0)
extern SCM scm_dbl2big (double d);
#endif
extern double scm_i_big2dbl (SCM b);
#if (SCM_DEBUG_DEPRECATED == 0)
extern double scm_big2dbl (SCM b);
extern SCM scm_long2num (long sl);
extern SCM scm_ulong2num (unsigned long sl);
#endif
extern SCM scm_short2num (short n);
extern SCM scm_ushort2num (unsigned short n);
extern SCM scm_int2num (int n);
extern SCM scm_uint2num (unsigned int n);
extern SCM scm_long2num (long n);
extern SCM scm_ulong2num (unsigned long n);
extern SCM scm_bits2num (scm_bits_t n);
extern SCM scm_ubits2num (scm_ubits_t n);
extern SCM scm_size2num (size_t n);
extern SCM scm_ptrdiff2num (ptrdiff_t n);
extern short scm_num2short (SCM num, unsigned long int pos,
const char *s_caller);
extern unsigned short scm_num2ushort (SCM num, unsigned long int pos,
const char *s_caller);
extern int scm_num2int (SCM num, unsigned long int pos,
const char *s_caller);
extern unsigned int scm_num2uint (SCM num, unsigned long int pos,
const char *s_caller);
extern long scm_num2long (SCM num, unsigned long int pos,
const char *s_caller);
#ifdef HAVE_LONG_LONGS
extern SCM scm_long_long2num (long_long sl);
extern long_long scm_num2long_long (SCM num, unsigned long int pos,
const char *s_caller);
extern ulong_long scm_num2ulong_long (SCM num, unsigned long int pos,
const char *s_caller);
#endif
extern unsigned long scm_num2ulong (SCM num, unsigned long int pos,
const char *s_caller);
extern scm_bits_t scm_num2bits (SCM num, unsigned long int pos,
const char *s_caller);
extern scm_ubits_t scm_num2ubits (SCM num, unsigned long int pos,
const char *s_caller);
extern ptrdiff_t scm_num2ptrdiff (SCM num, unsigned long int pos,
const char *s_caller);
extern size_t scm_num2size (SCM num, unsigned long int pos,
const char *s_caller);
#ifdef HAVE_LONG_LONGS
extern SCM scm_long_long2num (long long sl);
extern SCM scm_ulong_long2num (unsigned long long sl);
extern long long scm_num2long_long (SCM num, unsigned long int pos,
const char *s_caller);
extern unsigned long long scm_num2ulong_long (SCM num, unsigned long int pos,
const char *s_caller);
#endif
extern void scm_init_numbers (void);
#endif /* NUMBERSH */

14
libguile/objects.c
View file

@ -158,7 +158,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
case scm_tc7_smob:
{
long type = SCM_TYP16 (x);
scm_bits_t type = SCM_TYP16 (x);
if (type != scm_tc16_port_with_ps)
return scm_smob_class[SCM_TC2SMOBNUM (type)];
x = SCM_PORT_WITH_PS_PORT (x);
@ -251,7 +251,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
SCM
scm_mcache_lookup_cmethod (SCM cache, SCM args)
{
int i, n, end, mask;
scm_bits_t i, n, end, mask;
SCM ls, methods, z = SCM_CDDR (cache);
n = SCM_INUM (SCM_CAR (z)); /* maximum number of specializers */
methods = SCM_CADR (z);
@ -266,8 +266,8 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
else
{
/* Compute a hash value */
int hashset = SCM_INUM (methods);
int j = n;
scm_bits_t hashset = SCM_INUM (methods);
scm_bits_t j = n;
mask = SCM_INUM (SCM_CAR (z = SCM_CDDR (z)));
methods = SCM_CADR (z);
i = 0;
@ -287,7 +287,7 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
/* Search for match */
do
{
int j = n;
scm_bits_t j = n;
z = SCM_VELTS (methods)[i];
ls = args; /* list of arguments */
if (SCM_NIMP (ls))
@ -449,7 +449,7 @@ SCM_DEFINE (scm_object_procedure, "object-procedure", 1, 0, 0,
SCM
scm_i_make_class_object (SCM meta,
SCM layout_string,
unsigned long flags)
scm_ubits_t flags)
{
SCM c;
SCM layout = scm_make_struct_layout (layout_string);
@ -466,7 +466,7 @@ SCM_DEFINE (scm_make_class_object, "make-class-object", 2, 0, 0,
"slot layout specified by @var{layout}.")
#define FUNC_NAME s_scm_make_class_object
{
unsigned long flags = 0;
scm_ubits_t flags = 0;
SCM_VALIDATE_STRUCT (1,metaclass);
SCM_VALIDATE_STRING (2,layout);
if (SCM_EQ_P (metaclass, scm_metaclass_operator))

4
libguile/objects.h
View file

@ -214,7 +214,7 @@ extern SCM scm_no_applicable_method;
/* Goops functions. */
extern SCM scm_make_extended_class (char *type_name);
extern void scm_make_port_classes (int ptobnum, char *type_name);
extern void scm_make_port_classes (scm_bits_t ptobnum, char *type_name);
extern void scm_change_object_class (SCM, SCM, SCM);
extern SCM scm_memoize_method (SCM x, SCM args);
@ -239,7 +239,7 @@ extern SCM scm_make_class_object (SCM metaclass, SCM layout);
extern SCM scm_make_subclass_object (SCM c, SCM layout);
extern SCM scm_i_make_class_object (SCM metaclass, SCM layout_string,
unsigned long flags);
scm_ubits_t flags);
extern void scm_init_objects (void);
#endif /* OBJECTSH */

6
libguile/options.c
View file

@ -121,7 +121,7 @@ SCM_SYMBOL (scm_no_sym, "no");
static SCM protected_objects;
SCM
scm_options (SCM arg, scm_option options[], int n, const char *s)
scm_options (SCM arg, scm_option_t options[], int n, const char *s)
{
int i, docp = (!SCM_UNBNDP (arg) && !SCM_NULLP (arg) && !SCM_CONSP (arg));
/* Let `arg' GC protect the arguments */
@ -139,7 +139,7 @@ scm_options (SCM arg, scm_option options[], int n, const char *s)
ls);
break;
case SCM_OPTION_INTEGER:
ls = scm_cons (SCM_MAKINUM ((int) options[i].val), ls);
ls = scm_cons (SCM_MAKINUM (options[i].val), ls);
break;
case SCM_OPTION_SCM:
ls = scm_cons ((SCM) options[i].val, ls);
@ -212,7 +212,7 @@ scm_options (SCM arg, scm_option options[], int n, const char *s)
void
scm_init_opts (SCM (*func) (SCM), scm_option options[], int n)
scm_init_opts (SCM (*func) (SCM), scm_option_t options[], int n)
{
int i;

14
libguile/options.h
View file

@ -51,7 +51,7 @@
typedef struct scm_option
typedef struct scm_option_t
{
int type;
char *name;
@ -59,18 +59,22 @@ typedef struct scm_option
/*
schizophrenic use: both SCM and int
*/
unsigned long val;
scm_bits_t val;
/* SCM val */
char *doc;
} scm_option;
} scm_option_t;
#if (SCM_DEBUG_DEPRECATED == 0)
# define scm_option scm_option_t
#endif
#define SCM_OPTION_BOOLEAN 0
#define SCM_OPTION_INTEGER 1
#define SCM_OPTION_SCM 2
extern SCM scm_options (SCM new_mode, scm_option options[], int n, const char *s);
extern void scm_init_opts (SCM (*func) (SCM), scm_option options[], int n);
extern SCM scm_options (SCM new_mode, scm_option_t options[], int n, const char *s);
extern void scm_init_opts (SCM (*func) (SCM), scm_option_t options[], int n);
extern void scm_init_options (void);
#endif /* OPTIONSH */

96
libguile/ports.c
View file

@ -86,8 +86,8 @@
* Indexes into this table are used when generating type
* tags for smobjects (if you know a tag you can get an index and conversely).
*/
scm_ptob_descriptor *scm_ptobs;
int scm_numptob;
scm_ptob_descriptor_t *scm_ptobs;
scm_bits_t scm_numptob;
/* GC marker for a port with stream of SCM type. */
SCM
@ -128,10 +128,10 @@ scm_make_port_type (char *name,
SCM_DEFER_INTS;
SCM_SYSCALL (tmp = (char *) realloc ((char *) scm_ptobs,
(1 + scm_numptob)
* sizeof (scm_ptob_descriptor)));
* sizeof (scm_ptob_descriptor_t)));
if (tmp)
{
scm_ptobs = (scm_ptob_descriptor *) tmp;
scm_ptobs = (scm_ptob_descriptor_t *) tmp;
scm_ptobs[scm_numptob].name = name;
scm_ptobs[scm_numptob].mark = 0;
@ -171,7 +171,7 @@ scm_set_port_mark (long tc, SCM (*mark) (SCM))
}
void
scm_set_port_free (long tc, scm_sizet (*free) (SCM))
scm_set_port_free (long tc, size_t (*free) (SCM))
{
scm_ptobs[SCM_TC2PTOBNUM (tc)].free = free;
}
@ -246,7 +246,7 @@ SCM_DEFINE (scm_char_ready_p, "char-ready?", 0, 1, 0,
"interactive port that has no ready characters.}")
#define FUNC_NAME s_scm_char_ready_p
{
scm_port *pt;
scm_port_t *pt;
if (SCM_UNBNDP (port))
port = scm_cur_inp;
@ -264,7 +264,7 @@ SCM_DEFINE (scm_char_ready_p, "char-ready?", 0, 1, 0,
return SCM_BOOL_T;
else
{
scm_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)];
scm_ptob_descriptor_t *ptob = &scm_ptobs[SCM_PTOBNUM (port)];
if (ptob->input_waiting)
return SCM_BOOL(ptob->input_waiting (port));
@ -278,7 +278,7 @@ SCM_DEFINE (scm_char_ready_p, "char-ready?", 0, 1, 0,
into memory starting at dest. returns the number of chars moved. */
size_t scm_take_from_input_buffers (SCM port, char *dest, size_t read_len)
{
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_port_t *pt = SCM_PTAB_ENTRY (port);
size_t chars_read = 0;
size_t from_buf = min (pt->read_end - pt->read_pos, read_len);
@ -313,8 +313,8 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
#define FUNC_NAME s_scm_drain_input
{
SCM result;
scm_port *pt = SCM_PTAB_ENTRY (port);
int count;
scm_port_t *pt = SCM_PTAB_ENTRY (port);
scm_bits_t count;
SCM_VALIDATE_OPINPORT (1,port);
@ -422,32 +422,32 @@ SCM_DEFINE (scm_set_current_error_port, "set-current-error-port", 1, 0, 0,
/* The port table --- an array of pointers to ports. */
scm_port **scm_port_table;
scm_port_t **scm_port_table;
int scm_port_table_size = 0; /* Number of ports in scm_port_table. */
int scm_port_table_room = 20; /* Size of the array. */
scm_bits_t scm_port_table_size = 0; /* Number of ports in scm_port_table. */
scm_bits_t scm_port_table_room = 20; /* Size of the array. */
/* Add a port to the table. */
scm_port *
scm_port_t *
scm_add_to_port_table (SCM port)
#define FUNC_NAME "scm_add_to_port_table"
{
scm_port *entry;
scm_port_t *entry;
if (scm_port_table_size == scm_port_table_room)
{
/* initial malloc is in gc.c. this doesn't use scm_must_malloc etc.,
since it can never be freed during gc. */
void *newt = realloc ((char *) scm_port_table,
(scm_sizet) (sizeof (scm_port *)
(size_t) (sizeof (scm_port_t *)
* scm_port_table_room * 2));
if (newt == NULL)
scm_memory_error ("scm_add_to_port_table");
scm_port_table = (scm_port **) newt;
scm_port_table = (scm_port_t **) newt;
scm_port_table_room *= 2;
}
entry = (scm_port *) scm_must_malloc (sizeof (scm_port), FUNC_NAME);
entry = (scm_port_t *) scm_must_malloc (sizeof (scm_port_t), FUNC_NAME);
entry->port = port;
entry->entry = scm_port_table_size;
@ -474,8 +474,8 @@ void
scm_remove_from_port_table (SCM port)
#define FUNC_NAME "scm_remove_from_port_table"
{
scm_port *p = SCM_PTAB_ENTRY (port);
int i = p->entry;
scm_port_t *p = SCM_PTAB_ENTRY (port);
scm_bits_t i = p->entry;
if (i >= scm_port_table_size)
SCM_MISC_ERROR ("Port not in table: ~S", SCM_LIST1 (port));
@ -515,7 +515,7 @@ SCM_DEFINE (scm_pt_member, "pt-member", 1, 0, 0,
"@code{--enable-guile-debug} builds.")
#define FUNC_NAME s_scm_pt_member
{
int i;
scm_bits_t i;
SCM_VALIDATE_INUM_COPY (1,index,i);
if (i < 0 || i >= scm_port_table_size)
return SCM_BOOL_F;
@ -526,7 +526,7 @@ SCM_DEFINE (scm_pt_member, "pt-member", 1, 0, 0,
#endif
void
scm_port_non_buffer (scm_port *pt)
scm_port_non_buffer (scm_port_t *pt)
{
pt->read_pos = pt->read_buf = pt->read_end = &pt->shortbuf;
pt->write_buf = pt->write_pos = &pt->shortbuf;
@ -649,7 +649,7 @@ SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0,
"descriptors.")
#define FUNC_NAME s_scm_close_port
{
scm_sizet i;
size_t i;
int rv;
port = SCM_COERCE_OUTPORT (port);
@ -709,7 +709,7 @@ SCM_DEFINE (scm_port_for_each, "port-for-each", 1, 0, 0,
"have no effect as far as @var{port-for-each} is concerned.\n")
#define FUNC_NAME s_scm_port_for_each
{
int i;
scm_bits_t i;
SCM ports;
SCM_VALIDATE_PROC (1, proc);
@ -752,7 +752,7 @@ SCM_DEFINE (scm_close_all_ports_except, "close-all-ports-except", 0, 0, 1,
"Use port-for-each instead.")
#define FUNC_NAME s_scm_close_all_ports_except
{
int i = 0;
scm_bits_t i = 0;
SCM_VALIDATE_REST_ARGUMENT (ports);
while (i < scm_port_table_size)
{
@ -872,7 +872,7 @@ SCM_DEFINE (scm_flush_all_ports, "flush-all-ports", 0, 0, 0,
"all open output ports. The return value is unspecified.")
#define FUNC_NAME s_scm_flush_all_ports
{
int i;
size_t i;
for (i = 0; i < scm_port_table_size; i++)
{
@ -907,7 +907,7 @@ SCM_DEFINE (scm_read_char, "read-char", 0, 1, 0,
int
scm_fill_input (SCM port)
{
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_port_t *pt = SCM_PTAB_ENTRY (port);
if (pt->read_buf == pt->putback_buf)
{
@ -926,7 +926,7 @@ int
scm_getc (SCM port)
{
int c;
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_port_t *pt = SCM_PTAB_ENTRY (port);
if (pt->rw_active == SCM_PORT_WRITE)
{
@ -982,10 +982,10 @@ scm_puts (const char *s, SCM port)
*/
void
scm_lfwrite (const char *ptr, scm_sizet size, SCM port)
scm_lfwrite (const char *ptr, size_t size, SCM port)
{
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)];
scm_port_t *pt = SCM_PTAB_ENTRY (port);
scm_ptob_descriptor_t *ptob = &scm_ptobs[SCM_PTOBNUM (port)];
if (pt->rw_active == SCM_PORT_READ)
scm_end_input (port);
@ -1004,11 +1004,11 @@ scm_lfwrite (const char *ptr, scm_sizet size, SCM port)
*
* Warning: Doesn't update port line and column counts! */
scm_sizet
scm_c_read (SCM port, void *buffer, scm_sizet size)
size_t
scm_c_read (SCM port, void *buffer, size_t size)
{
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_sizet n_read = 0, n_available;
scm_port_t *pt = SCM_PTAB_ENTRY (port);
size_t n_read = 0, n_available;
if (pt->rw_active == SCM_PORT_WRITE)
scm_ptobs[SCM_PTOBNUM (port)].flush (port);
@ -1058,10 +1058,10 @@ scm_c_read (SCM port, void *buffer, scm_sizet size)
*/
void
scm_c_write (SCM port, const void *ptr, scm_sizet size)
scm_c_write (SCM port, const void *ptr, size_t size)
{
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (port)];
scm_port_t *pt = SCM_PTAB_ENTRY (port);
scm_ptob_descriptor_t *ptob = &scm_ptobs[SCM_PTOBNUM (port)];
if (pt->rw_active == SCM_PORT_READ)
scm_end_input (port);
@ -1075,15 +1075,15 @@ scm_c_write (SCM port, const void *ptr, scm_sizet size)
void
scm_flush (SCM port)
{
scm_sizet i = SCM_PTOBNUM (port);
scm_bits_t i = SCM_PTOBNUM (port);
(scm_ptobs[i].flush) (port);
}
void
scm_end_input (SCM port)
{
int offset;
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_bits_t offset;
scm_port_t *pt = SCM_PTAB_ENTRY (port);
if (pt->read_buf == pt->putback_buf)
{
@ -1106,7 +1106,7 @@ void
scm_ungetc (int c, SCM port)
#define FUNC_NAME "scm_ungetc"
{
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_port_t *pt = SCM_PTAB_ENTRY (port);
if (pt->read_buf == pt->putback_buf)
/* already using the put-back buffer. */
@ -1115,7 +1115,7 @@ scm_ungetc (int c, SCM port)
if (pt->read_end == pt->read_buf + pt->read_buf_size
&& pt->read_buf == pt->read_pos)
{
int new_size = pt->read_buf_size * 2;
size_t new_size = pt->read_buf_size * 2;
unsigned char *tmp = (unsigned char *)
scm_must_realloc (pt->putback_buf, pt->read_buf_size, new_size,
FUNC_NAME);
@ -1302,7 +1302,7 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0,
SCM_OUT_OF_RANGE (3, whence);
if (SCM_OPPORTP (fd_port))
{
scm_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (fd_port);
scm_ptob_descriptor_t *ptob = scm_ptobs + SCM_PTOBNUM (fd_port);
if (!ptob->seek)
SCM_MISC_ERROR ("port is not seekable",
@ -1355,8 +1355,8 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0,
}
else if (SCM_OPOUTPORTP (object))
{
scm_port *pt = SCM_PTAB_ENTRY (object);
scm_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (object);
scm_port_t *pt = SCM_PTAB_ENTRY (object);
scm_ptob_descriptor_t *ptob = scm_ptobs + SCM_PTOBNUM (object);
if (!ptob->truncate)
SCM_MISC_ERROR ("port is not truncatable", SCM_EOL);
@ -1505,7 +1505,7 @@ void
scm_ports_prehistory ()
{
scm_numptob = 0;
scm_ptobs = (scm_ptob_descriptor *) malloc (sizeof (scm_ptob_descriptor));
scm_ptobs = (scm_ptob_descriptor_t *) malloc (sizeof (scm_ptob_descriptor_t));
}
@ -1529,7 +1529,7 @@ scm_void_port (char *mode_str)
{
int mode_bits;
SCM answer;
scm_port * pt;
scm_port_t * pt;
SCM_NEWCELL (answer);
SCM_DEFER_INTS;

58
libguile/ports.h
View file

@ -59,18 +59,18 @@
#define SCM_INITIAL_PUTBACK_BUF_SIZE 4
/* values for the rw_active flag. */
enum scm_port_rw_active {
typedef enum scm_port_rw_active_t {
SCM_PORT_NEITHER = 0,
SCM_PORT_READ = 1,
SCM_PORT_WRITE = 2
};
} scm_port_rw_active_t;
/* C representation of a Scheme port. */
typedef struct
{
SCM port; /* Link back to the port object. */
int entry; /* Index in port table. */
scm_bits_t entry; /* Index in port table. */
int revealed; /* 0 not revealed, > 1 revealed.
* Revealed ports do not get GC'd.
*/
@ -78,7 +78,7 @@ typedef struct
scm_bits_t stream;
SCM file_name; /* debugging support. */
int line_number; /* debugging support. */
long line_number; /* debugging support. */
int column_number; /* debugging support. */
/* port buffers. the buffer(s) are set up for all ports.
@ -120,20 +120,20 @@ typedef struct
flushed before switching between
reading and writing, seeking, etc. */
enum scm_port_rw_active rw_active; /* for random access ports,
indicates which of the buffers
is currently in use. can be
SCM_PORT_WRITE, SCM_PORT_READ,
or SCM_PORT_NEITHER. */
scm_port_rw_active_t rw_active; /* for random access ports,
indicates which of the buffers
is currently in use. can be
SCM_PORT_WRITE, SCM_PORT_READ,
or SCM_PORT_NEITHER. */
/* a buffer for un-read chars and strings. */
unsigned char *putback_buf;
int putback_buf_size; /* allocated size of putback_buf. */
} scm_port;
size_t putback_buf_size; /* allocated size of putback_buf. */
} scm_port_t;
extern scm_port **scm_port_table;
extern int scm_port_table_size; /* Number of ports in scm_port_table. */
extern scm_port_t **scm_port_table;
extern scm_bits_t scm_port_table_size; /* Number of ports in scm_port_table. */
#define SCM_READ_BUFFER_EMPTY_P(c_port) (c_port->read_pos >= c_port->read_end)
@ -167,7 +167,7 @@ extern int scm_port_table_size; /* Number of ports in scm_port_table. */
#define SCM_CLR_PORT_OPEN_FLAG(p) \
SCM_SET_CELL_WORD_0 ((p), SCM_CELL_WORD_0 (p) & ~SCM_OPN)
#define SCM_PTAB_ENTRY(x) ((scm_port *) SCM_CELL_WORD_1 (x))
#define SCM_PTAB_ENTRY(x) ((scm_port_t *) SCM_CELL_WORD_1 (x))
#define SCM_SETPTAB_ENTRY(x,ent) (SCM_SET_CELL_WORD_1 ((x), (scm_bits_t) (ent)))
#define SCM_STREAM(x) (SCM_PTAB_ENTRY(x)->stream)
#define SCM_SETSTREAM(x,s) (SCM_PTAB_ENTRY(x)->stream = (scm_bits_t) (s))
@ -185,11 +185,11 @@ extern int scm_port_table_size; /* Number of ports in scm_port_table. */
/* port-type description. */
typedef struct scm_ptob_descriptor
typedef struct scm_ptob_descriptor_t
{
char *name;
SCM (*mark) (SCM);
scm_sizet (*free) (SCM);
size_t (*free) (SCM);
int (*print) (SCM exp, SCM port, scm_print_state *pstate);
SCM (*equalp) (SCM, SCM);
int (*close) (SCM port);
@ -204,7 +204,13 @@ typedef struct scm_ptob_descriptor
off_t (*seek) (SCM port, off_t OFFSET, int WHENCE);
void (*truncate) (SCM port, off_t length);
} scm_ptob_descriptor;
} scm_ptob_descriptor_t;
#if (SCM_DEBUG_DEPRECATED == 0)
# define scm_port scm_port_t
# define scm_ptob_descriptor scm_ptob_descriptor_t
# define scm_port_rw_active scm_port_rw_active_t
#endif
#define SCM_TC2PTOBNUM(x) (0x0ff & ((x) >> 8))
#define SCM_PTOBNUM(x) (SCM_TC2PTOBNUM (SCM_CELL_TYPE (x)))
@ -213,9 +219,9 @@ typedef struct scm_ptob_descriptor
extern scm_ptob_descriptor *scm_ptobs;
extern int scm_numptob;
extern int scm_port_table_room;
extern scm_ptob_descriptor_t *scm_ptobs;
extern scm_bits_t scm_numptob;
extern scm_bits_t scm_port_table_room;
@ -226,7 +232,7 @@ extern scm_bits_t scm_make_port_type (char *name,
const void *data,
size_t size));
extern void scm_set_port_mark (long tc, SCM (*mark) (SCM));
extern void scm_set_port_free (long tc, scm_sizet (*free) (SCM));
extern void scm_set_port_free (long tc, size_t (*free) (SCM));
extern void scm_set_port_print (long tc,
int (*print) (SCM exp,
SCM port,
@ -257,12 +263,12 @@ extern SCM scm_current_load_port (void);
extern SCM scm_set_current_input_port (SCM port);
extern SCM scm_set_current_output_port (SCM port);
extern SCM scm_set_current_error_port (SCM port);
extern scm_port * scm_add_to_port_table (SCM port);
extern scm_port_t * scm_add_to_port_table (SCM port);
extern void scm_remove_from_port_table (SCM port);
extern void scm_grow_port_cbuf (SCM port, size_t requested);
extern SCM scm_pt_size (void);
extern SCM scm_pt_member (SCM member);
extern void scm_port_non_buffer (scm_port *pt);
extern void scm_port_non_buffer (scm_port_t *pt);
extern int scm_revealed_count (SCM port);
extern SCM scm_port_revealed (SCM port);
extern SCM scm_set_port_revealed_x (SCM port, SCM rcount);
@ -282,9 +288,9 @@ extern SCM scm_flush_all_ports (void);
extern SCM scm_read_char (SCM port);
extern void scm_putc (char c, SCM port);
extern void scm_puts (const char *str_data, SCM port);
extern scm_sizet scm_c_read (SCM port, void *buffer, scm_sizet size);
extern void scm_c_write (SCM port, const void *buffer, scm_sizet size);
extern void scm_lfwrite (const char *ptr, scm_sizet size, SCM port);
extern size_t scm_c_read (SCM port, void *buffer, size_t size);
extern void scm_c_write (SCM port, const void *buffer, size_t size);
extern void scm_lfwrite (const char *ptr, size_t size, SCM port);
extern void scm_flush (SCM port);
extern void scm_end_input (SCM port);
extern int scm_fill_input (SCM port);

4
libguile/posix.c
View file

@ -224,7 +224,7 @@ SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0,
{
SCM ans;
int ngroups;
scm_sizet size;
size_t size;
GETGROUPS_T *groups;
ngroups = getgroups (0, NULL);
@ -831,7 +831,7 @@ scm_convert_exec_args (SCM args, int argn, const char *subr)
for (i = 0; !SCM_NULLP (args); args = SCM_CDR (args), ++i)
{
SCM arg = SCM_CAR (args);
scm_sizet len;
size_t len;
char *dst;
char *src;

32
libguile/print.c
View file

@ -127,7 +127,7 @@ char *scm_isymnames[] =
"#<unbound>"
};
scm_option scm_print_opts[] = {
scm_option_t scm_print_opts[] = {
{ SCM_OPTION_SCM, "closure-hook", SCM_UNPACK (SCM_BOOL_F),
"Hook for printing closures (should handle macros as well)." },
{ SCM_OPTION_BOOLEAN, "source", 0,
@ -282,8 +282,8 @@ grow_ref_stack (scm_print_state *pstate)
static void
print_circref (SCM port,scm_print_state *pstate,SCM ref)
{
register int i;
int self = pstate->top - 1;
register scm_bits_t i;
scm_bits_t self = pstate->top - 1;
i = pstate->top - 1;
if (SCM_CONSP (pstate->ref_stack[i]))
{
@ -358,9 +358,9 @@ taloop:
else if (SCM_ILOCP (exp))
{
scm_puts ("#@", port);
scm_intprint (SCM_IFRAME (exp), 10, port);
scm_intprint ((long) SCM_IFRAME (exp), 10, port);
scm_putc (SCM_ICDRP (exp) ? '-' : '+', port);
scm_intprint (SCM_IDIST (exp), 10, port);
scm_intprint ((long) SCM_IDIST (exp), 10, port);
}
else
{
@ -438,7 +438,7 @@ taloop:
case scm_tc7_string:
if (SCM_WRITINGP (pstate))
{
scm_sizet i;
size_t i;
scm_putc ('"', port);
for (i = 0; i < SCM_STRING_LENGTH (exp); ++i)
@ -458,13 +458,13 @@ taloop:
break;
case scm_tc7_symbol:
{
int pos;
int end;
int len;
size_t pos;
size_t end;
size_t len;
char * str;
int weird;
int maybe_weird;
int mw_pos = 0;
size_t mw_pos = 0;
len = SCM_SYMBOL_LENGTH (exp);
str = SCM_SYMBOL_CHARS (exp);
@ -548,8 +548,8 @@ taloop:
scm_puts ("#(", port);
common_vector_printer:
{
register long i;
int last = SCM_VECTOR_LENGTH (exp) - 1;
register scm_bits_t i;
scm_bits_t last = SCM_VECTOR_LENGTH (exp) - 1;
int cutp = 0;
if (pstate->fancyp && SCM_VECTOR_LENGTH (exp) > pstate->length)
{
@ -749,7 +749,7 @@ void
scm_iprlist (char *hdr,SCM exp,int tlr,SCM port,scm_print_state *pstate)
{
register SCM hare, tortoise;
int floor = pstate->top - 2;
scm_bits_t floor = pstate->top - 2;
scm_puts (hdr, port);
/* CHECK_INTS; */
if (pstate->fancyp)
@ -774,7 +774,7 @@ scm_iprlist (char *hdr,SCM exp,int tlr,SCM port,scm_print_state *pstate)
scm_iprin1 (SCM_CAR (exp), port, pstate);
for (exp = SCM_CDR (exp); SCM_ECONSP (exp); exp = SCM_CDR (exp))
{
register int i;
register scm_bits_t i;
for (i = floor; i >= 0; --i)
if (SCM_EQ_P (pstate->ref_stack[i], exp))
@ -797,13 +797,13 @@ end:
fancy_printing:
{
int n = pstate->length;
scm_bits_t n = pstate->length;
scm_iprin1 (SCM_CAR (exp), port, pstate);
exp = SCM_CDR (exp); --n;
for (; SCM_ECONSP (exp); exp = SCM_CDR (exp))
{
register unsigned long i;
register scm_ubits_t i;
for (i = 0; i < pstate->top; ++i)
if (SCM_EQ_P (pstate->ref_stack[i], exp))

2
libguile/print.h
View file

@ -51,7 +51,7 @@
#include "libguile/options.h"
extern scm_option scm_print_opts[];
extern scm_option_t scm_print_opts[];
#define SCM_PRINT_CLOSURE (SCM_PACK (scm_print_opts[0].val))
#define SCM_PRINT_SOURCE_P ((int) scm_print_opts[1].val)

32
libguile/procs.c
View file

@ -60,29 +60,29 @@
/* {Procedures}
*/
scm_subr_entry *scm_subr_table;
scm_subr_entry_t *scm_subr_table;
/* libguile contained approx. 700 primitive procedures on 24 Aug 1999. */
/* Increased to 800 on 2001-05-07 -- Guile now has 779 primitives on
startup, 786 with guile-readline. 'martin */
int scm_subr_table_size = 0;
int scm_subr_table_room = 800;
scm_bits_t scm_subr_table_size = 0;
scm_bits_t scm_subr_table_room = 800;
SCM
scm_c_make_subr (const char *name, int type, SCM (*fcn) ())
scm_c_make_subr (const char *name, scm_bits_t type, SCM (*fcn) ())
{
register SCM z;
int entry;
scm_bits_t entry;
if (scm_subr_table_size == scm_subr_table_room)
{
scm_sizet new_size = scm_subr_table_room * 3 / 2;
scm_bits_t new_size = scm_subr_table_room * 3 / 2;
void *new_table
= scm_must_realloc ((char *) scm_subr_table,
sizeof (scm_subr_entry) * scm_subr_table_room,
sizeof (scm_subr_entry) * new_size,
sizeof (scm_subr_entry_t) * scm_subr_table_room,
sizeof (scm_subr_entry_t) * new_size,
"scm_subr_table");
scm_subr_table = new_table;
scm_subr_table_room = new_size;
@ -104,7 +104,7 @@ scm_c_make_subr (const char *name, int type, SCM (*fcn) ())
}
SCM
scm_c_define_subr (const char *name, int type, SCM (*fcn) ())
scm_c_define_subr (const char *name, scm_bits_t type, SCM (*fcn) ())
{
SCM subr = scm_c_make_subr (name, type, fcn);
scm_define (SCM_SUBR_ENTRY(subr).name, subr);
@ -116,7 +116,7 @@ scm_c_define_subr (const char *name, int type, SCM (*fcn) ())
void
scm_free_subr_entry (SCM subr)
{
int entry = SCM_SUBRNUM (subr);
scm_bits_t entry = SCM_SUBRNUM (subr);
/* Move last entry in table to the free position */
scm_subr_table[entry] = scm_subr_table[scm_subr_table_size - 1];
SCM_SET_SUBRNUM (scm_subr_table[entry].handle, entry);
@ -125,7 +125,7 @@ scm_free_subr_entry (SCM subr)
SCM
scm_c_make_subr_with_generic (const char *name,
int type, SCM (*fcn) (), SCM *gf)
scm_bits_t type, SCM (*fcn) (), SCM *gf)
{
SCM subr = scm_c_make_subr (name, type, fcn);
SCM_SUBR_ENTRY(subr).generic = gf;
@ -134,7 +134,7 @@ scm_c_make_subr_with_generic (const char *name,
SCM
scm_c_define_subr_with_generic (const char *name,
int type, SCM (*fcn) (), SCM *gf)
scm_bits_t type, SCM (*fcn) (), SCM *gf)
{
SCM subr = scm_c_make_subr_with_generic (name, type, fcn, gf);
scm_define (SCM_SUBR_ENTRY(subr).name, subr);
@ -144,7 +144,7 @@ scm_c_define_subr_with_generic (const char *name,
void
scm_mark_subr_table ()
{
int i;
scm_bits_t i;
for (i = 0; i < scm_subr_table_size; ++i)
{
SCM_SETGCMARK (scm_subr_table[i].name);
@ -158,7 +158,7 @@ scm_mark_subr_table ()
#ifdef CCLO
SCM
scm_makcclo (SCM proc, long len)
scm_makcclo (SCM proc, size_t len)
{
scm_bits_t *base = scm_must_malloc (len * sizeof (scm_bits_t), "compiled-closure");
unsigned long i;
@ -390,8 +390,8 @@ void
scm_init_subr_table ()
{
scm_subr_table
= ((scm_subr_entry *)
scm_must_malloc (sizeof (scm_subr_entry) * scm_subr_table_room,
= ((scm_subr_entry_t *)
scm_must_malloc (sizeof (scm_subr_entry_t) * scm_subr_table_room,
"scm_subr_table"));
}

22
libguile/procs.h
View file

@ -63,7 +63,11 @@ typedef struct
* *generic == 0 until first method
*/
SCM properties; /* procedure properties */
} scm_subr_entry;
} scm_subr_entry_t;
#if (SCM_DEBUG_DEPRECATED == 0)
# define scm_subr_entry scm_subr_entry_t
#endif
#define SCM_SUBRNUM(subr) (SCM_CELL_WORD_0 (subr) >> 8)
#define SCM_SET_SUBRNUM(subr, num) \
@ -153,21 +157,21 @@ typedef struct
#define SCM_PROCEDURE(obj) SCM_CELL_OBJECT_1 (obj)
#define SCM_SETTER(obj) SCM_CELL_OBJECT_2 (obj)
extern scm_subr_entry *scm_subr_table;
extern int scm_subr_table_size;
extern int scm_subr_table_room;
extern scm_subr_entry_t *scm_subr_table;
extern scm_bits_t scm_subr_table_size;
extern scm_bits_t scm_subr_table_room;
extern void scm_mark_subr_table (void);
extern void scm_free_subr_entry (SCM subr);
extern SCM scm_c_make_subr (const char *name, int type, SCM (*fcn)());
extern SCM scm_c_make_subr_with_generic (const char *name, int type,
extern SCM scm_c_make_subr (const char *name, scm_bits_t type, SCM (*fcn)());
extern SCM scm_c_make_subr_with_generic (const char *name, scm_bits_t type,
SCM (*fcn)(), SCM *gf);
extern SCM scm_c_define_subr (const char *name, int type, SCM (*fcn)());
extern SCM scm_c_define_subr_with_generic (const char *name, int type,
extern SCM scm_c_define_subr (const char *name, scm_bits_t type, SCM (*fcn)());
extern SCM scm_c_define_subr_with_generic (const char *name, scm_bits_t type,
SCM (*fcn)(), SCM *gf);
extern SCM scm_makcclo (SCM proc, long len);
extern SCM scm_makcclo (SCM proc, size_t len);
extern SCM scm_procedure_p (SCM obj);
extern SCM scm_closure_p (SCM obj);
extern SCM scm_thunk_p (SCM obj);

231
libguile/ramap.c
View file

@ -166,12 +166,12 @@ do { type (*v0)[2] = (type (*)[2]) SCM_VELTS (ra0);\
break;\
} while (0)
static scm_sizet
static scm_bits_t
cind (SCM ra, SCM inds)
{
scm_sizet i;
scm_bits_t i;
int k;
long *ve = (long*) SCM_VELTS (inds);
scm_bits_t *ve = (scm_bits_t *) SCM_VELTS (inds);
if (!SCM_ARRAYP (ra))
return *ve;
i = SCM_ARRAY_BASE (ra);
@ -193,10 +193,10 @@ int
scm_ra_matchp (SCM ra0, SCM ras)
{
SCM ra1;
scm_array_dim dims;
scm_array_dim *s0 = &dims;
scm_array_dim *s1;
scm_sizet bas0 = 0;
scm_array_dim_t dims;
scm_array_dim_t *s0 = &dims;
scm_array_dim_t *s1;
scm_bits_t bas0 = 0;
int i, ndim = 1;
int exact = 2 /* 4 */ ; /* Don't care about values >2 (yet?) */
if (SCM_IMP (ra0)) return 0;
@ -255,7 +255,7 @@ scm_ra_matchp (SCM ra0, SCM ras)
case scm_tc7_dvect:
case scm_tc7_cvect:
{
unsigned long int length;
scm_bits_t length;
if (1 != ndim)
return 0;
@ -322,7 +322,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
SCM inds, z;
SCM vra0, ra1, vra1;
SCM lvra, *plvra;
long *vinds;
scm_bits_t *vinds;
int k, kmax;
switch (scm_ra_matchp (ra0, lra))
{
@ -339,7 +339,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
if (SCM_IMP (vra0)) goto gencase;
if (!SCM_ARRAYP (vra0))
{
unsigned long int length = SCM_INUM (scm_uniform_vector_length (vra0));
scm_bits_t length = SCM_INUM (scm_uniform_vector_length (vra0));
vra1 = scm_make_ra (1);
SCM_ARRAY_BASE (vra1) = 0;
SCM_ARRAY_DIMS (vra1)->lbnd = 0;
@ -397,7 +397,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
}
else
{
unsigned long int length = SCM_INUM (scm_uniform_vector_length (ra0));
scm_bits_t length = SCM_INUM (scm_uniform_vector_length (ra0));
kmax = 0;
SCM_ARRAY_DIMS (vra0)->lbnd = 0;
SCM_ARRAY_DIMS (vra0)->ubnd = length - 1;
@ -429,7 +429,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
plvra = SCM_CDRLOC (*plvra);
}
inds = scm_make_uve (SCM_ARRAY_NDIM (ra0), SCM_MAKINUM (-1L));
vinds = (long *) SCM_VELTS (inds);
vinds = (scm_bits_t *) SCM_VELTS (inds);
for (k = 0; k <= kmax; k++)
vinds[k] = SCM_ARRAY_DIMS (ra0)[k].lbnd;
k = kmax;
@ -478,10 +478,10 @@ int
scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
#define FUNC_NAME s_scm_array_fill_x
{
scm_sizet i;
scm_sizet n = SCM_ARRAY_DIMS (ra)->ubnd - SCM_ARRAY_DIMS (ra)->lbnd + 1;
long inc = SCM_ARRAY_DIMS (ra)->inc;
scm_sizet base = SCM_ARRAY_BASE (ra);
scm_bits_t i;
scm_bits_t n = SCM_ARRAY_DIMS (ra)->ubnd - SCM_ARRAY_DIMS (ra)->lbnd + 1;
scm_bits_t inc = SCM_ARRAY_DIMS (ra)->inc;
scm_bits_t base = SCM_ARRAY_BASE (ra);
ra = SCM_ARRAY_V (ra);
switch SCM_TYP7 (ra)
@ -511,27 +511,27 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
break;
case scm_tc7_bvect:
{ /* scope */
long *ve = (long *) SCM_VELTS (ra);
if (1 == inc && (n >= SCM_LONG_BIT || n == SCM_BITVECTOR_LENGTH (ra)))
scm_bits_t *ve = (scm_bits_t *) SCM_VELTS (ra);
if (1 == inc && (n >= SCM_BITS_LENGTH || n == SCM_BITVECTOR_LENGTH (ra)))
{
i = base / SCM_LONG_BIT;
i = base / SCM_BITS_LENGTH;
if (SCM_FALSEP (fill))
{
if (base % SCM_LONG_BIT) /* leading partial word */
ve[i++] &= ~(~0L << (base % SCM_LONG_BIT));
for (; i < (base + n) / SCM_LONG_BIT; i++)
if (base % SCM_BITS_LENGTH) /* leading partial word */
ve[i++] &= ~(~0L << (base % SCM_BITS_LENGTH));
for (; i < (base + n) / SCM_BITS_LENGTH; i++)
ve[i] = 0L;
if ((base + n) % SCM_LONG_BIT) /* trailing partial word */
ve[i] &= (~0L << ((base + n) % SCM_LONG_BIT));
if ((base + n) % SCM_BITS_LENGTH) /* trailing partial word */
ve[i] &= (~0L << ((base + n) % SCM_BITS_LENGTH));
}
else if (SCM_EQ_P (fill, SCM_BOOL_T))
{
if (base % SCM_LONG_BIT)
ve[i++] |= ~0L << (base % SCM_LONG_BIT);
for (; i < (base + n) / SCM_LONG_BIT; i++)
if (base % SCM_BITS_LENGTH)
ve[i++] |= ~0L << (base % SCM_BITS_LENGTH);
for (; i < (base + n) / SCM_BITS_LENGTH; i++)
ve[i] = ~0L;
if ((base + n) % SCM_LONG_BIT)
ve[i] |= ~(~0L << ((base + n) % SCM_LONG_BIT));
if ((base + n) % SCM_BITS_LENGTH)
ve[i] |= ~(~0L << ((base + n) % SCM_BITS_LENGTH));
}
else
badarg2:SCM_WRONG_TYPE_ARG (2, fill);
@ -540,10 +540,10 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
{
if (SCM_FALSEP (fill))
for (i = base; n--; i += inc)
ve[i / SCM_LONG_BIT] &= ~(1L << (i % SCM_LONG_BIT));
ve[i / SCM_BITS_LENGTH] &= ~(1L << (i % SCM_BITS_LENGTH));
else if (SCM_EQ_P (fill, SCM_BOOL_T))
for (i = base; n--; i += inc)
ve[i / SCM_LONG_BIT] |= (1L << (i % SCM_LONG_BIT));
ve[i / SCM_BITS_LENGTH] |= (1L << (i % SCM_BITS_LENGTH));
else
goto badarg2;
}
@ -637,9 +637,9 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
static int
racp (SCM src, SCM dst)
{
long n = (SCM_ARRAY_DIMS (src)->ubnd - SCM_ARRAY_DIMS (src)->lbnd + 1);
long inc_d, inc_s = SCM_ARRAY_DIMS (src)->inc;
scm_sizet i_d, i_s = SCM_ARRAY_BASE (src);
scm_bits_t n = (SCM_ARRAY_DIMS (src)->ubnd - SCM_ARRAY_DIMS (src)->lbnd + 1);
scm_bits_t inc_d, inc_s = SCM_ARRAY_DIMS (src)->inc;
scm_bits_t i_d, i_s = SCM_ARRAY_BASE (src);
dst = SCM_CAR (dst);
inc_d = SCM_ARRAY_DIMS (dst)->inc;
i_d = SCM_ARRAY_BASE (dst);
@ -674,21 +674,22 @@ racp (SCM src, SCM dst)
case scm_tc7_bvect:
if (SCM_TYP7 (src) != scm_tc7_bvect)
goto gencase;
if (1 == inc_d && 1 == inc_s && i_s % SCM_LONG_BIT == i_d % SCM_LONG_BIT && n >= SCM_LONG_BIT)
if (1 == inc_d && 1 == inc_s && i_s % SCM_BITS_LENGTH == i_d % SCM_BITS_LENGTH
&& n >= SCM_BITS_LENGTH)
{
long *sv = (long *) SCM_VELTS (src);
long *dv = (long *) SCM_VELTS (dst);
sv += i_s / SCM_LONG_BIT;
dv += i_d / SCM_LONG_BIT;
if (i_s % SCM_LONG_BIT)
scm_bits_t *sv = (scm_bits_t *) SCM_VELTS (src);
scm_bits_t *dv = (scm_bits_t *) SCM_VELTS (dst);
sv += i_s / SCM_BITS_LENGTH;
dv += i_d / SCM_BITS_LENGTH;
if (i_s % SCM_BITS_LENGTH)
{ /* leading partial word */
*dv = (*dv & ~(~0L << (i_s % SCM_LONG_BIT))) | (*sv & (~0L << (i_s % SCM_LONG_BIT)));
*dv = (*dv & ~(~0L << (i_s % SCM_BITS_LENGTH))) | (*sv & (~0L << (i_s % SCM_BITS_LENGTH)));
dv++;
sv++;
n -= SCM_LONG_BIT - (i_s % SCM_LONG_BIT);
n -= SCM_BITS_LENGTH - (i_s % SCM_BITS_LENGTH);
}
IVDEP (src != dst,
for (; n >= SCM_LONG_BIT; n -= SCM_LONG_BIT, sv++, dv++)
for (; n >= SCM_BITS_LENGTH; n -= SCM_BITS_LENGTH, sv++, dv++)
*dv = *sv;)
if (n) /* trailing partial word */
*dv = (*dv & (~0L << n)) | (*sv & ~(~0L << n));
@ -853,11 +854,11 @@ int
scm_ra_eqp (SCM ra0, SCM ras)
{
SCM ra1 = SCM_CAR (ras), ra2 = SCM_CAR (SCM_CDR (ras));
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
scm_sizet i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
long inc2 = SCM_ARRAY_DIMS (ra1)->inc;
scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
scm_bits_t i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2);
scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc;
scm_bits_t inc1 = SCM_ARRAY_DIMS (ra1)->inc;
scm_bits_t inc2 = SCM_ARRAY_DIMS (ra1)->inc;
ra0 = SCM_ARRAY_V (ra0);
ra1 = SCM_ARRAY_V (ra1);
ra2 = SCM_ARRAY_V (ra2);
@ -912,11 +913,11 @@ scm_ra_eqp (SCM ra0, SCM ras)
static int
ra_compare (SCM ra0,SCM ra1,SCM ra2,int opt)
{
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
scm_sizet i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
long inc2 = SCM_ARRAY_DIMS (ra1)->inc;
scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
scm_bits_t i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2);
scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc;
scm_bits_t inc1 = SCM_ARRAY_DIMS (ra1)->inc;
scm_bits_t inc2 = SCM_ARRAY_DIMS (ra1)->inc;
ra0 = SCM_ARRAY_V (ra0);
ra1 = SCM_ARRAY_V (ra1);
ra2 = SCM_ARRAY_V (ra2);
@ -1006,15 +1007,15 @@ scm_ra_greqp (SCM ra0, SCM ras)
int
scm_ra_sum (SCM ra0, SCM ras)
{
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
scm_sizet i0 = SCM_ARRAY_BASE (ra0);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
scm_bits_t i0 = SCM_ARRAY_BASE (ra0);
scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0);
if (SCM_NNULLP(ras))
{
SCM ra1 = SCM_CAR (ras);
scm_sizet i1 = SCM_ARRAY_BASE (ra1);
long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
scm_bits_t i1 = SCM_ARRAY_BASE (ra1);
scm_bits_t inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1);
switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
{
@ -1045,9 +1046,9 @@ scm_ra_sum (SCM ra0, SCM ras)
int
scm_ra_difference (SCM ra0, SCM ras)
{
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
scm_sizet i0 = SCM_ARRAY_BASE (ra0);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
scm_bits_t i0 = SCM_ARRAY_BASE (ra0);
scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0);
if (SCM_NULLP (ras))
{
@ -1073,8 +1074,8 @@ scm_ra_difference (SCM ra0, SCM ras)
else
{
SCM ra1 = SCM_CAR (ras);
scm_sizet i1 = SCM_ARRAY_BASE (ra1);
long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
scm_bits_t i1 = SCM_ARRAY_BASE (ra1);
scm_bits_t inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1);
switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
{
@ -1101,15 +1102,15 @@ scm_ra_difference (SCM ra0, SCM ras)
int
scm_ra_product (SCM ra0, SCM ras)
{
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
scm_sizet i0 = SCM_ARRAY_BASE (ra0);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
scm_bits_t i0 = SCM_ARRAY_BASE (ra0);
scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0);
if (SCM_NNULLP (ras))
{
SCM ra1 = SCM_CAR (ras);
scm_sizet i1 = SCM_ARRAY_BASE (ra1);
long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
scm_bits_t i1 = SCM_ARRAY_BASE (ra1);
scm_bits_t inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1);
switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
{
@ -1152,9 +1153,9 @@ scm_ra_product (SCM ra0, SCM ras)
int
scm_ra_divide (SCM ra0, SCM ras)
{
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
scm_sizet i0 = SCM_ARRAY_BASE (ra0);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
scm_bits_t i0 = SCM_ARRAY_BASE (ra0);
scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0);
if (SCM_NULLP (ras))
{
@ -1188,8 +1189,8 @@ scm_ra_divide (SCM ra0, SCM ras)
else
{
SCM ra1 = SCM_CAR (ras);
scm_sizet i1 = SCM_ARRAY_BASE (ra1);
long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
scm_bits_t i1 = SCM_ARRAY_BASE (ra1);
scm_bits_t inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1);
switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
{
@ -1237,10 +1238,10 @@ scm_array_identity (SCM dst, SCM src)
static int
ramap (SCM ra0,SCM proc,SCM ras)
{
long i = SCM_ARRAY_DIMS (ra0)->lbnd;
long inc = SCM_ARRAY_DIMS (ra0)->inc;
long n = SCM_ARRAY_DIMS (ra0)->ubnd;
long base = SCM_ARRAY_BASE (ra0) - i * inc;
scm_bits_t i = SCM_ARRAY_DIMS (ra0)->lbnd;
scm_bits_t inc = SCM_ARRAY_DIMS (ra0)->inc;
scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd;
scm_bits_t base = SCM_ARRAY_BASE (ra0) - i * inc;
ra0 = SCM_ARRAY_V (ra0);
if (SCM_NULLP (ras))
for (; i <= n; i++)
@ -1249,8 +1250,8 @@ ramap (SCM ra0,SCM proc,SCM ras)
{
SCM ra1 = SCM_CAR (ras);
SCM args, *ve = &ras;
scm_sizet k, i1 = SCM_ARRAY_BASE (ra1);
long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
scm_bits_t k, i1 = SCM_ARRAY_BASE (ra1);
scm_bits_t inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1);
ras = SCM_CDR (ras);
if (SCM_NULLP(ras))
@ -1278,9 +1279,9 @@ ramap_cxr (SCM ra0,SCM proc,SCM ras)
{
SCM ra1 = SCM_CAR (ras);
SCM e1 = SCM_UNDEFINED;
scm_sizet i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc;
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra1)->lbnd + 1;
scm_bits_t i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1);
scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc;
scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra1)->lbnd + 1;
ra0 = SCM_ARRAY_V (ra0);
ra1 = SCM_ARRAY_V (ra1);
switch (SCM_TYP7 (ra0))
@ -1339,11 +1340,11 @@ ramap_rp (SCM ra0,SCM proc,SCM ras)
{
SCM ra1 = SCM_CAR (ras), ra2 = SCM_CAR (SCM_CDR (ras));
SCM e1 = SCM_UNDEFINED, e2 = SCM_UNDEFINED;
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
scm_sizet i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
long inc2 = SCM_ARRAY_DIMS (ra1)->inc;
scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
scm_bits_t i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2);
scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc;
scm_bits_t inc1 = SCM_ARRAY_DIMS (ra1)->inc;
scm_bits_t inc2 = SCM_ARRAY_DIMS (ra1)->inc;
ra0 = SCM_ARRAY_V (ra0);
ra1 = SCM_ARRAY_V (ra1);
ra2 = SCM_ARRAY_V (ra2);
@ -1424,9 +1425,9 @@ ramap_1 (SCM ra0,SCM proc,SCM ras)
{
SCM ra1 = SCM_CAR (ras);
SCM e1 = SCM_UNDEFINED;
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
scm_sizet i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc;
scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
scm_bits_t i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1);
scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra0 = SCM_ARRAY_V (ra0);
ra1 = SCM_ARRAY_V (ra1);
if (scm_tc7_vector == SCM_TYP7 (ra0) || scm_tc7_wvect == SCM_TYP7 (ra0))
@ -1445,9 +1446,9 @@ ramap_2o (SCM ra0,SCM proc,SCM ras)
{
SCM ra1 = SCM_CAR (ras);
SCM e1 = SCM_UNDEFINED;
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
scm_sizet i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc;
scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
scm_bits_t i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1);
scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra0 = SCM_ARRAY_V (ra0);
ra1 = SCM_ARRAY_V (ra1);
ras = SCM_CDR (ras);
@ -1468,8 +1469,8 @@ ramap_2o (SCM ra0,SCM proc,SCM ras)
{
SCM ra2 = SCM_CAR (ras);
SCM e2 = SCM_UNDEFINED;
scm_sizet i2 = SCM_ARRAY_BASE (ra2);
long inc2 = SCM_ARRAY_DIMS (ra2)->inc;
scm_bits_t i2 = SCM_ARRAY_BASE (ra2);
scm_bits_t inc2 = SCM_ARRAY_DIMS (ra2)->inc;
ra2 = SCM_ARRAY_V (ra2);
if (scm_tc7_vector == SCM_TYP7 (ra0) || scm_tc7_wvect == SCM_TYP7 (ra0))
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
@ -1491,9 +1492,9 @@ static int
ramap_a (SCM ra0,SCM proc,SCM ras)
{
SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED;
long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
scm_sizet i0 = SCM_ARRAY_BASE (ra0);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
scm_bits_t i0 = SCM_ARRAY_BASE (ra0);
scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0);
if (SCM_NULLP (ras))
for (; n-- > 0; i0 += inc0)
@ -1501,8 +1502,8 @@ ramap_a (SCM ra0,SCM proc,SCM ras)
else
{
SCM ra1 = SCM_CAR (ras);
scm_sizet i1 = SCM_ARRAY_BASE (ra1);
long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
scm_bits_t i1 = SCM_ARRAY_BASE (ra1);
scm_bits_t inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1);
for (; n-- > 0; i0 += inc0, i1 += inc1)
scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)),
@ -1631,10 +1632,10 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
static int
rafe (SCM ra0,SCM proc,SCM ras)
{
long i = SCM_ARRAY_DIMS (ra0)->lbnd;
scm_sizet i0 = SCM_ARRAY_BASE (ra0);
long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
long n = SCM_ARRAY_DIMS (ra0)->ubnd;
scm_bits_t i = SCM_ARRAY_DIMS (ra0)->lbnd;
scm_bits_t i0 = SCM_ARRAY_BASE (ra0);
scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc;
scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd;
ra0 = SCM_ARRAY_V (ra0);
if (SCM_NULLP (ras))
for (; i <= n; i++, i0 += inc0)
@ -1643,8 +1644,8 @@ rafe (SCM ra0,SCM proc,SCM ras)
{
SCM ra1 = SCM_CAR (ras);
SCM args, *ve = &ras;
scm_sizet k, i1 = SCM_ARRAY_BASE (ra1);
long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
scm_bits_t k, i1 = SCM_ARRAY_BASE (ra1);
scm_bits_t inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1);
ras = SCM_CDR (ras);
if (SCM_NULLP(ras))
@ -1701,7 +1702,7 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
"@end lisp")
#define FUNC_NAME s_scm_array_index_map_x
{
scm_sizet i;
scm_bits_t i;
SCM_VALIDATE_NIM (1,ra);
SCM_VALIDATE_PROC (2,proc);
switch (SCM_TYP7(ra))
@ -1729,7 +1730,7 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
case scm_tc7_dvect:
case scm_tc7_cvect:
{
unsigned long int length = SCM_INUM (scm_uniform_vector_length (ra));
scm_bits_t length = SCM_INUM (scm_uniform_vector_length (ra));
for (i = 0; i < length; i++)
scm_array_set_x (ra, scm_apply (proc, SCM_MAKINUM (i), scm_listofnull),
SCM_MAKINUM (i));
@ -1740,7 +1741,7 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
{
SCM args = SCM_EOL;
SCM inds = scm_make_uve (SCM_ARRAY_NDIM (ra), SCM_MAKINUM (-1L));
long *vinds = (long *) SCM_VELTS (inds);
scm_bits_t *vinds = (scm_bits_t *) SCM_VELTS (inds);
int j, k, kmax = SCM_ARRAY_NDIM (ra) - 1;
if (kmax < 0)
return scm_array_set_x (ra, scm_apply(proc, SCM_EOL, SCM_EOL),
@ -1787,9 +1788,9 @@ static int
raeql_1 (SCM ra0,SCM as_equal,SCM ra1)
{
SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED;
scm_sizet i0 = 0, i1 = 0;
long inc0 = 1, inc1 = 1;
scm_sizet n;
scm_bits_t i0 = 0, i1 = 0;
scm_bits_t inc0 = 1, inc1 = 1;
scm_bits_t n;
ra1 = SCM_CAR (ra1);
if (SCM_ARRAYP(ra0))
{
@ -1915,9 +1916,9 @@ static int
raeql (SCM ra0,SCM as_equal,SCM ra1)
{
SCM v0 = ra0, v1 = ra1;
scm_array_dim dim0, dim1;
scm_array_dim *s0 = &dim0, *s1 = &dim1;
scm_sizet bas0 = 0, bas1 = 0;
scm_array_dim_t dim0, dim1;
scm_array_dim_t *s0 = &dim0, *s1 = &dim1;
scm_bits_t bas0 = 0, bas1 = 0;
int k, unroll = 1, vlen = 1, ndim = 1;
if (SCM_ARRAYP (ra0))
{

44
libguile/random.c
View file

@ -73,7 +73,7 @@
* scm_init_random().
*/
scm_rng scm_the_rng;
scm_rng_t scm_the_rng;
/*
@ -106,7 +106,7 @@ scm_rng scm_the_rng;
#if SIZEOF_LONG > 4 || defined (HAVE_LONG_LONGS)
unsigned long
scm_i_uniform32 (scm_i_rstate *state)
scm_i_uniform32 (scm_i_rstate_t *state)
{
LONG64 x = (LONG64) A * state->w + state->c;
LONG32 w = x & 0xffffffffUL;
@ -132,7 +132,7 @@ scm_i_uniform32 (scm_i_rstate *state)
#define H(x) ((x) >> 16)
unsigned long
scm_i_uniform32 (scm_i_rstate *state)
scm_i_uniform32 (scm_i_rstate_t *state)
{
LONG32 x1 = L (A) * L (state->w);
LONG32 x2 = L (A) * H (state->w);
@ -148,7 +148,7 @@ scm_i_uniform32 (scm_i_rstate *state)
#endif
void
scm_i_init_rstate (scm_i_rstate *state, char *seed, int n)
scm_i_init_rstate (scm_i_rstate_t *state, char *seed, int n)
{
LONG32 w = 0L;
LONG32 c = 0L;
@ -167,10 +167,10 @@ scm_i_init_rstate (scm_i_rstate *state, char *seed, int n)
state->c = c;
}
scm_i_rstate *
scm_i_copy_rstate (scm_i_rstate *state)
scm_i_rstate_t *
scm_i_copy_rstate (scm_i_rstate_t *state)
{
scm_rstate *new_state = malloc (scm_the_rng.rstate_size);
scm_rstate_t *new_state = malloc (scm_the_rng.rstate_size);
if (new_state == 0)
scm_memory_error ("rstate");
return memcpy (new_state, state, scm_the_rng.rstate_size);
@ -181,10 +181,10 @@ scm_i_copy_rstate (scm_i_rstate *state)
* Random number library functions
*/
scm_rstate *
scm_rstate_t *
scm_c_make_rstate (char *seed, int n)
{
scm_rstate *state = malloc (scm_the_rng.rstate_size);
scm_rstate_t *state = malloc (scm_the_rng.rstate_size);
if (state == 0)
scm_memory_error ("rstate");
state->reserved0 = 0;
@ -193,7 +193,7 @@ scm_c_make_rstate (char *seed, int n)
}
scm_rstate *
scm_rstate_t *
scm_c_default_rstate ()
#define FUNC_NAME "scm_c_default_rstate"
{
@ -206,7 +206,7 @@ scm_c_default_rstate ()
inline double
scm_c_uniform01 (scm_rstate *state)
scm_c_uniform01 (scm_rstate_t *state)
{
double x = (double) scm_the_rng.random_bits (state) / (double) 0xffffffffUL;
return ((x + (double) scm_the_rng.random_bits (state))
@ -214,7 +214,7 @@ scm_c_uniform01 (scm_rstate *state)
}
double
scm_c_normal01 (scm_rstate *state)
scm_c_normal01 (scm_rstate_t *state)
{
if (state->reserved0)
{
@ -237,7 +237,7 @@ scm_c_normal01 (scm_rstate *state)
}
double
scm_c_exp1 (scm_rstate *state)
scm_c_exp1 (scm_rstate_t *state)
{
return - log (scm_c_uniform01 (state));
}
@ -245,7 +245,7 @@ scm_c_exp1 (scm_rstate *state)
unsigned char scm_masktab[256];
unsigned long
scm_c_random (scm_rstate *state, unsigned long m)
scm_c_random (scm_rstate_t *state, unsigned long m)
{
unsigned int r, mask;
mask = (m < 0x100
@ -260,7 +260,7 @@ scm_c_random (scm_rstate *state, unsigned long m)
}
SCM
scm_c_random_bignum (scm_rstate *state, SCM m)
scm_c_random_bignum (scm_rstate_t *state, SCM m)
{
SCM b;
int i, nd;
@ -292,7 +292,7 @@ scm_c_random_bignum (scm_rstate *state, SCM m)
? scm_masktab[w >> 16] << 16 | 0xffff
: scm_masktab[w >> 24] << 24 | 0xffffff));
}
b = scm_mkbig (nd, 0);
b = scm_i_mkbig (nd, 0);
bits = (LONG32 *) SCM_BDIGITS (b);
do
{
@ -322,7 +322,7 @@ scm_c_random_bignum (scm_rstate *state, SCM m)
/* now fill up the rest of the bignum */
while (i)
bits[--i] = scm_the_rng.random_bits (state);
b = scm_normbig (b);
b = scm_i_normbig (b);
if (SCM_INUMP (b))
return b;
} while (scm_bigcomp (b, m) <= 0);
@ -336,12 +336,12 @@ scm_c_random_bignum (scm_rstate *state, SCM m)
scm_bits_t scm_tc16_rstate;
static SCM
make_rstate (scm_rstate *state)
make_rstate (scm_rstate_t *state)
{
SCM_RETURN_NEWSMOB (scm_tc16_rstate, state);
}
static scm_sizet
static size_t
rstate_free (SCM rstate)
{
free (SCM_RSTATE (rstate));
@ -568,12 +568,12 @@ scm_init_random ()
{
int i, m;
/* plug in default RNG */
scm_rng rng =
scm_rng_t rng =
{
sizeof (scm_i_rstate),
sizeof (scm_i_rstate_t),
(unsigned long (*)()) scm_i_uniform32,
(void (*)()) scm_i_init_rstate,
(scm_rstate *(*)()) scm_i_copy_rstate
(scm_rstate_t *(*)()) scm_i_copy_rstate
};
scm_the_rng = rng;

50
libguile/random.h
View file

@ -62,47 +62,53 @@
* Look how the default generator is "plugged in" in scm_init_random().
*/
typedef struct scm_rstate {
typedef struct scm_rstate_t {
int reserved0;
double reserved1;
/* Custom fields follow here */
} scm_rstate;
} scm_rstate_t;
typedef struct scm_rng {
typedef struct scm_rng_t {
size_t rstate_size; /* size of random state */
unsigned long (*random_bits) (scm_rstate *state); /* gives 32 random bits */
void (*init_rstate) (scm_rstate *state, char *seed, int n);
scm_rstate *(*copy_rstate) (scm_rstate *state);
} scm_rng;
unsigned long (*random_bits) (scm_rstate_t *state); /* gives 32 random bits */
void (*init_rstate) (scm_rstate_t *state, char *seed, int n);
scm_rstate_t *(*copy_rstate) (scm_rstate_t *state);
} scm_rng_t;
extern scm_rng scm_the_rng;
extern scm_rng_t scm_the_rng;
/*
* Default RNG
*/
typedef struct scm_i_rstate {
scm_rstate rstate;
typedef struct scm_i_rstate_t {
scm_rstate_t rstate;
unsigned long w;
unsigned long c;
} scm_i_rstate;
} scm_i_rstate_t;
extern unsigned long scm_i_uniform32 (scm_i_rstate *);
extern void scm_i_init_rstate (scm_i_rstate *, char *seed, int n);
extern scm_i_rstate *scm_i_copy_rstate (scm_i_rstate *);
#if (SCM_DEBUG_DEPRECATED == 0)
# define scm_rstate scm_rstate_t
# define scm_rng scm_rng_t
# define scm_i_rstate scm_i_rstate_t
#endif
extern unsigned long scm_i_uniform32 (scm_i_rstate_t *);
extern void scm_i_init_rstate (scm_i_rstate_t *, char *seed, int n);
extern scm_i_rstate_t *scm_i_copy_rstate (scm_i_rstate_t *);
/*
* Random number library functions
*/
extern scm_rstate *scm_c_make_rstate (char *, int);
extern scm_rstate *scm_c_default_rstate (void);
extern scm_rstate_t *scm_c_make_rstate (char *, int);
extern scm_rstate_t *scm_c_default_rstate (void);
#define scm_c_uniform32(RSTATE) scm_the_rng.random_bits (RSTATE)
extern double scm_c_uniform01 (scm_rstate *);
extern double scm_c_normal01 (scm_rstate *);
extern double scm_c_exp1 (scm_rstate *);
extern unsigned long scm_c_random (scm_rstate *, unsigned long m);
extern SCM scm_c_random_bignum (scm_rstate *, SCM m);
extern double scm_c_uniform01 (scm_rstate_t *);
extern double scm_c_normal01 (scm_rstate_t *);
extern double scm_c_exp1 (scm_rstate_t *);
extern unsigned long scm_c_random (scm_rstate_t *, unsigned long m);
extern SCM scm_c_random_bignum (scm_rstate_t *, SCM m);
/*
@ -110,7 +116,7 @@ extern SCM scm_c_random_bignum (scm_rstate *, SCM m);
*/
extern scm_bits_t scm_tc16_rstate;
#define SCM_RSTATEP(obj) SCM_TYP16_PREDICATE (scm_tc16_rstate, obj)
#define SCM_RSTATE(obj) ((scm_rstate *) SCM_CELL_WORD_1 (obj))
#define SCM_RSTATE(obj) ((scm_rstate_t *) SCM_CELL_WORD_1 (obj))
extern unsigned char scm_masktab[256];

30
libguile/rdelim.c
View file

@ -78,13 +78,13 @@ SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0,
"a delimiter, this value is @code{#f}.")
#define FUNC_NAME s_scm_read_delimited_x
{
long j;
size_t j;
char *buf;
long cstart;
long cend;
size_t cstart;
size_t cend;
int c;
char *cdelims;
int num_delims;
size_t num_delims;
SCM_VALIDATE_STRING_COPY (1, delims, cdelims);
num_delims = SCM_STRING_LENGTH (delims);
@ -97,7 +97,7 @@ SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0,
for (j = cstart; j < cend; j++)
{
int k;
size_t k;
c = scm_getc (port);
for (k = 0; k < num_delims; k++)
@ -122,9 +122,9 @@ SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0,
#undef FUNC_NAME
static unsigned char *
scm_do_read_line (SCM port, int *len_p)
scm_do_read_line (SCM port, size_t *len_p)
{
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_port_t *pt = SCM_PTAB_ENTRY (port);
unsigned char *end;
/* I thought reading lines was simple. Mercy me. */
@ -134,7 +134,7 @@ scm_do_read_line (SCM port, int *len_p)
if ((end = memchr (pt->read_pos, '\n', (pt->read_end - pt->read_pos)))
!= 0)
{
int buf_len = (end + 1) - pt->read_pos;
size_t buf_len = (end + 1) - pt->read_pos;
/* Allocate a buffer of the perfect size. */
unsigned char *buf = scm_must_malloc (buf_len + 1, "%read-line");
@ -151,18 +151,18 @@ scm_do_read_line (SCM port, int *len_p)
{
/* When live, len is always the number of characters in the
current buffer that are part of the current line. */
int len = (pt->read_end - pt->read_pos);
int buf_size = (len < 50) ? 60 : len * 2;
size_t len = (pt->read_end - pt->read_pos);
size_t buf_size = (len < 50) ? 60 : len * 2;
/* Invariant: buf always has buf_size + 1 characters allocated;
the `+ 1' is for the final '\0'. */
unsigned char *buf = scm_must_malloc (buf_size + 1, "%read-line");
int buf_len = 0;
size_t buf_len = 0;
for (;;)
{
if (buf_len + len > buf_size)
{
int new_size = (buf_len + len) * 2;
size_t new_size = (buf_len + len) * 2;
buf = scm_must_realloc (buf, buf_size + 1, new_size + 1,
"%read-line");
buf_size = new_size;
@ -223,9 +223,9 @@ SCM_DEFINE (scm_read_line, "%read-line", 0, 1, 0,
"@code{(#<eof> . #<eof>)}.")
#define FUNC_NAME s_scm_read_line
{
scm_port *pt;
scm_port_t *pt;
char *s;
int slen;
size_t slen;
SCM line, term;
if (SCM_UNBNDP (port))
@ -247,7 +247,7 @@ SCM_DEFINE (scm_read_line, "%read-line", 0, 1, 0,
term = SCM_MAKE_CHAR ('\n');
s[slen-1] = '\0';
line = scm_take_str (s, slen-1);
scm_done_malloc (-1);
scm_done_free (1);
SCM_INCLINE (port);
}
else

14
libguile/read.c
View file

@ -66,7 +66,7 @@
SCM_SYMBOL (scm_keyword_prefix, "prefix");
scm_option scm_read_opts[] = {
scm_option_t scm_read_opts[] = {
{ SCM_OPTION_BOOLEAN, "copy", 0,
"Copy source code expressions." },
{ SCM_OPTION_BOOLEAN, "positions", 0,
@ -126,9 +126,9 @@ SCM_DEFINE (scm_read, "read", 0, 1, 0,
char *
scm_grow_tok_buf (SCM *tok_buf)
{
unsigned long int oldlen = SCM_STRING_LENGTH (*tok_buf);
size_t oldlen = SCM_STRING_LENGTH (*tok_buf);
SCM newstr = scm_allocate_string (2 * oldlen);
unsigned long int i;
size_t i;
for (i = 0; i != oldlen; ++i)
SCM_STRING_CHARS (newstr) [i] = SCM_STRING_CHARS (*tok_buf) [i];
@ -203,7 +203,7 @@ scm_casei_streq (char *s1, char *s2)
#define recsexpr(obj, line, column, filename) (obj)
#else
static SCM
recsexpr (SCM obj,int line,int column,SCM filename)
recsexpr (SCM obj, long line, int column, SCM filename)
{
if (!SCM_CONSP(obj)) {
return obj;
@ -286,7 +286,7 @@ scm_lreadr (SCM *tok_buf,SCM port,SCM *copy)
#define FUNC_NAME "scm_lreadr"
{
int c;
scm_sizet j;
size_t j;
SCM p;
tryagain:
@ -535,10 +535,10 @@ tryagain_no_flush_ws:
_Pragma ("noopt"); /* # pragma _CRI noopt */
#endif
scm_sizet
size_t
scm_read_token (int ic, SCM *tok_buf, SCM port, int weird)
{
register scm_sizet j;
register size_t j;
register int c;
register char *p;

4
libguile/read.h
View file

@ -67,7 +67,7 @@
#define SCM_WHITE_SPACES SCM_SINGLE_SPACES: case '\t'
extern scm_option scm_read_opts[];
extern scm_option_t scm_read_opts[];
#define SCM_COPY_SOURCE_P scm_read_opts[0].val
#define SCM_RECORD_POSITIONS_P scm_read_opts[1].val
@ -83,7 +83,7 @@ extern char * scm_grow_tok_buf (SCM * tok_buf);
extern int scm_flush_ws (SCM port, const char *eoferr);
extern int scm_casei_streq (char * s1, char * s2);
extern SCM scm_lreadr (SCM * tok_buf, SCM port, SCM *copy);
extern scm_sizet scm_read_token (int ic, SCM * tok_buf, SCM port, int weird);
extern size_t scm_read_token (int ic, SCM * tok_buf, SCM port, int weird);
extern SCM scm_lreadparen (SCM * tok_buf, SCM port, char *name, SCM *copy);
extern SCM scm_lreadrecparen (SCM * tok_buf, SCM port, char *name, SCM *copy);
extern SCM scm_read_hash_extend (SCM chr, SCM proc);

2
libguile/regex-posix.c
View file

@ -93,7 +93,7 @@
scm_bits_t scm_tc16_regex;
static scm_sizet
static size_t
regex_free (SCM obj)
{
regfree (SCM_RGX (obj));

4
libguile/root.c
View file

@ -171,7 +171,7 @@ scm_make_root (SCM parent)
#if 0
SCM scm_exitval; /* INUM with return value */
#endif
static int n_dynamic_roots = 0;
static scm_bits_t n_dynamic_roots = 0;
/* cwdr fills out both of these structures, and then passes a pointer
@ -253,7 +253,7 @@ scm_internal_cwdr (scm_catch_body_t body, void *body_data,
SCM_REDEFER_INTS;
{
scm_contregs *contregs = scm_must_malloc (sizeof (scm_contregs),
scm_contregs_t *contregs = scm_must_malloc (sizeof (scm_contregs_t),
"inferior root continuation");
contregs->num_stack_items = 0;

2
libguile/root.h
View file

@ -96,7 +96,7 @@ typedef struct scm_root_state
SCM continuation_stack_ptr;
#ifdef DEBUG_EXTENSIONS
/* It is very inefficient to have this variable in the root state. */
scm_debug_frame *last_debug_frame;
scm_debug_frame_t *last_debug_frame;
#endif
SCM progargs; /* vestigial */

8
libguile/rw.c
View file

@ -111,13 +111,13 @@ SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0,
#define FUNC_NAME s_scm_read_string_x_partial
{
char *dest;
long read_len;
long chars_read = 0;
scm_bits_t read_len;
scm_bits_t chars_read = 0;
int fdes;
{
long offset;
long last;
scm_bits_t offset;
scm_bits_t last;
SCM_VALIDATE_SUBSTRING_SPEC_COPY (1, str, dest, 3, start, offset,
4, end, last);

10
libguile/script.c
View file

@ -74,14 +74,14 @@ scm_cat_path (char *str1, const char *str2, long n)
n = strlen (str2);
if (str1)
{
long len = strlen (str1);
str1 = (char *) realloc (str1, (scm_sizet) (len + n + 1));
size_t len = strlen (str1);
str1 = (char *) realloc (str1, (size_t) (len + n + 1));
if (!str1)
return 0L;
strncat (str1 + len, str2, n);
return str1;
}
str1 = (char *) malloc ((scm_sizet) (n + 1));
str1 = (char *) malloc ((size_t) (n + 1));
if (!str1)
return 0L;
str1[0] = 0;
@ -233,9 +233,9 @@ static char *
script_read_arg (FILE *f)
#define FUNC_NAME "script_read_arg"
{
int size = 7;
size_t size = 7;
char *buf = malloc (size + 1);
int len = 0;
size_t len = 0;
if (! buf)
return 0;

2
libguile/simpos.c
View file

@ -110,7 +110,7 @@ SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0,
SCM_VALIDATE_STRING (1, nam);
SCM_STRING_COERCE_0TERMINATION_X (nam);
val = getenv (SCM_STRING_CHARS (nam));
return (val) ? scm_makfromstr(val, (scm_sizet)strlen(val), 0) : SCM_BOOL_F;
return (val) ? scm_makfromstr(val, (size_t)strlen(val), 0) : SCM_BOOL_F;
}
#undef FUNC_NAME

28
libguile/smob.c
View file

@ -67,7 +67,7 @@
*/
#define MAX_SMOB_COUNT 256
int scm_numsmob;
scm_bits_t scm_numsmob;
scm_smob_descriptor scm_smobs[MAX_SMOB_COUNT];
/* {Mark}
@ -100,13 +100,13 @@ scm_markcdr (SCM ptr)
/* {Free}
*/
scm_sizet
size_t
scm_free0 (SCM ptr)
{
return 0;
}
scm_sizet
size_t
scm_smob_free (SCM obj)
{
scm_must_free ((char *) SCM_CELL_WORD_1 (obj));
@ -119,7 +119,7 @@ scm_smob_free (SCM obj)
int
scm_smob_print (SCM exp, SCM port, scm_print_state *pstate)
{
unsigned int n = SCM_SMOBNUM (exp);
size_t n = SCM_SMOBNUM (exp);
scm_puts ("#<", port);
scm_puts (SCM_SMOBNAME (n) ? SCM_SMOBNAME (n) : "smob", port);
scm_putc (' ', port);
@ -286,10 +286,10 @@ scm_smob_apply_3_error (SCM smob, SCM a1, SCM a2, SCM rst)
scm_bits_t
scm_make_smob_type (char *name, scm_sizet size)
scm_make_smob_type (char *name, size_t size)
#define FUNC_NAME "scm_make_smob_type"
{
unsigned int new_smob;
size_t new_smob;
SCM_ENTER_A_SECTION; /* scm_numsmob */
new_smob = scm_numsmob;
@ -323,7 +323,7 @@ scm_set_smob_mark (scm_bits_t tc, SCM (*mark) (SCM))
}
void
scm_set_smob_free (scm_bits_t tc, scm_sizet (*free) (SCM))
scm_set_smob_free (scm_bits_t tc, size_t (*free) (SCM))
{
scm_smobs[SCM_TC2SMOBNUM (tc)].free = free;
}
@ -453,8 +453,8 @@ scm_set_smob_apply (scm_bits_t tc, SCM (*apply) (),
SCM
scm_make_smob (scm_bits_t tc)
{
int n = SCM_TC2SMOBNUM (tc);
scm_sizet size = scm_smobs[n].size;
size_t n = SCM_TC2SMOBNUM (tc);
size_t size = scm_smobs[n].size;
SCM z;
SCM_NEWCELL (z);
if (size != 0)
@ -481,13 +481,13 @@ scm_make_smob (scm_bits_t tc)
#if (SCM_DEBUG_DEPRECATED == 0)
long
scm_make_smob_type_mfpe (char *name, scm_sizet size,
scm_make_smob_type_mfpe (char *name, size_t size,
SCM (*mark) (SCM),
scm_sizet (*free) (SCM),
size_t (*free) (SCM),
int (*print) (SCM, SCM, scm_print_state *),
SCM (*equalp) (SCM, SCM))
{
long answer = scm_make_smob_type (name, size);
scm_bits_t answer = scm_make_smob_type (name, size);
scm_set_smob_mfpe (answer, mark, free, print, equalp);
return answer;
}
@ -495,7 +495,7 @@ scm_make_smob_type_mfpe (char *name, scm_sizet size,
void
scm_set_smob_mfpe (long tc,
SCM (*mark) (SCM),
scm_sizet (*free) (SCM),
size_t (*free) (SCM),
int (*print) (SCM, SCM, scm_print_state *),
SCM (*equalp) (SCM, SCM))
{
@ -526,7 +526,7 @@ free_print (SCM exp, SCM port, scm_print_state *pstate)
void
scm_smob_prehistory ()
{
unsigned int i;
size_t i;
scm_bits_t tc;
scm_numsmob = 0;

20
libguile/smob.h
View file

@ -52,9 +52,9 @@
typedef struct scm_smob_descriptor
{
char *name;
scm_sizet size;
size_t size;
SCM (*mark) (SCM);
scm_sizet (*free) (SCM);
size_t (*free) (SCM);
int (*print) (SCM exp, SCM port, scm_print_state *pstate);
SCM (*equalp) (SCM, SCM);
SCM (*apply) ();
@ -124,15 +124,15 @@ do { \
#define SCM_SMOB_APPLY_2(x,a1,a2) (SCM_SMOB_DESCRIPTOR (x).apply_2 (x, (a1), (a2)))
#define SCM_SMOB_APPLY_3(x,a1,a2,rst) (SCM_SMOB_DESCRIPTOR (x).apply_3 (x, (a1), (a2), (rst)))
extern int scm_numsmob;
extern scm_bits_t scm_numsmob;
extern scm_smob_descriptor scm_smobs[];
extern SCM scm_mark0 (SCM ptr);
extern SCM scm_markcdr (SCM ptr);
extern scm_sizet scm_free0 (SCM ptr);
extern scm_sizet scm_smob_free (SCM obj);
extern size_t scm_free0 (SCM ptr);
extern size_t scm_smob_free (SCM obj);
extern int scm_smob_print (SCM exp, SCM port, scm_print_state *pstate);
/* The following set of functions is the standard way to create new
@ -143,10 +143,10 @@ extern int scm_smob_print (SCM exp, SCM port, scm_print_state *pstate);
* values using `scm_set_smob_xxx'.
*/
extern scm_bits_t scm_make_smob_type (char *name, scm_sizet size);
extern scm_bits_t scm_make_smob_type (char *name, size_t size);
extern void scm_set_smob_mark (scm_bits_t tc, SCM (*mark) (SCM));
extern void scm_set_smob_free (scm_bits_t tc, scm_sizet (*free) (SCM));
extern void scm_set_smob_free (scm_bits_t tc, size_t (*free) (SCM));
extern void scm_set_smob_print (scm_bits_t tc,
int (*print) (SCM, SCM, scm_print_state*));
extern void scm_set_smob_equalp (scm_bits_t tc, SCM (*equalp) (SCM, SCM));
@ -165,15 +165,15 @@ extern void scm_smob_prehistory (void);
#if (SCM_DEBUG_DEPRECATED == 0)
extern long scm_make_smob_type_mfpe (char *name, scm_sizet size,
extern long scm_make_smob_type_mfpe (char *name, size_t size,
SCM (*mark) (SCM),
scm_sizet (*free) (SCM),
size_t (*free) (SCM),
int (*print) (SCM, SCM, scm_print_state*),
SCM (*equalp) (SCM, SCM));
extern void scm_set_smob_mfpe (long tc,
SCM (*mark) (SCM),
scm_sizet (*free) (SCM),
size_t (*free) (SCM),
int (*print) (SCM, SCM, scm_print_state*),
SCM (*equalp) (SCM, SCM));

16
libguile/socket.c
View file

@ -307,7 +307,7 @@ static SCM ipv6_net_to_num (const char *src)
}
else
{
result = scm_mkbig (big_digits, 0);
result = scm_i_mkbig (big_digits, 0);
memcpy (SCM_BDIGITS (result), addr, big_digits * bytes_per_dig);
}
return result;
@ -497,8 +497,8 @@ SCM_DEFINE (scm_getsockopt, "getsockopt", 3, 0, 0,
char optval[sizeof (struct linger)];
int optlen = sizeof (struct linger);
#else
char optval[sizeof (scm_sizet)];
int optlen = sizeof (scm_sizet);
char optval[sizeof (size_t)];
int optlen = sizeof (size_t);
#endif
int ilevel;
int ioptname;
@ -538,7 +538,7 @@ SCM_DEFINE (scm_getsockopt, "getsockopt", 3, 0, 0,
#endif
)
{
return scm_long2num (*(scm_sizet *) optval);
return scm_long2num (*(size_t *) optval);
}
}
return scm_long2num (*(int *) optval);
@ -565,7 +565,7 @@ SCM_DEFINE (scm_setsockopt, "setsockopt", 4, 0, 0,
#ifdef HAVE_STRUCT_LINGER
char optval[sizeof (struct linger)];
#else
char optval[sizeof (scm_sizet)];
char optval[sizeof (size_t)];
#endif
int ilevel, ioptname;
@ -624,8 +624,8 @@ SCM_DEFINE (scm_setsockopt, "setsockopt", 4, 0, 0,
{
long lv = SCM_NUM2LONG (4, value);
optlen = (int) sizeof (scm_sizet);
(*(scm_sizet *) optval) = (scm_sizet) lv;
optlen = (int) sizeof (size_t);
(*(size_t *) optval) = (size_t) lv;
}
}
if (optlen == -1)
@ -961,7 +961,7 @@ scm_addr_vector (const struct sockaddr *address, const char *proc)
ve = SCM_VELTS (result);
ve[0] = scm_ulong2num ((unsigned long) fam);
ve[1] = scm_makfromstr (nad->sun_path,
(scm_sizet) strlen (nad->sun_path), 0);
(size_t) strlen (nad->sun_path), 0);
}
break;
#endif

42
libguile/sort.c
View file

@ -456,7 +456,7 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0,
"applied to all elements i - 1 and i")
#define FUNC_NAME s_scm_sorted_p
{
long len, j; /* list/vector length, temp j */
scm_bits_t len, j; /* list/vector length, temp j */
SCM item, rest; /* rest of items loop variable */
SCM *vp;
cmp_fun_t cmp = scm_cmp_function (less);
@ -528,7 +528,7 @@ SCM_DEFINE (scm_merge, "merge", 3, 0, 0,
"Note: this does _not_ accept vectors.")
#define FUNC_NAME s_scm_merge
{
long alen, blen; /* list lengths */
scm_bits_t alen, blen; /* list lengths */
SCM build, last;
cmp_fun_t cmp = scm_cmp_function (less);
SCM_VALIDATE_NIM (3,less);
@ -641,7 +641,7 @@ SCM_DEFINE (scm_merge_x, "merge!", 3, 0, 0,
"Note: this does _not_ accept vectors.")
#define FUNC_NAME s_scm_merge_x
{
long alen, blen; /* list lengths */
scm_bits_t alen, blen; /* list lengths */
SCM_VALIDATE_NIM (3,less);
if (SCM_NULLP (alist))
@ -669,13 +669,13 @@ static SCM
scm_merge_list_step (SCM * seq,
cmp_fun_t cmp,
SCM less,
int n)
scm_bits_t n)
{
SCM a, b;
if (n > 2)
{
long mid = n / 2;
scm_bits_t mid = n / 2;
a = scm_merge_list_step (seq, cmp, less, mid);
b = scm_merge_list_step (seq, cmp, less, n - mid);
return scm_merge_list_x (a, b, mid, n - mid, cmp, less);
@ -717,7 +717,7 @@ SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0,
"This is not a stable sort.")
#define FUNC_NAME s_scm_sort_x
{
long len; /* list/vector length */
scm_bits_t len; /* list/vector length */
if (SCM_NULLP(items))
return SCM_EOL;
@ -757,7 +757,7 @@ SCM_DEFINE (scm_sort, "sort", 2, 0, 0,
SCM_VALIDATE_NIM (2,less);
if (SCM_CONSP (items))
{
long len;
scm_bits_t len;
SCM_VALIDATE_LIST_COPYLEN (1,items,len);
items = scm_list_copy (items);
@ -767,7 +767,7 @@ SCM_DEFINE (scm_sort, "sort", 2, 0, 0,
/* support ordinary vectors even if arrays not available? */
else if (SCM_VECTORP (items))
{
long len = SCM_VECTOR_LENGTH (items);
scm_bits_t len = SCM_VECTOR_LENGTH (items);
SCM sortvec = scm_make_uve (len, scm_array_prototype (items));
scm_array_copy_x (items, sortvec);
@ -788,15 +788,15 @@ scm_merge_vector_x (void *const vecbase,
void *const tempbase,
cmp_fun_t cmp,
SCM less,
long low,
long mid,
long high)
scm_bits_t low,
scm_bits_t mid,
scm_bits_t high)
{
register SCM *vp = (SCM *) vecbase;
register SCM *temp = (SCM *) tempbase;
long it; /* Index for temp vector */
long i1 = low; /* Index for lower vector segment */
long i2 = mid + 1; /* Index for upper vector segment */
scm_bits_t it; /* Index for temp vector */
scm_bits_t i1 = low; /* Index for lower vector segment */
scm_bits_t i2 = mid + 1; /* Index for upper vector segment */
/* Copy while both segments contain more characters */
for (it = low; (i1 <= mid) && (i2 <= high); ++it)
@ -823,12 +823,12 @@ scm_merge_vector_step (void *const vp,
void *const temp,
cmp_fun_t cmp,
SCM less,
long low,
long high)
scm_bits_t low,
scm_bits_t high)
{
if (high > low)
{
long mid = (low + high) / 2;
scm_bits_t mid = (low + high) / 2;
scm_merge_vector_step (vp, temp, cmp, less, low, mid);
scm_merge_vector_step (vp, temp, cmp, less, mid+1, high);
scm_merge_vector_x (vp, temp, cmp, less, low, mid, high);
@ -847,7 +847,7 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0,
"This is a stable sort.")
#define FUNC_NAME s_scm_stable_sort_x
{
long len; /* list/vector length */
scm_bits_t len; /* list/vector length */
if (SCM_NULLP (items))
return SCM_EOL;
@ -887,7 +887,7 @@ SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0,
"This is a stable sort.")
#define FUNC_NAME s_scm_stable_sort
{
long len; /* list/vector length */
scm_bits_t len; /* list/vector length */
if (SCM_NULLP (items))
return SCM_EOL;
@ -933,7 +933,7 @@ SCM_DEFINE (scm_sort_list_x, "sort-list!", 2, 0, 0,
"This is a stable sort.")
#define FUNC_NAME s_scm_sort_list_x
{
long len;
scm_bits_t len;
SCM_VALIDATE_LIST_COPYLEN (1,items,len);
SCM_VALIDATE_NIM (2,less);
return scm_merge_list_step (&items, scm_cmp_function (less), less, len);
@ -947,7 +947,7 @@ SCM_DEFINE (scm_sort_list, "sort-list", 2, 0, 0,
"list elements. This is a stable sort.")
#define FUNC_NAME s_scm_sort_list
{
long len;
scm_bits_t len;
SCM_VALIDATE_LIST_COPYLEN (1,items,len);
SCM_VALIDATE_NIM (2,less);
items = scm_list_copy (items);

38
libguile/srcprop.c
View file

@ -84,8 +84,8 @@ SCM_GLOBAL_SYMBOL (scm_sym_column, "column");
SCM_GLOBAL_SYMBOL (scm_sym_breakpoint, "breakpoint");
scm_bits_t scm_tc16_srcprops;
static scm_srcprops_chunk *srcprops_chunklist = 0;
static scm_srcprops *srcprops_freelist = 0;
static scm_srcprops_chunk_t *srcprops_chunklist = 0;
static scm_srcprops_t *srcprops_freelist = 0;
static SCM
@ -97,11 +97,11 @@ srcprops_mark (SCM obj)
}
static scm_sizet
static size_t
srcprops_free (SCM obj)
{
*((scm_srcprops **) SCM_CELL_WORD_1 (obj)) = srcprops_freelist;
srcprops_freelist = (scm_srcprops *) SCM_CELL_WORD_1 (obj);
*((scm_srcprops_t **) SCM_CELL_WORD_1 (obj)) = srcprops_freelist;
srcprops_freelist = (scm_srcprops_t *) SCM_CELL_WORD_1 (obj);
return 0; /* srcprops_chunks are not freed until leaving guile */
}
@ -120,19 +120,19 @@ srcprops_print (SCM obj, SCM port, scm_print_state *pstate)
SCM
scm_make_srcprops (int line, int col, SCM filename, SCM copy, SCM plist)
scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM plist)
{
register scm_srcprops *ptr;
register scm_srcprops_t *ptr;
SCM_DEFER_INTS;
if ((ptr = srcprops_freelist) != NULL)
srcprops_freelist = *(scm_srcprops **)ptr;
srcprops_freelist = *(scm_srcprops_t **)ptr;
else
{
int i;
scm_srcprops_chunk *mem;
scm_sizet n = sizeof (scm_srcprops_chunk)
+ sizeof (scm_srcprops) * (SRCPROPS_CHUNKSIZE - 1);
SCM_SYSCALL (mem = (scm_srcprops_chunk *) malloc (n));
size_t i;
scm_srcprops_chunk_t *mem;
size_t n = sizeof (scm_srcprops_chunk_t)
+ sizeof (scm_srcprops_t) * (SRCPROPS_CHUNKSIZE - 1);
SCM_SYSCALL (mem = (scm_srcprops_chunk_t *) malloc (n));
if (mem == NULL)
scm_memory_error ("srcprops");
scm_mallocated += n;
@ -140,9 +140,9 @@ scm_make_srcprops (int line, int col, SCM filename, SCM copy, SCM plist)
srcprops_chunklist = mem;
ptr = &mem->srcprops[0];
for (i = 1; i < SRCPROPS_CHUNKSIZE - 1; ++i)
*(scm_srcprops **)&ptr[i] = &ptr[i + 1];
*(scm_srcprops **)&ptr[SRCPROPS_CHUNKSIZE - 1] = 0;
srcprops_freelist = (scm_srcprops *) &ptr[1];
*(scm_srcprops_t **)&ptr[i] = &ptr[i + 1];
*(scm_srcprops_t **)&ptr[SRCPROPS_CHUNKSIZE - 1] = 0;
srcprops_freelist = (scm_srcprops_t *) &ptr[1];
}
ptr->pos = SRCPROPMAKPOS (line, col);
ptr->fname = filename;
@ -344,13 +344,13 @@ scm_init_srcprop ()
void
scm_finish_srcprop ()
{
register scm_srcprops_chunk *ptr = srcprops_chunklist, *next;
register scm_srcprops_chunk_t *ptr = srcprops_chunklist, *next;
while (ptr)
{
next = ptr->next;
free ((char *) ptr);
scm_mallocated -= sizeof (scm_srcprops_chunk)
+ sizeof (scm_srcprops) * (SRCPROPS_CHUNKSIZE - 1);
scm_mallocated -= sizeof (scm_srcprops_chunk_t)
+ sizeof (scm_srcprops_t) * (SRCPROPS_CHUNKSIZE - 1);
ptr = next;
}
}

27
libguile/srcprop.h
View file

@ -80,32 +80,37 @@ do { \
extern scm_bits_t scm_tc16_srcprops;
typedef struct scm_srcprops
typedef struct scm_srcprops_t
{
unsigned long pos;
SCM fname;
SCM copy;
SCM plist;
} scm_srcprops;
} scm_srcprops_t;
#define SRCPROPS_CHUNKSIZE 2047 /* Number of srcprops per chunk */
typedef struct scm_srcprops_chunk
typedef struct scm_srcprops_chunk_t
{
struct scm_srcprops_chunk *next;
scm_srcprops srcprops[1];
} scm_srcprops_chunk;
struct scm_srcprops_chunk_t *next;
scm_srcprops_t srcprops[1];
} scm_srcprops_chunk_t;
#if (SCM_DEBUG_DEPRECATED == 0)
# define scm_srcprops scm_srcprops_t
# define scm_srcprops_chunk scm_srcprops_chunk_t
#endif
#define SCM_SOURCE_PROPERTY_FLAG_BREAK (1L << 16)
#define SRCPROPSP(p) (SCM_TYP16_PREDICATE (scm_tc16_srcprops, p))
#define SRCPROPBRK(p) \
(SCM_BOOL (SCM_CELL_WORD_0 (p) & SCM_SOURCE_PROPERTY_FLAG_BREAK))
#define SRCPROPPOS(p) ((scm_srcprops *) SCM_CELL_WORD_1 (p))->pos
#define SRCPROPPOS(p) ((scm_srcprops_t *) SCM_CELL_WORD_1 (p))->pos
#define SRCPROPLINE(p) (SRCPROPPOS(p) >> 12)
#define SRCPROPCOL(p) (SRCPROPPOS(p) & 0x0fffL)
#define SRCPROPFNAME(p) ((scm_srcprops *) SCM_CELL_WORD_1 (p))->fname
#define SRCPROPCOPY(p) ((scm_srcprops *) SCM_CELL_WORD_1 (p))->copy
#define SRCPROPPLIST(p) ((scm_srcprops *) SCM_CELL_WORD_1 (p))->plist
#define SRCPROPFNAME(p) ((scm_srcprops_t *) SCM_CELL_WORD_1 (p))->fname
#define SRCPROPCOPY(p) ((scm_srcprops_t *) SCM_CELL_WORD_1 (p))->copy
#define SRCPROPPLIST(p) ((scm_srcprops_t *) SCM_CELL_WORD_1 (p))->plist
#define SETSRCPROPBRK(p) \
(SCM_SET_CELL_WORD_0 ((p), SCM_CELL_WORD_0 (p) \
| SCM_SOURCE_PROPERTY_FLAG_BREAK))
@ -133,7 +138,7 @@ extern SCM scm_sym_breakpoint;
extern SCM scm_srcprops_to_plist (SCM obj);
extern SCM scm_make_srcprops (int line, int col, SCM fname, SCM copy, SCM plist);
extern SCM scm_make_srcprops (long line, int col, SCM fname, SCM copy, SCM plist);
extern SCM scm_source_property (SCM obj, SCM key);
extern SCM scm_set_source_property_x (SCM obj, SCM key, SCM datum);
extern SCM scm_source_properties (SCM obj);

2
libguile/stackchk.c
View file

@ -72,7 +72,7 @@ scm_report_stack_overflow ()
#endif
long
long
scm_stack_size (SCM_STACKITEM *start)
{
SCM_STACKITEM stack;

81
libguile/stacks.c
View file

@ -92,11 +92,11 @@
* Representation:
*
* The stack is represented as a struct with an id slot and a tail
* array of scm_info_frame structs.
* array of scm_info_frame_t structs.
*
* A frame is represented as a pair where the car contains a stack and
* the cdr an inum. The inum is an index to the first SCM value of
* the scm_info_frame struct.
* the scm_info_frame_t struct.
*
* Stacks
* Constructor
@ -129,7 +129,7 @@
*/
/* Stacks often contain pointers to other items on the stack; for
example, each scm_debug_frame structure contains a pointer to the
example, each scm_debug_frame_t structure contains a pointer to the
next frame out. When we capture a continuation, we copy the stack
into the heap, and just leave all the pointers unchanged. This
makes it simple to restore the continuation --- just copy the stack
@ -143,30 +143,30 @@
OFFSET) is a pointer to the copy in the continuation of the
original referent, cast to an scm_debug_MUMBLE *. */
#define RELOC_INFO(ptr, offset) \
((scm_debug_info *) ((SCM_STACKITEM *) (ptr) + (offset)))
((scm_debug_info_t *) ((SCM_STACKITEM *) (ptr) + (offset)))
#define RELOC_FRAME(ptr, offset) \
((scm_debug_frame *) ((SCM_STACKITEM *) (ptr) + (offset)))
((scm_debug_frame_t *) ((SCM_STACKITEM *) (ptr) + (offset)))
/* Count number of debug info frames on a stack, beginning with
* DFRAME. OFFSET is used for relocation of pointers when the stack
* is read from a continuation.
*/
static int
stack_depth (scm_debug_frame *dframe,long offset,SCM *id,int *maxp)
static scm_bits_t
stack_depth (scm_debug_frame_t *dframe,scm_bits_t offset,SCM *id,int *maxp)
{
int n;
int max_depth = SCM_BACKTRACE_MAXDEPTH;
scm_bits_t n;
scm_bits_t max_depth = SCM_BACKTRACE_MAXDEPTH;
for (n = 0;
dframe && !SCM_VOIDFRAMEP (*dframe) && n < max_depth;
dframe = RELOC_FRAME (dframe->prev, offset))
{
if (SCM_EVALFRAMEP (*dframe))
{
scm_debug_info * info = RELOC_INFO (dframe->info, offset);
scm_debug_info_t * info = RELOC_INFO (dframe->info, offset);
n += (info - dframe->vect) / 2 + 1;
/* Data in the apply part of an eval info frame comes from previous
stack frame if the scm_debug_info vector is overflowed. */
stack frame if the scm_debug_info_t vector is overflowed. */
if ((((info - dframe->vect) & 1) == 0)
&& SCM_OVERFLOWP (*dframe)
&& !SCM_UNBNDP (info[1].a.proc))
@ -185,12 +185,12 @@ stack_depth (scm_debug_frame *dframe,long offset,SCM *id,int *maxp)
/* Read debug info from DFRAME into IFRAME.
*/
static void
read_frame (scm_debug_frame *dframe,long offset,scm_info_frame *iframe)
read_frame (scm_debug_frame_t *dframe,scm_bits_t offset,scm_info_frame_t *iframe)
{
scm_bits_t flags = SCM_UNPACK (SCM_INUM0); /* UGh. */
if (SCM_EVALFRAMEP (*dframe))
{
scm_debug_info * info = RELOC_INFO (dframe->info, offset);
scm_debug_info_t * info = RELOC_INFO (dframe->info, offset);
if ((info - dframe->vect) & 1)
{
/* Debug.vect ends with apply info. */
@ -246,16 +246,16 @@ do { \
} while (0)
/* Fill the scm_info_frame vector IFRAME with data from N stack frames
/* Fill the scm_info_frame_t vector IFRAME with data from N stack frames
* starting with the first stack frame represented by debug frame
* DFRAME.
*/
static int
read_frames (scm_debug_frame *dframe,long offset,int n,scm_info_frame *iframes)
static scm_bits_t
read_frames (scm_debug_frame_t *dframe,scm_bits_t offset,scm_bits_t n,scm_info_frame_t *iframes)
{
scm_info_frame *iframe = iframes;
scm_debug_info *info;
scm_info_frame_t *iframe = iframes;
scm_debug_info_t *info;
static SCM applybody = SCM_UNDEFINED;
/* The value of applybody has to be setup after r4rs.scm has executed. */
@ -280,7 +280,7 @@ read_frames (scm_debug_frame *dframe,long offset,int n,scm_info_frame *iframes)
if ((info - dframe->vect) & 1)
--info;
/* Data in the apply part of an eval info frame comes from
previous stack frame if the scm_debug_info vector is overflowed. */
previous stack frame if the scm_debug_info_t vector is overflowed. */
else if (SCM_OVERFLOWP (*dframe)
&& !SCM_UNBNDP (info[1].a.proc))
{
@ -345,11 +345,11 @@ read_frames (scm_debug_frame *dframe,long offset,int n,scm_info_frame *iframes)
*/
static void
narrow_stack (SCM stack,int inner,SCM inner_key,int outer,SCM outer_key)
narrow_stack (SCM stack,scm_bits_t inner,SCM inner_key,scm_bits_t outer,SCM outer_key)
{
scm_stack *s = SCM_STACK (stack);
int i;
int n = s->length;
scm_stack_t *s = SCM_STACK (stack);
scm_bits_t i;
scm_bits_t n = s->length;
/* Cut inner part. */
if (SCM_EQ_P (inner_key, SCM_BOOL_T))
@ -421,10 +421,11 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
"resulting stack will be narrowed.")
#define FUNC_NAME s_scm_make_stack
{
int n, maxp, size;
scm_debug_frame *dframe = scm_last_debug_frame;
scm_info_frame *iframe;
long offset = 0;
scm_bits_t n, size;
int maxp;
scm_debug_frame_t *dframe = scm_last_debug_frame;
scm_info_frame_t *iframe;
scm_bits_t offset = 0;
SCM stack, id;
SCM inner_cut, outer_cut;
@ -436,10 +437,10 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
{
SCM_ASSERT (SCM_NIMP (obj), obj, SCM_ARG1, FUNC_NAME);
if (SCM_DEBUGOBJP (obj))
dframe = (scm_debug_frame *) SCM_DEBUGOBJ_FRAME (obj);
dframe = (scm_debug_frame_t *) SCM_DEBUGOBJ_FRAME (obj);
else if (SCM_CONTINUATIONP (obj))
{
offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (obj) + sizeof (scm_contregs))
offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (obj) + sizeof (scm_contregs_t))
- SCM_BASE (obj));
#ifndef STACK_GROWS_UP
offset += SCM_CONTINUATION_LENGTH (obj);
@ -512,18 +513,18 @@ SCM_DEFINE (scm_stack_id, "stack-id", 1, 0, 0,
"Return the identifier given to @var{stack} by @code{start-stack}.")
#define FUNC_NAME s_scm_stack_id
{
scm_debug_frame *dframe;
long offset = 0;
scm_debug_frame_t *dframe;
scm_bits_t offset = 0;
if (SCM_EQ_P (stack, SCM_BOOL_T))
dframe = scm_last_debug_frame;
else
{
SCM_VALIDATE_NIM (1,stack);
if (SCM_DEBUGOBJP (stack))
dframe = (scm_debug_frame *) SCM_DEBUGOBJ_FRAME (stack);
dframe = (scm_debug_frame_t *) SCM_DEBUGOBJ_FRAME (stack);
else if (SCM_CONTINUATIONP (stack))
{
offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (stack) + sizeof (scm_contregs))
offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (stack) + sizeof (scm_contregs_t))
- SCM_BASE (stack));
#ifndef STACK_GROWS_UP
offset += SCM_CONTINUATION_LENGTH (stack);
@ -586,16 +587,16 @@ SCM_DEFINE (scm_last_stack_frame, "last-stack-frame", 1, 0, 0,
"debug object or a continuation.")
#define FUNC_NAME s_scm_last_stack_frame
{
scm_debug_frame *dframe;
long offset = 0;
scm_debug_frame_t *dframe;
scm_bits_t offset = 0;
SCM stack;
SCM_VALIDATE_NIM (1,obj);
if (SCM_DEBUGOBJP (obj))
dframe = (scm_debug_frame *) SCM_DEBUGOBJ_FRAME (obj);
dframe = (scm_debug_frame_t *) SCM_DEBUGOBJ_FRAME (obj);
else if (SCM_CONTINUATIONP (obj))
{
offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (obj) + sizeof (scm_contregs))
offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (obj) + sizeof (scm_contregs_t))
- SCM_BASE (obj));
#ifndef STACK_GROWS_UP
offset += SCM_CONTINUATION_LENGTH (obj);
@ -616,7 +617,7 @@ SCM_DEFINE (scm_last_stack_frame, "last-stack-frame", 1, 0, 0,
SCM_STACK (stack) -> length = 1;
SCM_STACK (stack) -> frames = &SCM_STACK (stack) -> tail[0];
read_frame (dframe, offset,
(scm_info_frame *) &SCM_STACK (stack) -> frames[0]);
(scm_info_frame_t *) &SCM_STACK (stack) -> frames[0]);
return scm_cons (stack, SCM_INUM0);;
}
@ -671,7 +672,7 @@ SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0,
"@var{frame} is the first frame in its stack.")
#define FUNC_NAME s_scm_frame_previous
{
int n;
scm_bits_t n;
SCM_VALIDATE_FRAME (1,frame);
n = SCM_INUM (SCM_CDR (frame)) + 1;
if (n >= SCM_STACK_LENGTH (SCM_CAR (frame)))
@ -687,7 +688,7 @@ SCM_DEFINE (scm_frame_next, "frame-next", 1, 0, 0,
"@var{frame} is the last frame in its stack.")
#define FUNC_NAME s_scm_frame_next
{
int n;
scm_bits_t n;
SCM_VALIDATE_FRAME (1,frame);
n = SCM_INUM (SCM_CDR (frame)) - 1;
if (n < 0)

25
libguile/stacks.h
View file

@ -55,24 +55,29 @@
/* {Frames and stacks}
*/
typedef struct scm_info_frame {
typedef struct scm_info_frame_t {
/* SCM flags; */
scm_bits_t flags;
SCM source;
SCM proc;
SCM args;
} scm_info_frame;
#define SCM_FRAME_N_SLOTS (sizeof (scm_info_frame) / sizeof (SCM))
} scm_info_frame_t;
#define SCM_FRAME_N_SLOTS (sizeof (scm_info_frame_t) / sizeof (SCM))
#define SCM_STACK(obj) ((scm_stack *) SCM_STRUCT_DATA (obj))
#define SCM_STACK(obj) ((scm_stack_t *) SCM_STRUCT_DATA (obj))
#define SCM_STACK_LAYOUT "pwuourpW"
typedef struct scm_stack {
typedef struct scm_stack_t {
SCM id; /* Stack id */
scm_info_frame *frames; /* Info frames */
unsigned int length; /* Stack length */
unsigned int tail_length;
scm_info_frame tail[1];
} scm_stack;
scm_info_frame_t *frames; /* Info frames */
scm_bits_t length; /* Stack length */
scm_bits_t tail_length;
scm_info_frame_t tail[1];
} scm_stack_t;
#if (SCM_DEBUG_DEPRECATED == 0)
# define scm_info_frame scm_info_frame_t
# define scm_stack scm_stack_t
#endif
extern SCM scm_stack_type;

32
libguile/strings.c
View file

@ -96,7 +96,7 @@ SCM_DEFINE (scm_string, "string", 0, 0, 1,
SCM result;
{
long i = scm_ilength (chrs);
scm_bits_t i = scm_ilength (chrs);
SCM_ASSERT (i >= 0, chrs, SCM_ARGn, FUNC_NAME);
result = scm_allocate_string (i);
@ -121,7 +121,7 @@ SCM_DEFINE (scm_string, "string", 0, 0, 1,
#if (SCM_DEBUG_DEPRECATED == 0)
SCM
scm_makstr (long len, int dummy)
scm_makstr (size_t len, int dummy)
#define FUNC_NAME "scm_makstr"
{
SCM s;
@ -153,7 +153,7 @@ scm_makfromstrs (int argc, char **argv)
if (0 > i)
for (i = 0; argv[i]; i++);
while (i--)
lst = scm_cons (scm_makfromstr (argv[i], (scm_sizet) strlen (argv[i]), 0), lst);
lst = scm_cons (scm_makfromstr (argv[i], (size_t) strlen (argv[i]), 0), lst);
return lst;
}
@ -167,7 +167,7 @@ scm_makfromstrs (int argc, char **argv)
strings by claiming they're shared substrings of a string we just
made up. */
SCM
scm_take_str (char *s, int len)
scm_take_str (char *s, size_t len)
#define FUNC_NAME "scm_take_str"
{
SCM answer;
@ -192,7 +192,7 @@ scm_take0str (char *s)
}
SCM
scm_makfromstr (const char *src, scm_sizet len, int dummy)
scm_makfromstr (const char *src, size_t len, int dummy)
{
SCM s = scm_allocate_string (len);
char *dst = SCM_STRING_CHARS (s);
@ -206,7 +206,7 @@ SCM
scm_makfrom0str (const char *src)
{
if (!src) return SCM_BOOL_F;
return scm_makfromstr (src, (scm_sizet) strlen (src), 0);
return scm_makfromstr (src, (size_t) strlen (src), 0);
}
@ -218,7 +218,7 @@ scm_makfrom0str_opt (const char *src)
SCM
scm_allocate_string (scm_sizet len)
scm_allocate_string (size_t len)
#define FUNC_NAME "scm_allocate_string"
{
char *mem;
@ -248,7 +248,7 @@ SCM_DEFINE (scm_make_string, "make-string", 1, 1, 0,
{
if (SCM_INUMP (k))
{
long int i = SCM_INUM (k);
scm_bits_t i = SCM_INUM (k);
SCM res;
SCM_ASSERT_RANGE (1, k, i >= 0);
@ -290,7 +290,7 @@ SCM_DEFINE (scm_string_ref, "string-ref", 2, 0, 0,
"indexing. @var{k} must be a valid index of @var{str}.")
#define FUNC_NAME s_scm_string_ref
{
int idx;
scm_bits_t idx;
SCM_VALIDATE_STRING (1, str);
SCM_VALIDATE_INUM_COPY (2, k, idx);
@ -330,8 +330,8 @@ SCM_DEFINE (scm_substring, "substring", 2, 1, 0,
"0 <= @var{start} <= @var{end} <= (string-length @var{str}).")
#define FUNC_NAME s_scm_substring
{
long int from;
long int to;
scm_bits_t from;
scm_bits_t to;
SCM_VALIDATE_STRING (1, str);
SCM_VALIDATE_INUM (2, start);
@ -342,7 +342,7 @@ SCM_DEFINE (scm_substring, "substring", 2, 1, 0,
to = SCM_INUM (end);
SCM_ASSERT_RANGE (3, end, from <= to && to <= SCM_STRING_LENGTH (str));
return scm_makfromstr (&SCM_STRING_CHARS (str)[from], (scm_sizet) (to - from), 0);
return scm_makfromstr (&SCM_STRING_CHARS (str)[from], (size_t) (to - from), 0);
}
#undef FUNC_NAME
@ -354,7 +354,7 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
#define FUNC_NAME s_scm_string_append
{
SCM res;
register long i = 0;
size_t i = 0;
register SCM l, s;
register unsigned char *data;
@ -393,8 +393,8 @@ SCM_DEFINE (scm_make_shared_substring, "make-shared-substring", 1, 2, 0,
"occupies the same storage space as @var{str}.")
#define FUNC_NAME s_scm_make_shared_substring
{
long f;
long t;
scm_bits_t f;
scm_bits_t t;
SCM answer;
SCM len_str;
@ -411,7 +411,7 @@ SCM_DEFINE (scm_make_shared_substring, "make-shared-substring", 1, 2, 0,
SCM_DEFER_INTS;
if (SCM_SUBSTRP (str))
{
long offset;
scm_bits_t offset;
offset = SCM_INUM (SCM_SUBSTR_OFFSET (str));
f += offset;
t += offset;

10
libguile/strings.h
View file

@ -58,7 +58,7 @@
#endif
#define SCM_SET_STRING_CHARS(s, c) (SCM_SET_CELL_WORD_1 ((s), (c)))
#define SCM_STRING_MAX_LENGTH ((1L << 24) - 1)
#define SCM_STRING_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8)
#define SCM_STRING_LENGTH(x) (((size_t) SCM_CELL_WORD_0 (x)) >> 8)
#define SCM_SET_STRING_LENGTH(s, l) (SCM_SET_CELL_WORD_0 ((s), ((l) << 8) + scm_tc7_string))
#define SCM_STRING_COERCE_0TERMINATION_X(x) \
@ -71,12 +71,12 @@ extern SCM scm_string_p (SCM x);
extern SCM scm_read_only_string_p (SCM x);
extern SCM scm_string (SCM chrs);
extern SCM scm_makfromstrs (int argc, char **argv);
extern SCM scm_take_str (char *s, int len);
extern SCM scm_take_str (char *s, size_t len);
extern SCM scm_take0str (char *s);
extern SCM scm_makfromstr (const char *src, scm_sizet len, int);
extern SCM scm_makfromstr (const char *src, size_t len, int);
extern SCM scm_makfrom0str (const char *src);
extern SCM scm_makfrom0str_opt (const char *src);
extern SCM scm_allocate_string (scm_sizet len);
extern SCM scm_allocate_string (size_t len);
extern SCM scm_make_string (SCM k, SCM chr);
extern SCM scm_string_length (SCM str);
extern SCM scm_string_ref (SCM str, SCM k);
@ -100,7 +100,7 @@ extern void scm_init_strings (void);
? (char *) SCM_CELL_WORD_1 (SCM_CDDR (x)) + SCM_INUM (SCM_CADR (x)) \
: (char *) SCM_CELL_WORD_1 (x))
extern SCM scm_make_shared_substring (SCM str, SCM frm, SCM to);
extern SCM scm_makstr (long len, int);
extern SCM scm_makstr (size_t len, int);
#endif /* SCM_DEBUG_DEPRECATED == 0 */

29
libguile/strop.c
View file

@ -48,14 +48,14 @@ xSCM_DEFINE (scm_i_index, "i-index", 2, 2, 0,
"@code{rindex} function, depending on the value of @var{direction}."
*/
/* implements index if direction > 0 otherwise rindex. */
static int
static scm_bits_t
scm_i_index (SCM *str, SCM chr, int direction, SCM sub_start,
SCM sub_end, const char *why)
{
unsigned char * p;
int x;
int lower;
int upper;
scm_bits_t x;
scm_bits_t lower;
scm_bits_t upper;
int ch;
SCM_ASSERT (SCM_STRINGP (*str), *str, SCM_ARG1, why);
@ -116,7 +116,7 @@ SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0,
"@end lisp")
#define FUNC_NAME s_scm_string_index
{
int pos;
scm_bits_t pos;
if (SCM_UNBNDP (frm))
frm = SCM_BOOL_F;
@ -146,7 +146,7 @@ SCM_DEFINE (scm_string_rindex, "string-rindex", 2, 2, 0,
"@end lisp")
#define FUNC_NAME s_scm_string_rindex
{
int pos;
scm_bits_t pos;
if (SCM_UNBNDP (frm))
frm = SCM_BOOL_F;
@ -238,7 +238,7 @@ SCM_DEFINE (scm_substring_move_x, "substring-move!", 5, 0, 0,
"are different strings, it does not matter which function you use.")
#define FUNC_NAME s_scm_substring_move_x
{
long s1, s2, e, len;
scm_bits_t s1, s2, e, len;
SCM_VALIDATE_STRING (1,str1);
SCM_VALIDATE_INUM_COPY (2,start1,s1);
@ -274,7 +274,7 @@ SCM_DEFINE (scm_substring_fill_x, "substring-fill!", 4, 0, 0,
"@end lisp")
#define FUNC_NAME s_scm_substring_fill_x
{
long i, e;
scm_bits_t i, e;
char c;
SCM_VALIDATE_STRING (1,str);
SCM_VALIDATE_INUM_COPY (2,start,i);
@ -313,7 +313,7 @@ SCM_DEFINE (scm_string_to_list, "string->list", 1, 0, 0,
"concerned.")
#define FUNC_NAME s_scm_string_to_list
{
long i;
scm_bits_t i;
SCM res = SCM_EOL;
unsigned char *src;
SCM_VALIDATE_STRING (1,str);
@ -352,7 +352,7 @@ SCM_DEFINE (scm_string_fill_x, "string-fill!", 2, 0, 0,
#define FUNC_NAME s_scm_string_fill_x
{
register char *dst, c;
register long k;
register scm_bits_t k;
SCM_VALIDATE_STRING_COPY (1,str,dst);
SCM_VALIDATE_CHAR_COPY (2,chr,c);
for (k = SCM_STRING_LENGTH (str)-1;k >= 0;k--) dst[k] = c;
@ -366,7 +366,7 @@ SCM_DEFINE (scm_string_fill_x, "string-fill!", 2, 0, 0,
static SCM
string_upcase_x (SCM v)
{
unsigned long k;
scm_bits_t k;
for (k = 0; k < SCM_STRING_LENGTH (v); ++k)
SCM_STRING_UCHARS (v) [k] = scm_upcase (SCM_STRING_UCHARS (v) [k]);
@ -411,7 +411,7 @@ SCM_DEFINE (scm_string_upcase, "string-upcase", 1, 0, 0,
static SCM
string_downcase_x (SCM v)
{
unsigned long k;
scm_bits_t k;
for (k = 0; k < SCM_STRING_LENGTH (v); ++k)
SCM_STRING_UCHARS (v) [k] = scm_downcase (SCM_STRING_UCHARS (v) [k]);
@ -457,7 +457,8 @@ static SCM
string_capitalize_x (SCM str)
{
char *sz;
int i, len, in_word=0;
scm_bits_t i, len;
int in_word=0;
len = SCM_STRING_LENGTH(str);
sz = SCM_STRING_CHARS (str);
@ -531,7 +532,7 @@ SCM_DEFINE (scm_string_split, "string-split", 2, 0, 0,
"@end lisp")
#define FUNC_NAME s_scm_string_split
{
int idx, last_idx;
scm_bits_t idx, last_idx;
char * p;
int ch;
SCM res = SCM_EOL;

12
libguile/strorder.c
View file

@ -64,7 +64,7 @@ SCM_DEFINE1 (scm_string_equal_p, "string=?", scm_tc7_rpsubr,
"characters.")
#define FUNC_NAME s_scm_string_equal_p
{
scm_sizet length;
size_t length;
SCM_VALIDATE_STRING (1, s1);
SCM_VALIDATE_STRING (2, s2);
@ -74,7 +74,7 @@ SCM_DEFINE1 (scm_string_equal_p, "string=?", scm_tc7_rpsubr,
{
unsigned char *c1 = SCM_STRING_UCHARS (s1) + length - 1;
unsigned char *c2 = SCM_STRING_UCHARS (s2) + length - 1;
scm_sizet i;
size_t i;
/* comparing from back to front typically finds mismatches faster */
for (i = 0; i != length; ++i, --c1, --c2)
@ -99,7 +99,7 @@ SCM_DEFINE1 (scm_string_ci_equal_p, "string-ci=?", scm_tc7_rpsubr,
"return @code{#f}.")
#define FUNC_NAME s_scm_string_ci_equal_p
{
scm_sizet length;
size_t length;
SCM_VALIDATE_STRING (1, s1);
SCM_VALIDATE_STRING (2, s2);
@ -109,7 +109,7 @@ SCM_DEFINE1 (scm_string_ci_equal_p, "string-ci=?", scm_tc7_rpsubr,
{
unsigned char *c1 = SCM_STRING_UCHARS (s1) + length - 1;
unsigned char *c2 = SCM_STRING_UCHARS (s2) + length - 1;
scm_sizet i;
size_t i;
/* comparing from back to front typically finds mismatches faster */
for (i = 0; i != length; ++i, --c1, --c2)
@ -131,7 +131,7 @@ SCM_DEFINE1 (scm_string_ci_equal_p, "string-ci=?", scm_tc7_rpsubr,
static SCM
string_less_p (SCM s1, SCM s2)
{
scm_sizet i, length1, length2, lengthm;
size_t i, length1, length2, lengthm;
unsigned char *c1, *c2;
length1 = SCM_STRING_LENGTH (s1);
@ -211,7 +211,7 @@ SCM_DEFINE1 (scm_string_geq_p, "string>=?", scm_tc7_rpsubr,
static SCM
string_ci_less_p (SCM s1, SCM s2)
{
scm_sizet i, length1, length2, lengthm;
size_t i, length1, length2, lengthm;
unsigned char *c1, *c2;
length1 = SCM_STRING_LENGTH (s1);

26
libguile/strports.c
View file

@ -86,7 +86,7 @@ scm_bits_t scm_tc16_strport;
static int
stfill_buffer (SCM port)
{
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_port_t *pt = SCM_PTAB_ENTRY (port);
if (pt->read_pos >= pt->read_end)
return EOF;
@ -97,13 +97,13 @@ stfill_buffer (SCM port)
/* change the size of a port's string to new_size. this doesn't
change read_buf_size. */
static void
st_resize_port (scm_port *pt, off_t new_size)
st_resize_port (scm_port_t *pt, off_t new_size)
{
SCM old_stream = SCM_PACK (pt->stream);
SCM new_stream = scm_allocate_string (new_size);
unsigned long int old_size = SCM_STRING_LENGTH (old_stream);
unsigned long int min_size = min (old_size, new_size);
unsigned long int i;
size_t old_size = SCM_STRING_LENGTH (old_stream);
size_t min_size = min (old_size, new_size);
size_t i;
off_t index = pt->write_pos - pt->write_buf;
@ -130,7 +130,7 @@ st_resize_port (scm_port *pt, off_t new_size)
static void
st_flush (SCM port)
{
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_port_t *pt = SCM_PTAB_ENTRY (port);
if (pt->write_pos == pt->write_end)
{
@ -148,7 +148,7 @@ st_flush (SCM port)
static void
st_write (SCM port, const void *data, size_t size)
{
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_port_t *pt = SCM_PTAB_ENTRY (port);
const char *input = (char *) data;
while (size > 0)
@ -168,7 +168,7 @@ st_write (SCM port, const void *data, size_t size)
static void
st_end_input (SCM port, int offset)
{
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_port_t *pt = SCM_PTAB_ENTRY (port);
if (pt->read_pos - pt->read_buf < offset)
scm_misc_error ("st_end_input", "negative position", SCM_EOL);
@ -180,7 +180,7 @@ st_end_input (SCM port, int offset)
static off_t
st_seek (SCM port, off_t offset, int whence)
{
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_port_t *pt = SCM_PTAB_ENTRY (port);
off_t target;
if (pt->rw_active == SCM_PORT_READ && offset == 0 && whence == SEEK_CUR)
@ -252,7 +252,7 @@ st_seek (SCM port, off_t offset, int whence)
static void
st_truncate (SCM port, off_t length)
{
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_port_t *pt = SCM_PTAB_ENTRY (port);
if (length > pt->write_buf_size)
st_resize_port (pt, length);
@ -270,8 +270,8 @@ SCM
scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
{
SCM z;
scm_port *pt;
int str_len;
scm_port_t *pt;
size_t str_len;
SCM_ASSERT (SCM_INUMP(pos) && SCM_INUM(pos) >= 0, pos, SCM_ARG1, caller);
SCM_ASSERT (SCM_STRINGP (str), str, SCM_ARG1, caller);
@ -304,7 +304,7 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
/* create a new string from a string port's buffer. */
SCM scm_strport_to_string (SCM port)
{
scm_port *pt = SCM_PTAB_ENTRY (port);
scm_port_t *pt = SCM_PTAB_ENTRY (port);
if (pt->rw_active == SCM_PORT_WRITE)
st_flush (port);

14
libguile/struct.c
View file

@ -84,7 +84,7 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
{ /* scope */
char * field_desc;
scm_sizet len;
size_t len;
int x;
len = SCM_STRING_LENGTH (fields);
@ -331,20 +331,20 @@ scm_alloc_struct (int n_words, int n_extra, char *who)
return p;
}
scm_sizet
size_t
scm_struct_free_0 (scm_bits_t * vtable, scm_bits_t * data)
{
return 0;
}
scm_sizet
size_t
scm_struct_free_light (scm_bits_t * vtable, scm_bits_t * data)
{
scm_must_free (data);
return vtable [scm_struct_i_size] & ~SCM_STRUCTF_MASK;
}
scm_sizet
size_t
scm_struct_free_standard (scm_bits_t * vtable, scm_bits_t * data)
{
size_t n = (data[scm_struct_i_n_words] + scm_struct_n_extra_words)
@ -353,7 +353,7 @@ scm_struct_free_standard (scm_bits_t * vtable, scm_bits_t * data)
return n;
}
scm_sizet
size_t
scm_struct_free_entity (scm_bits_t * vtable, scm_bits_t * data)
{
size_t n = (data[scm_struct_i_n_words] + scm_struct_entity_n_extra_words)
@ -736,8 +736,8 @@ SCM_DEFINE (scm_struct_vtable_tag, "struct-vtable-tag", 1, 0, 0,
* how to associate names with vtables.
*/
unsigned int
scm_struct_ihashq (SCM obj, unsigned int n)
scm_bits_t
scm_struct_ihashq (SCM obj, scm_bits_t n)
{
/* The length of the hash table should be a relative prime it's not
necessary to shift down the address. */

12
libguile/struct.h
View file

@ -70,7 +70,7 @@
#define scm_vtable_index_printer 3 /* A printer for this struct type. */
#define scm_vtable_offset_user 4 /* Where do user fields start? */
typedef scm_sizet (*scm_struct_free_t) (scm_bits_t * vtable, scm_bits_t * data);
typedef size_t (*scm_struct_free_t) (scm_bits_t * vtable, scm_bits_t * data);
#define SCM_STRUCTF_MASK (0xFFF << 20)
#define SCM_STRUCTF_ENTITY (1L << 30) /* Indicates presence of proc slots */
@ -106,10 +106,10 @@ extern SCM scm_structs_to_free;
extern scm_bits_t * scm_alloc_struct (int n_words, int n_extra, char * who);
extern scm_sizet scm_struct_free_0 (scm_bits_t * vtable, scm_bits_t * data);
extern scm_sizet scm_struct_free_light (scm_bits_t * vtable, scm_bits_t * data);
extern scm_sizet scm_struct_free_standard (scm_bits_t * vtable, scm_bits_t * data);
extern scm_sizet scm_struct_free_entity (scm_bits_t * vtable, scm_bits_t * data);
extern size_t scm_struct_free_0 (scm_bits_t * vtable, scm_bits_t * data);
extern size_t scm_struct_free_light (scm_bits_t * vtable, scm_bits_t * data);
extern size_t scm_struct_free_standard (scm_bits_t * vtable, scm_bits_t * data);
extern size_t scm_struct_free_entity (scm_bits_t * vtable, scm_bits_t * data);
extern SCM scm_make_struct_layout (SCM fields);
extern SCM scm_struct_p (SCM x);
extern SCM scm_struct_vtable_p (SCM x);
@ -119,7 +119,7 @@ extern SCM scm_struct_ref (SCM handle, SCM pos);
extern SCM scm_struct_set_x (SCM handle, SCM pos, SCM val);
extern SCM scm_struct_vtable (SCM handle);
extern SCM scm_struct_vtable_tag (SCM handle);
extern unsigned int scm_struct_ihashq (SCM obj, unsigned int n);
extern scm_bits_t scm_struct_ihashq (SCM obj, scm_bits_t n);
extern SCM scm_struct_create_handle (SCM obj);
extern SCM scm_struct_vtable_name (SCM vtable);
extern SCM scm_set_struct_vtable_name_x (SCM vtable, SCM name);

16
libguile/symbols-deprecated.c
View file

@ -78,7 +78,7 @@ SCM
scm_sym2ovcell_soft (SCM sym, SCM obarray)
{
SCM lsym, z;
scm_sizet hash = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (obarray);
size_t hash = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (obarray);
scm_c_issue_deprecation_warning ("`scm_sym2ovcell_soft' is deprecated. "
"Use hashtables instead.");
@ -139,11 +139,11 @@ scm_sym2ovcell (SCM sym, SCM obarray)
SCM
scm_intern_obarray_soft (const char *name,scm_sizet len,SCM obarray,unsigned int softness)
scm_intern_obarray_soft (const char *name,size_t len,SCM obarray,unsigned int softness)
{
SCM symbol = scm_mem2symbol (name, len);
scm_sizet raw_hash = SCM_SYMBOL_HASH (symbol);
scm_sizet hash;
size_t raw_hash = SCM_SYMBOL_HASH (symbol);
size_t hash;
SCM lsym;
scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. "
@ -184,7 +184,7 @@ scm_intern_obarray_soft (const char *name,scm_sizet len,SCM obarray,unsigned int
SCM
scm_intern_obarray (const char *name,scm_sizet len,SCM obarray)
scm_intern_obarray (const char *name,size_t len,SCM obarray)
{
scm_c_issue_deprecation_warning ("`scm_intern_obarray' is deprecated. "
"Use hashtables instead.");
@ -194,7 +194,7 @@ scm_intern_obarray (const char *name,scm_sizet len,SCM obarray)
SCM
scm_intern (const char *name,scm_sizet len)
scm_intern (const char *name,size_t len)
{
scm_c_issue_deprecation_warning ("`scm_intern' is deprecated. "
"Use scm_c_define or scm_c_lookup instead.");
@ -328,7 +328,7 @@ SCM_DEFINE (scm_intern_symbol, "intern-symbol", 2, 0, 0,
"with this name is already present.")
#define FUNC_NAME s_scm_intern_symbol
{
scm_sizet hval;
size_t hval;
SCM_VALIDATE_SYMBOL (2,s);
if (SCM_FALSEP (o))
return SCM_UNSPECIFIED;
@ -369,7 +369,7 @@ SCM_DEFINE (scm_unintern_symbol, "unintern-symbol", 2, 0, 0,
"otherwise.")
#define FUNC_NAME s_scm_unintern_symbol
{
scm_sizet hval;
size_t hval;
scm_c_issue_deprecation_warning ("`unintern-symbol' is deprecated. "
"Use hashtables instead.");

10
libguile/symbols.c
View file

@ -87,10 +87,10 @@ SCM_DEFINE (scm_sys_symbols, "%symbols", 0, 0, 0,
SCM
scm_mem2symbol (const char *name, scm_sizet len)
scm_mem2symbol (const char *name, size_t len)
{
scm_sizet raw_hash = scm_string_hash ((const unsigned char *) name, len);
scm_sizet hash = raw_hash % SCM_VECTOR_LENGTH (symbols);
size_t raw_hash = scm_string_hash ((const unsigned char *) name, len);
size_t hash = raw_hash % SCM_VECTOR_LENGTH (symbols);
{
/* Try to find the symbol in the symbols table */
@ -104,7 +104,7 @@ scm_mem2symbol (const char *name, scm_sizet len)
&& SCM_SYMBOL_LENGTH (sym) == len)
{
char *chrs = SCM_SYMBOL_CHARS (sym);
scm_sizet i = len;
size_t i = len;
while (i != 0)
{
@ -236,7 +236,7 @@ SCM_DEFINE (scm_gensym, "gensym", 0, 1, 0,
{
char buf[MAX_PREFIX_LENGTH + SCM_INTBUFLEN];
char *name = buf;
int len;
size_t len;
if (SCM_UNBNDP (prefix))
{
name[0] = 'g';

14
libguile/symbols.h
View file

@ -55,11 +55,11 @@
*/
#define SCM_SYMBOLP(x) (SCM_NIMP (x) && (SCM_TYP7 (x) == scm_tc7_symbol))
#define SCM_SYMBOL_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8)
#define SCM_SYMBOL_LENGTH(x) (((scm_ubits_t) SCM_CELL_WORD_0 (x)) >> 8)
#define SCM_SET_SYMBOL_LENGTH(s, l) (SCM_SET_CELL_WORD_0 ((s), ((l) << 8) + scm_tc7_symbol))
#define SCM_SYMBOL_CHARS(x) ((char *) (SCM_CELL_WORD_1 (x)))
#define SCM_SET_SYMBOL_CHARS(s, c) (SCM_SET_CELL_WORD_1 ((s), (c)))
#define SCM_SYMBOL_HASH(X) ((unsigned long) SCM_CELL_WORD_2 (X))
#define SCM_SYMBOL_HASH(X) ((scm_ubits_t) SCM_CELL_WORD_2 (X))
#define SCM_SET_SYMBOL_HASH(X, v) (SCM_SET_CELL_WORD_2 ((X), (v)))
#define SCM_PROP_SLOTS(X) (SCM_CELL_WORD_3 (X))
@ -74,7 +74,7 @@
#ifdef GUILE_DEBUG
extern SCM scm_sys_symbols (void);
#endif
extern SCM scm_mem2symbol (const char*, scm_sizet);
extern SCM scm_mem2symbol (const char*, size_t);
extern SCM scm_str2symbol (const char*);
extern SCM scm_symbol_p (SCM x);
@ -103,7 +103,7 @@ extern void scm_init_symbols (void);
#define SCM_SUBSTR_STR(x) (SCM_CDDR (x))
#define SCM_SUBSTR_OFFSET(x) (SCM_CADR (x))
#define SCM_LENGTH_MAX (0xffffffL)
#define SCM_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8)
#define SCM_LENGTH(x) (((scm_ubits_t) SCM_CELL_WORD_0 (x)) >> 8)
#define SCM_SETLENGTH(x, v, t) (SCM_SET_CELL_WORD_0 ((x), ((v) << 8) + (t)))
#define SCM_ROSTRINGP(x) (SCM_NIMP(x) && ((SCM_TYP7S(x)==scm_tc7_string) \
|| (SCM_TYP7(x) == scm_tc7_symbol)))
@ -129,9 +129,9 @@ extern void scm_init_symbols (void);
extern SCM scm_sym2vcell (SCM sym, SCM thunk, SCM definep);
extern SCM scm_sym2ovcell_soft (SCM sym, SCM obarray);
extern SCM scm_sym2ovcell (SCM sym, SCM obarray);
extern SCM scm_intern_obarray_soft (const char *name, scm_sizet len, SCM obarray, unsigned int softness);
extern SCM scm_intern_obarray (const char *name, scm_sizet len, SCM obarray);
extern SCM scm_intern (const char *name, scm_sizet len);
extern SCM scm_intern_obarray_soft (const char *name, size_t len, SCM obarray, unsigned int softness);
extern SCM scm_intern_obarray (const char *name, size_t len, SCM obarray);
extern SCM scm_intern (const char *name, size_t len);
extern SCM scm_intern0 (const char *name);
extern SCM scm_sysintern (const char *name, SCM val);
extern SCM scm_sysintern0 (const char *name);

Some files were not shown because too many files have changed in this diff Show more