diff options
112 files changed, 2579 insertions, 1896 deletions
@@ -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. @@ -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: @@ -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 diff --git a/acconfig.h b/acconfig.h index 1d28d2eac..35c37f95f 100644 --- a/acconfig.h +++ b/acconfig.h @@ -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 diff --git a/configure.in b/configure.in index 8eebe814e..89257b497 100644 --- a/configure.in +++ b/configure.in @@ -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 diff --git a/doc/scheme-data.texi b/doc/scheme-data.texi index 7f283f446..03d7043fc 100755 --- a/doc/scheme-data.texi +++ b/doc/scheme-data.texi @@ -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. diff --git a/guile-readline/ChangeLog b/guile-readline/ChangeLog index 5adbb6e54..00119b8bf 100644 --- a/guile-readline/ChangeLog +++ b/guile-readline/ChangeLog @@ -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 diff --git a/guile-readline/readline.c b/guile-readline/readline.c index 35c332fd6..04a797ba0 100644 --- a/guile-readline/readline.c +++ b/guile-readline/readline.c @@ -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; diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 54089721f..ba567ae01 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -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 diff --git a/libguile/Makefile.am b/libguile/Makefile.am index b123255d0..5a8cc58e1 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -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) diff --git a/libguile/__scm.h b/libguile/__scm.h index 9e0fea279..753684edc 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -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" diff --git a/libguile/backtrace.c b/libguile/backtrace.c index 95fb71cd0..b4636a160 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -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; diff --git a/libguile/continuations.c b/libguile/continuations.c index 28985e060..81bbe65bd 100644 --- a/libguile/continuations.c +++ b/libguile/continuations.c @@ -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 */ diff --git a/libguile/continuations.h b/libguile/continuations.h index 85029fb23..0d31225c9 100644 --- a/libguile/continuations.h +++ b/libguile/continuations.h @@ -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)\ diff --git a/libguile/coop-threads.c b/libguile/coop-threads.c index e76f9179c..a003d5b41 100644 --- a/libguile/coop-threads.c +++ b/libguile/coop-threads.c @@ -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, diff --git a/libguile/debug.c b/libguile/debug.c index c5e7468db..efece65f7 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -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"); diff --git a/libguile/debug.h b/libguile/debug.h index ba143ace6..2ee0e777c 100644 --- a/libguile/debug.h +++ b/libguile/debug.h @@ -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 diff --git a/libguile/dynl.c b/libguile/dynl.c index e46866beb..c26dd2a15 100644 --- a/libguile/dynl.c +++ b/libguile/dynl.c @@ -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; diff --git a/libguile/dynwind.c b/libguile/dynwind.c index 54323a568..ef0a144ce 100644 --- a/libguile/dynwind.c +++ b/libguile/dynwind.c @@ -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; diff --git a/libguile/dynwind.h b/libguile/dynwind.h index a8e888b23..49823762c 100644 --- a/libguile/dynwind.h +++ b/libguile/dynwind.h @@ -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 diff --git a/libguile/environments.c b/libguile/environments.c index c7b9f2d85..6455cd9b1 100644 --- a/libguile/environments.c +++ b/libguile/environments.c @@ -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; diff --git a/libguile/environments.h b/libguile/environments.h index 04332d0a0..7382bdb62 100644 --- a/libguile/environments.h +++ b/libguile/environments.h @@ -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); }; diff --git a/libguile/error.c b/libguile/error.c index 88ba47c7d..b37db72a5 100644 --- a/libguile/error.c +++ b/libguile/error.c @@ -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) { diff --git a/libguile/eval.c b/libguile/eval.c index 335afd03b..17fbdc632 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -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]); diff --git a/libguile/eval.h b/libguile/eval.h index 2ce79fd5c..d34c723da 100644 --- a/libguile/eval.h +++ b/libguile/eval.h @@ -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)) diff --git a/libguile/extensions.c b/libguile/extensions.c index 3d4f7d8cd..0a5346009 100644 --- a/libguile/extensions.c +++ b/libguile/extensions.c @@ -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)) diff --git a/libguile/filesys.c b/libguile/filesys.c index e48d37764..8648d447a 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -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) diff --git a/libguile/fluids.c b/libguile/fluids.c index 0283467c8..aedb27ed8 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -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); diff --git a/libguile/fports.c b/libguile/fports.c index 4579d3eb7..68fba2b13 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -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); diff --git a/libguile/fports.h b/libguile/fports.h index 3d970d9a8..efdf81885 100644 --- a/libguile/fports.h +++ b/libguile/fports.h @@ -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)) diff --git a/libguile/gc.c b/libguile/gc.c index 657346d84..3aaab5c0e 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -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; diff --git a/libguile/gc.h b/libguile/gc.h index 331c15386..464d4df08 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -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); diff --git a/libguile/gdbint.c b/libguile/gdbint.c index 3a28549da..4965de4f2 100644 --- a/libguile/gdbint.c +++ b/libguile/gdbint.c @@ -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; diff --git a/libguile/gh.h b/libguile/gh.h index 834e4b775..ed3f2d386 100644 --- a/libguile/gh.h +++ b/libguile/gh.h @@ -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); diff --git a/libguile/gh_data.c b/libguile/gh_data.c index 368b223f5..5dbf21da9 100644 --- a/libguile/gh_data.c +++ b/libguile/gh_data.c @@ -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 diff --git a/libguile/gh_list.c b/libguile/gh_list.c index 7bdd9440d..c52af4223 100644 --- a/libguile/gh_list.c +++ b/libguile/gh_list.c @@ -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)); } diff --git a/libguile/goops.c b/libguile/goops.c index 1b9b6e57d..dc6d3a8f0 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -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); diff --git a/libguile/goops.h b/libguile/goops.h index 9867096af..60b331cbb 100644 --- a/libguile/goops.h +++ b/libguile/goops.h @@ -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); diff --git a/libguile/gsubr.c b/libguile/gsubr.c index 6989080bb..090b1e928 100644 --- a/libguile/gsubr.c +++ b/libguile/gsubr.c @@ -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 diff --git a/libguile/gsubr.h b/libguile/gsubr.h index 108243374..fbf546203 100644 --- a/libguile/gsubr.h +++ b/libguile/gsubr.h @@ -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)) diff --git a/libguile/guardians.c b/libguile/guardians.c index f7eac2817..c41f048bd 100644 --- a/libguile/guardians.c +++ b/libguile/guardians.c @@ -175,7 +175,7 @@ guardian_mark (SCM ptr) } -static scm_sizet +static size_t guardian_free (SCM ptr) { scm_must_free (GUARDIAN (ptr)); diff --git a/libguile/hash.c b/libguile/hash.c index 4bc40d291..5a7244569 100644 --- a/libguile/hash.c +++ b/libguile/hash.c @@ -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, diff --git a/libguile/hash.h b/libguile/hash.h index 0b2ba1037..95bd8581f 100644 --- a/libguile/hash.h +++ b/libguile/hash.h @@ -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); diff --git a/libguile/hashtab.c b/libguile/hashtab.c index 50eac4ce8..ef91c7aca 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -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) { diff --git a/libguile/hashtab.h b/libguile/hashtab.h index ff79cc701..1bd2a1483 100644 --- a/libguile/hashtab.h +++ b/libguile/hashtab.h @@ -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); diff --git a/libguile/hooks.c b/libguile/hooks.c index 9834474aa..9d7cf5b00 100644 --- a/libguile/hooks.c +++ b/libguile/hooks.c @@ -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); diff --git a/libguile/init.c b/libguile/init.c index 2001e7910..0cb54f3ad 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -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) diff --git a/libguile/ioext.c b/libguile/ioext.c index 2c1ed4a46..c142d2981 100644 --- a/libguile/ioext.c +++ b/libguile/ioext.c @@ -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; diff --git a/libguile/list.c b/libguile/list.c index 956a4aa85..6bc0371be 100644 --- a/libguile/list.c +++ b/libguile/list.c @@ -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; diff --git a/libguile/list.h b/libguile/list.h index 4493816ee..70a2eca3a 100644 --- a/libguile/list.h +++ b/libguile/list.h @@ -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); diff --git a/libguile/load.c b/libguile/load.c index acc75e46f..b17224600 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -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), diff --git a/libguile/mallocs.c b/libguile/mallocs.c index 1874f3bde..3ce7d2f90 100644 --- a/libguile/mallocs.c +++ b/libguile/mallocs.c @@ -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) diff --git a/libguile/mallocs.h b/libguile/mallocs.h index e6a393891..f60622d8f 100644 --- a/libguile/mallocs.h +++ b/libguile/mallocs.h @@ -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 */ diff --git a/libguile/modules.c b/libguile/modules.c index fb466d511..fb2d456e9 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -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; diff --git a/libguile/net_db.c b/libguile/net_db.c index a2660e2d8..4f5e64ed8 100644 --- a/libguile/net_db.c +++ b/libguile/net_db.c @@ -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; } diff --git a/libguile/num2integral.i.c b/libguile/num2integral.i.c new file mode 100644 index 000000000..3e5d65389 --- /dev/null +++ b/libguile/num2integral.i.c @@ -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: +*/ diff --git a/libguile/numbers.c b/libguile/numbers.c index 26da3e4ad..261248b62 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -54,10 +54,11 @@ #include "libguile/validate.h" #include "libguile/numbers.h" +#include "libguile/deprecation.h" -static SCM scm_divbigbig (SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn, int modes); +static SCM scm_divbigbig (SCM_BIGDIG *x, size_t nx, SCM_BIGDIG *y, size_t ny, int sgn, int modes); static SCM scm_divbigint (SCM x, long z, int sgn, int mode); @@ -161,7 +162,7 @@ scm_abs (SCM x) return SCM_MAKINUM (-xx); } else { #ifdef SCM_BIGDIG - return scm_long2big (-xx); + return scm_i_long2big (-xx); #else scm_num_overflow (s_abs); #endif @@ -170,7 +171,7 @@ scm_abs (SCM x) if (!SCM_BIGSIGN (x)) { return x; } else { - return scm_copybig (x, 0); + return scm_i_copybig (x, 0); } } else if (SCM_REALP (x)) { return scm_make_real (fabs (SCM_REAL_VALUE (x))); @@ -198,7 +199,7 @@ scm_quotient (SCM x, SCM y) return SCM_MAKINUM (z); } else { #ifdef SCM_BIGDIG - return scm_long2big (z); + return scm_i_long2big (z); #else scm_num_overflow (s_quotient); #endif @@ -227,9 +228,9 @@ scm_quotient (SCM x, SCM y) long z = yy < 0 ? -yy : yy; if (z < SCM_BIGRAD) { - SCM sw = scm_copybig (x, SCM_BIGSIGN (x) ? (yy > 0) : (yy < 0)); + SCM sw = scm_i_copybig (x, SCM_BIGSIGN (x) ? (yy > 0) : (yy < 0)); scm_divbigdig (SCM_BDIGITS (sw), SCM_NUMDIGS (sw), (SCM_BIGDIG) z); - return scm_normbig (sw); + return scm_i_normbig (sw); } else { #ifndef SCM_DIGSTOOBIG long w = scm_pseudolong (z); @@ -421,7 +422,7 @@ scm_gcd (SCM x, SCM y) return SCM_MAKINUM (result); } else { #ifdef SCM_BIGDIG - return scm_long2big (result); + return scm_i_long2big (result); #else scm_num_overflow (s_gcd); #endif @@ -435,7 +436,7 @@ scm_gcd (SCM x, SCM y) } else if (SCM_BIGP (x)) { big_gcd: if (SCM_BIGSIGN (x)) - x = scm_copybig (x, 0); + x = scm_i_copybig (x, 0); newy: if (SCM_INUMP (y)) { if (SCM_EQ_P (y, SCM_INUM0)) { @@ -445,7 +446,7 @@ scm_gcd (SCM x, SCM y) } } else if (SCM_BIGP (y)) { if (SCM_BIGSIGN (y)) - y = scm_copybig (y, 0); + y = scm_i_copybig (y, 0); switch (scm_bigcomp (x, y)) { case -1: /* x > y */ @@ -555,18 +556,18 @@ scm_lcm (SCM n1, SCM n2) #ifdef SCM_BIGDIG SCM scm_copy_big_dec(SCM b, int sign); -SCM scm_copy_smaller(SCM_BIGDIG *x, scm_sizet nx, int zsgn); -SCM scm_big_ior(SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy); -SCM scm_big_xor(SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy); -SCM scm_big_and(SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy, int zsgn); -SCM scm_big_test(SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy); +SCM scm_copy_smaller(SCM_BIGDIG *x, size_t nx, int zsgn); +SCM scm_big_ior(SCM_BIGDIG *x, size_t nx, int xsgn, SCM bigy); +SCM scm_big_xor(SCM_BIGDIG *x, size_t nx, int xsgn, SCM bigy); +SCM scm_big_and(SCM_BIGDIG *x, size_t nx, int xsgn, SCM bigy, int zsgn); +SCM scm_big_test(SCM_BIGDIG *x, size_t nx, int xsgn, SCM bigy); SCM scm_copy_big_dec(SCM b, int sign) { long num = -1; - scm_sizet nx = SCM_NUMDIGS(b); - scm_sizet i = 0; - SCM ans = scm_mkbig(nx, sign); + size_t nx = SCM_NUMDIGS(b); + size_t i = 0; + SCM ans = scm_i_mkbig(nx, sign); SCM_BIGDIG *src = SCM_BDIGITS(b), *dst = SCM_BDIGITS(ans); if SCM_BIGSIGN(b) do { num += src[i]; @@ -578,11 +579,11 @@ SCM scm_copy_big_dec(SCM b, int sign) return ans; } -SCM scm_copy_smaller(SCM_BIGDIG *x, scm_sizet nx, int zsgn) +SCM scm_copy_smaller(SCM_BIGDIG *x, size_t nx, int zsgn) { long num = -1; - scm_sizet i = 0; - SCM z = scm_mkbig(nx, zsgn); + size_t i = 0; + SCM z = scm_i_mkbig(nx, zsgn); SCM_BIGDIG *zds = SCM_BDIGITS(z); if (zsgn) do { num += x[i]; @@ -593,12 +594,12 @@ SCM scm_copy_smaller(SCM_BIGDIG *x, scm_sizet nx, int zsgn) return z; } -SCM scm_big_ior(SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy) +SCM scm_big_ior(SCM_BIGDIG *x, size_t nx, int xsgn, SCM bigy) /* Assumes nx <= SCM_NUMDIGS(bigy) */ /* Assumes xsgn equals either 0 or SCM_BIGSIGNFLAG */ { long num = -1; - scm_sizet i = 0, ny = SCM_NUMDIGS(bigy); + size_t i = 0, ny = SCM_NUMDIGS(bigy); SCM z = scm_copy_big_dec (bigy, xsgn & SCM_BIGSIGN (bigy)); SCM_BIGDIG *zds = SCM_BDIGITS(z); if (xsgn) { @@ -615,7 +616,7 @@ SCM scm_big_ior(SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy) num = SCM_BIGDN(num); if (!num) return z; } - scm_adjbig(z, 1 + ny); /* OOPS, overflowed into next digit. */ + scm_i_adjbig(z, 1 + ny); /* OOPS, overflowed into next digit. */ SCM_BDIGITS(z)[ny] = 1; return z; } @@ -623,12 +624,12 @@ SCM scm_big_ior(SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy) return z; } -SCM scm_big_xor(SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy) +SCM scm_big_xor(SCM_BIGDIG *x, size_t nx, int xsgn, SCM bigy) /* Assumes nx <= SCM_NUMDIGS(bigy) */ /* Assumes xsgn equals either 0 or SCM_BIGSIGNFLAG */ { long num = -1; - scm_sizet i = 0, ny = SCM_NUMDIGS(bigy); + size_t i = 0, ny = SCM_NUMDIGS(bigy); SCM z = scm_copy_big_dec(bigy, xsgn ^ SCM_BIGSIGN(bigy)); SCM_BIGDIG *zds = SCM_BDIGITS(z); if (xsgn) do { @@ -647,19 +648,19 @@ SCM scm_big_xor(SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy) num += zds[i]; zds[i++] = SCM_BIGLO(num); num = SCM_BIGDN(num); - if (!num) return scm_normbig(z); + if (!num) return scm_i_normbig(z); } } - return scm_normbig(z); + return scm_i_normbig(z); } -SCM scm_big_and(SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy, int zsgn) +SCM scm_big_and(SCM_BIGDIG *x, size_t nx, int xsgn, SCM bigy, int zsgn) /* Assumes nx <= SCM_NUMDIGS(bigy) */ /* Assumes xsgn equals either 0 or SCM_BIGSIGNFLAG */ /* return sign equals either 0 or SCM_BIGSIGNFLAG */ { long num = -1; - scm_sizet i = 0; + size_t i = 0; SCM z; SCM_BIGDIG *zds; if (xsgn==zsgn) { @@ -683,7 +684,7 @@ SCM scm_big_and(SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy, int zsgn) num += zds[i]; zds[i++] = SCM_BIGLO(num); num = SCM_BIGDN(num); - if (!num) return scm_normbig(z); + if (!num) return scm_i_normbig(z); } } else if (xsgn) { @@ -694,15 +695,15 @@ SCM scm_big_and(SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy, int zsgn) carry = (mask >= SCM_BIGRAD) ? 1 : 0; } while (++i < nx); } else do zds[i] = zds[i] & x[i]; while (++i < nx); - return scm_normbig(z); + return scm_i_normbig(z); } -SCM scm_big_test(SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy) +SCM scm_big_test(SCM_BIGDIG *x, size_t nx, int xsgn, SCM bigy) /* Assumes nx <= SCM_NUMDIGS(bigy) */ /* Assumes xsgn equals either 0 or SCM_BIGSIGNFLAG */ { SCM_BIGDIG *y; - scm_sizet i = 0; + size_t i = 0; long num = -1; if (SCM_BIGSIGN(bigy) & xsgn) return SCM_BOOL_T; if (SCM_NUMDIGS(bigy) != nx && xsgn) return SCM_BOOL_T; @@ -1062,9 +1063,9 @@ SCM_DEFINE (scm_logbit_p, "logbit?", 2, 0, 0, return SCM_BOOL_F; } else if (SCM_BIGSIGN (j)) { long num = -1; - scm_sizet i = 0; + size_t i = 0; SCM_BIGDIG * x = SCM_BDIGITS (j); - scm_sizet nx = iindex / SCM_BITSPERDIG; + size_t nx = iindex / SCM_BITSPERDIG; while (1) { num += x[i]; if (nx == i++) { @@ -1225,7 +1226,7 @@ SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0, long int in = SCM_INUM (n); unsigned long int bits = iend - istart; - if (in < 0 && bits >= SCM_FIXNUM_BIT) + if (in < 0 && bits >= SCM_I_FIXNUM_BIT) { /* Since we emulate two's complement encoded numbers, this special * case requires us to produce a result that has more bits than can be @@ -1235,10 +1236,10 @@ SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0, goto generalcase; } - if (istart < SCM_FIXNUM_BIT) + if (istart < SCM_I_FIXNUM_BIT) { in = in >> istart; - if (bits < SCM_FIXNUM_BIT) + if (bits < SCM_I_FIXNUM_BIT) return SCM_MAKINUM (in & ((1L << bits) - 1)); else /* we know: in >= 0 */ return SCM_MAKINUM (in); @@ -1304,7 +1305,7 @@ SCM_DEFINE (scm_logcount, "logcount", 1, 0, 0, return scm_logcount (scm_difference (SCM_MAKINUM (-1L), n)); } else { unsigned long int c = 0; - scm_sizet i = SCM_NUMDIGS (n); + size_t i = SCM_NUMDIGS (n); SCM_BIGDIG * ds = SCM_BDIGITS (n); while (i--) { SCM_BIGDIG d; @@ -1379,7 +1380,7 @@ SCM_DEFINE (scm_integer_length, "integer-length", 1, 0, 0, static const char s_bignum[] = "bignum"; SCM -scm_mkbig (scm_sizet nlen, int sign) +scm_i_mkbig (size_t nlen, int sign) { SCM v; /* Cast to long int to avoid signed/unsigned comparison warnings. */ @@ -1395,9 +1396,8 @@ scm_mkbig (scm_sizet nlen, int sign) return v; } - SCM -scm_big2inum (SCM b, scm_sizet l) +scm_i_big2inum (SCM b, size_t l) { unsigned long num = 0; SCM_BIGDIG *tmp = SCM_BDIGITS (b); @@ -1413,13 +1413,12 @@ scm_big2inum (SCM b, scm_sizet l) return b; } - -static const char s_adjbig[] = "scm_adjbig"; +static const char s_adjbig[] = "scm_i_adjbig"; SCM -scm_adjbig (SCM b, scm_sizet nlen) +scm_i_adjbig (SCM b, size_t nlen) { - scm_sizet nsiz = nlen; + size_t nsiz = nlen; if (((nsiz << SCM_BIGSIZEFIELD) >> SCM_BIGSIZEFIELD) != nlen) scm_memory_error (s_adjbig); @@ -1438,13 +1437,11 @@ scm_adjbig (SCM b, scm_sizet nlen) return b; } - - SCM -scm_normbig (SCM b) +scm_i_normbig (SCM b) { #ifndef _UNICOS - scm_sizet nlen = SCM_NUMDIGS (b); + size_t nlen = SCM_NUMDIGS (b); #else int nlen = SCM_NUMDIGS (b); /* unsigned nlen breaks on Cray when nlen => 0 */ #endif @@ -1452,137 +1449,30 @@ scm_normbig (SCM b) while (nlen-- && !zds[nlen]); nlen++; if (nlen * SCM_BITSPERDIG / SCM_CHAR_BIT <= sizeof (SCM)) - if (SCM_INUMP (b = scm_big2inum (b, (scm_sizet) nlen))) + if (SCM_INUMP (b = scm_i_big2inum (b, (size_t) nlen))) return b; if (SCM_NUMDIGS (b) == nlen) return b; - return scm_adjbig (b, (scm_sizet) nlen); + return scm_i_adjbig (b, (size_t) nlen); } - - SCM -scm_copybig (SCM b, int sign) +scm_i_copybig (SCM b, int sign) { - scm_sizet i = SCM_NUMDIGS (b); - SCM ans = scm_mkbig (i, sign); + size_t i = SCM_NUMDIGS (b); + SCM ans = scm_i_mkbig (i, sign); SCM_BIGDIG *src = SCM_BDIGITS (b), *dst = SCM_BDIGITS (ans); while (i--) dst[i] = src[i]; return ans; } - - -SCM -scm_long2big (long n) -{ - scm_sizet i = 0; - SCM_BIGDIG *digits; - SCM ans = scm_mkbig (SCM_DIGSPERLONG, n < 0); - digits = SCM_BDIGITS (ans); - if (n < 0) - n = -n; - while (i < SCM_DIGSPERLONG) - { - digits[i++] = SCM_BIGLO (n); - n = SCM_BIGDN ((unsigned long) n); - } - return ans; -} - -#ifdef HAVE_LONG_LONGS - -SCM -scm_long_long2big (long_long n) -{ - scm_sizet i; - SCM_BIGDIG *digits; - SCM ans; - int n_digits; - - { - long tn; - tn = (long) n; - if ((long long) tn == n) - return scm_long2big (tn); - } - - { - long_long tn; - - for (tn = n, n_digits = 0; - tn; - ++n_digits, tn = SCM_BIGDN ((ulong_long) tn)) - ; - } - - i = 0; - ans = scm_mkbig (n_digits, n < 0); - digits = SCM_BDIGITS (ans); - if (n < 0) - n = -n; - while (i < n_digits) - { - digits[i++] = SCM_BIGLO (n); - n = SCM_BIGDN ((ulong_long) n); - } - return ans; -} -#endif /* HAVE_LONG_LONGS */ - - -SCM -scm_2ulong2big (unsigned long *np) -{ - unsigned long n; - scm_sizet i; - SCM_BIGDIG *digits; - SCM ans; - - ans = scm_mkbig (2 * SCM_DIGSPERLONG, 0); - digits = SCM_BDIGITS (ans); - - n = np[0]; - for (i = 0; i < SCM_DIGSPERLONG; ++i) - { - digits[i] = SCM_BIGLO (n); - n = SCM_BIGDN ((unsigned long) n); - } - n = np[1]; - for (i = 0; i < SCM_DIGSPERLONG; ++i) - { - digits[i + SCM_DIGSPERLONG] = SCM_BIGLO (n); - n = SCM_BIGDN ((unsigned long) n); - } - return ans; -} - - - -SCM -scm_ulong2big (unsigned long n) -{ - scm_sizet i = 0; - SCM_BIGDIG *digits; - SCM ans = scm_mkbig (SCM_DIGSPERLONG, 0); - digits = SCM_BDIGITS (ans); - while (i < SCM_DIGSPERLONG) - { - digits[i++] = SCM_BIGLO (n); - n = SCM_BIGDN (n); - } - return ans; -} - - - int scm_bigcomp (SCM x, SCM y) { int xsign = SCM_BIGSIGN (x); int ysign = SCM_BIGSIGN (y); - scm_sizet xlen, ylen; + size_t xlen, ylen; /* Look at the signs, first. */ if (ysign < xsign) @@ -1627,7 +1517,7 @@ scm_pseudolong (long x) SCM_BIGDIG bd[SCM_DIGSPERLONG]; } p; - scm_sizet i = 0; + size_t i = 0; if (x < 0) x = -x; while (i < SCM_DIGSPERLONG) @@ -1645,7 +1535,7 @@ scm_pseudolong (long x) void scm_longdigs (long x, SCM_BIGDIG digs[]) { - scm_sizet i = 0; + size_t i = 0; if (x < 0) x = -x; while (i < SCM_DIGSPERLONG) @@ -1659,13 +1549,13 @@ scm_longdigs (long x, SCM_BIGDIG digs[]) SCM -scm_addbig (SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy, int sgny) +scm_addbig (SCM_BIGDIG *x, size_t nx, int xsgn, SCM bigy, int sgny) { /* Assumes nx <= SCM_NUMDIGS(bigy) */ /* Assumes xsgn and sgny scm_equal either 0 or SCM_BIGSIGNFLAG */ long num = 0; - scm_sizet i = 0, ny = SCM_NUMDIGS (bigy); - SCM z = scm_copybig (bigy, SCM_BIGSIGN (bigy) ^ sgny); + size_t i = 0, ny = SCM_NUMDIGS (bigy); + SCM z = scm_i_copybig (bigy, SCM_BIGSIGN (bigy) ^ sgny); SCM_BIGDIG *zds = SCM_BDIGITS (z); if (xsgn ^ SCM_BIGSIGN (z)) { @@ -1734,21 +1624,21 @@ scm_addbig (SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy, int sgny) } if (num) { - z = scm_adjbig (z, ny + 1); + z = scm_i_adjbig (z, ny + 1); SCM_BDIGITS (z)[ny] = num; return z; } } - return scm_normbig (z); + return scm_i_normbig (z); } SCM -scm_mulbig (SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn) +scm_mulbig (SCM_BIGDIG *x, size_t nx, SCM_BIGDIG *y, size_t ny, int sgn) { - scm_sizet i = 0, j = nx + ny; + size_t i = 0, j = nx + ny; unsigned long n = 0; - SCM z = scm_mkbig (j, sgn); + SCM z = scm_i_mkbig (j, sgn); SCM_BIGDIG *zds = SCM_BDIGITS (z); while (j--) zds[j] = 0; @@ -1772,12 +1662,12 @@ scm_mulbig (SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn) } } while (++i < nx); - return scm_normbig (z); + return scm_i_normbig (z); } unsigned int -scm_divbigdig (SCM_BIGDIG * ds, scm_sizet h, SCM_BIGDIG div) +scm_divbigdig (SCM_BIGDIG * ds, size_t h, SCM_BIGDIG div) { register unsigned long t2 = 0; while (h--) @@ -1800,7 +1690,7 @@ scm_divbigint (SCM x, long z, int sgn, int mode) { register unsigned long t2 = 0; register SCM_BIGDIG *ds = SCM_BDIGITS (x); - scm_sizet nd = SCM_NUMDIGS (x); + size_t nd = SCM_NUMDIGS (x); while (nd--) t2 = (SCM_BIGUP (t2) + ds[nd]) % z; if (mode && t2) @@ -1825,14 +1715,14 @@ scm_divbigint (SCM x, long z, int sgn, int mode) static SCM -scm_divbigbig (SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn, int modes) +scm_divbigbig (SCM_BIGDIG *x, size_t nx, SCM_BIGDIG *y, size_t ny, int sgn, int modes) { /* modes description 0 remainder 1 scm_modulo 2 quotient 3 quotient but returns SCM_UNDEFINED if division is not exact. */ - scm_sizet i = 0, j = 0; + size_t i = 0, j = 0; long num = 0; unsigned long t2 = 0; SCM z, newy; @@ -1842,7 +1732,7 @@ scm_divbigbig (SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn switch (modes) { case 0: /* remainder -- just return x */ - z = scm_mkbig (nx, sgn); + z = scm_i_mkbig (nx, sgn); zds = SCM_BDIGITS (z); do { @@ -1851,7 +1741,7 @@ scm_divbigbig (SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn while (++i < nx); return z; case 1: /* scm_modulo -- return y-x */ - z = scm_mkbig (ny, sgn); + z = scm_i_mkbig (ny, sgn); zds = SCM_BDIGITS (z); do { @@ -1889,7 +1779,7 @@ scm_divbigbig (SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn return SCM_UNDEFINED; /* the division is not exact */ } - z = scm_mkbig (nx == ny ? nx + 2 : nx + 1, sgn); + z = scm_i_mkbig (nx == ny ? nx + 2 : nx + 1, sgn); zds = SCM_BDIGITS (z); if (nx == ny) zds[nx + 1] = 0; @@ -1898,7 +1788,7 @@ scm_divbigbig (SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn if (y[ny - 1] < (SCM_BIGRAD >> 1)) { /* normalize operands */ d = SCM_BIGRAD / (y[ny - 1] + 1); - newy = scm_mkbig (ny, 0); + newy = scm_i_mkbig (ny, 0); yds = SCM_BDIGITS (newy); while (j < ny) { @@ -2012,9 +1902,9 @@ scm_divbigbig (SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn doadj: for (j = ny; j && !zds[j - 1]; --j); if (j * SCM_BITSPERDIG <= sizeof (SCM) * SCM_CHAR_BIT) - if (SCM_INUMP (z = scm_big2inum (z, j))) + if (SCM_INUMP (z = scm_i_big2inum (z, j))) return z; - return scm_adjbig (z, j); + return scm_i_adjbig (z, j); } #endif @@ -2033,11 +1923,11 @@ static const double fx[] = -static scm_sizet +static size_t idbl2str (double f, char *a) { int efmt, dpt, d, i, wp = scm_dblprec; - scm_sizet ch = 0; + size_t ch = 0; int exp = 0; if (f == 0.0) @@ -2173,10 +2063,10 @@ idbl2str (double f, char *a) } -static scm_sizet +static size_t iflo2str (SCM flt, char *str) { - scm_sizet i; + size_t i; if (SCM_SLOPPY_REALP (flt)) i = idbl2str (SCM_REAL_VALUE (flt), str); else @@ -2197,11 +2087,11 @@ iflo2str (SCM flt, char *str) characters in the result. rad is output base p is destination: worst case (base 2) is SCM_INTBUFLEN */ -scm_sizet +size_t scm_iint2str (long num, int rad, char *p) { - scm_sizet j = 1; - scm_sizet i; + size_t j = 1; + size_t i; unsigned long n = (num < 0) ? -num : num; for (n /= rad; n > 0; n /= rad) @@ -2232,14 +2122,14 @@ scm_iint2str (long num, int rad, char *p) static SCM big2str (SCM b, unsigned int radix) { - SCM t = scm_copybig (b, 0); /* sign of temp doesn't matter */ + SCM t = scm_i_copybig (b, 0); /* sign of temp doesn't matter */ register SCM_BIGDIG *ds = SCM_BDIGITS (t); - scm_sizet i = SCM_NUMDIGS (t); - scm_sizet j = radix == 16 ? (SCM_BITSPERDIG * i) / 4 + 2 + size_t i = SCM_NUMDIGS (t); + size_t j = radix == 16 ? (SCM_BITSPERDIG * i) / 4 + 2 : radix >= 10 ? (SCM_BITSPERDIG * i * 241L) / 800 + 2 : (SCM_BITSPERDIG * i) + 2; - scm_sizet k = 0; - scm_sizet radct = 0; + size_t k = 0; + size_t radct = 0; SCM_BIGDIG radpow = 1, radmod = 0; SCM ss = scm_allocate_string (j); char *s = SCM_STRING_CHARS (ss), c; @@ -2297,7 +2187,7 @@ SCM_DEFINE (scm_number_to_string, "number->string", 1, 1, 0, if (SCM_INUMP (n)) { char num_buf [SCM_INTBUFLEN]; - scm_sizet length = scm_iint2str (SCM_INUM (n), base, num_buf); + size_t length = scm_iint2str (SCM_INUM (n), base, num_buf); return scm_makfromstr (num_buf, length, 0); } else if (SCM_BIGP (n)) { return big2str (n, (unsigned int) base); @@ -2335,7 +2225,7 @@ scm_bigprint (SCM exp, SCM port, scm_print_state *pstate) { #ifdef SCM_BIGDIG exp = big2str (exp, (unsigned int) 10); - scm_lfwrite (SCM_STRING_CHARS (exp), (scm_sizet) SCM_STRING_LENGTH (exp), port); + scm_lfwrite (SCM_STRING_CHARS (exp), (size_t) SCM_STRING_LENGTH (exp), port); #else scm_ipruk ("bignum", exp, port); #endif @@ -2412,9 +2302,9 @@ scm_small_istr2int (char *str, long len, long radix) SCM scm_istr2int (char *str, long len, long radix) { - scm_sizet j; - register scm_sizet k, blen = 1; - scm_sizet i = 0; + size_t j; + register size_t k, blen = 1; + size_t i = 0; int c; SCM res; register SCM_BIGDIG *ds; @@ -2441,7 +2331,7 @@ scm_istr2int (char *str, long len, long radix) if (++i == (unsigned) len) return SCM_BOOL_F; /* bad if lone `+' or `-' */ } - res = scm_mkbig (j, '-' == str[0]); + res = scm_i_mkbig (j, '-' == str[0]); ds = SCM_BDIGITS (res); for (k = j; k--;) ds[k] = 0; @@ -2494,11 +2384,11 @@ scm_istr2int (char *str, long len, long radix) } while (i < (unsigned) len); if (blen * SCM_BITSPERDIG / SCM_CHAR_BIT <= sizeof (SCM)) - if (SCM_INUMP (res = scm_big2inum (res, blen))) + if (SCM_INUMP (res = scm_i_big2inum (res, blen))) return res; if (j == blen) return res; - return scm_adjbig (res, blen); + return scm_i_adjbig (res, blen); } SCM @@ -3047,9 +2937,9 @@ scm_num_eq_p (SCM x, SCM y) } else if (SCM_BIGP (y)) { return SCM_BOOL (0 == scm_bigcomp (x, y)); } else if (SCM_REALP (y)) { - return SCM_BOOL (scm_big2dbl (x) == SCM_REAL_VALUE (y)); + return SCM_BOOL (scm_i_big2dbl (x) == SCM_REAL_VALUE (y)); } else if (SCM_COMPLEXP (y)) { - return SCM_BOOL ((scm_big2dbl (x) == SCM_COMPLEX_REAL (y)) + return SCM_BOOL ((scm_i_big2dbl (x) == SCM_COMPLEX_REAL (y)) && (0.0 == SCM_COMPLEX_IMAG (y))); } else { SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p); @@ -3058,7 +2948,7 @@ scm_num_eq_p (SCM x, SCM y) if (SCM_INUMP (y)) { return SCM_BOOL (SCM_REAL_VALUE (x) == (double) SCM_INUM (y)); } else if (SCM_BIGP (y)) { - return SCM_BOOL (SCM_REAL_VALUE (x) == scm_big2dbl (y)); + return SCM_BOOL (SCM_REAL_VALUE (x) == scm_i_big2dbl (y)); } else if (SCM_REALP (y)) { return SCM_BOOL (SCM_REAL_VALUE (x) == SCM_REAL_VALUE (y)); } else if (SCM_COMPLEXP (y)) { @@ -3072,7 +2962,7 @@ scm_num_eq_p (SCM x, SCM y) return SCM_BOOL ((SCM_COMPLEX_REAL (x) == (double) SCM_INUM (y)) && (SCM_COMPLEX_IMAG (x) == 0.0)); } else if (SCM_BIGP (y)) { - return SCM_BOOL ((SCM_COMPLEX_REAL (x) == scm_big2dbl (y)) + return SCM_BOOL ((SCM_COMPLEX_REAL (x) == scm_i_big2dbl (y)) && (SCM_COMPLEX_IMAG (x) == 0.0)); } else if (SCM_REALP (y)) { return SCM_BOOL ((SCM_COMPLEX_REAL (x) == SCM_REAL_VALUE (y)) @@ -3114,7 +3004,7 @@ scm_less_p (SCM x, SCM y) } else if (SCM_BIGP (y)) { return SCM_BOOL (1 == scm_bigcomp (x, y)); } else if (SCM_REALP (y)) { - return SCM_BOOL (scm_big2dbl (x) < SCM_REAL_VALUE (y)); + return SCM_BOOL (scm_i_big2dbl (x) < SCM_REAL_VALUE (y)); } else { SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p); } @@ -3122,7 +3012,7 @@ scm_less_p (SCM x, SCM y) if (SCM_INUMP (y)) { return SCM_BOOL (SCM_REAL_VALUE (x) < (double) SCM_INUM (y)); } else if (SCM_BIGP (y)) { - return SCM_BOOL (SCM_REAL_VALUE (x) < scm_big2dbl (y)); + return SCM_BOOL (SCM_REAL_VALUE (x) < scm_i_big2dbl (y)); } else if (SCM_REALP (y)) { return SCM_BOOL (SCM_REAL_VALUE (x) < SCM_REAL_VALUE (y)); } else { @@ -3283,7 +3173,7 @@ scm_max (SCM x, SCM y) } else if (SCM_BIGP (y)) { return (1 == scm_bigcomp (x, y)) ? y : x; } else if (SCM_REALP (y)) { - double z = scm_big2dbl (x); + double z = scm_i_big2dbl (x); return (z <= SCM_REAL_VALUE (y)) ? y : scm_make_real (z); } else { SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max); @@ -3293,7 +3183,7 @@ scm_max (SCM x, SCM y) double z = SCM_INUM (y); return (SCM_REAL_VALUE (x) < z) ? scm_make_real (z) : x; } else if (SCM_BIGP (y)) { - double z = scm_big2dbl (y); + double z = scm_i_big2dbl (y); return (SCM_REAL_VALUE (x) < z) ? scm_make_real (z) : x; } else if (SCM_REALP (y)) { return (SCM_REAL_VALUE (x) < SCM_REAL_VALUE (y)) ? y : x; @@ -3341,7 +3231,7 @@ scm_min (SCM x, SCM y) } else if (SCM_BIGP (y)) { return (-1 == scm_bigcomp (x, y)) ? y : x; } else if (SCM_REALP (y)) { - double z = scm_big2dbl (x); + double z = scm_i_big2dbl (x); return (z < SCM_REAL_VALUE (y)) ? scm_make_real (z) : y; } else { SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min); @@ -3351,7 +3241,7 @@ scm_min (SCM x, SCM y) double z = SCM_INUM (y); return (SCM_REAL_VALUE (x) <= z) ? x : scm_make_real (z); } else if (SCM_BIGP (y)) { - double z = scm_big2dbl (y); + double z = scm_i_big2dbl (y); return (SCM_REAL_VALUE (x) <= z) ? x : scm_make_real (z); } else if (SCM_REALP (y)) { return (SCM_REAL_VALUE (x) < SCM_REAL_VALUE (y)) ? x : y; @@ -3390,7 +3280,7 @@ scm_sum (SCM x, SCM y) return SCM_MAKINUM (z); } else { #ifdef SCM_BIGDIG - return scm_long2big (z); + return scm_i_long2big (z); #else /* SCM_BIGDIG */ return scm_make_real ((double) z); #endif /* SCM_BIGDIG */ @@ -3429,9 +3319,9 @@ scm_sum (SCM x, SCM y) return scm_addbig (SCM_BDIGITS (x), SCM_NUMDIGS (x), SCM_BIGSIGN (x), y, 0); } else if (SCM_REALP (y)) { - return scm_make_real (scm_big2dbl (x) + SCM_REAL_VALUE (y)); + return scm_make_real (scm_i_big2dbl (x) + SCM_REAL_VALUE (y)); } else if (SCM_COMPLEXP (y)) { - return scm_make_complex (scm_big2dbl (x) + SCM_COMPLEX_REAL (y), + return scm_make_complex (scm_i_big2dbl (x) + SCM_COMPLEX_REAL (y), SCM_COMPLEX_IMAG (y)); } else { SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum); @@ -3440,7 +3330,7 @@ scm_sum (SCM x, SCM y) if (SCM_INUMP (y)) { return scm_make_real (SCM_REAL_VALUE (x) + SCM_INUM (y)); } else if (SCM_BIGP (y)) { - return scm_make_real (SCM_REAL_VALUE (x) + scm_big2dbl (y)); + return scm_make_real (SCM_REAL_VALUE (x) + scm_i_big2dbl (y)); } else if (SCM_REALP (y)) { return scm_make_real (SCM_REAL_VALUE (x) + SCM_REAL_VALUE (y)); } else if (SCM_COMPLEXP (y)) { @@ -3454,7 +3344,7 @@ scm_sum (SCM x, SCM y) return scm_make_complex (SCM_COMPLEX_REAL (x) + SCM_INUM (y), SCM_COMPLEX_IMAG (x)); } else if (SCM_BIGP (y)) { - return scm_make_complex (SCM_COMPLEX_REAL (x) + scm_big2dbl (y), + return scm_make_complex (SCM_COMPLEX_REAL (x) + scm_i_big2dbl (y), SCM_COMPLEX_IMAG (x)); } else if (SCM_REALP (y)) { return scm_make_complex (SCM_COMPLEX_REAL (x) + SCM_REAL_VALUE (y), @@ -3489,16 +3379,16 @@ scm_difference (SCM x, SCM y) return SCM_MAKINUM (xx); } else { #ifdef SCM_BIGDIG - return scm_long2big (xx); + return scm_i_long2big (xx); #else return scm_make_real ((double) xx); #endif } } else if (SCM_BIGP (x)) { - SCM z = scm_copybig (x, !SCM_BIGSIGN (x)); + SCM z = scm_i_copybig (x, !SCM_BIGSIGN (x)); unsigned int digs = SCM_NUMDIGS (z); unsigned int size = digs * SCM_BITSPERDIG / SCM_CHAR_BIT; - return size <= sizeof (SCM) ? scm_big2inum (z, digs) : z; + return size <= sizeof (SCM) ? scm_i_big2inum (z, digs) : z; } else if (SCM_REALP (x)) { return scm_make_real (-SCM_REAL_VALUE (x)); } else if (SCM_COMPLEXP (x)) { @@ -3517,7 +3407,7 @@ scm_difference (SCM x, SCM y) return SCM_MAKINUM (z); } else { #ifdef SCM_BIGDIG - return scm_long2big (z); + return scm_i_long2big (z); #else return scm_make_real ((double) z); #endif @@ -3561,9 +3451,9 @@ scm_difference (SCM x, SCM y) : scm_addbig (SCM_BDIGITS (y), SCM_NUMDIGS (y), SCM_BIGSIGN (y) ^ SCM_BIGSIGNFLAG, x, 0); } else if (SCM_REALP (y)) { - return scm_make_real (scm_big2dbl (x) - SCM_REAL_VALUE (y)); + return scm_make_real (scm_i_big2dbl (x) - SCM_REAL_VALUE (y)); } else if (SCM_COMPLEXP (y)) { - return scm_make_complex (scm_big2dbl (x) - SCM_COMPLEX_REAL (y), + return scm_make_complex (scm_i_big2dbl (x) - SCM_COMPLEX_REAL (y), - SCM_COMPLEX_IMAG (y)); } else { SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference); @@ -3572,7 +3462,7 @@ scm_difference (SCM x, SCM y) if (SCM_INUMP (y)) { return scm_make_real (SCM_REAL_VALUE (x) - SCM_INUM (y)); } else if (SCM_BIGP (y)) { - return scm_make_real (SCM_REAL_VALUE (x) - scm_big2dbl (y)); + return scm_make_real (SCM_REAL_VALUE (x) - scm_i_big2dbl (y)); } else if (SCM_REALP (y)) { return scm_make_real (SCM_REAL_VALUE (x) - SCM_REAL_VALUE (y)); } else if (SCM_COMPLEXP (y)) { @@ -3586,7 +3476,7 @@ scm_difference (SCM x, SCM y) return scm_make_complex (SCM_COMPLEX_REAL (x) - SCM_INUM (y), SCM_COMPLEX_IMAG (x)); } else if (SCM_BIGP (y)) { - return scm_make_complex (SCM_COMPLEX_REAL (x) - scm_big2dbl (y), + return scm_make_complex (SCM_COMPLEX_REAL (x) - scm_i_big2dbl (y), SCM_COMPLEX_IMAG (x)); } else if (SCM_REALP (y)) { return scm_make_complex (SCM_COMPLEX_REAL (x) - SCM_REAL_VALUE (y), @@ -3689,9 +3579,9 @@ scm_product (SCM x, SCM y) SCM_BDIGITS (y), SCM_NUMDIGS (y), SCM_BIGSIGN (x) ^ SCM_BIGSIGN (y)); } else if (SCM_REALP (y)) { - return scm_make_real (scm_big2dbl (x) * SCM_REAL_VALUE (y)); + return scm_make_real (scm_i_big2dbl (x) * SCM_REAL_VALUE (y)); } else if (SCM_COMPLEXP (y)) { - double z = scm_big2dbl (x); + double z = scm_i_big2dbl (x); return scm_make_complex (z * SCM_COMPLEX_REAL (y), z * SCM_COMPLEX_IMAG (y)); } else { @@ -3701,7 +3591,7 @@ scm_product (SCM x, SCM y) if (SCM_INUMP (y)) { return scm_make_real (SCM_INUM (y) * SCM_REAL_VALUE (x)); } else if (SCM_BIGP (y)) { - return scm_make_real (scm_big2dbl (y) * SCM_REAL_VALUE (x)); + return scm_make_real (scm_i_big2dbl (y) * SCM_REAL_VALUE (x)); } else if (SCM_REALP (y)) { return scm_make_real (SCM_REAL_VALUE (x) * SCM_REAL_VALUE (y)); } else if (SCM_COMPLEXP (y)) { @@ -3715,7 +3605,7 @@ scm_product (SCM x, SCM y) return scm_make_complex (SCM_INUM (y) * SCM_COMPLEX_REAL (x), SCM_INUM (y) * SCM_COMPLEX_IMAG (x)); } else if (SCM_BIGP (y)) { - double z = scm_big2dbl (y); + double z = scm_i_big2dbl (y); return scm_make_complex (z * SCM_COMPLEX_REAL (x), z * SCM_COMPLEX_IMAG (x)); } else if (SCM_REALP (y)) { @@ -3742,7 +3632,7 @@ scm_num2dbl (SCM a, const char *why) if (SCM_INUMP (a)) { return (double) SCM_INUM (a); } else if (SCM_BIGP (a)) { - return scm_big2dbl (a); + return scm_i_big2dbl (a); } else if (SCM_REALP (a)) { return (SCM_REAL_VALUE (a)); } else { @@ -3771,7 +3661,7 @@ scm_divide (SCM x, SCM y) return scm_make_real (1.0 / (double) SCM_INUM (x)); } } else if (SCM_BIGP (x)) { - return scm_make_real (1.0 / scm_big2dbl (x)); + return scm_make_real (1.0 / scm_i_big2dbl (x)); } else if (SCM_REALP (x)) { return scm_make_real (1.0 / SCM_REAL_VALUE (x)); } else if (SCM_COMPLEXP (x)) { @@ -3798,14 +3688,14 @@ scm_divide (SCM x, SCM y) return SCM_MAKINUM (z); } else { #ifdef SCM_BIGDIG - return scm_long2big (z); + return scm_i_long2big (z); #else return scm_make_real ((double) xx / (double) yy); #endif } } } else if (SCM_BIGP (y)) { - return scm_make_real ((double) xx / scm_big2dbl (y)); + return scm_make_real ((double) xx / scm_i_big2dbl (y)); } else if (SCM_REALP (y)) { return scm_make_real ((double) xx / SCM_REAL_VALUE (y)); } else if (SCM_COMPLEXP (y)) { @@ -3830,11 +3720,11 @@ scm_divide (SCM x, SCM y) } else { long z = yy < 0 ? -yy : yy; if (z < SCM_BIGRAD) { - SCM w = scm_copybig (x, SCM_BIGSIGN (x) ? (yy > 0) : (yy < 0)); + SCM w = scm_i_copybig (x, SCM_BIGSIGN (x) ? (yy > 0) : (yy < 0)); return scm_divbigdig (SCM_BDIGITS (w), SCM_NUMDIGS (w), (SCM_BIGDIG) z) - ? scm_make_real (scm_big2dbl (x) / (double) yy) - : scm_normbig (w); + ? scm_make_real (scm_i_big2dbl (x) / (double) yy) + : scm_i_normbig (w); } else { SCM w; #ifndef SCM_DIGSTOOBIG @@ -3851,7 +3741,7 @@ scm_divide (SCM x, SCM y) #endif return (!SCM_UNBNDP (w)) ? w - : scm_make_real (scm_big2dbl (x) / (double) yy); + : scm_make_real (scm_i_big2dbl (x) / (double) yy); } } } else if (SCM_BIGP (y)) { @@ -3860,11 +3750,11 @@ scm_divide (SCM x, SCM y) SCM_BIGSIGN (x) ^ SCM_BIGSIGN (y), 3); return (!SCM_UNBNDP (w)) ? w - : scm_make_real (scm_big2dbl (x) / scm_big2dbl (y)); + : scm_make_real (scm_i_big2dbl (x) / scm_i_big2dbl (y)); } else if (SCM_REALP (y)) { - return scm_make_real (scm_big2dbl (x) / SCM_REAL_VALUE (y)); + return scm_make_real (scm_i_big2dbl (x) / SCM_REAL_VALUE (y)); } else if (SCM_COMPLEXP (y)) { - a = scm_big2dbl (x); + a = scm_i_big2dbl (x); goto complex_div; } else { SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide); @@ -3874,7 +3764,7 @@ scm_divide (SCM x, SCM y) if (SCM_INUMP (y)) { return scm_make_real (rx / (double) SCM_INUM (y)); } else if (SCM_BIGP (y)) { - return scm_make_real (rx / scm_big2dbl (y)); + return scm_make_real (rx / scm_i_big2dbl (y)); } else if (SCM_REALP (y)) { return scm_make_real (rx / SCM_REAL_VALUE (y)); } else if (SCM_COMPLEXP (y)) { @@ -3890,7 +3780,7 @@ scm_divide (SCM x, SCM y) double d = SCM_INUM (y); return scm_make_complex (rx / d, ix / d); } else if (SCM_BIGP (y)) { - double d = scm_big2dbl (y); + double d = scm_i_big2dbl (y); return scm_make_complex (rx / d, ix / d); } else if (SCM_REALP (y)) { double d = SCM_REAL_VALUE (y); @@ -4047,7 +3937,7 @@ scm_two_doubles (SCM x, SCM y, const char *sstring, struct dpair *xy) if (SCM_INUMP (x)) { xy->x = SCM_INUM (x); } else if (SCM_BIGP (x)) { - xy->x = scm_big2dbl (x); + xy->x = scm_i_big2dbl (x); } else if (SCM_REALP (x)) { xy->x = SCM_REAL_VALUE (x); } else { @@ -4057,7 +3947,7 @@ scm_two_doubles (SCM x, SCM y, const char *sstring, struct dpair *xy) if (SCM_INUMP (y)) { xy->y = SCM_INUM (y); } else if (SCM_BIGP (y)) { - xy->y = scm_big2dbl (y); + xy->y = scm_i_big2dbl (y); } else if (SCM_REALP (y)) { xy->y = SCM_REAL_VALUE (y); } else { @@ -4176,7 +4066,7 @@ scm_magnitude (SCM z) return SCM_MAKINUM (-zz); } else { #ifdef SCM_BIGDIG - return scm_long2big (-zz); + return scm_i_long2big (-zz); #else scm_num_overflow (s_magnitude); #endif @@ -4185,7 +4075,7 @@ scm_magnitude (SCM z) if (!SCM_BIGSIGN (z)) { return z; } else { - return scm_copybig (z, 0); + return scm_i_copybig (z, 0); } } else if (SCM_REALP (z)) { return scm_make_real (fabs (SCM_REAL_VALUE (z))); @@ -4243,7 +4133,7 @@ SCM_DEFINE (scm_inexact_to_exact, "inexact->exact", 1, 0, 0, return SCM_MAKINUM (lu); #ifdef SCM_BIGDIG } else if (isfinite (u)) { - return scm_dbl2big (u); + return scm_i_dbl2big (u); #endif } else { scm_num_overflow (s_scm_inexact_to_exact); @@ -4259,9 +4149,9 @@ SCM_DEFINE (scm_inexact_to_exact, "inexact->exact", 1, 0, 0, /* d must be integer */ SCM -scm_dbl2big (double d) +scm_i_dbl2big (double d) { - scm_sizet i = 0; + size_t i = 0; long c; SCM_BIGDIG *digits; SCM ans; @@ -4271,7 +4161,7 @@ scm_dbl2big (double d) u /= SCM_BIGRAD; i++; } - ans = scm_mkbig (i, d < 0); + ans = scm_i_mkbig (i, d < 0); digits = SCM_BDIGITS (ans); while (i--) { @@ -4287,13 +4177,11 @@ scm_dbl2big (double d) return ans; } - - double -scm_big2dbl (SCM b) +scm_i_big2dbl (SCM b) { double ans = 0.0; - scm_sizet i = SCM_NUMDIGS (b); + size_t i = SCM_NUMDIGS (b); SCM_BIGDIG *digits = SCM_BDIGITS (b); while (i--) ans = digits[i] + SCM_BIGRAD * ans; @@ -4301,111 +4189,101 @@ scm_big2dbl (SCM b) return - ans; return ans; } -#endif - -SCM -scm_long2num (long sl) -{ - if (!SCM_FIXABLE (sl)) - { -#ifdef SCM_BIGDIG - return scm_long2big (sl); -#else - return scm_make_real ((double) sl); #endif - } - return SCM_MAKINUM (sl); -} - #ifdef HAVE_LONG_LONGS - -SCM -scm_long_long2num (long_long sl) -{ - if (!SCM_FIXABLE (sl)) - { -#ifdef SCM_BIGDIG - return scm_long_long2big (sl); -#else - return scm_make_real ((double) sl); -#endif - } - else - { - /* we know that sl fits into an inum */ - return SCM_MAKINUM ((scm_bits_t) sl); - } -} - -#endif /* HAVE_LONG_LONGS */ - - -SCM -scm_ulong2num (unsigned long sl) -{ - if (!SCM_POSFIXABLE (sl)) - { -#ifdef SCM_BIGDIG - return scm_ulong2big (sl); -#else - return scm_make_real ((double) sl); +# ifndef LLONG_MAX +# define ULLONG_MAX ((unsigned long long) (-1)) +# define LLONG_MAX ((long long) (ULLONG_MAX >> 1)) +# define LLONG_MIN (~LLONG_MAX) +# endif #endif - } - return SCM_MAKINUM (sl); -} - - -long -scm_num2long (SCM num, unsigned long int pos, const char *s_caller) -{ - if (SCM_INUMP (num)) { - return SCM_INUM (num); - } else if (SCM_BIGP (num)) { - long int res; - /* can't use res directly in case num is -2^31. */ - unsigned long int pos_res = 0; - unsigned long int old_res = 0; - scm_sizet l; - - for (l = SCM_NUMDIGS (num); l--;) { - pos_res = SCM_BIGUP (pos_res) + SCM_BDIGITS (num)[l]; - if (pos_res >= old_res) { - old_res = pos_res; - } else { - /* overflow. */ - scm_out_of_range (s_caller, num); - } - } - if (SCM_BIGSIGN (num)) { - res = -pos_res; - if (res <= 0) { - return res; - } else { - scm_out_of_range (s_caller, num); - } - } else { - res = pos_res; - if (res >= 0) { - return res; - } else { - scm_out_of_range (s_caller, num); - } - } - } else if (SCM_REALP (num)) { - double u = SCM_REAL_VALUE (num); - long int 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); - } -} +#define SIZE_MAX ((size_t) (-1)) +/* the below is not really guaranteed to work (I think), but probably does: */ +#define PTRDIFF_MIN ((ptrdiff_t) ((ptrdiff_t)1 << (sizeof (ptrdiff_t) * 8 - 1))) +#define PTRDIFF_MAX (~ PTRDIFF_MIN) + +#define NUM2INTEGRAL scm_num2short +#define INTEGRAL2NUM scm_short2num +#define INTEGRAL2BIG scm_i_short2big +#define ITYPE short +#define MIN_VALUE SHRT_MIN +#define MAX_VALUE SHRT_MAX +#include "libguile/num2integral.i.c" + +#define NUM2INTEGRAL scm_num2ushort +#define INTEGRAL2NUM scm_ushort2num +#define INTEGRAL2BIG scm_i_ushort2big +#define UNSIGNED +#define ITYPE unsigned short +#define MAX_VALUE USHRT_MAX +#include "libguile/num2integral.i.c" + +#define NUM2INTEGRAL scm_num2int +#define INTEGRAL2NUM scm_int2num +#define INTEGRAL2BIG scm_i_int2big +#define ITYPE int +#define MIN_VALUE INT_MIN +#define MAX_VALUE INT_MAX +#include "libguile/num2integral.i.c" + +#define NUM2INTEGRAL scm_num2uint +#define INTEGRAL2NUM scm_uint2num +#define INTEGRAL2BIG scm_i_uint2big +#define UNSIGNED +#define ITYPE unsigned int +#define MAX_VALUE UINT_MAX +#include "libguile/num2integral.i.c" + +#define NUM2INTEGRAL scm_num2long +#define INTEGRAL2NUM scm_long2num +#define INTEGRAL2BIG scm_i_long2big +#define ITYPE long +#define MIN_VALUE LONG_MIN +#define MAX_VALUE LONG_MAX +#include "libguile/num2integral.i.c" + +#define NUM2INTEGRAL scm_num2ulong +#define INTEGRAL2NUM scm_ulong2num +#define INTEGRAL2BIG scm_i_ulong2big +#define UNSIGNED +#define ITYPE unsigned long +#define MAX_VALUE ULONG_MAX +#include "libguile/num2integral.i.c" + +#define NUM2INTEGRAL scm_num2bits +#define INTEGRAL2NUM scm_bits2num +#define INTEGRAL2BIG scm_i_bits2big +#define ITYPE scm_bits_t +#define MIN_VALUE ((scm_bits_t) ((scm_ubits_t)1 << (sizeof (scm_bits_t) - 1))) +#define MAX_VALUE (~MIN_VALUE) +#include "libguile/num2integral.i.c" + +#define NUM2INTEGRAL scm_num2ubits +#define INTEGRAL2NUM scm_ubits2num +#define INTEGRAL2BIG scm_i_ubits2big +#define UNSIGNED +#define ITYPE scm_ubits_t +#define MAX_VALUE ((scm_ubits_t) ((scm_bits_t) (-1))) +#include "libguile/num2integral.i.c" + +#define NUM2INTEGRAL scm_num2ptrdiff +#define INTEGRAL2NUM scm_ptrdiff2num +#define INTEGRAL2BIG scm_i_ptrdiff2big +#define ITYPE ptrdiff_t +#define MIN_VALUE PTRDIFF_MIN +#define MAX_VALUE PTRDIFF_MAX +#include "libguile/num2integral.i.c" + +#define NUM2INTEGRAL scm_num2size +#define INTEGRAL2NUM scm_size2num +#define INTEGRAL2BIG scm_i_size2big +#define UNSIGNED +#define ITYPE size_t +#define MAX_VALUE SIZE_MAX +#include "libguile/num2integral.i.c" #ifdef HAVE_LONG_LONGS @@ -4413,133 +4291,80 @@ scm_num2long (SCM num, unsigned long int pos, const char *s_caller) #define ULONG_LONG_MAX (~0ULL) #endif -long_long -scm_num2long_long (SCM num, unsigned long int pos, const char *s_caller) -{ - if (SCM_INUMP (num)) { - return SCM_INUM (num); - } else if (SCM_BIGP (num)) { - long long res; - /* can't use res directly in case num is -2^63. */ - unsigned long long int pos_res = 0; - scm_sizet l; - - for (l = SCM_NUMDIGS (num); l--;) { - if (pos_res > SCM_BIGDN(ULONG_LONG_MAX)) - scm_out_of_range (s_caller, num); - pos_res = SCM_LONGLONGBIGUP (pos_res) + SCM_BDIGITS (num)[l]; - } - if (SCM_BIGSIGN (num)) { - res = -pos_res; - if (res <= 0) { - return res; - } else { - scm_out_of_range (s_caller, num); - } - } else { - res = pos_res; - if (res >= 0) { - return res; - } else { - scm_out_of_range (s_caller, num); - } - } - } else if (SCM_REALP (num)) { - double u = SCM_REAL_VALUE (num); - long long int 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); - } -} +#define NUM2INTEGRAL scm_num2long_long +#define INTEGRAL2NUM scm_long_long2num +#define INTEGRAL2BIG scm_i_long_long2big +#define ITYPE long long +#define MIN_VALUE LLONG_MIN +#define MAX_VALUE LLONG_MAX +#include "libguile/num2integral.i.c" + +#define NUM2INTEGRAL scm_num2ulong_long +#define INTEGRAL2NUM scm_ulong_long2num +#define INTEGRAL2BIG scm_i_ulong_long2big +#define UNSIGNED +#define ITYPE unsigned long long +#define MAX_VALUE ULLONG_MAX +#include "libguile/num2integral.i.c" -ulong_long -scm_num2ulong_long (SCM num, unsigned long int pos, const char *s_caller) -{ - if (SCM_INUMP (num)) - { - long long nnum = SCM_INUM (num); - if (nnum >= 0) - return nnum; - else - scm_out_of_range (s_caller, num); - } - else if (SCM_BIGP (num)) - { - unsigned long long res = 0; - scm_sizet l; +#endif /* HAVE_LONG_LONGS */ - if (SCM_BIGSIGN (num)) - scm_out_of_range (s_caller, num); +#ifdef GUILE_DEBUG - for (l = SCM_NUMDIGS (num); l--;) { - if (res > SCM_BIGDN(ULONG_LONG_MAX)) - scm_out_of_range (s_caller, num); - res = SCM_LONGLONGBIGUP (res) + SCM_BDIGITS (num)[l]; - } - return res; - } - else if (SCM_REALP (num)) - { - double u = SCM_REAL_VALUE (num); - unsigned long long int 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); -} +#define CHECK(type, v) \ + do { \ + if ((v) != scm_num2##type (scm_##type##2num (v), 1, "check_sanity")) \ + abort (); \ + } while (0); -#endif /* HAVE_LONG_LONGS */ +static void +check_sanity () +{ + CHECK (short, 0); + CHECK (ushort, 0U); + CHECK (int, 0); + CHECK (uint, 0U); + CHECK (long, 0L); + CHECK (ulong, 0UL); + CHECK (size, 0); + CHECK (ptrdiff, 0); + + CHECK (short, -1); + CHECK (int, -1); + CHECK (long, -1L); + CHECK (ptrdiff, -1); + + CHECK (short, SHRT_MAX); + CHECK (short, SHRT_MIN); + CHECK (ushort, USHRT_MAX); + CHECK (int, INT_MAX); + CHECK (int, INT_MIN); + CHECK (uint, UINT_MAX); + CHECK (long, LONG_MAX); + CHECK (long, LONG_MIN); + CHECK (ulong, ULONG_MAX); + CHECK (size, SIZE_MAX); + CHECK (ptrdiff, PTRDIFF_MAX); + CHECK (ptrdiff, PTRDIFF_MIN); +#ifdef HAVE_LONG_LONGS + CHECK (long_long, 0LL); + CHECK (ulong_long, 0ULL); -unsigned long -scm_num2ulong (SCM num, unsigned long int pos, const char *s_caller) -{ - if (SCM_INUMP (num)) { - long nnum = SCM_INUM (num); - if (nnum >= 0) { - return nnum; - } else { - scm_out_of_range (s_caller, num); - } - } else if (SCM_BIGP (num)) { - unsigned long int res = 0; - scm_sizet l; - - if (SCM_BIGSIGN (num)) - scm_out_of_range (s_caller, num); - - for (l = SCM_NUMDIGS (num); l--;) { - if (res > SCM_BIGDN(ULONG_MAX)) - scm_out_of_range (s_caller, num); - res = SCM_BIGUP (res) + SCM_BDIGITS (num)[l]; - } - return res; - } else if (SCM_REALP (num)) { - double u = SCM_REAL_VALUE (num); - unsigned long int 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); - } + CHECK (long_long, -1LL); + + CHECK (long_long, LLONG_MAX); + CHECK (long_long, LLONG_MIN); + CHECK (ulong_long, ULLONG_MAX); +#endif } +#endif void scm_init_numbers () { - abs_most_negative_fixnum = scm_long2big (- SCM_MOST_NEGATIVE_FIXNUM); + abs_most_negative_fixnum = scm_i_long2big (- SCM_MOST_NEGATIVE_FIXNUM); scm_permanent_object (abs_most_negative_fixnum); /* It may be possible to tune the performance of some algorithms by using @@ -4571,11 +4396,104 @@ scm_init_numbers () scm_dblprec = scm_dblprec - 1; } #endif /* DBL_DIG */ + +#ifdef GUILE_DEBUG + check_sanity (); +#endif + #ifndef SCM_MAGIC_SNARFER #include "libguile/numbers.x" #endif } +#if (SCM_DEBUG_DEPRECATED == 0) + +SCM +scm_mkbig (size_t len, int sign) +{ + scm_c_issue_deprecation_warning ("`scm_mkbig' is deprecated. " + "Use `scm_i_mkbig' instead."); + return scm_i_mkbig (len, sign); +} + +SCM +scm_big2inum (SCM b, size_t l) +{ + scm_c_issue_deprecation_warning ("`scm_big2inum' is deprecated. " + "Use `scm_i_big2num' instead."); + return scm_i_big2inum (b, l); +} + +SCM +scm_adjbig (SCM b, size_t nlen) +{ + scm_c_issue_deprecation_warning ("`scm_adjbig' is deprecated. " + "Use `scm_i_adjbig' instead."); + return scm_i_adjbig (b, nlen); +} + +SCM +scm_normbig (SCM b) +{ + scm_c_issue_deprecation_warning ("`scm_normbig' is deprecated. " + "Use `scm_i_normbig' instead."); + return scm_i_normbig (b); +} + +SCM +scm_copybig (SCM b, int sign) +{ + scm_c_issue_deprecation_warning ("`scm_copybig' is deprecated. " + "Use `scm_i_copybig' instead."); + return scm_i_copybig (b, sign); +} + +SCM +scm_2ulong2big (unsigned long *np) +{ + unsigned long n; + size_t i; + SCM_BIGDIG *digits; + SCM ans; + + ans = scm_i_mkbig (2 * SCM_DIGSPERLONG, 0); + digits = SCM_BDIGITS (ans); + + n = np[0]; + for (i = 0; i < SCM_DIGSPERLONG; ++i) + { + digits[i] = SCM_BIGLO (n); + n = SCM_BIGDN ((unsigned long) n); + } + n = np[1]; + for (i = 0; i < SCM_DIGSPERLONG; ++i) + { + digits[i + SCM_DIGSPERLONG] = SCM_BIGLO (n); + n = SCM_BIGDN ((unsigned long) n); + } + return ans; +} + +SCM +scm_dbl2big (double d) +{ + scm_c_issue_deprecation_warning ("`scm_dbl2big' is deprecated. " + "Use `scm_dbl2num' instead," + "or `scm_i_dbl2big'."); + return scm_i_dbl2big (d); +} + +double +scm_big2dbl (SCM b) +{ + scm_c_issue_deprecation_warning ("`scm_big2dbl' is deprecated. " + "Use `scm_num2dbl' instead," + "or `scm_i_big2dbl'."); + return scm_i_big2dbl (b); +} + +#endif + /* Local Variables: c-file-style: "gnu" diff --git a/libguile/numbers.h b/libguile/numbers.h index 23df0d7d8..09dc4bdbe 100644 --- a/libguile/numbers.h +++ b/libguile/numbers.h @@ -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); + +#define SCM_FIXNUM_BIT SCM_I_FIXNUM_BIT +#endif + #ifdef HAVE_LONG_LONGS -extern SCM scm_long_long2big (long_long n); +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); +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 long_long scm_num2long_long (SCM num, unsigned long int pos, +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 ulong_long scm_num2ulong_long (SCM num, unsigned long int pos, +extern unsigned long 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 void scm_init_numbers (void); #endif /* NUMBERSH */ diff --git a/libguile/objects.c b/libguile/objects.c index ac32e89ec..042549ca6 100644 --- a/libguile/objects.c +++ b/libguile/objects.c @@ -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)) diff --git a/libguile/objects.h b/libguile/objects.h index 20e3fb3ea..5e3d27f30 100644 --- a/libguile/objects.h +++ b/libguile/objects.h @@ -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 */ diff --git a/libguile/options.c b/libguile/options.c index c5260e669..f363ce866 100644 --- a/libguile/options.c +++ b/libguile/options.c @@ -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; diff --git a/libguile/options.h b/libguile/options.h index 7b36fc21c..7450b7309 100644 --- a/libguile/options.h +++ b/libguile/options.h @@ -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 */ diff --git a/libguile/ports.c b/libguile/ports.c index 6a15c2c0b..f49a72dfa 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -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; diff --git a/libguile/ports.h b/libguile/ports.h index b37634f9b..fa9198415 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -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); diff --git a/libguile/posix.c b/libguile/posix.c index 6f8c11e0a..83e8bac10 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -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; diff --git a/libguile/print.c b/libguile/print.c index dca8d84df..7e08fe49a 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -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)) diff --git a/libguile/print.h b/libguile/print.h index 25c1dbe0f..25fa3d5db 100644 --- a/libguile/print.h +++ b/libguile/print.h @@ -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) diff --git a/libguile/procs.c b/libguile/procs.c index 735a76c26..85e9abd08 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -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")); } diff --git a/libguile/procs.h b/libguile/procs.h index 9b8af9138..acb2bc94f 100644 --- a/libguile/procs.h +++ b/libguile/procs.h @@ -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); diff --git a/libguile/ramap.c b/libguile/ramap.c index 023cd5ad5..3970f6191 100644 --- a/libguile/ramap.c +++ b/libguile/ramap.c @@ -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)) { diff --git a/libguile/random.c b/libguile/random.c index 63cfffe33..b41db73b2 100644 --- a/libguile/random.c +++ b/libguile/random.c @@ -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; diff --git a/libguile/random.h b/libguile/random.h index 797bae4a0..f6d37cc81 100644 --- a/libguile/random.h +++ b/libguile/random.h @@ -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]; diff --git a/libguile/rdelim.c b/libguile/rdelim.c index 1440e1b6c..c029b3f8c 100644 --- a/libguile/rdelim.c +++ b/libguile/rdelim.c @@ -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 diff --git a/libguile/read.c b/libguile/read.c index 635a4ae42..57c90d6e0 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -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; diff --git a/libguile/read.h b/libguile/read.h index 3b5c37902..5c93e6d20 100644 --- a/libguile/read.h +++ b/libguile/read.h @@ -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); diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c index 1f02d688b..867bed14d 100644 --- a/libguile/regex-posix.c +++ b/libguile/regex-posix.c @@ -93,7 +93,7 @@ scm_bits_t scm_tc16_regex; -static scm_sizet +static size_t regex_free (SCM obj) { regfree (SCM_RGX (obj)); diff --git a/libguile/root.c b/libguile/root.c index a0d092030..23ca98256 100644 --- a/libguile/root.c +++ b/libguile/root.c @@ -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; diff --git a/libguile/root.h b/libguile/root.h index 40671e55e..764052ce6 100644 --- a/libguile/root.h +++ b/libguile/root.h @@ -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 */ diff --git a/libguile/rw.c b/libguile/rw.c index 28d4ea604..e0d271cf5 100644 --- a/libguile/rw.c +++ b/libguile/rw.c @@ -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); diff --git a/libguile/script.c b/libguile/script.c index 2eda0b378..7c7c3f162 100644 --- a/libguile/script.c +++ b/libguile/script.c @@ -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; diff --git a/libguile/simpos.c b/libguile/simpos.c index a03ec6c30..cfc1c9e41 100644 --- a/libguile/simpos.c +++ b/libguile/simpos.c @@ -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 diff --git a/libguile/smob.c b/libguile/smob.c index 6d80f8fe3..a487b9715 100644 --- a/libguile/smob.c +++ b/libguile/smob.c @@ -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; diff --git a/libguile/smob.h b/libguile/smob.h index 5c1a56e8e..9cbf38738 100644 --- a/libguile/smob.h +++ b/libguile/smob.h @@ -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)); diff --git a/libguile/socket.c b/libguile/socket.c index 5fbba91ca..109918d83 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -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 diff --git a/libguile/sort.c b/libguile/sort.c index 954f75eeb..5b5dc9584 100644 --- a/libguile/sort.c +++ b/libguile/sort.c @@ -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); diff --git a/libguile/srcprop.c b/libguile/srcprop.c index ef368aa2c..e16573ec0 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -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; } } diff --git a/libguile/srcprop.h b/libguile/srcprop.h index 93c60ac26..b53eb13b7 100644 --- a/libguile/srcprop.h +++ b/libguile/srcprop.h @@ -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); diff --git a/libguile/stackchk.c b/libguile/stackchk.c index bede70e86..e8971e322 100644 --- a/libguile/stackchk.c +++ b/libguile/stackchk.c @@ -72,7 +72,7 @@ scm_report_stack_overflow () #endif -long +long scm_stack_size (SCM_STACKITEM *start) { SCM_STACKITEM stack; diff --git a/libguile/stacks.c b/libguile/stacks.c index 63bbda07b..9085bec68 100644 --- a/libguile/stacks.c +++ b/libguile/stacks.c @@ -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) diff --git a/libguile/stacks.h b/libguile/stacks.h index fda1f1b00..b596f87cf 100644 --- a/libguile/stacks.h +++ b/libguile/stacks.h @@ -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; diff --git a/libguile/strings.c b/libguile/strings.c index 792b0f8af..c2ab44166 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -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; diff --git a/libguile/strings.h b/libguile/strings.h index a96e8de55..608467d52 100644 --- a/libguile/strings.h +++ b/libguile/strings.h @@ -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 */ diff --git a/libguile/strop.c b/libguile/strop.c index 2cf4c0221..4efb95599 100644 --- a/libguile/strop.c +++ b/libguile/strop.c @@ -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; diff --git a/libguile/strorder.c b/libguile/strorder.c index bbf4ba30f..c50a2469b 100644 --- a/libguile/strorder.c +++ b/libguile/strorder.c @@ -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); diff --git a/libguile/strports.c b/libguile/strports.c index 3a8faaa51..4fb102664 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -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); diff --git a/libguile/struct.c b/libguile/struct.c index 4e8db5d17..5710f4080 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -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. */ diff --git a/libguile/struct.h b/libguile/struct.h index 7c784eb3b..b66db2122 100644 --- a/libguile/struct.h +++ b/libguile/struct.h @@ -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); diff --git a/libguile/symbols-deprecated.c b/libguile/symbols-deprecated.c index 49ba28799..63dfdbd0d 100644 --- a/libguile/symbols-deprecated.c +++ b/libguile/symbols-deprecated.c @@ -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."); diff --git a/libguile/symbols.c b/libguile/symbols.c index d46085a09..6a463f914 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -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'; diff --git a/libguile/symbols.h b/libguile/symbols.h index 1d10b371e..fe4870b0e 100644 --- a/libguile/symbols.h +++ b/libguile/symbols.h @@ -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); diff --git a/libguile/tags.h b/libguile/tags.h index e64ad4c35..eebe63e75 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -58,7 +58,8 @@ /* In the beginning was the Word: */ -typedef long scm_bits_t; +typedef SCM_BITS_T scm_bits_t; +typedef SCM_UBITS_T scm_ubits_t; /* But as external interface, we use SCM, which may, according to the desired * level of type checking, be defined in several ways: diff --git a/libguile/throw.c b/libguile/throw.c index 677b6bdc0..63af28650 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -79,7 +79,7 @@ static scm_bits_t tc16_jmpbuffer; #define JBJMPBUF(OBJ) ((jmp_buf *) SCM_CELL_WORD_1 (OBJ)) #define SETJBJMPBUF(x,v) (SCM_SET_CELL_WORD_1 ((x), (v))) #ifdef DEBUG_EXTENSIONS -#define SCM_JBDFRAME(x) ((scm_debug_frame *) SCM_CELL_WORD_2 (x)) +#define SCM_JBDFRAME(x) ((scm_debug_frame_t *) SCM_CELL_WORD_2 (x)) #define SCM_SETJBDFRAME(x,v) (SCM_SET_CELL_WORD_2 ((x), (v))) #endif diff --git a/libguile/unif.c b/libguile/unif.c index afb0a0cf2..daa74bd3f 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -93,14 +93,16 @@ scm_bits_t scm_tc16_array; /* return the size of an element in a uniform array or 0 if type not found. */ -scm_sizet +size_t scm_uniform_element_size (SCM obj) { - scm_sizet result; + size_t result; switch (SCM_TYP7 (obj)) { case scm_tc7_bvect: + result = sizeof (scm_bits_t); + break; case scm_tc7_uvect: case scm_tc7_ivect: result = sizeof (long); @@ -116,7 +118,7 @@ scm_uniform_element_size (SCM obj) #ifdef HAVE_LONG_LONGS case scm_tc7_llvect: - result = sizeof (long_long); + result = sizeof (long long); break; #endif @@ -154,20 +156,32 @@ singp (SCM obj) } } +#if (SIZEOF_SIZE_T < SCM_SIZEOF_BITS_T) +# define CHECK_BYTE_SIZE(s,k) SCM_ASSERT_RANGE (1, scm_bits2num (k), k <= (size_t)(~(size_t)0)) +#else +# define CHECK_BYTE_SIZE(s,k) +#endif + SCM -scm_make_uve (long k, SCM prot) +scm_make_uve (scm_bits_t k, SCM prot) #define FUNC_NAME "scm_make_uve" { SCM v; - long i, type; + size_t i; + scm_bits_t type; + scm_ubits_t size_in_bytes; if (SCM_EQ_P (prot, SCM_BOOL_T)) { SCM_NEWCELL (v); if (k > 0) { - SCM_ASSERT_RANGE (1, scm_long2num (k), k <= SCM_BITVECTOR_MAX_LENGTH); - i = sizeof (long) * ((k + SCM_LONG_BIT - 1) / SCM_LONG_BIT); + SCM_ASSERT_RANGE (1, scm_bits2num (k), + k <= SCM_BITVECTOR_MAX_LENGTH); + size_in_bytes = sizeof (scm_bits_t) * ((k + SCM_BITS_LENGTH - 1) / + SCM_BITS_LENGTH); + CHECK_BYTE_SIZE (size_in_bytes, k); + i = (size_t) size_in_bytes; SCM_SET_BITVECTOR_BASE (v, (char *) scm_must_malloc (i, "vector")); SCM_SET_BITVECTOR_LENGTH (v, k); } @@ -180,17 +194,19 @@ scm_make_uve (long k, SCM prot) } else if (SCM_CHARP (prot) && (SCM_CHAR (prot) == '\0')) { - i = sizeof (char) * k; + size_in_bytes = sizeof (char) * k; type = scm_tc7_byvect; } else if (SCM_CHARP (prot)) { - i = sizeof (char) * k; + size_in_bytes = sizeof (char) * k; + CHECK_BYTE_SIZE (size_in_bytes, k); + i = (size_t) size_in_bytes; return scm_allocate_string (i); } else if (SCM_INUMP (prot)) { - i = sizeof (long) * k; + size_in_bytes = sizeof (long) * k; if (SCM_INUM (prot) > 0) type = scm_tc7_uvect; else @@ -203,13 +219,13 @@ scm_make_uve (long k, SCM prot) s = SCM_SYMBOL_CHARS (prot)[0]; if (s == 's') { - i = sizeof (short) * k; + size_in_bytes = sizeof (short) * k; type = scm_tc7_svect; } #ifdef HAVE_LONG_LONGS else if (s == 'l') { - i = sizeof (long_long) * k; + size_in_bytes = sizeof (long long) * k; type = scm_tc7_llvect; } #endif @@ -217,6 +233,7 @@ scm_make_uve (long k, SCM prot) { return scm_c_make_vector (k, SCM_UNDEFINED); } + } else if (!SCM_INEXACTP (prot)) /* Huge non-unif vectors are NOT supported. */ @@ -224,21 +241,24 @@ scm_make_uve (long k, SCM prot) return scm_c_make_vector (k, SCM_UNDEFINED); else if (singp (prot)) { - i = sizeof (float) * k; + size_in_bytes = sizeof (float) * k; type = scm_tc7_fvect; } else if (SCM_COMPLEXP (prot)) { - i = 2 * sizeof (double) * k; + size_in_bytes = 2 * sizeof (double) * k; type = scm_tc7_cvect; } else { - i = sizeof (double) * k; + size_in_bytes = sizeof (double) * k; type = scm_tc7_dvect; } - SCM_ASSERT_RANGE (1, scm_long2num (k), k <= SCM_UVECTOR_MAX_LENGTH); + CHECK_BYTE_SIZE (size_in_bytes, k); + i = (size_t) size_in_bytes; + + SCM_ASSERT_RANGE (1, scm_bits2num (k), k <= SCM_UVECTOR_MAX_LENGTH); SCM_NEWCELL (v); SCM_DEFER_INTS; @@ -399,8 +419,8 @@ SCM_DEFINE (scm_array_dimensions, "array-dimensions", 1, 0, 0, #define FUNC_NAME s_scm_array_dimensions { SCM res = SCM_EOL; - scm_sizet k; - scm_array_dim *s; + size_t k; + scm_array_dim_t *s; if (SCM_IMP (ra)) return SCM_BOOL_F; switch (SCM_TYP7 (ra)) @@ -468,8 +488,8 @@ SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0, #define FUNC_NAME s_scm_shared_array_increments { SCM res = SCM_EOL; - scm_sizet k; - scm_array_dim *s; + size_t k; + scm_array_dim_t *s; SCM_ASSERT (SCM_ARRAYP (ra), ra, SCM_ARG1, FUNC_NAME); k = SCM_ARRAY_NDIM (ra); s = SCM_ARRAY_DIMS (ra); @@ -483,22 +503,22 @@ SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0, static char s_bad_ind[] = "Bad scm_array index"; -long +scm_bits_t scm_aind (SCM ra, SCM args, const char *what) #define FUNC_NAME what { SCM ind; - register long j; - register scm_sizet pos = SCM_ARRAY_BASE (ra); - register scm_sizet k = SCM_ARRAY_NDIM (ra); - scm_array_dim *s = SCM_ARRAY_DIMS (ra); + register scm_bits_t j; + register scm_bits_t pos = SCM_ARRAY_BASE (ra); + register size_t k = SCM_ARRAY_NDIM (ra); + scm_array_dim_t *s = SCM_ARRAY_DIMS (ra); if (SCM_INUMP (args)) { if (k != 1) scm_error_num_args_subr (what); return pos + (SCM_INUM (args) - s->lbnd) * (s->inc); } - while (k && SCM_NIMP (args)) + while (k && !SCM_NULLP (args)) { ind = SCM_CAR (args); args = SCM_CDR (args); @@ -525,8 +545,8 @@ scm_make_ra (int ndim) SCM ra; SCM_NEWCELL (ra); SCM_DEFER_INTS; - SCM_NEWSMOB(ra, ((long) ndim << 17) + scm_tc16_array, - scm_must_malloc ((long) (sizeof (scm_array) + ndim * sizeof (scm_array_dim)), + SCM_NEWSMOB(ra, ((scm_bits_t) ndim << 17) + scm_tc16_array, + scm_must_malloc ((sizeof (scm_array) + ndim * sizeof (scm_array_dim)), "array")); SCM_ARRAY_V (ra) = scm_nullvect; SCM_ALLOW_INTS; @@ -540,7 +560,7 @@ static char s_bad_spec[] = "Bad scm_array dimension"; SCM scm_shap2ra (SCM args, const char *what) { - scm_array_dim *s; + scm_array_dim_t *s; SCM ra, spec, sp; int ndim = scm_ilength (args); if (ndim < 0) @@ -586,10 +606,11 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1, "fill the array, otherwise @var{prototype} is used.") #define FUNC_NAME s_scm_dimensions_to_uniform_array { - scm_sizet k; - unsigned long int rlen = 1; - scm_array_dim *s; + size_t k; + scm_bits_t rlen = 1; + scm_array_dim_t *s; SCM ra; + if (SCM_INUMP (dims)) { SCM answer = scm_make_uve (SCM_INUM (dims), prot); @@ -601,15 +622,18 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1, scm_array_fill_x (answer, prot); return answer; } + SCM_ASSERT (SCM_NULLP (dims) || SCM_CONSP (dims), dims, SCM_ARG1, FUNC_NAME); ra = scm_shap2ra (dims, FUNC_NAME); SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra); s = SCM_ARRAY_DIMS (ra); k = SCM_ARRAY_NDIM (ra); + while (k--) { s[k].inc = rlen; + SCM_ASSERT_RANGE (1, dims, s[k].inc >= 0); SCM_ASSERT_RANGE (1, dims, s[k].lbnd <= s[k].ubnd); rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc; } @@ -624,7 +648,7 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1, scm_array_fill_x (ra, prot); if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra)) - if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc)) + if (s[0].ubnd < s[0].lbnd || (0 == s[0].lbnd && 1 == s[0].inc)) return SCM_ARRAY_V (ra); return ra; } @@ -634,10 +658,10 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1, void scm_ra_set_contp (SCM ra) { - scm_sizet k = SCM_ARRAY_NDIM (ra); + size_t k = SCM_ARRAY_NDIM (ra); if (k) { - long inc = SCM_ARRAY_DIMS (ra)[k - 1].inc; + scm_bits_t inc = SCM_ARRAY_DIMS (ra)[k - 1].inc; /*??*/ while (k--) { if (inc != SCM_ARRAY_DIMS (ra)[k].inc) @@ -675,9 +699,10 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, SCM ra; SCM inds, indptr; SCM imap; - scm_sizet i, k; - long old_min, new_min, old_max, new_max; - scm_array_dim *s; + size_t k; + scm_bits_t i; + scm_bits_t old_min, new_min, old_max, new_max; + scm_array_dim_t *s; SCM_VALIDATE_REST_ARGUMENT (dims); SCM_VALIDATE_ARRAY (1,oldra); @@ -719,7 +744,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, } imap = scm_apply (mapfunc, scm_reverse (inds), SCM_EOL); if (SCM_ARRAYP (oldra)) - i = (scm_sizet) scm_aind (oldra, imap, FUNC_NAME); + i = scm_aind (oldra, imap, FUNC_NAME); else { if (SCM_NINUMP (imap)) @@ -768,7 +793,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra)) { SCM v = SCM_ARRAY_V (ra); - unsigned long int length = SCM_INUM (scm_uniform_vector_length (v)); + scm_bits_t length = SCM_INUM (scm_uniform_vector_length (v)); if (1 == s->inc && 0 == s->lbnd && length == 1 + s->ubnd) return v; if (s->ubnd < s->lbnd) @@ -805,7 +830,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, #define FUNC_NAME s_scm_transpose_array { SCM res, vargs, *ve = &vargs; - scm_array_dim *s, *r; + scm_array_dim_t *s, *r; int ndim, i, k; SCM_VALIDATE_REST_ARGUMENT (args); @@ -914,7 +939,7 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1, #define FUNC_NAME s_scm_enclose_array { SCM axv, res, ra_inr; - scm_array_dim vdim, *s = &vdim; + scm_array_dim_t vdim, *s = &vdim; int ndim, j, k, ninr, noutr; SCM_VALIDATE_REST_ARGUMENT (axes); @@ -998,10 +1023,10 @@ SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1, #define FUNC_NAME s_scm_array_in_bounds_p { SCM ind = SCM_EOL; - long pos = 0; - register scm_sizet k; - register long j; - scm_array_dim *s; + scm_bits_t pos = 0; + register size_t k; + register scm_bits_t j; + scm_array_dim_t *s; SCM_VALIDATE_REST_ARGUMENT (args); SCM_ASRTGO (SCM_NIMP (v), badarg1); @@ -1064,7 +1089,7 @@ tail: case scm_tc7_vector: case scm_tc7_wvect: { - unsigned long int length = SCM_INUM (scm_uniform_vector_length (v)); + scm_bits_t length = SCM_INUM (scm_uniform_vector_length (v)); SCM_ASRTGO (SCM_NULLP (args) && SCM_INUMP (ind), wna); return SCM_BOOL(pos >= 0 && pos < length); } @@ -1083,7 +1108,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, "@var{array}.") #define FUNC_NAME s_scm_uniform_vector_ref { - long pos; + scm_bits_t pos; if (SCM_IMP (v)) { @@ -1097,7 +1122,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, } else { - unsigned long int length; + scm_bits_t length; if (SCM_NIMP (args)) { SCM_ASSERT (SCM_CONSP (args) && SCM_INUMP (SCM_CAR (args)), args, SCM_ARG2, FUNC_NAME); @@ -1151,13 +1176,13 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, case scm_tc7_uvect: return scm_ulong2num (((unsigned long *) SCM_VELTS (v))[pos]); case scm_tc7_ivect: - return scm_long2num(((signed long *) SCM_VELTS (v))[pos]); + return scm_long2num (((signed long *) SCM_VELTS (v))[pos]); case scm_tc7_svect: return SCM_MAKINUM (((short *) SCM_CELL_WORD_1 (v))[pos]); #ifdef HAVE_LONG_LONGS case scm_tc7_llvect: - return scm_long_long2num (((long_long *) SCM_CELL_WORD_1 (v))[pos]); + return scm_long_long2num (((long long *) SCM_CELL_WORD_1 (v))[pos]); #endif case scm_tc7_fvect: @@ -1178,7 +1203,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, tries to recycle conses. (Make *sure* you want them recycled.) */ SCM -scm_cvref (SCM v, scm_sizet pos, SCM last) +scm_cvref (SCM v, scm_bits_t pos, SCM last) #define FUNC_NAME "scm_cvref" { switch SCM_TYP7 (v) @@ -1202,7 +1227,7 @@ scm_cvref (SCM v, scm_sizet pos, SCM last) return SCM_MAKINUM (((short *) SCM_CELL_WORD_1 (v))[pos]); #ifdef HAVE_LONG_LONGS case scm_tc7_llvect: - return scm_long_long2num (((long_long *) SCM_CELL_WORD_1 (v))[pos]); + return scm_long_long2num (((long long *) SCM_CELL_WORD_1 (v))[pos]); #endif case scm_tc7_fvect: if (SCM_NIMP (last) && !SCM_EQ_P (last, scm_flo0) && SCM_SLOPPY_REALP (last)) @@ -1261,7 +1286,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, "@var{new-value}. The value returned by array-set! is unspecified.") #define FUNC_NAME s_scm_array_set_x { - long pos = 0; + scm_bits_t pos = 0; SCM_VALIDATE_REST_ARGUMENT (args); SCM_ASRTGO (SCM_NIMP (v), badarg1); @@ -1272,7 +1297,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, } else { - unsigned long int length; + scm_bits_t length; if (SCM_NIMP (args)) { SCM_ASSERT (SCM_CONSP(args) && SCM_INUMP (SCM_CAR (args)), args, @@ -1317,10 +1342,10 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, ((char *) SCM_UVECTOR_BASE (v))[pos] = SCM_INUM (obj); break; case scm_tc7_uvect: - SCM_VELTS(v)[pos] = SCM_PACK (scm_num2ulong(obj, SCM_ARG2, FUNC_NAME)); + ((unsigned long *) SCM_VELTS(v))[pos] = SCM_PACK (scm_num2ulong(obj, SCM_ARG2, FUNC_NAME)); break; case scm_tc7_ivect: - SCM_VELTS(v)[pos] = SCM_PACK (scm_num2long (obj, SCM_ARG2, FUNC_NAME)); + ((long *) SCM_VELTS(v))[pos] = SCM_PACK (scm_num2long (obj, SCM_ARG2, FUNC_NAME)); break; case scm_tc7_svect: SCM_ASRTGO (SCM_INUMP (obj), badobj); @@ -1328,7 +1353,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, break; #ifdef HAVE_LONG_LONGS case scm_tc7_llvect: - ((long_long *) SCM_CELL_WORD_1 (v))[pos] = scm_num2long_long (obj, SCM_ARG2, FUNC_NAME); + ((long long *) SCM_CELL_WORD_1 (v))[pos] = scm_num2long_long (obj, SCM_ARG2, FUNC_NAME); break; #endif @@ -1400,7 +1425,8 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0, return ra; case scm_tc7_smob: { - scm_sizet k, ndim = SCM_ARRAY_NDIM (ra), len = 1; + size_t k, ndim = SCM_ARRAY_NDIM (ra); + scm_bits_t len = 1; if (!SCM_ARRAYP (ra) || !SCM_ARRAY_CONTP (ra)) return SCM_BOOL_F; for (k = 0; k < ndim; k++) @@ -1412,15 +1438,15 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0, if (scm_tc7_bvect == SCM_TYP7 (SCM_ARRAY_V (ra))) { if (len != SCM_BITVECTOR_LENGTH (SCM_ARRAY_V (ra)) || - SCM_ARRAY_BASE (ra) % SCM_LONG_BIT || - len % SCM_LONG_BIT) + SCM_ARRAY_BASE (ra) % SCM_BITS_LENGTH || + len % SCM_BITS_LENGTH) return SCM_BOOL_F; } } { SCM v = SCM_ARRAY_V (ra); - unsigned long int length = SCM_INUM (scm_uniform_vector_length (v)); + scm_bits_t length = SCM_INUM (scm_uniform_vector_length (v)); if ((len == length) && 0 == SCM_ARRAY_BASE (ra) && SCM_ARRAY_DIMS (ra)->inc) return v; } @@ -1442,8 +1468,9 @@ SCM scm_ra2contig (SCM ra, int copy) { SCM ret; - long inc = 1; - scm_sizet k, len = 1; + scm_bits_t inc = 1; + size_t k; + scm_bits_t len = 1; for (k = SCM_ARRAY_NDIM (ra); k--;) len *= SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd + 1; k = SCM_ARRAY_NDIM (ra); @@ -1452,8 +1479,8 @@ scm_ra2contig (SCM ra, int copy) if (scm_tc7_bvect != SCM_TYP7 (SCM_ARRAY_V (ra))) return ra; if ((len == SCM_BITVECTOR_LENGTH (SCM_ARRAY_V (ra)) && - 0 == SCM_ARRAY_BASE (ra) % SCM_LONG_BIT && - 0 == len % SCM_LONG_BIT)) + 0 == SCM_ARRAY_BASE (ra) % SCM_BITS_LENGTH && + 0 == len % SCM_BITS_LENGTH)) return ra; } ret = scm_make_ra (k); @@ -1491,10 +1518,10 @@ SCM_DEFINE (scm_uniform_array_read_x, "uniform-array-read!", 1, 3, 0, #define FUNC_NAME s_scm_uniform_array_read_x { SCM cra = SCM_UNDEFINED, v = ra; - long sz, vlen, ans; - long cstart = 0; - long cend; - long offset = 0; + int sz; + scm_bits_t vlen, ans; + scm_bits_t cstart = 0, cend = 0; + scm_bits_t offset = 0; char *base; SCM_ASRTGO (SCM_NIMP (v), badarg1); @@ -1525,9 +1552,9 @@ loop: break; case scm_tc7_bvect: base = (char *) SCM_BITVECTOR_BASE (v); - vlen = (vlen + SCM_LONG_BIT - 1) / SCM_LONG_BIT; - cstart /= SCM_LONG_BIT; - sz = sizeof (long); + vlen = (vlen + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; + cstart /= SCM_BITS_LENGTH; + sz = sizeof (scm_bits_t); break; case scm_tc7_byvect: base = (char *) SCM_UVECTOR_BASE (v); @@ -1545,7 +1572,7 @@ loop: #ifdef HAVE_LONG_LONGS case scm_tc7_llvect: base = (char *) SCM_UVECTOR_BASE (v); - sz = sizeof (long_long); + sz = sizeof (long long); break; #endif case scm_tc7_fvect: @@ -1566,15 +1593,15 @@ loop: if (!SCM_UNBNDP (start)) { offset = - SCM_NUM2LONG (3, start); + SCM_NUM2BITS (3, start); if (offset < 0 || offset >= cend) scm_out_of_range (FUNC_NAME, start); if (!SCM_UNBNDP (end)) { - long tend = - SCM_NUM2LONG (4, end); + scm_bits_t tend = + SCM_NUM2BITS (4, end); if (tend <= offset || tend > cend) scm_out_of_range (FUNC_NAME, end); @@ -1584,7 +1611,7 @@ loop: if (SCM_NIMP (port_or_fd)) { - scm_port *pt = SCM_PTAB_ENTRY (port_or_fd); + scm_port_t *pt = SCM_PTAB_ENTRY (port_or_fd); int remaining = (cend - offset) * sz; char *dest = base + (cstart + offset) * sz; @@ -1625,12 +1652,12 @@ loop: { SCM_SYSCALL (ans = read (SCM_INUM (port_or_fd), base + (cstart + offset) * sz, - (scm_sizet) (sz * (cend - offset)))); + (sz * (cend - offset)))); if (ans == -1) SCM_SYSERROR; } if (SCM_TYP7 (v) == scm_tc7_bvect) - ans *= SCM_LONG_BIT; + ans *= SCM_BITS_LENGTH; if (!SCM_EQ_P (v, ra) && !SCM_EQ_P (cra, ra)) scm_array_copy_x (cra, ra); @@ -1653,10 +1680,9 @@ SCM_DEFINE (scm_uniform_array_write, "uniform-array-write", 1, 3, 0, "@code{(current-output-port)}.") #define FUNC_NAME s_scm_uniform_array_write { - long sz, vlen, ans; - long offset = 0; - long cstart = 0; - long cend; + int sz; + scm_bits_t vlen, ans; + scm_bits_t offset = 0, cstart = 0, cend; char *base; port_or_fd = SCM_COERCE_OUTPORT (port_or_fd); @@ -1689,9 +1715,9 @@ loop: break; case scm_tc7_bvect: base = (char *) SCM_BITVECTOR_BASE (v); - vlen = (vlen + SCM_LONG_BIT - 1) / SCM_LONG_BIT; - cstart /= SCM_LONG_BIT; - sz = sizeof (long); + vlen = (vlen + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; + cstart /= SCM_BITS_LENGTH; + sz = sizeof (scm_bits_t); break; case scm_tc7_byvect: base = (char *) SCM_UVECTOR_BASE (v); @@ -1709,7 +1735,7 @@ loop: #ifdef HAVE_LONG_LONGS case scm_tc7_llvect: base = (char *) SCM_UVECTOR_BASE (v); - sz = sizeof (long_long); + sz = sizeof (long long); break; #endif case scm_tc7_fvect: @@ -1730,15 +1756,15 @@ loop: if (!SCM_UNBNDP (start)) { offset = - SCM_NUM2LONG (3, start); + SCM_NUM2BITS (3, start); if (offset < 0 || offset >= cend) scm_out_of_range (FUNC_NAME, start); if (!SCM_UNBNDP (end)) { - long tend = - SCM_NUM2LONG (4, end); + scm_bits_t tend = + SCM_NUM2BITS (4, end); if (tend <= offset || tend > cend) scm_out_of_range (FUNC_NAME, end); @@ -1757,12 +1783,12 @@ loop: { SCM_SYSCALL (ans = write (SCM_INUM (port_or_fd), base + (cstart + offset) * sz, - (scm_sizet) (sz * (cend - offset)))); + (sz * (cend - offset)))); if (ans == -1) SCM_SYSERROR; } if (SCM_TYP7 (v) == scm_tc7_bvect) - ans *= SCM_LONG_BIT; + ans *= SCM_BITS_LENGTH; return SCM_MAKINUM (ans); } @@ -1783,13 +1809,13 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0, if (SCM_BITVECTOR_LENGTH (bitvector) == 0) { return SCM_INUM0; } else { - unsigned long int count = 0; - unsigned long int i = (SCM_BITVECTOR_LENGTH (bitvector) - 1) / SCM_LONG_BIT; - unsigned long int w = SCM_UNPACK (SCM_VELTS (bitvector)[i]); + scm_bits_t count = 0; + size_t i = (SCM_BITVECTOR_LENGTH (bitvector) - 1) / SCM_BITS_LENGTH; + scm_ubits_t w = SCM_UNPACK (SCM_VELTS (bitvector)[i]); if (SCM_FALSEP (b)) { w = ~w; }; - w <<= SCM_LONG_BIT - 1 - ((SCM_BITVECTOR_LENGTH (bitvector) - 1) % SCM_LONG_BIT); + w <<= SCM_BITS_LENGTH - 1 - ((SCM_BITVECTOR_LENGTH (bitvector) - 1) % SCM_BITS_LENGTH); while (1) { while (w) { count += cnt_tab[w & 0x0f]; @@ -1817,8 +1843,11 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0, "within the specified range @code{#f} is returned.") #define FUNC_NAME s_scm_bit_position { - long i, lenw, xbits, pos; - register unsigned long w; + size_t i; + scm_bits_t pos; + size_t lenw; + int xbits; + register scm_ubits_t w; SCM_VALIDATE_BOOL (1, item); SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG2, FUNC_NAME); @@ -1828,15 +1857,15 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0, if (pos == SCM_BITVECTOR_LENGTH (v)) return SCM_BOOL_F; - lenw = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT; /* watch for part words */ - i = pos / SCM_LONG_BIT; + lenw = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_BITS_LENGTH; /* watch for part words */ + i = pos / SCM_BITS_LENGTH; w = SCM_UNPACK (SCM_VELTS (v)[i]); if (SCM_FALSEP (item)) w = ~w; - xbits = (pos % SCM_LONG_BIT); + xbits = (pos % SCM_BITS_LENGTH); pos -= xbits; w = ((w >> xbits) << xbits); - xbits = SCM_LONG_BIT - 1 - (SCM_BITVECTOR_LENGTH (v) - 1) % SCM_LONG_BIT; + xbits = SCM_BITS_LENGTH - 1 - (SCM_BITVECTOR_LENGTH (v) - 1) % SCM_BITS_LENGTH; while (!0) { if (w && (i == lenw)) @@ -1863,7 +1892,7 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0, } if (++i > lenw) break; - pos += SCM_LONG_BIT; + pos += SCM_BITS_LENGTH; w = SCM_UNPACK (SCM_VELTS (v)[i]); if (SCM_FALSEP (item)) w = ~w; @@ -1885,7 +1914,8 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, "@var{bool}. The return value is unspecified.") #define FUNC_NAME s_scm_bit_set_star_x { - register long i, k, vlen; + register size_t i; + scm_bits_t vlen; SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG1, FUNC_NAME); SCM_ASRTGO (SCM_NIMP (kv), badarg2); switch SCM_TYP7 (kv) @@ -1893,11 +1923,13 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, default: badarg2:SCM_WRONG_TYPE_ARG (2, kv); case scm_tc7_uvect: + { + unsigned long k; vlen = SCM_BITVECTOR_LENGTH (v); if (SCM_FALSEP (obj)) for (i = SCM_UVECTOR_LENGTH (kv); i;) { - k = SCM_UNPACK (SCM_VELTS (kv)[--i]); + k = ((unsigned long *) SCM_VELTS (kv))[--i]; if (k >= vlen) scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); SCM_BITVEC_CLR(v,k); @@ -1905,7 +1937,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, else if (SCM_EQ_P (obj, SCM_BOOL_T)) for (i = SCM_UVECTOR_LENGTH (kv); i;) { - k = SCM_UNPACK (SCM_VELTS (kv)[--i]); + k = ((unsigned long *) SCM_VELTS (kv))[--i]; if (k >= vlen) scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); SCM_BITVEC_SET(v,k); @@ -1913,18 +1945,22 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0, else badarg3:SCM_WRONG_TYPE_ARG (3, obj); break; + } case scm_tc7_bvect: + { + scm_ubits_t k; SCM_ASSERT (SCM_BITVECTOR_LENGTH (v) == SCM_BITVECTOR_LENGTH (kv), v, SCM_ARG1, FUNC_NAME); if (SCM_FALSEP (obj)) - for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;) - SCM_UNPACK (SCM_VELTS (v)[k]) &= ~ SCM_UNPACK(SCM_VELTS (kv)[k]); + for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; k--;) + ((scm_ubits_t *) SCM_VELTS (v))[k] &= ~ ((scm_ubits_t *) SCM_VELTS (kv))[k]; else if (SCM_EQ_P (obj, SCM_BOOL_T)) - for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;) - SCM_UNPACK (SCM_VELTS (v)[k]) |= SCM_UNPACK (SCM_VELTS (kv)[k]); + for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; k--;) + ((scm_ubits_t *) SCM_VELTS (v))[k] |= ((scm_ubits_t *) SCM_VELTS (kv))[k]; else goto badarg3; break; } + } return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -1939,8 +1975,8 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, "@var{bv} is not modified.") #define FUNC_NAME s_scm_bit_count_star { - register long i, vlen, count = 0; - register unsigned long k; + register size_t i; + scm_bits_t vlen, count = 0; int fObj = 0; SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG1, FUNC_NAME); @@ -1951,11 +1987,13 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, badarg2: SCM_WRONG_TYPE_ARG (2, kv); case scm_tc7_uvect: + { + unsigned long k; vlen = SCM_BITVECTOR_LENGTH (v); if (SCM_FALSEP (obj)) for (i = SCM_UVECTOR_LENGTH (kv); i;) { - k = SCM_UNPACK (SCM_VELTS (kv)[--i]); + k = ((unsigned long *) SCM_VELTS (kv))[--i]; if (k >= vlen) scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); if (!SCM_BITVEC_REF(v,k)) @@ -1964,7 +2002,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, else if (SCM_EQ_P (obj, SCM_BOOL_T)) for (i = SCM_UVECTOR_LENGTH (kv); i;) { - k = SCM_UNPACK (SCM_VELTS (kv)[--i]); + k = ((unsigned long *) SCM_VELTS (kv))[--i]; if (k >= vlen) scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); if (SCM_BITVEC_REF (v,k)) @@ -1973,15 +2011,20 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, else badarg3:SCM_WRONG_TYPE_ARG (3, obj); break; + } case scm_tc7_bvect: + { + scm_ubits_t k; SCM_ASSERT (SCM_BITVECTOR_LENGTH (v) == SCM_BITVECTOR_LENGTH (kv), v, SCM_ARG1, FUNC_NAME); if (0 == SCM_BITVECTOR_LENGTH (v)) return SCM_INUM0; SCM_ASRTGO (SCM_BOOLP (obj), badarg3); fObj = SCM_EQ_P (obj, SCM_BOOL_T); - i = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT; - k = SCM_UNPACK (SCM_VELTS (kv)[i]) & (fObj ? SCM_UNPACK (SCM_VELTS (v)[i]) : ~ SCM_UNPACK (SCM_VELTS (v)[i])); - k <<= SCM_LONG_BIT - 1 - ((SCM_BITVECTOR_LENGTH (v) - 1) % SCM_LONG_BIT); + i = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_BITS_LENGTH; + k = + ((scm_ubits_t *) SCM_VELTS (kv))[i] + & (fObj ? ((scm_ubits_t *) SCM_VELTS (v))[i] : ~ ((scm_ubits_t *) SCM_VELTS (v))[i]); + k <<= SCM_BITS_LENGTH - 1 - ((SCM_BITVECTOR_LENGTH (v) - 1) % SCM_BITS_LENGTH); while (1) { for (; k; k >>= 4) @@ -1990,7 +2033,10 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, return SCM_MAKINUM (count); /* urg. repetitive (see above.) */ - k = SCM_UNPACK (SCM_VELTS (kv)[i]) & (fObj ? SCM_UNPACK(SCM_VELTS (v)[i]) : ~SCM_UNPACK (SCM_VELTS (v)[i])); + k = + ((scm_ubits_t *) SCM_VELTS (kv))[i] + & (fObj ? ((scm_ubits_t *) SCM_VELTS (v))[i] : ~ ((scm_ubits_t *) SCM_VELTS (v))[i]); + } } } return SCM_MAKINUM (count); @@ -2003,13 +2049,13 @@ SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0, "Modifies @var{bv} by replacing each element with its negation.") #define FUNC_NAME s_scm_bit_invert_x { - long int k; + scm_bits_t k; SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG1, FUNC_NAME); k = SCM_BITVECTOR_LENGTH (v); - for (k = (k + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;) - SCM_UNPACK (SCM_VELTS (v)[k]) = ~SCM_UNPACK (SCM_VELTS (v)[k]); + for (k = (k + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; k--;) + ((scm_ubits_t *) SCM_VELTS (v))[k] = ~((scm_ubits_t *) SCM_VELTS (v))[k]; return SCM_UNSPECIFIED; } @@ -2017,19 +2063,19 @@ SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0, SCM -scm_istr2bve (char *str, long len) +scm_istr2bve (char *str, scm_bits_t len) { SCM v = scm_make_uve (len, SCM_BOOL_T); - long *data = (long *) SCM_VELTS (v); - register unsigned long mask; - register long k; - register long j; - for (k = 0; k < (len + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k++) + scm_ubits_t *data = (scm_ubits_t *) SCM_VELTS (v); + register scm_bits_t mask; + register size_t k; + register int j; + for (k = 0; k < (len + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; k++) { data[k] = 0L; - j = len - k * SCM_LONG_BIT; - if (j > SCM_LONG_BIT) - j = SCM_LONG_BIT; + j = len - k * SCM_BITS_LENGTH; + if (j > SCM_BITS_LENGTH) + j = SCM_BITS_LENGTH; for (mask = 1L; j--; mask <<= 1) switch (*str++) { @@ -2048,11 +2094,11 @@ scm_istr2bve (char *str, long len) static SCM -ra2l (SCM ra,scm_sizet base,scm_sizet k) +ra2l (SCM ra, scm_bits_t base, size_t k) { register SCM res = SCM_EOL; - register long inc = SCM_ARRAY_DIMS (ra)[k].inc; - register scm_sizet i; + register scm_bits_t inc = SCM_ARRAY_DIMS (ra)[k].inc; + register scm_bits_t i; if (SCM_ARRAY_DIMS (ra)[k].ubnd < SCM_ARRAY_DIMS (ra)[k].lbnd) return SCM_EOL; i = base + (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd) * inc; @@ -2083,7 +2129,7 @@ SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0, #define FUNC_NAME s_scm_array_to_list { SCM res = SCM_EOL; - register long k; + register size_t k; SCM_ASRTGO (SCM_NIMP (v), badarg1); switch SCM_TYP7 (v) { @@ -2099,48 +2145,48 @@ SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0, return scm_string_to_list (v); case scm_tc7_bvect: { - long *data = (long *) SCM_VELTS (v); - register unsigned long mask; - for (k = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT; k > 0; k--) - for (mask = 1UL << (SCM_LONG_BIT - 1); mask; mask >>= 1) - res = scm_cons (SCM_BOOL(((long *) data)[k] & mask), res); - for (mask = 1L << ((SCM_BITVECTOR_LENGTH (v) % SCM_LONG_BIT) - 1); mask; mask >>= 1) - res = scm_cons (SCM_BOOL(((long *) data)[k] & mask), res); + scm_ubits_t *data = (scm_ubits_t *) SCM_VELTS (v); + register scm_ubits_t mask; + for (k = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_BITS_LENGTH; k > 0; k--) + for (mask = 1UL << (SCM_BITS_LENGTH - 1); mask; mask >>= 1) + res = scm_cons (SCM_BOOL(data[k] & mask), res); + for (mask = 1L << ((SCM_BITVECTOR_LENGTH (v) % SCM_BITS_LENGTH) - 1); mask; mask >>= 1) + res = scm_cons (SCM_BOOL(data[k] & mask), res); return res; } case scm_tc7_byvect: { signed char *data = (signed char *) SCM_VELTS (v); - scm_sizet k = SCM_UVECTOR_LENGTH (v); + scm_bits_t k = SCM_UVECTOR_LENGTH (v); while (k != 0) res = scm_cons (SCM_MAKINUM (data[--k]), res); return res; } case scm_tc7_uvect: { - long *data = (long *)SCM_VELTS(v); + scm_ubits_t *data = (scm_ubits_t *) SCM_VELTS(v); for (k = SCM_UVECTOR_LENGTH(v) - 1; k >= 0; k--) - res = scm_cons(scm_ulong2num(data[k]), res); + res = scm_cons(scm_ubits2num(data[k]), res); return res; } case scm_tc7_ivect: { - long *data = (long *)SCM_VELTS(v); + scm_bits_t *data = (scm_bits_t *) SCM_VELTS(v); for (k = SCM_UVECTOR_LENGTH(v) - 1; k >= 0; k--) - res = scm_cons(scm_long2num(data[k]), res); + res = scm_cons(scm_bits2num(data[k]), res); return res; } case scm_tc7_svect: { short *data = (short *)SCM_VELTS(v); for (k = SCM_UVECTOR_LENGTH(v) - 1; k >= 0; k--) - res = scm_cons(SCM_MAKINUM (data[k]), res); + res = scm_cons(scm_short2num (data[k]), res); return res; } #ifdef HAVE_LONG_LONGS case scm_tc7_llvect: { - long_long *data = (long_long *)SCM_VELTS(v); + long long *data = (long long *)SCM_VELTS(v); for (k = SCM_UVECTOR_LENGTH(v) - 1; k >= 0; k--) res = scm_cons(scm_long_long2num(data[k]), res); return res; @@ -2172,7 +2218,7 @@ SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0, #undef FUNC_NAME -static int l2ra(SCM lst, SCM ra, scm_sizet base, scm_sizet k); +static int l2ra (SCM lst, SCM ra, scm_bits_t base, size_t k); SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0, (SCM ndim, SCM prot, SCM lst), @@ -2186,7 +2232,7 @@ SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0, SCM shp = SCM_EOL; SCM row = lst; SCM ra; - scm_sizet k; + scm_bits_t k; long n; SCM_VALIDATE_INUM_COPY (1,ndim,k); while (k--) @@ -2207,7 +2253,7 @@ SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0, } if (!SCM_ARRAYP (ra)) { - unsigned long int length = SCM_INUM (scm_uniform_vector_length (ra)); + scm_bits_t length = SCM_INUM (scm_uniform_vector_length (ra)); for (k = 0; k < length; k++, lst = SCM_CDR (lst)) scm_array_set_x (ra, SCM_CAR (lst), SCM_MAKINUM (k)); return ra; @@ -2220,10 +2266,10 @@ SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0, #undef FUNC_NAME static int -l2ra (SCM lst, SCM ra, scm_sizet base, scm_sizet k) +l2ra (SCM lst, SCM ra, scm_bits_t base, size_t k) { - register long inc = SCM_ARRAY_DIMS (ra)[k].inc; - register long n = (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd); + register scm_bits_t inc = SCM_ARRAY_DIMS (ra)[k].inc; + register scm_bits_t n = (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd); int ok = 1; if (n <= 0) return (SCM_NULLP (lst)); @@ -2258,10 +2304,10 @@ l2ra (SCM lst, SCM ra, scm_sizet base, scm_sizet k) static void -rapr1 (SCM ra,scm_sizet j,scm_sizet k,SCM port,scm_print_state *pstate) +rapr1 (SCM ra, scm_bits_t j, size_t k, SCM port, scm_print_state *pstate) { - long inc = 1; - long n = (SCM_TYP7 (ra) == scm_tc7_smob + scm_bits_t inc = 1; + scm_bits_t n = (SCM_TYP7 (ra) == scm_tc7_smob ? 0 : SCM_INUM (scm_uniform_vector_length (ra))); int enclosed = 0; @@ -2284,7 +2330,7 @@ tail: } if (k + 1 < SCM_ARRAY_NDIM (ra)) { - long i; + scm_bits_t i; inc = SCM_ARRAY_DIMS (ra)[k].inc; for (i = SCM_ARRAY_DIMS (ra)[k].lbnd; i < SCM_ARRAY_DIMS (ra)[k].ubnd; i++) { @@ -2301,8 +2347,7 @@ tail: } break; } - if SCM_ARRAY_NDIM - (ra) + if (SCM_ARRAY_NDIM (ra) > 0) { /* Could be zero-dimensional */ inc = SCM_ARRAY_DIMS (ra)[k].inc; n = (SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd + 1); @@ -2438,7 +2483,7 @@ int scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate) { SCM v = exp; - scm_sizet base = 0; + scm_bits_t base = 0; scm_putc ('#', port); tail: switch SCM_TYP7 (v) @@ -2465,21 +2510,23 @@ tail: case scm_tc7_bvect: if (SCM_EQ_P (exp, v)) { /* a uve, not an scm_array */ - register long i, j, w; + register size_t i; + register int j; + scm_ubits_t w; scm_putc ('*', port); - for (i = 0; i < (SCM_BITVECTOR_LENGTH (exp)) / SCM_LONG_BIT; i++) + for (i = 0; i < (SCM_BITVECTOR_LENGTH (exp) / SCM_BITS_LENGTH); i++) { - scm_bits_t w = SCM_UNPACK (SCM_VELTS (exp)[i]); - for (j = SCM_LONG_BIT; j; j--) + w = SCM_UNPACK (SCM_VELTS (exp)[i]); + for (j = SCM_BITS_LENGTH; j; j--) { scm_putc (w & 1 ? '1' : '0', port); w >>= 1; } } - j = SCM_BITVECTOR_LENGTH (exp) % SCM_LONG_BIT; + j = SCM_BITVECTOR_LENGTH (exp) % SCM_BITS_LENGTH; if (j) { - w = SCM_UNPACK (SCM_VELTS (exp)[SCM_BITVECTOR_LENGTH (exp) / SCM_LONG_BIT]); + w = SCM_UNPACK (SCM_VELTS (exp)[SCM_BITVECTOR_LENGTH (exp) / SCM_BITS_LENGTH]); for (; j; j--) { scm_putc (w & 1 ? '1' : '0', port); @@ -2584,7 +2631,7 @@ array_mark (SCM ptr) } -static scm_sizet +static size_t array_free (SCM ptr) { scm_must_free (SCM_ARRAY_MEM (ptr)); diff --git a/libguile/unif.h b/libguile/unif.h index 6cd376eda..14ff17904 100644 --- a/libguile/unif.h +++ b/libguile/unif.h @@ -58,21 +58,26 @@ bit 15 is the SCM_ARRAY_FLAG_CONTIGUOUS flag bits 16-31 hold the smob type id: scm_tc16_array CDR: pointer to a malloced block containing an scm_array structure - followed by an scm_array_dim structure for each dimension. + followed by an scm_array_dim_t structure for each dimension. */ -typedef struct scm_array +typedef struct scm_array_t { SCM v; /* the contents of the array, e.g., a vector or uniform vector. */ - scm_sizet base; -} scm_array; + scm_bits_t base; +} scm_array_t; -typedef struct scm_array_dim +typedef struct scm_array_dim_t { - long lbnd; - long ubnd; - long inc; -} scm_array_dim; + scm_bits_t lbnd; + scm_bits_t ubnd; + scm_bits_t inc; +} scm_array_dim_t; + +#if (SCM_DEBUG_DEPRECATED == 0) +# define scm_array scm_array_t +# define scm_array_dim scm_array_dim_t +#endif extern scm_bits_t scm_tc16_array; @@ -83,35 +88,37 @@ extern scm_bits_t scm_tc16_array; #endif #define SCM_ARRAYP(a) SCM_TYP16_PREDICATE (scm_tc16_array, a) -#define SCM_ARRAY_NDIM(x) ((scm_sizet) (SCM_CELL_WORD_0 (x) >> 17)) +#define SCM_ARRAY_NDIM(x) ((size_t) ((scm_ubits_t) (SCM_CELL_WORD_0 (x)) >> 17)) #define SCM_ARRAY_CONTP(x) (SCM_CELL_WORD_0 (x) & SCM_ARRAY_FLAG_CONTIGUOUS) #define SCM_SET_ARRAY_CONTIGUOUS_FLAG(x) \ (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) | SCM_ARRAY_FLAG_CONTIGUOUS)) #define SCM_CLR_ARRAY_CONTIGUOUS_FLAG(x) \ (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & ~SCM_ARRAY_FLAG_CONTIGUOUS)) -#define SCM_ARRAY_MEM(a) ((scm_array *) SCM_CELL_WORD_1 (a)) +#define SCM_ARRAY_MEM(a) ((scm_array_t *) SCM_CELL_WORD_1 (a)) #define SCM_ARRAY_V(a) (SCM_ARRAY_MEM (a)->v) #define SCM_ARRAY_BASE(a) (SCM_ARRAY_MEM (a)->base) -#define SCM_ARRAY_DIMS(a) ((scm_array_dim *)((char *) SCM_ARRAY_MEM (a) + sizeof (scm_array))) +#define SCM_ARRAY_DIMS(a) ((scm_array_dim_t *)((char *) SCM_ARRAY_MEM (a) + sizeof (scm_array))) + +#define SCM_I_MAX_LENGTH ((scm_ubits_t)((scm_bits_t)-1) >> 8) #define SCM_UVECTOR_BASE(x) ((void *) (SCM_CELL_WORD_1 (x))) #define SCM_SET_UVECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b))) -#define SCM_UVECTOR_MAX_LENGTH (0xffffffL) -#define SCM_UVECTOR_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8) +#define SCM_UVECTOR_MAX_LENGTH SCM_I_MAX_LENGTH +#define SCM_UVECTOR_LENGTH(x) (((scm_ubits_t) SCM_CELL_WORD_0 (x)) >> 8) #define SCM_SET_UVECTOR_LENGTH(v, l, t) (SCM_SET_CELL_WORD_0 ((v), ((l) << 8) + (t))) #define SCM_BITVECTOR_P(x) (!SCM_IMP (x) && (SCM_TYP7 (x) == scm_tc7_bvect)) #define SCM_BITVECTOR_BASE(x) ((void *) (SCM_CELL_WORD_1 (x))) #define SCM_SET_BITVECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b))) -#define SCM_BITVECTOR_MAX_LENGTH (0xffffffL) -#define SCM_BITVECTOR_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8) +#define SCM_BITVECTOR_MAX_LENGTH SCM_I_MAX_LENGTH +#define SCM_BITVECTOR_LENGTH(x) (((scm_ubits_t) SCM_CELL_WORD_0 (x)) >> 8) #define SCM_SET_BITVECTOR_LENGTH(v, l) (SCM_SET_CELL_WORD_0 ((v), ((l) << 8) + scm_tc7_bvect)) -extern scm_sizet scm_uniform_element_size (SCM obj); -extern SCM scm_make_uve (long k, SCM prot); +extern size_t scm_uniform_element_size (SCM obj); +extern SCM scm_make_uve (scm_bits_t k, SCM prot); extern SCM scm_uniform_vector_length (SCM v); extern SCM scm_array_p (SCM v, SCM prot); extern SCM scm_array_rank (SCM ra); @@ -119,7 +126,7 @@ extern SCM scm_array_dimensions (SCM ra); extern SCM scm_shared_array_root (SCM ra); extern SCM scm_shared_array_offset (SCM ra); extern SCM scm_shared_array_increments (SCM ra); -extern long scm_aind (SCM ra, SCM args, const char *what); +extern scm_bits_t scm_aind (SCM ra, SCM args, const char *what); extern SCM scm_make_ra (int ndim); extern SCM scm_shap2ra (SCM args, const char *what); extern SCM scm_dimensions_to_uniform_array (SCM dims, SCM prot, SCM fill); @@ -129,7 +136,7 @@ extern SCM scm_transpose_array (SCM ra, SCM args); extern SCM scm_enclose_array (SCM ra, SCM axes); extern SCM scm_array_in_bounds_p (SCM v, SCM args); extern SCM scm_uniform_vector_ref (SCM v, SCM args); -extern SCM scm_cvref (SCM v, scm_sizet pos, SCM last); +extern SCM scm_cvref (SCM v, scm_bits_t pos, SCM last); extern SCM scm_array_set_x (SCM v, SCM obj, SCM args); extern SCM scm_array_contents (SCM ra, SCM strict); extern SCM scm_ra2contig (SCM ra, int copy); @@ -140,7 +147,7 @@ extern SCM scm_bit_position (SCM item, SCM v, SCM k); extern SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj); extern SCM scm_bit_count_star (SCM v, SCM kv, SCM obj); extern SCM scm_bit_invert_x (SCM v); -extern SCM scm_istr2bve (char *str, long len); +extern SCM scm_istr2bve (char *str, scm_bits_t len); extern SCM scm_array_to_list (SCM v); extern SCM scm_list_to_uniform_array (SCM ndim, SCM prot, SCM lst); extern int scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate); diff --git a/libguile/validate.h b/libguile/validate.h index e2699b255..cc8df1561 100644 --- a/libguile/validate.h +++ b/libguile/validate.h @@ -1,4 +1,4 @@ -/* $Id: validate.h,v 1.31 2001-04-10 07:57:05 dirk Exp $ */ +/* $Id: validate.h,v 1.32 2001-05-24 00:50:51 cmm Exp $ */ /* Copyright (C) 1999,2000,2001 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify @@ -61,8 +61,51 @@ #define SCM_WRONG_TYPE_ARG(pos, obj) \ do { scm_wrong_type_arg (FUNC_NAME, pos, obj); } while (0) +#define SCM_NUM2SIZE(pos, arg) (scm_num2size (arg, pos, FUNC_NAME)) + +#define SCM_NUM2SIZE_DEF(pos, arg, def) \ + (SCM_UNBNDP (arg) ? def : scm_num2size (arg, pos, FUNC_NAME)) + +#define SCM_NUM2PTRDIFF(pos, arg) (scm_num2ptrdiff (arg, pos, FUNC_NAME)) + +#define SCM_NUM2PTRDIFF_DEF(pos, arg, def) \ + (SCM_UNBNDP (arg) ? def : scm_num2ptrdiff (arg, pos, FUNC_NAME)) + +#define SCM_NUM2SHORT(pos, arg) (scm_num2short (arg, pos, FUNC_NAME)) + +#define SCM_NUM2SHORT_DEF(pos, arg, def) \ + (SCM_UNBNDP (arg) ? def : scm_num2short (arg, pos, FUNC_NAME)) + +#define SCM_NUM2USHORT(pos, arg) (scm_num2ushort (arg, pos, FUNC_NAME)) + +#define SCM_NUM2USHORT_DEF(pos, arg, def) \ + (SCM_UNBNDP (arg) ? def : scm_num2ushort (arg, pos, FUNC_NAME)) + +#define SCM_NUM2BITS(pos, arg) (scm_num2bits (arg, pos, FUNC_NAME)) + +#define SCM_NUM2BITS_DEF(pos, arg, def) \ + (SCM_UNBNDP (arg) ? def : scm_num2bits (arg, pos, FUNC_NAME)) + +#define SCM_NUM2UBITS(pos, arg) (scm_num2ubits (arg, pos, FUNC_NAME)) + +#define SCM_NUM2UBITS_DEF(pos, arg, def) \ + (SCM_UNBNDP (arg) ? def : scm_num2ubits (arg, pos, FUNC_NAME)) + +#define SCM_NUM2INT(pos, arg) (scm_num2int (arg, pos, FUNC_NAME)) + +#define SCM_NUM2INT_DEF(pos, arg, def) \ + (SCM_UNBNDP (arg) ? def : scm_num2int (arg, pos, FUNC_NAME)) + +#define SCM_NUM2UINT(pos, arg) (scm_num2uint (arg, pos, FUNC_NAME)) + +#define SCM_NUM2UINT_DEF(pos, arg, def) \ + (SCM_UNBNDP (arg) ? def : scm_num2uint (arg, pos, FUNC_NAME)) + #define SCM_NUM2ULONG(pos, arg) (scm_num2ulong (arg, pos, FUNC_NAME)) +#define SCM_NUM2ULONG_DEF(pos, arg, def) \ + (SCM_UNBNDP (arg) ? def : scm_num2ulong (arg, pos, FUNC_NAME)) + #define SCM_NUM2LONG(pos, arg) (scm_num2long (arg, pos, FUNC_NAME)) #define SCM_NUM2LONG_DEF(pos, arg, def) \ @@ -71,6 +114,15 @@ #define SCM_NUM2LONG_LONG(pos, arg) \ (scm_num2long_long (arg, pos, FUNC_NAME)) +#define SCM_NUM2LONG_LONG_DEF(pos, arg, def) \ + (SCM_UNBNDP (arg) ? def : scm_num2long_long (arg, pos, FUNC_NAME)) + +#define SCM_NUM2ULONG_LONG(pos, arg) \ + (scm_num2ulong_long (arg, pos, FUNC_NAME)) + +#define SCM_NUM2ULONG_LONG_DEF(pos, arg, def) \ + (SCM_UNBNDP (arg) ? def : scm_num2ulong_long (arg, pos, FUNC_NAME)) + #define SCM_OUT_OF_RANGE(pos, arg) \ do { scm_out_of_range_pos (FUNC_NAME, arg, SCM_MAKINUM (pos)); } while (0) @@ -395,7 +447,7 @@ else if (SCM_REALP (z)) \ cvar = SCM_REAL_VALUE (z); \ else if (SCM_BIGP (z)) \ - cvar = scm_big2dbl (z); \ + cvar = scm_i_big2dbl (z); \ else \ { \ cvar = 0.0; \ diff --git a/libguile/values.c b/libguile/values.c index 5aad29a89..2fbfaaae9 100644 --- a/libguile/values.c +++ b/libguile/values.c @@ -77,7 +77,7 @@ SCM_DEFINE (scm_values, "values", 0, 0, 1, "were not created by @code{call-with-values} is unspecified.") #define FUNC_NAME s_scm_values { - long n; + scm_bits_t n; SCM result; SCM_VALIDATE_LIST_COPYLEN (1, args, n); diff --git a/libguile/vectors.c b/libguile/vectors.c index 5958338c3..d6d5a7867 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -73,9 +73,9 @@ static char s_vector_set_length_x[] = "vector-set-length!"; SCM scm_vector_set_length_x (SCM vect, SCM len) { - long l; - scm_sizet siz; - scm_sizet sz; + scm_bits_t l; + size_t siz; + size_t sz; char *base; l = SCM_INUM (len); @@ -84,7 +84,7 @@ scm_vector_set_length_x (SCM vect, SCM len) #ifdef HAVE_ARRAYS if (SCM_TYP7 (vect) == scm_tc7_bvect) { - l = (l + SCM_LONG_BIT - 1) / SCM_LONG_BIT; + l = (l + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; } sz = scm_uniform_element_size (vect); if (sz != 0) @@ -118,8 +118,8 @@ scm_vector_set_length_x (SCM vect, SCM len) SCM_SETCHARS (vect, ((char *) scm_must_realloc (base, - (long) SCM_LENGTH (vect) * sz, - (long) siz, + (size_t) SCM_LENGTH (vect) * sz, + (size_t) siz, s_vector_set_length_x))); if (SCM_VECTORP (vect)) { @@ -180,7 +180,7 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1, { SCM res; SCM *data; - long i; + scm_bits_t i; /* Dirk:FIXME:: In case of multiple threads, the list might get corrupted while the vector is being created. */ @@ -222,7 +222,7 @@ scm_vector_ref (SCM v, SCM k) SCM_GASSERT2 (SCM_INUMP (k), g_vector_ref, v, k, SCM_ARG2, s_vector_ref); SCM_ASSERT_RANGE (2, k, SCM_INUM (k) < SCM_VECTOR_LENGTH (v) && SCM_INUM (k) >= 0); - return SCM_VELTS (v)[(long) SCM_INUM (k)]; + return SCM_VELTS (v)[(ptrdiff_t) SCM_INUM (k)]; } #undef FUNC_NAME @@ -250,7 +250,7 @@ scm_vector_set_x (SCM v, SCM k, SCM obj) g_vector_set_x, SCM_LIST3 (v, k, obj), SCM_ARG2, s_vector_set_x); SCM_ASSERT_RANGE (2, k, SCM_INUM (k) < SCM_VECTOR_LENGTH (v) && SCM_INUM (k) >= 0); - SCM_VELTS(v)[(long) SCM_INUM(k)] = obj; + SCM_VELTS(v)[(ptrdiff_t) SCM_INUM(k)] = obj; return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -281,7 +281,7 @@ SCM_DEFINE (scm_make_vector, "make-vector", 1, 1, 0, SCM -scm_c_make_vector (unsigned long int k, SCM fill) +scm_c_make_vector (size_t k, SCM fill) #define FUNC_NAME s_scm_make_vector { SCM v; @@ -289,9 +289,9 @@ scm_c_make_vector (unsigned long int k, SCM fill) if (k > 0) { - unsigned long int j; + size_t j; - SCM_ASSERT_RANGE (1, scm_ulong2num (k), k <= SCM_VECTOR_MAX_LENGTH); + SCM_ASSERT_RANGE (1, scm_size2num (k), k <= SCM_VECTOR_MAX_LENGTH); base = scm_must_malloc (k * sizeof (scm_bits_t), FUNC_NAME); for (j = 0; j != k; ++j) @@ -322,7 +322,7 @@ SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0, #define FUNC_NAME s_scm_vector_to_list { SCM res = SCM_EOL; - long i; + scm_bits_t i; SCM *data; SCM_VALIDATE_VECTOR (1,v); data = SCM_VELTS(v); @@ -338,11 +338,11 @@ SCM_DEFINE (scm_vector_fill_x, "vector-fill!", 2, 0, 0, "returned by @code{vector-fill!} is unspecified.") #define FUNC_NAME s_scm_vector_fill_x { - register long i; + register scm_bits_t i; register SCM *data; - SCM_VALIDATE_VECTOR (1,v); - data = SCM_VELTS(v); - for(i = SCM_VECTOR_LENGTH(v) - 1; i >= 0; i--) + SCM_VALIDATE_VECTOR (1, v); + data = SCM_VELTS (v); + for(i = SCM_VECTOR_LENGTH (v) - 1; i >= 0; i--) data[i] = fill; return SCM_UNSPECIFIED; } @@ -352,9 +352,9 @@ SCM_DEFINE (scm_vector_fill_x, "vector-fill!", 2, 0, 0, SCM scm_vector_equal_p(SCM x, SCM y) { - long i; - for(i = SCM_VECTOR_LENGTH(x)-1;i >= 0;i--) - if (SCM_FALSEP(scm_equal_p(SCM_VELTS(x)[i], SCM_VELTS(y)[i]))) + scm_bits_t i; + for(i = SCM_VECTOR_LENGTH (x) - 1; i >= 0; i--) + if (SCM_FALSEP (scm_equal_p (SCM_VELTS (x)[i], SCM_VELTS (y)[i]))) return SCM_BOOL_F; return SCM_BOOL_T; } @@ -365,9 +365,9 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0, "Vector version of @code{substring-move-left!}.") #define FUNC_NAME s_scm_vector_move_left_x { - long i; - long j; - long e; + scm_bits_t i; + scm_bits_t j; + scm_bits_t e; SCM_VALIDATE_VECTOR (1,vec1); SCM_VALIDATE_INUM_COPY (2,start1,i); @@ -388,9 +388,9 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0, "Vector version of @code{substring-move-right!}.") #define FUNC_NAME s_scm_vector_move_right_x { - long i; - long j; - long e; + scm_bits_t i; + scm_bits_t j; + scm_bits_t e; SCM_VALIDATE_VECTOR (1,vec1); SCM_VALIDATE_INUM_COPY (2,start1,i); diff --git a/libguile/vectors.h b/libguile/vectors.h index 77d6131bf..7058dcac2 100644 --- a/libguile/vectors.h +++ b/libguile/vectors.h @@ -55,7 +55,7 @@ #define SCM_VECTOR_BASE(x) ((scm_bits_t *) SCM_CELL_WORD_1 (x)) #define SCM_SET_VECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b))) #define SCM_VECTOR_MAX_LENGTH ((1L << 24) - 1) -#define SCM_VECTOR_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8) +#define SCM_VECTOR_LENGTH(x) (((scm_ubits_t) SCM_CELL_WORD_0 (x)) >> 8) #define SCM_SET_VECTOR_LENGTH(v, l, t) (SCM_SET_CELL_WORD_0 ((v), ((l) << 8) + (t))) #define SCM_VELTS(x) ((SCM *) SCM_CELL_WORD_1 (x)) @@ -67,14 +67,14 @@ /* bit vectors */ -#define SCM_BITVEC_REF(a, i) ((SCM_UNPACK(SCM_VELTS(a)[(i)/SCM_LONG_BIT]) & (1L<<((i)%SCM_LONG_BIT))) ? 1 : 0) -#define SCM_BITVEC_SET(a, i) SCM_UNPACK(SCM_VELTS(a)[(i)/SCM_LONG_BIT]) |= (1L<<((i)%SCM_LONG_BIT)) -#define SCM_BITVEC_CLR(a, i) SCM_UNPACK(SCM_VELTS(a)[(i)/SCM_LONG_BIT]) &= ~(1L<<((i)%SCM_LONG_BIT)) +#define SCM_BITVEC_REF(a, i) ((SCM_UNPACK(SCM_VELTS(a)[(i)/SCM_BITS_LENGTH]) & (1L<<((i)%SCM_BITS_LENGTH))) ? 1 : 0) +#define SCM_BITVEC_SET(a, i) SCM_UNPACK(SCM_VELTS(a)[(i)/SCM_BITS_LENGTH]) |= (1L<<((i)%SCM_BITS_LENGTH)) +#define SCM_BITVEC_CLR(a, i) SCM_UNPACK(SCM_VELTS(a)[(i)/SCM_BITS_LENGTH]) &= ~(1L<<((i)%SCM_BITS_LENGTH)) -extern SCM scm_c_make_vector (unsigned long int k, SCM fill); +extern SCM scm_c_make_vector (size_t k, SCM fill); extern SCM scm_vector_p (SCM x); extern SCM scm_vector_length (SCM v); diff --git a/libguile/vports.c b/libguile/vports.c index ba4230e50..cd29ce31d 100644 --- a/libguile/vports.c +++ b/libguile/vports.c @@ -75,7 +75,7 @@ static scm_bits_t scm_tc16_sfport; static void sf_flush (SCM port) { - scm_port *pt = SCM_PTAB_ENTRY (port); + scm_port_t *pt = SCM_PTAB_ENTRY (port); SCM stream = SCM_PACK (pt->stream); if (pt->write_pos > pt->write_buf) @@ -121,7 +121,7 @@ sf_fill_input (SCM port) return EOF; SCM_ASSERT (SCM_CHARP (ans), ans, SCM_ARG1, "sf_fill_input"); { - scm_port *pt = SCM_PTAB_ENTRY (port); + scm_port_t *pt = SCM_PTAB_ENTRY (port); *pt->read_buf = SCM_CHAR (ans); pt->read_pos = pt->read_buf; @@ -190,7 +190,7 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0, "@end lisp") #define FUNC_NAME s_scm_make_soft_port { - scm_port *pt; + scm_port_t *pt; SCM z; SCM_VALIDATE_VECTOR_LEN (1,pv,5); SCM_VALIDATE_STRING (2, modes); diff --git a/libguile/weaks.c b/libguile/weaks.c index 81a4b879f..1432ae264 100644 --- a/libguile/weaks.c +++ b/libguile/weaks.c @@ -90,7 +90,7 @@ SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1, { SCM res; SCM *data; - long i; + scm_bits_t i; /* Dirk:FIXME:: In case of multiple threads, the list might get corrupted while the vector is being created. */ @@ -235,8 +235,7 @@ scm_mark_weak_vector_spines (void *dummy1, void *dummy2, void *dummy3) { SCM *ptr; SCM obj; - int j; - int n; + scm_bits_t j, n; obj = w; ptr = SCM_VELTS (w); @@ -280,8 +279,8 @@ scm_scan_weak_vectors (void *dummy1, void *dummy2, void *dummy3) else /* if (SCM_IS_WHVEC_ANY (scm_weak_vectors[i])) */ { SCM obj = w; - register long n = SCM_VECTOR_LENGTH (w); - register long j; + register scm_bits_t n = SCM_VECTOR_LENGTH (w); + register scm_bits_t j; int weak_keys = SCM_IS_WHVEC (obj) || SCM_IS_WHVEC_B (obj); int weak_values = SCM_IS_WHVEC_V (obj) || SCM_IS_WHVEC_B (obj); diff --git a/srfi/srfi-14.c b/srfi/srfi-14.c index ceb10f2e0..2cb7dc9e3 100644 --- a/srfi/srfi-14.c +++ b/srfi/srfi-14.c @@ -81,7 +81,7 @@ charset_print (SCM charset, SCM port, scm_print_state *pstate) /* Smob free hook for character sets. */ -static scm_sizet +static size_t charset_free (SCM charset) { return scm_smob_free (charset); diff --git a/test-suite/guile-test b/test-suite/guile-test index fa2b714f8..362938a9d 100755 --- a/test-suite/guile-test +++ b/test-suite/guile-test @@ -1,4 +1,4 @@ -#!/bogus-path/guile \ +#!../libguile/guile \ -e main -s !# |