mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-14 23:50:19 +02:00
Code Activity

revert the ill-considered part of the 2001-05-24 changes

Browse source
This commit is contained in:
Michael Livshin 2001-05-26 20:51:22 +00:00
parent f3f70257a3
commit c014a02eec
63 changed files with 723 additions and 813 deletions
Download patch file Download diff file Expand all files Collapse all files

4
libguile/ChangeLog
View file

@ -1,3 +1,7 @@
2001-05-26 Michael Livshin <mlivshin@bigfoot.com>
revert the controversial part of the 2001-05-24 changes.
2001-05-25 Marius Vollmer <mvo@zagadka.ping.de> 2001-05-25 Marius Vollmer <mvo@zagadka.ping.de>
* modules.c (scm_env_module): Exported to Scheme. * modules.c (scm_env_module): Exported to Scheme.

2
libguile/__scm.h
View file

@ -255,8 +255,6 @@ typedef unsigned long long ulong_long;
# define SCM_LONG_BIT (SCM_CHAR_BIT * sizeof (long) / sizeof (char)) # define SCM_LONG_BIT (SCM_CHAR_BIT * sizeof (long) / sizeof (char))
#endif #endif
#define SCM_BITS_LENGTH (SCM_CHAR_BIT * SCM_SIZEOF_BITS_T)
#ifdef UCHAR_MAX #ifdef UCHAR_MAX
# define SCM_CHAR_CODE_LIMIT (UCHAR_MAX + 1L) # define SCM_CHAR_CODE_LIMIT (UCHAR_MAX + 1L)
#else #else

2
libguile/continuations.c
View file

@ -116,7 +116,7 @@ scm_make_continuation (int *first)
volatile SCM cont; volatile SCM cont;
scm_contregs_t *continuation; scm_contregs_t *continuation;
scm_contregs_t *rootcont = SCM_CONTREGS (scm_rootcont); scm_contregs_t *rootcont = SCM_CONTREGS (scm_rootcont);
scm_bits_t stack_size; long stack_size;
SCM_STACKITEM * src; SCM_STACKITEM * src;
SCM_ENTER_A_SECTION; SCM_ENTER_A_SECTION;

4
libguile/continuations.h
View file

@ -63,8 +63,8 @@ typedef struct
jmp_buf jmpbuf; jmp_buf jmpbuf;
SCM dynenv; SCM dynenv;
SCM_STACKITEM *base; /* base of the live stack, before it was saved. */ SCM_STACKITEM *base; /* base of the live stack, before it was saved. */
scm_bits_t num_stack_items; /* size of the saved stack. */ size_t num_stack_items; /* size of the saved stack. */
scm_ubits_t seq; /* dynamic root identifier. */ unsigned long seq; /* dynamic root identifier. */
#ifdef DEBUG_EXTENSIONS #ifdef DEBUG_EXTENSIONS
/* the most recently created debug frame on the live stack, before /* the most recently created debug frame on the live stack, before

2
libguile/debug.h
View file

@ -116,7 +116,7 @@ typedef union scm_debug_info_t
SCM id; SCM id;
} scm_debug_info_t; } scm_debug_info_t;
extern scm_bits_t scm_debug_eframe_size; extern long scm_debug_eframe_size;
typedef struct scm_debug_frame_t typedef struct scm_debug_frame_t
{ {

2
libguile/deprecation.c
View file

@ -52,7 +52,7 @@
#if SCM_DEBUG_DEPRECATED == 0 #if (SCM_DEBUG_DEPRECATED == 0)
/* This is either a boolean (when a summary should be printed) or a /* This is either a boolean (when a summary should be printed) or a
hashtab (when detailed warnings shouold be printed). hashtab (when detailed warnings shouold be printed).

2
libguile/dynwind.c
View file

@ -201,7 +201,7 @@ scm_swap_bindings (SCM glocs, SCM vals)
} }
void void
scm_dowinds (SCM to, scm_bits_t delta) scm_dowinds (SCM to, long delta)
{ {
tail: tail:
if (SCM_EQ_P (to, scm_dynwinds)); if (SCM_EQ_P (to, scm_dynwinds));

2
libguile/dynwind.h
View file

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

18
libguile/environments.c
View file

@ -508,7 +508,7 @@ observer_mark (SCM observer)
static int static int
observer_print (SCM type, SCM port, scm_print_state *pstate) observer_print (SCM type, SCM port, scm_print_state *pstate)
{ {
SCM address = scm_ubits2num (SCM_UNPACK (type)); SCM address = scm_ulong2num (SCM_UNPACK (type));
SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16)); SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16));
scm_puts ("#<observer ", port); scm_puts ("#<observer ", port);
@ -1004,7 +1004,7 @@ leaf_environment_free (SCM env)
static int static int
leaf_environment_print (SCM type, SCM port, scm_print_state *pstate) leaf_environment_print (SCM type, SCM port, scm_print_state *pstate)
{ {
SCM address = scm_ubits2num (SCM_UNPACK (type)); SCM address = scm_ulong2num (SCM_UNPACK (type));
SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16)); SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16));
scm_puts ("#<leaf environment ", port); scm_puts ("#<leaf environment ", port);
@ -1246,7 +1246,7 @@ eval_environment_folder (SCM extended_data, SCM symbol, SCM value, SCM tail)
if (!SCM_ENVIRONMENT_BOUND_P (local, symbol)) if (!SCM_ENVIRONMENT_BOUND_P (local, symbol))
{ {
SCM proc_as_nr = SCM_CADR (extended_data); SCM proc_as_nr = SCM_CADR (extended_data);
scm_ubits_t proc_as_ul = scm_num2ubits (proc_as_nr, 0, NULL); unsigned long int proc_as_ul = scm_num2ulong (proc_as_nr, 0, NULL);
scm_environment_folder proc = (scm_environment_folder) proc_as_ul; scm_environment_folder proc = (scm_environment_folder) proc_as_ul;
SCM data = SCM_CDDR (extended_data); 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 local = EVAL_ENVIRONMENT (env)->local;
SCM imported = EVAL_ENVIRONMENT (env)->imported; SCM imported = EVAL_ENVIRONMENT (env)->imported;
SCM proc_as_nr = scm_ubits2num ((scm_ubits_t) proc); SCM proc_as_nr = scm_ulong2num ((unsigned long int) proc);
SCM extended_data = scm_cons2 (local, proc_as_nr, data); SCM extended_data = scm_cons2 (local, proc_as_nr, data);
SCM tmp_result = scm_c_environment_fold (imported, eval_environment_folder, extended_data, init); SCM tmp_result = scm_c_environment_fold (imported, eval_environment_folder, extended_data, init);
@ -1365,7 +1365,7 @@ eval_environment_free (SCM env)
static int static int
eval_environment_print (SCM type, SCM port, scm_print_state *pstate) eval_environment_print (SCM type, SCM port, scm_print_state *pstate)
{ {
SCM address = scm_ubits2num (SCM_UNPACK (type)); SCM address = scm_ulong2num (SCM_UNPACK (type));
SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16)); SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16));
scm_puts ("#<eval environment ", port); 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 imported_env = SCM_CADR (extended_data);
SCM owner = import_environment_lookup (import_env, symbol); SCM owner = import_environment_lookup (import_env, symbol);
SCM proc_as_nr = SCM_CADDR (extended_data); SCM proc_as_nr = SCM_CADDR (extended_data);
scm_ubits_t proc_as_ul = scm_num2ubits (proc_as_nr, 0, NULL); unsigned long int proc_as_ul = scm_num2ulong (proc_as_nr, 0, NULL);
scm_environment_folder proc = (scm_environment_folder) proc_as_ul; scm_environment_folder proc = (scm_environment_folder) proc_as_ul;
SCM data = SCM_CDDDR (extended_data); SCM data = SCM_CDDDR (extended_data);
@ -1670,7 +1670,7 @@ import_environment_folder (SCM extended_data, SCM symbol, SCM value, SCM tail)
static SCM static SCM
import_environment_fold (SCM env, scm_environment_folder proc, SCM data, SCM init) import_environment_fold (SCM env, scm_environment_folder proc, SCM data, SCM init)
{ {
SCM proc_as_nr = scm_ubits2num ((scm_ubits_t) proc); SCM proc_as_nr = scm_ulong2num ((unsigned long int) proc);
SCM result = init; SCM result = init;
SCM l; SCM l;
@ -1781,7 +1781,7 @@ import_environment_free (SCM env)
static int static int
import_environment_print (SCM type, SCM port, scm_print_state *pstate) import_environment_print (SCM type, SCM port, scm_print_state *pstate)
{ {
SCM address = scm_ubits2num (SCM_UNPACK (type)); SCM address = scm_ulong2num (SCM_UNPACK (type));
SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16)); SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16));
scm_puts ("#<import environment ", port); scm_puts ("#<import environment ", port);
@ -2084,7 +2084,7 @@ export_environment_free (SCM env)
static int static int
export_environment_print (SCM type, SCM port, scm_print_state *pstate) export_environment_print (SCM type, SCM port, scm_print_state *pstate)
{ {
SCM address = scm_ubits2num (SCM_UNPACK (type)); SCM address = scm_ulong2num (SCM_UNPACK (type));
SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16)); SCM base16 = scm_number_to_string (address, SCM_MAKINUM (16));
scm_puts ("#<export environment ", port); scm_puts ("#<export environment ", port);

52
libguile/eval.c
View file

@ -162,7 +162,7 @@ char *alloca ();
SCM * SCM *
scm_ilookup (SCM iloc, SCM env) scm_ilookup (SCM iloc, SCM env)
{ {
register scm_bits_t ir = SCM_IFRAME (iloc); register long ir = SCM_IFRAME (iloc);
register SCM er = env; register SCM er = env;
for (; 0 != ir; --ir) for (; 0 != ir; --ir)
er = SCM_CDR (er); er = SCM_CDR (er);
@ -419,7 +419,7 @@ scm_unmemocar (SCM form, SCM env)
#ifdef DEBUG_EXTENSIONS #ifdef DEBUG_EXTENSIONS
else if (SCM_ILOCP (c)) else if (SCM_ILOCP (c))
{ {
scm_bits_t ir; long ir;
for (ir = SCM_IFRAME (c); ir != 0; --ir) for (ir = SCM_IFRAME (c); ir != 0; --ir)
env = SCM_CDR (env); env = SCM_CDR (env);
@ -536,7 +536,7 @@ SCM_GLOBAL_SYMBOL(scm_sym_if, s_if);
SCM SCM
scm_m_if (SCM xorig, SCM env) scm_m_if (SCM xorig, SCM env)
{ {
scm_bits_t len = scm_ilength (SCM_CDR (xorig)); long len = scm_ilength (SCM_CDR (xorig));
SCM_ASSYNT (len >= 2 && len <= 3, scm_s_expression, "if"); SCM_ASSYNT (len >= 2 && len <= 3, scm_s_expression, "if");
return scm_cons (SCM_IM_IF, SCM_CDR (xorig)); return scm_cons (SCM_IM_IF, SCM_CDR (xorig));
} }
@ -563,7 +563,7 @@ SCM_GLOBAL_SYMBOL(scm_sym_and, s_and);
SCM SCM
scm_m_and (SCM xorig, SCM env) scm_m_and (SCM xorig, SCM env)
{ {
scm_bits_t len = scm_ilength (SCM_CDR (xorig)); long len = scm_ilength (SCM_CDR (xorig));
SCM_ASSYNT (len >= 0, scm_s_test, s_and); SCM_ASSYNT (len >= 0, scm_s_test, s_and);
if (len >= 1) if (len >= 1)
return scm_cons (SCM_IM_AND, SCM_CDR (xorig)); return scm_cons (SCM_IM_AND, SCM_CDR (xorig));
@ -577,7 +577,7 @@ SCM_GLOBAL_SYMBOL(scm_sym_or,s_or);
SCM SCM
scm_m_or (SCM xorig, SCM env) scm_m_or (SCM xorig, SCM env)
{ {
scm_bits_t len = scm_ilength (SCM_CDR (xorig)); long len = scm_ilength (SCM_CDR (xorig));
SCM_ASSYNT (len >= 0, scm_s_test, s_or); SCM_ASSYNT (len >= 0, scm_s_test, s_or);
if (len >= 1) if (len >= 1)
return scm_cons (SCM_IM_OR, SCM_CDR (xorig)); return scm_cons (SCM_IM_OR, SCM_CDR (xorig));
@ -615,7 +615,7 @@ SCM
scm_m_cond (SCM xorig, SCM env) scm_m_cond (SCM xorig, SCM env)
{ {
SCM arg1, cdrx = scm_list_copy (SCM_CDR (xorig)), x = cdrx; SCM arg1, cdrx = scm_list_copy (SCM_CDR (xorig)), x = cdrx;
scm_bits_t len = scm_ilength (x); long len = scm_ilength (x);
SCM_ASSYNT (len >= 1, scm_s_clauses, s_cond); SCM_ASSYNT (len >= 1, scm_s_clauses, s_cond);
while (SCM_NIMP (x)) while (SCM_NIMP (x))
{ {
@ -705,7 +705,7 @@ SCM
scm_m_letstar (SCM xorig, SCM env) scm_m_letstar (SCM xorig, SCM env)
{ {
SCM x = SCM_CDR (xorig), arg1, proc, vars = SCM_EOL, *varloc = &vars; SCM x = SCM_CDR (xorig), arg1, proc, vars = SCM_EOL, *varloc = &vars;
scm_bits_t len = scm_ilength (x); long len = scm_ilength (x);
SCM_ASSYNT (len >= 2, scm_s_body, s_letstar); SCM_ASSYNT (len >= 2, scm_s_body, s_letstar);
proc = SCM_CAR (x); proc = SCM_CAR (x);
SCM_ASSYNT (scm_ilength (proc) >= 0, scm_s_bindings, s_letstar); 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 x = SCM_CDR (xorig), arg1, proc;
SCM vars = SCM_EOL, inits = SCM_EOL, steps = SCM_EOL; SCM vars = SCM_EOL, inits = SCM_EOL, steps = SCM_EOL;
SCM *initloc = &inits, *steploc = &steps; SCM *initloc = &inits, *steploc = &steps;
scm_bits_t len = scm_ilength (x); long len = scm_ilength (x);
SCM_ASSYNT (len >= 2, scm_s_test, "do"); SCM_ASSYNT (len >= 2, scm_s_test, "do");
proc = SCM_CAR (x); proc = SCM_CAR (x);
SCM_ASSYNT (scm_ilength (proc) >= 0, scm_s_bindings, "do"); 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 #define evalcar scm_eval_car
static SCM iqq (SCM form, SCM env, scm_bits_t depth); static SCM iqq (SCM form, SCM env, long depth);
SCM_SYNTAX(s_quasiquote, "quasiquote", scm_makacro, scm_m_quasiquote); SCM_SYNTAX(s_quasiquote, "quasiquote", scm_makacro, scm_m_quasiquote);
SCM_GLOBAL_SYMBOL(scm_sym_quasiquote, s_quasiquote); SCM_GLOBAL_SYMBOL(scm_sym_quasiquote, s_quasiquote);
@ -795,15 +795,15 @@ scm_m_quasiquote (SCM xorig, SCM env)
static SCM static SCM
iqq (SCM form, SCM env, scm_bits_t depth) iqq (SCM form, SCM env, long depth)
{ {
SCM tmp; SCM tmp;
scm_bits_t edepth = depth; long edepth = depth;
if (SCM_IMP (form)) if (SCM_IMP (form))
return form; return form;
if (SCM_VECTORP (form)) if (SCM_VECTORP (form))
{ {
scm_bits_t i = SCM_VECTOR_LENGTH (form); long i = SCM_VECTOR_LENGTH (form);
SCM *data = SCM_VELTS (form); SCM *data = SCM_VELTS (form);
tmp = SCM_EOL; tmp = SCM_EOL;
for (; --i >= 0;) for (; --i >= 0;)
@ -1043,7 +1043,7 @@ SCM_SYNTAX (s_nil_cond, "nil-cond", scm_makmmacro, scm_m_nil_cond);
SCM SCM
scm_m_nil_cond (SCM xorig, SCM env) scm_m_nil_cond (SCM xorig, SCM env)
{ {
scm_bits_t len = scm_ilength (SCM_CDR (xorig)); long len = scm_ilength (SCM_CDR (xorig));
SCM_ASSYNT (len >= 1 && (len & 1) == 1, scm_s_expression, "nil-cond"); SCM_ASSYNT (len >= 1 && (len & 1) == 1, scm_s_expression, "nil-cond");
return scm_cons (SCM_IM_NIL_COND, SCM_CDR (xorig)); 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
scm_m_0_cond (SCM xorig, SCM env) scm_m_0_cond (SCM xorig, SCM env)
{ {
scm_bits_t len = scm_ilength (SCM_CDR (xorig)); long len = scm_ilength (SCM_CDR (xorig));
SCM_ASSYNT (len >= 1 && (len & 1) == 1, scm_s_expression, "0-cond"); SCM_ASSYNT (len >= 1 && (len & 1) == 1, scm_s_expression, "0-cond");
return scm_cons (SCM_IM_0_COND, SCM_CDR (xorig)); return scm_cons (SCM_IM_0_COND, SCM_CDR (xorig));
} }
@ -1658,11 +1658,11 @@ scm_debug_frame_t *scm_last_debug_frame;
* stack frames at each real stack frame. * stack frames at each real stack frame.
*/ */
scm_bits_t scm_debug_eframe_size; long scm_debug_eframe_size;
int scm_debug_mode, scm_check_entry_p, scm_check_apply_p, scm_check_exit_p; int scm_debug_mode, scm_check_entry_p, scm_check_apply_p, scm_check_exit_p;
scm_bits_t scm_eval_stack; long scm_eval_stack;
scm_option_t scm_eval_opts[] = { scm_option_t scm_eval_opts[] = {
{ SCM_OPTION_INTEGER, "stack", 22000, "Size of thread stacks (in machine words)." } { SCM_OPTION_INTEGER, "stack", 22000, "Size of thread stacks (in machine words)." }
@ -2304,7 +2304,7 @@ dispatch:
* cuts down execution time for type dispatch to 50%. * cuts down execution time for type dispatch to 50%.
*/ */
{ {
scm_bits_t i, n, end, mask; long i, n, end, mask;
SCM z = SCM_CDDR (x); SCM z = SCM_CDDR (x);
n = SCM_INUM (SCM_CAR (z)); /* maximum number of specializers */ n = SCM_INUM (SCM_CAR (z)); /* maximum number of specializers */
proc = SCM_CADR (z); proc = SCM_CADR (z);
@ -2319,8 +2319,8 @@ dispatch:
else else
{ {
/* Compute a hash value */ /* Compute a hash value */
scm_bits_t hashset = SCM_INUM (proc); long hashset = SCM_INUM (proc);
scm_bits_t j = n; long j = n;
mask = SCM_INUM (SCM_CAR (z = SCM_CDDR (z))); mask = SCM_INUM (SCM_CAR (z = SCM_CDDR (z)));
proc = SCM_CADR (z); proc = SCM_CADR (z);
i = 0; i = 0;
@ -2340,7 +2340,7 @@ dispatch:
/* Search for match */ /* Search for match */
do do
{ {
scm_bits_t j = n; long j = n;
z = SCM_VELTS (proc)[i]; z = SCM_VELTS (proc)[i];
t.arg1 = arg2; /* list of arguments */ t.arg1 = arg2; /* list of arguments */
if (SCM_NIMP (t.arg1)) if (SCM_NIMP (t.arg1))
@ -3632,18 +3632,18 @@ ret:
and claim that the i'th element of ARGV is WHO's i+2'th argument. */ and claim that the i'th element of ARGV is WHO's i+2'th argument. */
static inline void static inline void
check_map_args (SCM argv, check_map_args (SCM argv,
scm_bits_t len, long len,
SCM gf, SCM gf,
SCM proc, SCM proc,
SCM args, SCM args,
const char *who) const char *who)
{ {
SCM *ve = SCM_VELTS (argv); SCM *ve = SCM_VELTS (argv);
scm_bits_t i; long i;
for (i = SCM_VECTOR_LENGTH (argv) - 1; i >= 1; i--) for (i = SCM_VECTOR_LENGTH (argv) - 1; i >= 1; i--)
{ {
scm_bits_t elt_len = scm_ilength (ve[i]); long elt_len = scm_ilength (ve[i]);
if (elt_len < 0) if (elt_len < 0)
{ {
@ -3674,7 +3674,7 @@ SCM
scm_map (SCM proc, SCM arg1, SCM args) scm_map (SCM proc, SCM arg1, SCM args)
#define FUNC_NAME s_map #define FUNC_NAME s_map
{ {
scm_bits_t i, len; long i, len;
SCM res = SCM_EOL; SCM res = SCM_EOL;
SCM *pres = &res; SCM *pres = &res;
SCM *ve = &args; /* Keep args from being optimized away. */ SCM *ve = &args; /* Keep args from being optimized away. */
@ -3723,7 +3723,7 @@ scm_for_each (SCM proc, SCM arg1, SCM args)
#define FUNC_NAME s_for_each #define FUNC_NAME s_for_each
{ {
SCM *ve = &args; /* Keep args from being optimized away. */ SCM *ve = &args; /* Keep args from being optimized away. */
scm_bits_t i, len; long i, len;
len = scm_ilength (arg1); len = scm_ilength (arg1);
SCM_GASSERTn (len >= 0, g_for_each, scm_cons2 (proc, arg1, args), SCM_GASSERTn (len >= 0, g_for_each, scm_cons2 (proc, arg1, args),
SCM_ARG2, s_for_each); SCM_ARG2, s_for_each);
@ -3862,7 +3862,7 @@ SCM_DEFINE (scm_copy_tree, "copy-tree", 1, 0, 0,
return obj; return obj;
if (SCM_VECTORP (obj)) if (SCM_VECTORP (obj))
{ {
size_t i = SCM_VECTOR_LENGTH (obj); unsigned long i = SCM_VECTOR_LENGTH (obj);
ans = scm_c_make_vector (i, SCM_UNSPECIFIED); ans = scm_c_make_vector (i, SCM_UNSPECIFIED);
while (i--) while (i--)
SCM_VELTS (ans)[i] = scm_copy_tree (SCM_VELTS (obj)[i]); SCM_VELTS (ans)[i] = scm_copy_tree (SCM_VELTS (obj)[i]);

6
libguile/eval.h
View file

@ -58,7 +58,7 @@ extern scm_option_t scm_eval_opts[];
#define SCM_EVAL_STACK scm_eval_opts[0].val #define SCM_EVAL_STACK scm_eval_opts[0].val
#define SCM_N_EVAL_OPTIONS 1 #define SCM_N_EVAL_OPTIONS 1
extern scm_bits_t scm_eval_stack; extern long scm_eval_stack;
extern scm_option_t scm_evaluator_trap_table[]; extern scm_option_t scm_evaluator_trap_table[];
@ -83,8 +83,8 @@ extern SCM scm_eval_options_interface (SCM setting);
#define SCM_ICDR (0x00080000L) #define SCM_ICDR (0x00080000L)
#define SCM_IFRINC (0x00000100L) #define SCM_IFRINC (0x00000100L)
#define SCM_IDSTMSK (-SCM_IDINC) #define SCM_IDSTMSK (-SCM_IDINC)
#define SCM_IFRAME(n) ((scm_bits_t)((SCM_ICDR-SCM_IFRINC)>>8) \ #define SCM_IFRAME(n) ((long)((SCM_ICDR-SCM_IFRINC)>>8) \
& (SCM_UNPACK (n)) >> 8) & (SCM_UNPACK (n) >> 8))
#define SCM_IDIST(n) (SCM_UNPACK (n) >> 20) #define SCM_IDIST(n) (SCM_UNPACK (n) >> 20)
#define SCM_ICDRP(n) (SCM_ICDR & SCM_UNPACK (n)) #define SCM_ICDRP(n) (SCM_ICDR & SCM_UNPACK (n))

16
libguile/fluids.c
View file

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

16
libguile/fports.c
View file

@ -79,7 +79,7 @@ static const size_t default_buffer_size = 1024;
/* create FPORT buffer with specified sizes (or -1 to use default size or /* create FPORT buffer with specified sizes (or -1 to use default size or
0 for no buffer. */ 0 for no buffer. */
static void static void
scm_fport_buffer_add (SCM port, scm_bits_t read_size, scm_bits_t write_size) scm_fport_buffer_add (SCM port, long read_size, int write_size)
#define FUNC_NAME "scm_fport_buffer_add" #define FUNC_NAME "scm_fport_buffer_add"
{ {
scm_fport_t *fp = SCM_FSTREAM (port); scm_fport_t *fp = SCM_FSTREAM (port);
@ -149,7 +149,7 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
#define FUNC_NAME s_scm_setvbuf #define FUNC_NAME s_scm_setvbuf
{ {
int cmode; int cmode;
scm_bits_t csize; long csize;
scm_port_t *pt; scm_port_t *pt;
port = SCM_COERCE_OUTPORT (port); port = SCM_COERCE_OUTPORT (port);
@ -203,7 +203,7 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
void void
scm_evict_ports (int fd) scm_evict_ports (int fd)
{ {
scm_bits_t i; long i;
for (i = 0; i < scm_port_table_size; i++) for (i = 0; i < scm_port_table_size; i++)
{ {
@ -505,7 +505,7 @@ static void fport_flush (SCM port);
static int static int
fport_fill_input (SCM port) fport_fill_input (SCM port)
{ {
scm_bits_t count; long count;
scm_port_t *pt = SCM_PTAB_ENTRY (port); scm_port_t *pt = SCM_PTAB_ENTRY (port);
scm_fport_t *fp = SCM_FSTREAM (port); scm_fport_t *fp = SCM_FSTREAM (port);
@ -675,19 +675,19 @@ fport_flush (SCM port)
scm_port_t *pt = SCM_PTAB_ENTRY (port); scm_port_t *pt = SCM_PTAB_ENTRY (port);
scm_fport_t *fp = SCM_FSTREAM (port); scm_fport_t *fp = SCM_FSTREAM (port);
unsigned char *ptr = pt->write_buf; unsigned char *ptr = pt->write_buf;
scm_bits_t init_size = pt->write_pos - pt->write_buf; long init_size = pt->write_pos - pt->write_buf;
scm_bits_t remaining = init_size; long remaining = init_size;
while (remaining > 0) while (remaining > 0)
{ {
scm_bits_t count; long count;
SCM_SYSCALL (count = write (fp->fdes, ptr, remaining)); SCM_SYSCALL (count = write (fp->fdes, ptr, remaining));
if (count < 0) if (count < 0)
{ {
/* error. assume nothing was written this call, but /* error. assume nothing was written this call, but
fix up the buffer for any previous successful writes. */ fix up the buffer for any previous successful writes. */
scm_bits_t done = init_size - remaining; long done = init_size - remaining;
if (done > 0) if (done > 0)
{ {

182
libguile/gc.c
View file

@ -257,11 +257,11 @@ size_t 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)) # define CELL_DN(p, span) MK_FP(FP_SEG(p), ~(8*(span)-1)&FP_OFF(p))
#else #else
# ifdef _UNICOS # ifdef _UNICOS
# define CELL_UP(p, span) (SCM_CELLPTR)(~(span) & ((scm_ubits_t)(p)+(span))) # define CELL_UP(p, span) (SCM_CELLPTR)(~(span) & ((long)(p)+(span)))
# define CELL_DN(p, span) (SCM_CELLPTR)(~(span) & (scm_ubits_t)(p)) # define CELL_DN(p, span) (SCM_CELLPTR)(~(span) & (long)(p))
# else # else
# define CELL_UP(p, span) (SCM_CELLPTR)(~(sizeof(scm_cell)*(span)-1L) & ((scm_ubits_t)(p)+sizeof(scm_cell)*(span)-1L)) # 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) & (scm_ubits_t)(p)) # define CELL_DN(p, span) (SCM_CELLPTR)(~(sizeof(scm_cell)*(span)-1L) & (long)(p))
# endif /* UNICOS */ # endif /* UNICOS */
#endif /* PROT386 */ #endif /* PROT386 */
@ -301,13 +301,13 @@ typedef struct scm_freelist_t {
/* number of cells per object on this list */ /* number of cells per object on this list */
int span; int span;
/* number of collected cells during last GC */ /* number of collected cells during last GC */
scm_ubits_t collected; unsigned long collected;
/* number of collected cells during penultimate GC */ /* number of collected cells during penultimate GC */
scm_ubits_t collected_1; unsigned long collected_1;
/* total number of cells in heap segments /* total number of cells in heap segments
* belonging to this list. * belonging to this list.
*/ */
scm_ubits_t heap_size; unsigned long heap_size;
} scm_freelist_t; } scm_freelist_t;
SCM scm_freelist = SCM_EOL; SCM scm_freelist = SCM_EOL;
@ -322,7 +322,7 @@ scm_freelist_t scm_master_freelist2 = {
/* scm_mtrigger /* scm_mtrigger
* is the number of bytes of must_malloc allocation needed to trigger gc. * is the number of bytes of must_malloc allocation needed to trigger gc.
*/ */
scm_ubits_t scm_mtrigger; unsigned long scm_mtrigger;
/* scm_gc_heap_lock /* scm_gc_heap_lock
* If set, don't expand the heap. Set only during gc, during which no allocation * If set, don't expand the heap. Set only during gc, during which no allocation
@ -347,20 +347,20 @@ SCM scm_structs_to_free;
/* GC Statistics Keeping /* GC Statistics Keeping
*/ */
scm_ubits_t scm_cells_allocated = 0; unsigned long scm_cells_allocated = 0;
scm_ubits_t scm_mallocated = 0; unsigned long scm_mallocated = 0;
scm_ubits_t scm_gc_cells_collected; unsigned long scm_gc_cells_collected;
scm_ubits_t scm_gc_yield; unsigned long scm_gc_yield;
static scm_ubits_t scm_gc_yield_1 = 0; /* previous GC yield */ static unsigned long scm_gc_yield_1 = 0; /* previous GC yield */
scm_ubits_t scm_gc_malloc_collected; unsigned long scm_gc_malloc_collected;
scm_ubits_t scm_gc_ports_collected; unsigned long scm_gc_ports_collected;
unsigned long scm_gc_time_taken = 0; unsigned long scm_gc_time_taken = 0;
static scm_ubits_t t_before_gc; static unsigned long t_before_gc;
static scm_ubits_t t_before_sweep; static unsigned long t_before_sweep;
unsigned long scm_gc_mark_time_taken = 0; unsigned long scm_gc_mark_time_taken = 0;
unsigned long scm_gc_sweep_time_taken = 0; unsigned long scm_gc_sweep_time_taken = 0;
scm_ubits_t scm_gc_times = 0; unsigned long scm_gc_times = 0;
scm_ubits_t scm_gc_cells_swept = 0; unsigned long scm_gc_cells_swept = 0;
double scm_gc_cells_marked_acc = 0.; double scm_gc_cells_marked_acc = 0.;
double scm_gc_cells_swept_acc = 0.; double scm_gc_cells_swept_acc = 0.;
@ -482,10 +482,10 @@ clear_mark_space ()
#if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST) #if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST)
/* Return the number of the heap segment containing CELL. */ /* Return the number of the heap segment containing CELL. */
static scm_bits_t static long
which_seg (SCM cell) which_seg (SCM cell)
{ {
scm_bits_t i; long i;
for (i = 0; i < scm_n_heap_segs; i++) for (i = 0; i < scm_n_heap_segs; i++)
if (SCM_PTR_LE (scm_heap_table[i].bounds[0], SCM2PTR (cell)) if (SCM_PTR_LE (scm_heap_table[i].bounds[0], SCM2PTR (cell))
@ -500,12 +500,12 @@ which_seg (SCM cell)
static void static void
map_free_list (scm_freelist_t *master, SCM freelist) map_free_list (scm_freelist_t *master, SCM freelist)
{ {
scm_bits_t last_seg = -1, count = 0; long last_seg = -1, count = 0;
SCM f; SCM f;
for (f = freelist; !SCM_NULLP (f); f = SCM_FREE_CELL_CDR (f)) for (f = freelist; !SCM_NULLP (f); f = SCM_FREE_CELL_CDR (f))
{ {
scm_bits_t this_seg = which_seg (f); long this_seg = which_seg (f);
if (this_seg != last_seg) if (this_seg != last_seg)
{ {
@ -529,7 +529,7 @@ SCM_DEFINE (scm_map_free_list, "map-free-list", 0, 0, 0,
"@code{--enable-guile-debug} builds of Guile.") "@code{--enable-guile-debug} builds of Guile.")
#define FUNC_NAME s_scm_map_free_list #define FUNC_NAME s_scm_map_free_list
{ {
scm_bits_t i; long i;
fprintf (stderr, "%ld segments total (%d:%ld", fprintf (stderr, "%ld segments total (%d:%ld",
(long) scm_n_heap_segs, (long) scm_n_heap_segs,
scm_heap_table[0].span, scm_heap_table[0].span,
@ -547,14 +547,14 @@ SCM_DEFINE (scm_map_free_list, "map-free-list", 0, 0, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
static scm_bits_t last_cluster; static long last_cluster;
static scm_bits_t last_size; static long last_size;
static scm_bits_t static long
free_list_length (char *title, scm_bits_t i, SCM freelist) free_list_length (char *title, long i, SCM freelist)
{ {
SCM ls; SCM ls;
scm_bits_t n = 0; long n = 0;
for (ls = freelist; !SCM_NULLP (ls); ls = SCM_FREE_CELL_CDR (ls)) for (ls = freelist; !SCM_NULLP (ls); ls = SCM_FREE_CELL_CDR (ls))
if (SCM_FREE_CELL_P (ls)) if (SCM_FREE_CELL_P (ls))
++n; ++n;
@ -586,7 +586,7 @@ static void
free_list_lengths (char *title, scm_freelist_t *master, SCM freelist) free_list_lengths (char *title, scm_freelist_t *master, SCM freelist)
{ {
SCM clusters; SCM clusters;
scm_bits_t i = 0, len, n = 0; long i = 0, len, n = 0;
fprintf (stderr, "%s\n\n", title); fprintf (stderr, "%s\n\n", title);
n += free_list_length ("free list", -1, freelist); n += free_list_length ("free list", -1, freelist);
for (clusters = master->clusters; for (clusters = master->clusters;
@ -625,8 +625,8 @@ SCM_DEFINE (scm_free_list_length, "free-list-length", 0, 0, 0,
static int scm_debug_check_freelist = 0; static int scm_debug_check_freelist = 0;
/* Number of calls to SCM_NEWCELL since startup. */ /* Number of calls to SCM_NEWCELL since startup. */
static scm_ubits_t scm_newcell_count; static unsigned long scm_newcell_count;
static scm_ubits_t scm_newcell2_count; static unsigned long scm_newcell2_count;
/* Search freelist for anything that isn't marked as a free cell. /* Search freelist for anything that isn't marked as a free cell.
Abort if we find something. */ Abort if we find something. */
@ -634,7 +634,7 @@ static void
scm_check_freelist (SCM freelist) scm_check_freelist (SCM freelist)
{ {
SCM f; SCM f;
scm_bits_t i = 0; long i = 0;
for (f = freelist; !SCM_NULLP (f); f = SCM_FREE_CELL_CDR (f), i++) for (f = freelist; !SCM_NULLP (f); f = SCM_FREE_CELL_CDR (f), i++)
if (!SCM_FREE_CELL_P (f)) if (!SCM_FREE_CELL_P (f))
@ -722,26 +722,26 @@ scm_debug_newcell2 (void)
static scm_ubits_t static unsigned long
master_cells_allocated (scm_freelist_t *master) master_cells_allocated (scm_freelist_t *master)
{ {
/* the '- 1' below is to ignore the cluster spine cells. */ /* the '- 1' below is to ignore the cluster spine cells. */
scm_bits_t objects = master->clusters_allocated * (master->cluster_size - 1); long objects = master->clusters_allocated * (master->cluster_size - 1);
if (SCM_NULLP (master->clusters)) if (SCM_NULLP (master->clusters))
objects -= master->left_to_collect; objects -= master->left_to_collect;
return master->span * objects; return master->span * objects;
} }
static scm_ubits_t static unsigned long
freelist_length (SCM freelist) freelist_length (SCM freelist)
{ {
scm_bits_t n; long n;
for (n = 0; !SCM_NULLP (freelist); freelist = SCM_FREE_CELL_CDR (freelist)) for (n = 0; !SCM_NULLP (freelist); freelist = SCM_FREE_CELL_CDR (freelist))
++n; ++n;
return n; return n;
} }
static scm_ubits_t static unsigned long
compute_cells_allocated () compute_cells_allocated ()
{ {
return (scm_cells_allocated return (scm_cells_allocated
@ -760,17 +760,17 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
"use of storage.") "use of storage.")
#define FUNC_NAME s_scm_gc_stats #define FUNC_NAME s_scm_gc_stats
{ {
scm_bits_t i; long i;
scm_bits_t n; long n;
SCM heap_segs; SCM heap_segs;
scm_ubits_t local_scm_mtrigger; unsigned long int local_scm_mtrigger;
scm_ubits_t local_scm_mallocated; unsigned long int local_scm_mallocated;
scm_ubits_t local_scm_heap_size; unsigned long int local_scm_heap_size;
scm_ubits_t local_scm_cells_allocated; unsigned long int local_scm_cells_allocated;
unsigned long local_scm_gc_time_taken; unsigned long int local_scm_gc_time_taken;
scm_ubits_t local_scm_gc_times; unsigned long int local_scm_gc_times;
unsigned long local_scm_gc_mark_time_taken; unsigned long int local_scm_gc_mark_time_taken;
unsigned long local_scm_gc_sweep_time_taken; unsigned long int local_scm_gc_sweep_time_taken;
double local_scm_gc_cells_swept; double local_scm_gc_cells_swept;
double local_scm_gc_cells_marked; double local_scm_gc_cells_marked;
SCM answer; SCM answer;
@ -783,8 +783,8 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
heap_segs = SCM_EOL; heap_segs = SCM_EOL;
n = scm_n_heap_segs; n = scm_n_heap_segs;
for (i = scm_n_heap_segs; i--; ) for (i = scm_n_heap_segs; i--; )
heap_segs = scm_cons (scm_cons (scm_ubits2num ((scm_ubits_t)scm_heap_table[i].bounds[1]), heap_segs = scm_cons (scm_cons (scm_ulong2num ((unsigned long)scm_heap_table[i].bounds[1]),
scm_ubits2num ((scm_ubits_t)scm_heap_table[i].bounds[0])), scm_ulong2num ((unsigned long)scm_heap_table[i].bounds[0])),
heap_segs); heap_segs);
if (scm_n_heap_segs != n) if (scm_n_heap_segs != n)
goto retry; goto retry;
@ -806,11 +806,11 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
local_scm_gc_cells_marked = scm_gc_cells_marked_acc; 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)), answer = scm_listify (scm_cons (sym_gc_time_taken, scm_ulong2num (local_scm_gc_time_taken)),
scm_cons (sym_cells_allocated, scm_ubits2num (local_scm_cells_allocated)), scm_cons (sym_cells_allocated, scm_ulong2num (local_scm_cells_allocated)),
scm_cons (sym_heap_size, scm_ubits2num (local_scm_heap_size)), scm_cons (sym_heap_size, scm_ulong2num (local_scm_heap_size)),
scm_cons (sym_mallocated, scm_ubits2num (local_scm_mallocated)), scm_cons (sym_mallocated, scm_ulong2num (local_scm_mallocated)),
scm_cons (sym_mtrigger, scm_ubits2num (local_scm_mtrigger)), scm_cons (sym_mtrigger, scm_ulong2num (local_scm_mtrigger)),
scm_cons (sym_times, scm_ubits2num (local_scm_gc_times)), scm_cons (sym_times, scm_ulong2num (local_scm_gc_times)),
scm_cons (sym_gc_mark_time_taken, scm_ulong2num (local_scm_gc_mark_time_taken)), 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_gc_sweep_time_taken, scm_ulong2num (local_scm_gc_sweep_time_taken)),
scm_cons (sym_cells_marked, scm_i_dbl2big (local_scm_gc_cells_marked)), scm_cons (sym_cells_marked, scm_i_dbl2big (local_scm_gc_cells_marked)),
@ -857,7 +857,7 @@ SCM_DEFINE (scm_object_address, "object-address", 1, 0, 0,
"returned by this function for @var{obj}") "returned by this function for @var{obj}")
#define FUNC_NAME s_scm_object_address #define FUNC_NAME s_scm_object_address
{ {
return scm_ubits2num (SCM_UNPACK (obj)); return scm_ulong2num ((unsigned long) SCM_UNPACK (obj));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -945,7 +945,7 @@ scm_gc_for_newcell (scm_freelist_t *master, SCM *freelist)
fprintf (stderr, "allocated = %lu, ", fprintf (stderr, "allocated = %lu, ",
(long) (scm_cells_allocated (long) (scm_cells_allocated
+ master_cells_allocated (&scm_master_freelist) + master_cells_allocated (&scm_master_freelist)
+ master_cells_allocated (&scm_master_freelist2))); + master_cells_allocated (&scm_master_freelist2)));
#endif #endif
scm_igc ("cells"); scm_igc ("cells");
adjust_min_yield (master); adjust_min_yield (master);
@ -1002,7 +1002,7 @@ scm_c_hook_t scm_after_gc_c_hook;
void void
scm_igc (const char *what) scm_igc (const char *what)
{ {
scm_bits_t j; long j;
++scm_gc_running_p; ++scm_gc_running_p;
scm_c_hook_run (&scm_before_gc_c_hook, 0); scm_c_hook_run (&scm_before_gc_c_hook, 0);
@ -1034,8 +1034,8 @@ scm_igc (const char *what)
/* flush dead entries from the continuation stack */ /* flush dead entries from the continuation stack */
{ {
scm_bits_t x; long x;
scm_bits_t bound; long bound;
SCM * elts; SCM * elts;
elts = SCM_VELTS (scm_continuation_stack); elts = SCM_VELTS (scm_continuation_stack);
bound = SCM_VECTOR_LENGTH (scm_continuation_stack); bound = SCM_VECTOR_LENGTH (scm_continuation_stack);
@ -1124,7 +1124,7 @@ void
MARK (SCM p) MARK (SCM p)
#define FUNC_NAME FNAME #define FUNC_NAME FNAME
{ {
register scm_bits_t i; register long i;
register SCM ptr; register SCM ptr;
scm_bits_t cell_type; scm_bits_t cell_type;
@ -1233,7 +1233,7 @@ gc_mark_loop_first_time:
{ {
/* ptr is a struct */ /* ptr is a struct */
SCM layout = SCM_PACK (vtable_data [scm_vtable_index_layout]); SCM layout = SCM_PACK (vtable_data [scm_vtable_index_layout]);
scm_bits_t len = SCM_SYMBOL_LENGTH (layout); long len = SCM_SYMBOL_LENGTH (layout);
char * fields_desc = SCM_SYMBOL_CHARS (layout); char * fields_desc = SCM_SYMBOL_CHARS (layout);
scm_bits_t * struct_data = (scm_bits_t *) SCM_STRUCT_DATA (ptr); scm_bits_t * struct_data = (scm_bits_t *) SCM_STRUCT_DATA (ptr);
@ -1244,7 +1244,7 @@ gc_mark_loop_first_time:
} }
if (len) if (len)
{ {
scm_bits_t x; long x;
for (x = 0; x < len - 2; x += 2, ++struct_data) for (x = 0; x < len - 2; x += 2, ++struct_data)
if (fields_desc[x] == 'p') if (fields_desc[x] == 'p')
@ -1322,8 +1322,8 @@ gc_mark_loop_first_time:
scm_weak_vectors = ptr; scm_weak_vectors = ptr;
if (SCM_IS_WHVEC_ANY (ptr)) if (SCM_IS_WHVEC_ANY (ptr))
{ {
scm_bits_t x; long x;
scm_bits_t len; long len;
int weak_keys; int weak_keys;
int weak_values; int weak_values;
@ -1449,9 +1449,9 @@ gc_mark_loop_first_time:
*/ */
void void
scm_mark_locations (SCM_STACKITEM x[], scm_ubits_t n) scm_mark_locations (SCM_STACKITEM x[], unsigned long n)
{ {
scm_ubits_t m; unsigned long m;
for (m = 0; m < n; ++m) for (m = 0; m < n; ++m)
{ {
@ -1459,14 +1459,14 @@ scm_mark_locations (SCM_STACKITEM x[], scm_ubits_t n)
if (SCM_CELLP (obj)) if (SCM_CELLP (obj))
{ {
SCM_CELLPTR ptr = SCM2PTR (obj); SCM_CELLPTR ptr = SCM2PTR (obj);
scm_bits_t i = 0; long i = 0;
scm_bits_t j = scm_n_heap_segs - 1; long j = scm_n_heap_segs - 1;
if (SCM_PTR_LE (scm_heap_table[i].bounds[0], ptr) if (SCM_PTR_LE (scm_heap_table[i].bounds[0], ptr)
&& SCM_PTR_GT (scm_heap_table[j].bounds[1], ptr)) && SCM_PTR_GT (scm_heap_table[j].bounds[1], ptr))
{ {
while (i <= j) while (i <= j)
{ {
scm_bits_t seg_id; long seg_id;
seg_id = -1; seg_id = -1;
if ((i == j) if ((i == j)
|| SCM_PTR_GT (scm_heap_table[i].bounds[1], ptr)) || SCM_PTR_GT (scm_heap_table[i].bounds[1], ptr))
@ -1475,7 +1475,7 @@ scm_mark_locations (SCM_STACKITEM x[], scm_ubits_t n)
seg_id = j; seg_id = j;
else else
{ {
scm_bits_t k; long k;
k = (i + j) / 2; k = (i + j) / 2;
if (k == i) if (k == i)
break; break;
@ -1523,14 +1523,14 @@ scm_cellp (SCM value)
{ {
if (SCM_CELLP (value)) { if (SCM_CELLP (value)) {
scm_cell * ptr = SCM2PTR (value); scm_cell * ptr = SCM2PTR (value);
scm_bits_t i = 0; unsigned long i = 0;
scm_bits_t j = scm_n_heap_segs - 1; unsigned long j = scm_n_heap_segs - 1;
if (SCM_GC_IN_CARD_HEADERP (ptr)) if (SCM_GC_IN_CARD_HEADERP (ptr))
return 0; return 0;
while (i < j) { while (i < j) {
scm_bits_t k = (i + j) / 2; long k = (i + j) / 2;
if (SCM_PTR_GT (scm_heap_table[k].bounds[1], ptr)) { if (SCM_PTR_GT (scm_heap_table[k].bounds[1], ptr)) {
j = k; j = k;
} else if (SCM_PTR_LE (scm_heap_table[k].bounds[0], ptr)) { } else if (SCM_PTR_LE (scm_heap_table[k].bounds[0], ptr)) {
@ -1566,7 +1566,7 @@ gc_sweep_freelist_start (scm_freelist_t *freelist)
static void static void
gc_sweep_freelist_finish (scm_freelist_t *freelist) gc_sweep_freelist_finish (scm_freelist_t *freelist)
{ {
scm_bits_t collected; long collected;
*freelist->clustertail = freelist->cells; *freelist->clustertail = freelist->cells;
if (!SCM_NULLP (freelist->cells)) if (!SCM_NULLP (freelist->cells))
{ {
@ -1604,9 +1604,9 @@ scm_gc_sweep ()
register SCM_CELLPTR ptr; register SCM_CELLPTR ptr;
register SCM nfreelist; register SCM nfreelist;
register scm_freelist_t *freelist; register scm_freelist_t *freelist;
register scm_ubits_t m; register unsigned long m;
register int span; register int span;
scm_bits_t i; long i;
size_t seg_size; size_t seg_size;
m = 0; m = 0;
@ -1616,7 +1616,7 @@ scm_gc_sweep ()
for (i = 0; i < scm_n_heap_segs; i++) for (i = 0; i < scm_n_heap_segs; i++)
{ {
register scm_bits_t left_to_collect; register long left_to_collect;
register size_t j; register size_t j;
/* Unmarked cells go onto the front of the freelist this heap /* Unmarked cells go onto the front of the freelist this heap
@ -1695,7 +1695,7 @@ scm_gc_sweep ()
break; break;
case scm_tc7_vector: case scm_tc7_vector:
{ {
scm_ubits_t length = SCM_VECTOR_LENGTH (scmptr); unsigned long int length = SCM_VECTOR_LENGTH (scmptr);
if (length > 0) if (length > 0)
{ {
m += length * sizeof (scm_bits_t); m += length * sizeof (scm_bits_t);
@ -1712,10 +1712,10 @@ scm_gc_sweep ()
#ifdef HAVE_ARRAYS #ifdef HAVE_ARRAYS
case scm_tc7_bvect: case scm_tc7_bvect:
{ {
size_t length = SCM_BITVECTOR_LENGTH (scmptr); unsigned long int length = SCM_BITVECTOR_LENGTH (scmptr);
if (length > 0) if (length > 0)
{ {
m += sizeof (long) * ((length + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH); m += sizeof (long) * ((length + SCM_LONG_BIT - 1) / SCM_LONG_BIT);
scm_must_free (SCM_BITVECTOR_BASE (scmptr)); scm_must_free (SCM_BITVECTOR_BASE (scmptr));
} }
} }
@ -1827,7 +1827,7 @@ scm_gc_sweep ()
#ifdef GC_FREE_SEGMENTS #ifdef GC_FREE_SEGMENTS
if (n == seg_size) if (n == seg_size)
{ {
register scm_bits_t j; register long j;
freelist->heap_size -= seg_size; freelist->heap_size -= seg_size;
free ((char *) scm_heap_table[i].bounds[0]); free ((char *) scm_heap_table[i].bounds[0]);
@ -1903,7 +1903,7 @@ void *
scm_must_malloc (size_t size, const char *what) scm_must_malloc (size_t size, const char *what)
{ {
void *ptr; void *ptr;
scm_ubits_t nm = scm_mallocated + size; unsigned long nm = scm_mallocated + size;
if (nm < size) if (nm < size)
/* The byte count of allocated objects has overflowed. This is /* The byte count of allocated objects has overflowed. This is
@ -1965,7 +1965,7 @@ scm_must_realloc (void *where,
const char *what) const char *what)
{ {
void *ptr; void *ptr;
scm_ubits_t nm; unsigned long nm;
if (size <= old_size) if (size <= old_size)
return where; return where;
@ -2065,7 +2065,7 @@ scm_must_free (void *obj)
* eh? Or even better, call scm_done_free. */ * eh? Or even better, call scm_done_free. */
void void
scm_done_malloc (scm_bits_t size) scm_done_malloc (long size)
{ {
if (size < 0) { if (size < 0) {
if (scm_mallocated < size) if (scm_mallocated < size)
@ -2076,7 +2076,7 @@ scm_done_malloc (scm_bits_t size)
scm_mallocated, which underflowed. */ scm_mallocated, which underflowed. */
abort (); abort ();
} else { } else {
scm_ubits_t nm = scm_mallocated + size; unsigned long nm = scm_mallocated + size;
if (nm < size) if (nm < size)
/* The byte count of allocated objects has overflowed. This is /* The byte count of allocated objects has overflowed. This is
probably because you forgot to report the correct size of freed probably because you forgot to report the correct size of freed
@ -2100,7 +2100,7 @@ scm_done_malloc (scm_bits_t size)
} }
void void
scm_done_free (scm_bits_t size) scm_done_free (long size)
{ {
if (size >= 0) { if (size >= 0) {
if (scm_mallocated < size) if (scm_mallocated < size)
@ -2111,7 +2111,7 @@ scm_done_free (scm_bits_t size)
scm_mallocated, which underflowed. */ scm_mallocated, which underflowed. */
abort (); abort ();
} else { } else {
scm_ubits_t nm = scm_mallocated + size; unsigned long nm = scm_mallocated + size;
if (nm < size) if (nm < size)
/* The byte count of allocated objects has overflowed. This is /* The byte count of allocated objects has overflowed. This is
probably because you forgot to report the correct size of freed probably because you forgot to report the correct size of freed
@ -2174,7 +2174,7 @@ init_heap_seg (SCM_CELLPTR seg_org, size_t size, scm_freelist_t *freelist)
{ {
register SCM_CELLPTR ptr; register SCM_CELLPTR ptr;
SCM_CELLPTR seg_end; SCM_CELLPTR seg_end;
scm_bits_t new_seg_index; long new_seg_index;
ptrdiff_t n_new_cells; ptrdiff_t n_new_cells;
int span = freelist->span; int span = freelist->span;
@ -2359,7 +2359,7 @@ alloc_some_heap (scm_freelist_t *freelist, policy_on_error error_policy)
* This gives dh > (f * h - y) / (1 - f) * This gives dh > (f * h - y) / (1 - f)
*/ */
int f = freelist->min_yield_fraction; int f = freelist->min_yield_fraction;
scm_ubits_t h = SCM_HEAP_SIZE; unsigned long h = SCM_HEAP_SIZE;
size_t min_cells = (f * h - 100 * (long) scm_gc_yield) / (99 - f); size_t min_cells = (f * h - 100 * (long) scm_gc_yield) / (99 - f);
len = SCM_EXPHEAP (freelist->heap_size); len = SCM_EXPHEAP (freelist->heap_size);
#ifdef DEBUGINFO #ifdef DEBUGINFO
@ -2613,7 +2613,7 @@ make_initial_segment (size_t init_heap_size, scm_freelist_t *freelist)
static void static void
init_freelist (scm_freelist_t *freelist, init_freelist (scm_freelist_t *freelist,
int span, int span,
scm_bits_t cluster_size, long cluster_size,
int min_yield) int min_yield)
{ {
freelist->clusters = SCM_EOL; freelist->clusters = SCM_EOL;

26
libguile/gc.h
View file

@ -97,7 +97,7 @@ typedef scm_cell * SCM_CELLPTR;
#define SCM_GC_SET_CARD_BVEC(card, bvec) \ #define SCM_GC_SET_CARD_BVEC(card, bvec) \
((card)->word_0 = (scm_bits_t) (bvec)) ((card)->word_0 = (scm_bits_t) (bvec))
#define SCM_GC_GET_CARD_FLAGS(card) ((scm_ubits_t) ((card)->word_1)) #define SCM_GC_GET_CARD_FLAGS(card) ((long) ((card)->word_1))
#define SCM_GC_SET_CARD_FLAGS(card, flags) \ #define SCM_GC_SET_CARD_FLAGS(card, flags) \
((card)->word_1 = (scm_bits_t) (flags)) ((card)->word_1 = (scm_bits_t) (flags))
#define SCM_GC_CLR_CARD_FLAGS(card) (SCM_GC_SET_CARD_FLAGS (card, 0L)) #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_SIZE_MASK (SCM_GC_CARD_SIZE - 1)
#define SCM_GC_CARD_ADDR_MASK (~SCM_GC_CARD_SIZE_MASK) #define SCM_GC_CARD_ADDR_MASK (~SCM_GC_CARD_SIZE_MASK)
#define SCM_GC_CELL_CARD(x) ((SCM_CELLPTR) ((scm_bits_t) (x) & SCM_GC_CARD_ADDR_MASK)) #define SCM_GC_CELL_CARD(x) ((SCM_CELLPTR) ((long) (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_SPAN(x) ((SCM_GC_CARD_DOUBLECELLP (SCM_GC_CELL_CARD (x))) ? 2 : 1)
#define SCM_GC_CELL_OFFSET(x) (((scm_bits_t) (x) & SCM_GC_CARD_SIZE_MASK) >> SCM_CELL_SIZE_SHIFT) #define SCM_GC_CELL_OFFSET(x) (((long) (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_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_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)) #define SCM_GC_CELL_SET_BIT(x) SCM_C_BVEC_SET (SCM_GC_CELL_BVEC (x), SCM_GC_CELL_OFFSET (x))
@ -319,13 +319,13 @@ extern SCM scm_freelist;
extern struct scm_freelist_t scm_master_freelist; extern struct scm_freelist_t scm_master_freelist;
extern SCM scm_freelist2; extern SCM scm_freelist2;
extern struct scm_freelist_t scm_master_freelist2; extern struct scm_freelist_t scm_master_freelist2;
extern scm_ubits_t scm_gc_cells_collected; extern unsigned long scm_gc_cells_collected;
extern scm_ubits_t scm_gc_yield; extern unsigned long scm_gc_yield;
extern scm_ubits_t scm_gc_malloc_collected; extern unsigned long scm_gc_malloc_collected;
extern scm_ubits_t scm_gc_ports_collected; extern unsigned long scm_gc_ports_collected;
extern scm_ubits_t scm_cells_allocated; extern unsigned long scm_cells_allocated;
extern scm_ubits_t scm_mallocated; extern unsigned long scm_mallocated;
extern scm_ubits_t scm_mtrigger; extern unsigned long scm_mtrigger;
extern SCM scm_after_gc_hook; 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_igc (const char *what);
extern void scm_gc_mark (SCM p); extern void scm_gc_mark (SCM p);
extern void scm_gc_mark_dependencies (SCM p); extern void scm_gc_mark_dependencies (SCM p);
extern void scm_mark_locations (SCM_STACKITEM x[], scm_ubits_t n); extern void scm_mark_locations (SCM_STACKITEM x[], unsigned long n);
extern int scm_cellp (SCM value); extern int scm_cellp (SCM value);
extern void scm_gc_sweep (void); extern void scm_gc_sweep (void);
extern void * scm_must_malloc (size_t len, const char *what); extern void * scm_must_malloc (size_t len, const char *what);
extern void * scm_must_realloc (void *where, extern void * scm_must_realloc (void *where,
size_t olen, size_t len, size_t olen, size_t len,
const char *what); 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_strdup (const char *str);
extern char *scm_must_strndup (const char *str, size_t n); extern char *scm_must_strndup (const char *str, size_t n);
extern void scm_done_malloc (long size);
extern void scm_done_free (long size);
extern void scm_must_free (void *obj); extern void scm_must_free (void *obj);
extern void scm_remember_upto_here_1 (SCM obj); extern void scm_remember_upto_here_1 (SCM obj);
extern void scm_remember_upto_here_2 (SCM obj1, SCM obj2); extern void scm_remember_upto_here_2 (SCM obj1, SCM obj2);

26
libguile/gh.h
View file

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

46
libguile/gh_data.c
View file

@ -95,7 +95,7 @@ gh_str02scm (const char *s)
If START + LEN is off the end of DST, signal an out-of-range If START + LEN is off the end of DST, signal an out-of-range
error. */ error. */
void void
gh_set_substr (char *src, SCM dst, scm_bits_t start, size_t len) gh_set_substr (char *src, SCM dst, long start, size_t len)
{ {
char *dst_ptr; char *dst_ptr;
size_t dst_len; size_t dst_len;
@ -121,9 +121,9 @@ gh_symbol2scm (const char *symbol_str)
} }
SCM SCM
gh_ints2scm (const int *d, scm_bits_t n) gh_ints2scm (const int *d, long n)
{ {
scm_bits_t i; long i;
SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED); SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED);
SCM *velts = SCM_VELTS(v); SCM *velts = SCM_VELTS(v);
@ -134,9 +134,9 @@ gh_ints2scm (const int *d, scm_bits_t n)
} }
SCM SCM
gh_doubles2scm (const double *d, scm_bits_t n) gh_doubles2scm (const double *d, long n)
{ {
scm_bits_t i; long i;
SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED); SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED);
SCM *velts = SCM_VELTS(v); SCM *velts = SCM_VELTS(v);
@ -162,7 +162,7 @@ makvect (char *m, size_t len, int type)
} }
SCM SCM
gh_chars2byvect (const char *d, scm_bits_t n) gh_chars2byvect (const char *d, long n)
{ {
char *m = scm_must_malloc (n * sizeof (char), "vector"); char *m = scm_must_malloc (n * sizeof (char), "vector");
memcpy (m, d, n * sizeof (char)); memcpy (m, d, n * sizeof (char));
@ -170,7 +170,7 @@ gh_chars2byvect (const char *d, scm_bits_t n)
} }
SCM SCM
gh_shorts2svect (const short *d, scm_bits_t n) gh_shorts2svect (const short *d, long n)
{ {
char *m = scm_must_malloc (n * sizeof (short), "vector"); char *m = scm_must_malloc (n * sizeof (short), "vector");
memcpy (m, d, n * sizeof (short)); memcpy (m, d, n * sizeof (short));
@ -178,7 +178,7 @@ gh_shorts2svect (const short *d, scm_bits_t n)
} }
SCM SCM
gh_longs2ivect (const long *d, scm_bits_t n) gh_longs2ivect (const long *d, long n)
{ {
char *m = scm_must_malloc (n * sizeof (long), "vector"); char *m = scm_must_malloc (n * sizeof (long), "vector");
memcpy (m, d, n * sizeof (long)); memcpy (m, d, n * sizeof (long));
@ -186,7 +186,7 @@ gh_longs2ivect (const long *d, scm_bits_t n)
} }
SCM SCM
gh_ulongs2uvect (const unsigned long *d, scm_bits_t n) gh_ulongs2uvect (const unsigned long *d, long n)
{ {
char *m = scm_must_malloc (n * sizeof (unsigned long), "vector"); char *m = scm_must_malloc (n * sizeof (unsigned long), "vector");
memcpy (m, d, n * sizeof (unsigned long)); memcpy (m, d, n * sizeof (unsigned long));
@ -194,7 +194,7 @@ gh_ulongs2uvect (const unsigned long *d, scm_bits_t n)
} }
SCM SCM
gh_floats2fvect (const float *d, scm_bits_t n) gh_floats2fvect (const float *d, long n)
{ {
char *m = scm_must_malloc (n * sizeof (float), "vector"); char *m = scm_must_malloc (n * sizeof (float), "vector");
memcpy (m, d, n * sizeof (float)); memcpy (m, d, n * sizeof (float));
@ -202,7 +202,7 @@ gh_floats2fvect (const float *d, scm_bits_t n)
} }
SCM SCM
gh_doubles2dvect (const double *d, scm_bits_t n) gh_doubles2dvect (const double *d, long n)
{ {
char *m = scm_must_malloc (n * sizeof (double), "vector"); char *m = scm_must_malloc (n * sizeof (double), "vector");
memcpy (m, d, n * sizeof (double)); memcpy (m, d, n * sizeof (double));
@ -251,8 +251,8 @@ gh_scm2char (SCM obj)
char * char *
gh_scm2chars (SCM obj, char *m) gh_scm2chars (SCM obj, char *m)
{ {
scm_bits_t i, n; long i, n;
scm_bits_t v; long v;
SCM val; SCM val;
if (SCM_IMP (obj)) if (SCM_IMP (obj))
scm_wrong_type_arg (0, 0, obj); scm_wrong_type_arg (0, 0, obj);
@ -311,8 +311,8 @@ gh_scm2chars (SCM obj, char *m)
short * short *
gh_scm2shorts (SCM obj, short *m) gh_scm2shorts (SCM obj, short *m)
{ {
scm_bits_t i, n; long i, n;
scm_bits_t v; long v;
SCM val; SCM val;
if (SCM_IMP (obj)) if (SCM_IMP (obj))
scm_wrong_type_arg (0, 0, obj); scm_wrong_type_arg (0, 0, obj);
@ -362,7 +362,7 @@ gh_scm2shorts (SCM obj, short *m)
long * long *
gh_scm2longs (SCM obj, long *m) gh_scm2longs (SCM obj, long *m)
{ {
scm_bits_t i, n; long i, n;
SCM val; SCM val;
if (SCM_IMP (obj)) if (SCM_IMP (obj))
scm_wrong_type_arg (0, 0, obj); scm_wrong_type_arg (0, 0, obj);
@ -412,7 +412,7 @@ gh_scm2longs (SCM obj, long *m)
float * float *
gh_scm2floats (SCM obj, float *m) gh_scm2floats (SCM obj, float *m)
{ {
scm_bits_t i, n; long i, n;
SCM val; SCM val;
if (SCM_IMP (obj)) if (SCM_IMP (obj))
scm_wrong_type_arg (0, 0, obj); scm_wrong_type_arg (0, 0, obj);
@ -475,7 +475,7 @@ gh_scm2floats (SCM obj, float *m)
double * double *
gh_scm2doubles (SCM obj, double *m) gh_scm2doubles (SCM obj, double *m)
{ {
scm_bits_t i, n; long i, n;
SCM val; SCM val;
if (SCM_IMP (obj)) if (SCM_IMP (obj))
scm_wrong_type_arg (0, 0, obj); scm_wrong_type_arg (0, 0, obj);
@ -583,7 +583,7 @@ gh_scm2newstr (SCM str, size_t *lenp)
region to fit the string. If truncation occurs, the corresponding region to fit the string. If truncation occurs, the corresponding
area of DST is left unchanged. */ area of DST is left unchanged. */
void void
gh_get_substr (SCM src, char *dst, scm_bits_t start, size_t len) gh_get_substr (SCM src, char *dst, long start, size_t len)
{ {
size_t src_len, effective_length; size_t src_len, effective_length;
SCM_ASSERT (SCM_STRINGP (src), src, SCM_ARG3, "gh_get_substr"); SCM_ASSERT (SCM_STRINGP (src), src, SCM_ARG3, "gh_get_substr");
@ -655,20 +655,20 @@ gh_vector_ref (SCM vec, SCM pos)
} }
/* returns the length of the given vector */ /* returns the length of the given vector */
scm_bits_t unsigned long
gh_vector_length (SCM v) gh_vector_length (SCM v)
{ {
return (size_t) SCM_VECTOR_LENGTH (v); return (unsigned long) SCM_VECTOR_LENGTH (v);
} }
#ifdef HAVE_ARRAYS #ifdef HAVE_ARRAYS
/* uniform vector support */ /* uniform vector support */
/* returns the length as a C unsigned long integer */ /* returns the length as a C unsigned long integer */
scm_ubits_t unsigned long
gh_uniform_vector_length (SCM v) gh_uniform_vector_length (SCM v)
{ {
return SCM_UVECTOR_LENGTH (v); return (unsigned long) SCM_UVECTOR_LENGTH (v);
} }
/* gets the given element from a uniform vector; ilist is a list (or /* gets the given element from a uniform vector; ilist is a list (or

2
libguile/gh_list.c
View file

@ -45,7 +45,7 @@
#include "libguile/gh.h" #include "libguile/gh.h"
/* returns the length of a list */ /* returns the length of a list */
scm_bits_t unsigned long
gh_length (SCM l) gh_length (SCM l)
{ {
return gh_scm2ulong (scm_length (l)); return gh_scm2ulong (scm_length (l));

72
libguile/goops.c
View file

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

4
libguile/goops.h
View file

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

4
libguile/gsubr.c
View file

@ -214,8 +214,8 @@ scm_gsubr_apply (SCM args)
SCM self = SCM_CAR (args); SCM self = SCM_CAR (args);
SCM (*fcn)() = SCM_SUBRF (SCM_GSUBR_PROC (self)); SCM (*fcn)() = SCM_SUBRF (SCM_GSUBR_PROC (self));
SCM v[SCM_GSUBR_MAX]; SCM v[SCM_GSUBR_MAX];
scm_bits_t typ = SCM_INUM (SCM_GSUBR_TYPE (self)); long typ = SCM_INUM (SCM_GSUBR_TYPE (self));
scm_bits_t i, n = SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ) + SCM_GSUBR_REST (typ); long i, n = SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ) + SCM_GSUBR_REST (typ);
#if 0 #if 0
if (n > SCM_GSUBR_MAX) if (n > SCM_GSUBR_MAX)
scm_misc_error (FUNC_NAME, scm_misc_error (FUNC_NAME,

6
libguile/gsubr.h
View file

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

34
libguile/hash.c
View file

@ -60,13 +60,13 @@ extern double floor();
#endif #endif
scm_bits_t unsigned long
scm_string_hash (const unsigned char *str, size_t len) scm_string_hash (const unsigned char *str, size_t len)
{ {
if (len > 5) if (len > 5)
{ {
size_t i = 5; size_t i = 5;
scm_bits_t h = 264; unsigned long h = 264;
while (i--) while (i--)
h = (h << 8) + (unsigned) str[h % len]; h = (h << 8) + (unsigned) str[h % len];
return h; return h;
@ -74,7 +74,7 @@ scm_string_hash (const unsigned char *str, size_t len)
else else
{ {
size_t i = len; size_t i = len;
scm_bits_t h = 0; unsigned long h = 0;
while (i) while (i)
h = (h << 8) + (unsigned) str[--i]; h = (h << 8) + (unsigned) str[--i];
return h; return h;
@ -86,8 +86,8 @@ scm_string_hash (const unsigned char *str, size_t len)
/* Dirk:FIXME:: scm_hasher could be made static. */ /* Dirk:FIXME:: scm_hasher could be made static. */
scm_bits_t unsigned long
scm_hasher (SCM obj, scm_bits_t n, size_t d) scm_hasher(SCM obj, unsigned long n, size_t d)
{ {
switch (SCM_ITAG3 (obj)) { switch (SCM_ITAG3 (obj)) {
case scm_tc3_int_1: case scm_tc3_int_1:
@ -95,7 +95,7 @@ scm_hasher (SCM obj, scm_bits_t n, size_t d)
return SCM_INUM(obj) % n; /* SCM_INUMP(obj) */ return SCM_INUM(obj) % n; /* SCM_INUMP(obj) */
case scm_tc3_imm24: case scm_tc3_imm24:
if (SCM_CHARP(obj)) if (SCM_CHARP(obj))
return (scm_ubits_t) (scm_downcase(SCM_CHAR(obj))) % n; return (unsigned)(scm_downcase(SCM_CHAR(obj))) % n;
switch (SCM_UNPACK (obj)) { switch (SCM_UNPACK (obj)) {
#ifndef SICP #ifndef SICP
case SCM_EOL: case SCM_EOL:
@ -152,14 +152,14 @@ scm_hasher (SCM obj, scm_bits_t n, size_t d)
if (len > 5) if (len > 5)
{ {
size_t i = d/2; size_t i = d/2;
scm_bits_t h = 1; unsigned long h = 1;
while (i--) h = ((h << 8) + (scm_hasher (data[h % len], n, 2))) % n; while (i--) h = ((h << 8) + (scm_hasher (data[h % len], n, 2))) % n;
return h; return h;
} }
else else
{ {
size_t i = len; size_t i = len;
scm_bits_t h = (n)-1; unsigned long h = (n)-1;
while (i--) h = ((h << 8) + (scm_hasher (data[i], n, d/len))) % n; while (i--) h = ((h << 8) + (scm_hasher (data[i], n, d/len))) % n;
return h; return h;
} }
@ -182,8 +182,8 @@ scm_hasher (SCM obj, scm_bits_t n, size_t d)
scm_bits_t unsigned long
scm_ihashq (SCM obj, scm_bits_t n) scm_ihashq (SCM obj, unsigned long n)
{ {
return (SCM_UNPACK (obj) >> 1) % n; return (SCM_UNPACK (obj) >> 1) % n;
} }
@ -212,14 +212,14 @@ SCM_DEFINE (scm_hashq, "hashq", 2, 0, 0,
scm_bits_t unsigned long
scm_ihashv (SCM obj, scm_bits_t n) scm_ihashv (SCM obj, unsigned long n)
{ {
if (SCM_CHARP(obj)) if (SCM_CHARP(obj))
return ((scm_ubits_t)(scm_downcase(SCM_CHAR(obj)))) % n; /* downcase!?!! */ return ((unsigned long) (scm_downcase (SCM_CHAR (obj)))) % n; /* downcase!?!! */
if (SCM_NUMP(obj)) if (SCM_NUMP(obj))
return (scm_bits_t) scm_hasher(obj, n, 10); return (unsigned long) scm_hasher(obj, n, 10);
else else
return SCM_UNPACK (obj) % n; return SCM_UNPACK (obj) % n;
} }
@ -248,10 +248,10 @@ SCM_DEFINE (scm_hashv, "hashv", 2, 0, 0,
scm_bits_t unsigned long
scm_ihash (SCM obj, scm_bits_t n) scm_ihash (SCM obj, unsigned long n)
{ {
return (scm_bits_t) scm_hasher (obj, n, 10); return (unsigned long) scm_hasher (obj, n, 10);
} }
SCM_DEFINE (scm_hash, "hash", 2, 0, 0, SCM_DEFINE (scm_hash, "hash", 2, 0, 0,

10
libguile/hash.h
View file

@ -48,13 +48,13 @@
extern scm_bits_t scm_string_hash (const unsigned char *str, size_t len); extern unsigned long 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 unsigned long scm_hasher (SCM obj, unsigned long n, size_t d);
extern scm_bits_t scm_ihashq (SCM obj, scm_bits_t n); extern unsigned long scm_ihashq (SCM obj, unsigned long n);
extern SCM scm_hashq (SCM obj, SCM n); extern SCM scm_hashq (SCM obj, SCM n);
extern scm_bits_t scm_ihashv (SCM obj, scm_bits_t n); extern unsigned long scm_ihashv (SCM obj, unsigned long n);
extern SCM scm_hashv (SCM obj, SCM n); extern SCM scm_hashv (SCM obj, SCM n);
extern scm_bits_t scm_ihash (SCM obj, scm_bits_t n); extern unsigned long scm_ihash (SCM obj, unsigned long n);
extern SCM scm_hash (SCM obj, SCM n); extern SCM scm_hash (SCM obj, SCM n);
extern void scm_init_hash (void); extern void scm_init_hash (void);

46
libguile/hashtab.c
View file

@ -55,20 +55,17 @@
SCM SCM
scm_c_make_hash_table (scm_bits_t k) scm_c_make_hash_table (unsigned long k)
{ {
return scm_c_make_vector (k, SCM_EOL); return scm_c_make_vector (k, SCM_EOL);
} }
SCM SCM
scm_hash_fn_get_handle (SCM table, SCM obj, scm_hash_fn_get_handle (SCM table,SCM obj,unsigned long (*hash_fn)(),SCM (*assoc_fn)(),void * closure)
scm_bits_t (*hash_fn) (),
SCM (*assoc_fn) (),
void *closure)
#define FUNC_NAME "scm_hash_fn_get_handle" #define FUNC_NAME "scm_hash_fn_get_handle"
{ {
scm_bits_t k; unsigned long k;
SCM h; SCM h;
SCM_VALIDATE_VECTOR (1, table); SCM_VALIDATE_VECTOR (1, table);
@ -84,13 +81,11 @@ scm_hash_fn_get_handle (SCM table, SCM obj,
SCM SCM
scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, scm_hash_fn_create_handle_x (SCM table,SCM obj,SCM init,unsigned long (*hash_fn)(),
scm_bits_t (*hash_fn) (), SCM (*assoc_fn)(),void * closure)
SCM (*assoc_fn) (),
void *closure)
#define FUNC_NAME "scm_hash_fn_create_handle_x" #define FUNC_NAME "scm_hash_fn_create_handle_x"
{ {
scm_bits_t k; unsigned long k;
SCM it; SCM it;
SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_create_handle_x"); SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_create_handle_x");
@ -121,10 +116,8 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init,
SCM SCM
scm_hash_fn_ref (SCM table, SCM obj, SCM dflt, scm_hash_fn_ref (SCM table,SCM obj,SCM dflt,unsigned long (*hash_fn)(),
scm_bits_t (*hash_fn) (), SCM (*assoc_fn)(),void * closure)
SCM (*assoc_fn) (),
void *closure)
{ {
SCM it = scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure); SCM it = scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure);
if (SCM_CONSP (it)) if (SCM_CONSP (it))
@ -137,10 +130,8 @@ scm_hash_fn_ref (SCM table, SCM obj, SCM dflt,
SCM SCM
scm_hash_fn_set_x (SCM table, SCM obj, SCM val, scm_hash_fn_set_x (SCM table,SCM obj,SCM val,unsigned long (*hash_fn)(),
scm_bits_t (*hash_fn) (), SCM (*assoc_fn)(),void * closure)
SCM (*assoc_fn) (),
void * closure)
{ {
SCM it; SCM it;
@ -154,13 +145,10 @@ scm_hash_fn_set_x (SCM table, SCM obj, SCM val,
SCM SCM
scm_hash_fn_remove_x (SCM table, SCM obj, scm_hash_fn_remove_x (SCM table,SCM obj,unsigned long (*hash_fn)(),SCM (*assoc_fn)(),
scm_bits_t (*hash_fn) (), SCM (*delete_fn)(),void * closure)
SCM (*assoc_fn) (),
SCM (*delete_fn) (),
void *closure)
{ {
scm_bits_t k; unsigned long k;
SCM h; SCM h;
SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_remove_x"); SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_remove_x");
@ -387,13 +375,13 @@ typedef struct scm_ihashx_closure_t
static scm_bits_t static unsigned long
scm_ihashx (SCM obj, scm_bits_t n, scm_ihashx_closure_t *closure) scm_ihashx (SCM obj, unsigned long n, scm_ihashx_closure_t *closure)
{ {
SCM answer; SCM answer;
SCM_DEFER_INTS; SCM_DEFER_INTS;
answer = scm_apply (closure->hash, answer = scm_apply (closure->hash,
SCM_LIST2 (obj, scm_bits2num (n)), SCM_LIST2 (obj, scm_ulong2num ((unsigned long)n)),
SCM_EOL); SCM_EOL);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
return SCM_INUM (answer); return SCM_INUM (answer);
@ -555,7 +543,7 @@ SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0,
SCM SCM
scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table) scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table)
{ {
scm_bits_t i, n = SCM_VECTOR_LENGTH (table); long i, n = SCM_VECTOR_LENGTH (table);
SCM result = init; SCM result = init;
for (i = 0; i < n; ++i) for (i = 0; i < n; ++i)
{ {

12
libguile/hashtab.h
View file

@ -53,13 +53,13 @@ typedef SCM scm_assoc_fn_t (SCM key, SCM alist, void *closure);
typedef SCM scm_delete_fn_t (SCM elt, SCM list); typedef SCM scm_delete_fn_t (SCM elt, SCM list);
#endif #endif
extern SCM scm_c_make_hash_table (scm_bits_t k); extern SCM scm_c_make_hash_table (unsigned long k);
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_get_handle (SCM table, SCM obj, unsigned long (*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_create_handle_x (SCM table, SCM obj, SCM init, unsigned long (*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_ref (SCM table, SCM obj, SCM dflt, unsigned long (*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_set_x (SCM table, SCM obj, SCM val, unsigned long (*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_hash_fn_remove_x (SCM table, SCM obj, unsigned long (*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_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table);
extern SCM scm_hashq_get_handle (SCM table, SCM obj); extern SCM scm_hashq_get_handle (SCM table, SCM obj);

2
libguile/ioext.c
View file

@ -297,7 +297,7 @@ SCM_DEFINE (scm_fdes_to_ports, "fdes->ports", 1, 0, 0,
{ {
SCM result = SCM_EOL; SCM result = SCM_EOL;
int int_fd; int int_fd;
scm_bits_t i; long i;
SCM_VALIDATE_INUM_COPY (1,fd,int_fd); SCM_VALIDATE_INUM_COPY (1,fd,int_fd);

18
libguile/list.c
View file

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

2
libguile/list.h
View file

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

2
libguile/load.c
View file

@ -495,7 +495,7 @@ init_build_info ()
{ {
static struct { char *name; char *value; } info[] = SCM_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)); SCM *loc = SCM_VARIABLE_LOC (scm_c_define ("%guile-build-info", SCM_EOL));
scm_bits_t i; unsigned long i;
for (i = 0; i < (sizeof (info) / sizeof (info[0])); i++) for (i = 0; i < (sizeof (info) / sizeof (info[0])); i++)
*loc = scm_acons (scm_str2symbol (info[i].name), *loc = scm_acons (scm_str2symbol (info[i].name),

2
libguile/modules.c
View file

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

16
libguile/numbers.c
View file

@ -4253,22 +4253,6 @@ scm_i_big2dbl (SCM b)
#define MAX_VALUE ULONG_MAX #define MAX_VALUE ULONG_MAX
#include "libguile/num2integral.i.c" #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 NUM2INTEGRAL scm_num2ptrdiff
#define INTEGRAL2NUM scm_ptrdiff2num #define INTEGRAL2NUM scm_ptrdiff2num
#define INTEGRAL2BIG scm_i_ptrdiff2big #define INTEGRAL2BIG scm_i_ptrdiff2big

14
libguile/numbers.h
View file

@ -62,7 +62,7 @@
* SCM_INUMP (SCM_CAR (x)) can give wrong answers. * SCM_INUMP (SCM_CAR (x)) can give wrong answers.
*/ */
#define SCM_I_FIXNUM_BIT (SCM_BITS_LENGTH - 2) #define SCM_I_FIXNUM_BIT (SCM_LONG_BIT - 2)
#define SCM_MOST_POSITIVE_FIXNUM ((1L << (SCM_I_FIXNUM_BIT - 1)) - 1) #define SCM_MOST_POSITIVE_FIXNUM ((1L << (SCM_I_FIXNUM_BIT - 1)) - 1)
#define SCM_MOST_NEGATIVE_FIXNUM (-SCM_MOST_POSITIVE_FIXNUM - 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 /* SCM_INTBUFLEN is the maximum number of characters neccessary for the
* printed or scm_string representation of an exact immediate. * printed or scm_string representation of an exact immediate.
*/ */
#define SCM_INTBUFLEN (5 + SCM_BITS_LENGTH) #define SCM_INTBUFLEN (5 + SCM_LONG_BIT)
@ -177,7 +177,7 @@
#define SCM_BIGSIGN(x) (SCM_CELL_WORD_0 (x) & SCM_BIGSIGNFLAG) #define SCM_BIGSIGN(x) (SCM_CELL_WORD_0 (x) & SCM_BIGSIGNFLAG)
#define SCM_BDIGITS(x) ((SCM_BIGDIG *) (SCM_CELL_WORD_1 (x))) #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_SET_BIGNUM_BASE(n, b) (SCM_SET_CELL_WORD_1 ((n), (b)))
#define SCM_NUMDIGS(x) ((size_t) ((scm_ubits_t) SCM_CELL_WORD_0 (x) >> SCM_BIGSIZEFIELD)) #define SCM_NUMDIGS(x) ((size_t) (SCM_CELL_WORD_0 (x) >> SCM_BIGSIZEFIELD))
#define SCM_SETNUMDIGS(x, v, sign) \ #define SCM_SETNUMDIGS(x, v, sign) \
SCM_SET_CELL_WORD_0 (x, \ SCM_SET_CELL_WORD_0 (x, \
scm_tc16_big \ scm_tc16_big \
@ -232,8 +232,6 @@ extern SCM scm_i_int2big (int n);
extern SCM scm_i_uint2big (unsigned int n); extern SCM scm_i_uint2big (unsigned int n);
extern SCM scm_i_long2big (long n); extern SCM scm_i_long2big (long n);
extern SCM scm_i_ulong2big (unsigned 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_size2big (size_t n);
extern SCM scm_i_ptrdiff2big (ptrdiff_t n); extern SCM scm_i_ptrdiff2big (ptrdiff_t n);
@ -330,8 +328,6 @@ extern SCM scm_int2num (int n);
extern SCM scm_uint2num (unsigned int n); extern SCM scm_uint2num (unsigned int n);
extern SCM scm_long2num (long n); extern SCM scm_long2num (long n);
extern SCM scm_ulong2num (unsigned 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_size2num (size_t n);
extern SCM scm_ptrdiff2num (ptrdiff_t n); extern SCM scm_ptrdiff2num (ptrdiff_t n);
extern short scm_num2short (SCM num, unsigned long int pos, extern short scm_num2short (SCM num, unsigned long int pos,
@ -346,10 +342,6 @@ extern long scm_num2long (SCM num, unsigned long int pos,
const char *s_caller); const char *s_caller);
extern unsigned long scm_num2ulong (SCM num, unsigned long int pos, extern unsigned long scm_num2ulong (SCM num, unsigned long int pos,
const char *s_caller); 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, extern ptrdiff_t scm_num2ptrdiff (SCM num, unsigned long int pos,
const char *s_caller); const char *s_caller);
extern size_t scm_num2size (SCM num, unsigned long int pos, extern size_t scm_num2size (SCM num, unsigned long int pos,

14
libguile/objects.c
View file

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

4
libguile/objects.h
View file

@ -214,7 +214,7 @@ extern SCM scm_no_applicable_method;
/* Goops functions. */ /* Goops functions. */
extern SCM scm_make_extended_class (char *type_name); extern SCM scm_make_extended_class (char *type_name);
extern void scm_make_port_classes (scm_bits_t ptobnum, char *type_name); extern void scm_make_port_classes (long ptobnum, char *type_name);
extern void scm_change_object_class (SCM, SCM, SCM); extern void scm_change_object_class (SCM, SCM, SCM);
extern SCM scm_memoize_method (SCM x, SCM args); 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_make_subclass_object (SCM c, SCM layout);
extern SCM scm_i_make_class_object (SCM metaclass, SCM layout_string, extern SCM scm_i_make_class_object (SCM metaclass, SCM layout_string,
scm_ubits_t flags); unsigned long flags);
extern void scm_init_objects (void); extern void scm_init_objects (void);
#endif /* OBJECTSH */ #endif /* OBJECTSH */

2
libguile/options.h
View file

@ -59,7 +59,7 @@ typedef struct scm_option_t
/* /*
schizophrenic use: both SCM and int schizophrenic use: both SCM and int
*/ */
scm_bits_t val; unsigned long val;
/* SCM val */ /* SCM val */
char *doc; char *doc;
} scm_option_t; } scm_option_t;

20
libguile/ports.c
View file

@ -87,7 +87,7 @@
* tags for smobjects (if you know a tag you can get an index and conversely). * tags for smobjects (if you know a tag you can get an index and conversely).
*/ */
scm_ptob_descriptor_t *scm_ptobs; scm_ptob_descriptor_t *scm_ptobs;
scm_bits_t scm_numptob; long scm_numptob;
/* GC marker for a port with stream of SCM type. */ /* GC marker for a port with stream of SCM type. */
SCM SCM
@ -314,7 +314,7 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
{ {
SCM result; SCM result;
scm_port_t *pt = SCM_PTAB_ENTRY (port); scm_port_t *pt = SCM_PTAB_ENTRY (port);
scm_bits_t count; long count;
SCM_VALIDATE_OPINPORT (1,port); SCM_VALIDATE_OPINPORT (1,port);
@ -424,8 +424,8 @@ SCM_DEFINE (scm_set_current_error_port, "set-current-error-port", 1, 0, 0,
scm_port_t **scm_port_table; scm_port_t **scm_port_table;
scm_bits_t scm_port_table_size = 0; /* Number of ports in scm_port_table. */ long scm_port_table_size = 0; /* Number of ports in scm_port_table. */
scm_bits_t scm_port_table_room = 20; /* Size of the array. */ long scm_port_table_room = 20; /* Size of the array. */
/* Add a port to the table. */ /* Add a port to the table. */
@ -475,7 +475,7 @@ scm_remove_from_port_table (SCM port)
#define FUNC_NAME "scm_remove_from_port_table" #define FUNC_NAME "scm_remove_from_port_table"
{ {
scm_port_t *p = SCM_PTAB_ENTRY (port); scm_port_t *p = SCM_PTAB_ENTRY (port);
scm_bits_t i = p->entry; long i = p->entry;
if (i >= scm_port_table_size) if (i >= scm_port_table_size)
SCM_MISC_ERROR ("Port not in table: ~S", SCM_LIST1 (port)); 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.") "@code{--enable-guile-debug} builds.")
#define FUNC_NAME s_scm_pt_member #define FUNC_NAME s_scm_pt_member
{ {
scm_bits_t i; long i;
SCM_VALIDATE_INUM_COPY (1,index,i); SCM_VALIDATE_INUM_COPY (1,index,i);
if (i < 0 || i >= scm_port_table_size) if (i < 0 || i >= scm_port_table_size)
return SCM_BOOL_F; return SCM_BOOL_F;
@ -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") "have no effect as far as @var{port-for-each} is concerned.\n")
#define FUNC_NAME s_scm_port_for_each #define FUNC_NAME s_scm_port_for_each
{ {
scm_bits_t i; long i;
SCM ports; SCM ports;
SCM_VALIDATE_PROC (1, proc); 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.") "Use port-for-each instead.")
#define FUNC_NAME s_scm_close_all_ports_except #define FUNC_NAME s_scm_close_all_ports_except
{ {
scm_bits_t i = 0; long i = 0;
SCM_VALIDATE_REST_ARGUMENT (ports); SCM_VALIDATE_REST_ARGUMENT (ports);
while (i < scm_port_table_size) while (i < scm_port_table_size)
{ {
@ -1075,14 +1075,14 @@ scm_c_write (SCM port, const void *ptr, size_t size)
void void
scm_flush (SCM port) scm_flush (SCM port)
{ {
scm_bits_t i = SCM_PTOBNUM (port); long i = SCM_PTOBNUM (port);
(scm_ptobs[i].flush) (port); (scm_ptobs[i].flush) (port);
} }
void void
scm_end_input (SCM port) scm_end_input (SCM port)
{ {
scm_bits_t offset; long offset;
scm_port_t *pt = SCM_PTAB_ENTRY (port); scm_port_t *pt = SCM_PTAB_ENTRY (port);
if (pt->read_buf == pt->putback_buf) if (pt->read_buf == pt->putback_buf)

8
libguile/ports.h
View file

@ -70,7 +70,7 @@ typedef enum scm_port_rw_active_t {
typedef struct typedef struct
{ {
SCM port; /* Link back to the port object. */ SCM port; /* Link back to the port object. */
scm_bits_t entry; /* Index in port table. */ long entry; /* Index in port table. */
int revealed; /* 0 not revealed, > 1 revealed. int revealed; /* 0 not revealed, > 1 revealed.
* Revealed ports do not get GC'd. * Revealed ports do not get GC'd.
*/ */
@ -133,7 +133,7 @@ typedef struct
} scm_port_t; } scm_port_t;
extern scm_port_t **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. */ extern long 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) #define SCM_READ_BUFFER_EMPTY_P(c_port) (c_port->read_pos >= c_port->read_end)
@ -220,8 +220,8 @@ typedef struct scm_ptob_descriptor_t
extern scm_ptob_descriptor_t *scm_ptobs; extern scm_ptob_descriptor_t *scm_ptobs;
extern scm_bits_t scm_numptob; extern long scm_numptob;
extern scm_bits_t scm_port_table_room; extern long scm_port_table_room;

16
libguile/print.c
View file

@ -282,8 +282,8 @@ grow_ref_stack (scm_print_state *pstate)
static void static void
print_circref (SCM port,scm_print_state *pstate,SCM ref) print_circref (SCM port,scm_print_state *pstate,SCM ref)
{ {
register scm_bits_t i; register long i;
scm_bits_t self = pstate->top - 1; long self = pstate->top - 1;
i = pstate->top - 1; i = pstate->top - 1;
if (SCM_CONSP (pstate->ref_stack[i])) if (SCM_CONSP (pstate->ref_stack[i]))
{ {
@ -548,8 +548,8 @@ taloop:
scm_puts ("#(", port); scm_puts ("#(", port);
common_vector_printer: common_vector_printer:
{ {
register scm_bits_t i; register long i;
scm_bits_t last = SCM_VECTOR_LENGTH (exp) - 1; long last = SCM_VECTOR_LENGTH (exp) - 1;
int cutp = 0; int cutp = 0;
if (pstate->fancyp && SCM_VECTOR_LENGTH (exp) > pstate->length) 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) scm_iprlist (char *hdr,SCM exp,int tlr,SCM port,scm_print_state *pstate)
{ {
register SCM hare, tortoise; register SCM hare, tortoise;
scm_bits_t floor = pstate->top - 2; long floor = pstate->top - 2;
scm_puts (hdr, port); scm_puts (hdr, port);
/* CHECK_INTS; */ /* CHECK_INTS; */
if (pstate->fancyp) 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); scm_iprin1 (SCM_CAR (exp), port, pstate);
for (exp = SCM_CDR (exp); SCM_ECONSP (exp); exp = SCM_CDR (exp)) for (exp = SCM_CDR (exp); SCM_ECONSP (exp); exp = SCM_CDR (exp))
{ {
register scm_bits_t i; register long i;
for (i = floor; i >= 0; --i) for (i = floor; i >= 0; --i)
if (SCM_EQ_P (pstate->ref_stack[i], exp)) if (SCM_EQ_P (pstate->ref_stack[i], exp))
@ -797,13 +797,13 @@ end:
fancy_printing: fancy_printing:
{ {
scm_bits_t n = pstate->length; long n = pstate->length;
scm_iprin1 (SCM_CAR (exp), port, pstate); scm_iprin1 (SCM_CAR (exp), port, pstate);
exp = SCM_CDR (exp); --n; exp = SCM_CDR (exp); --n;
for (; SCM_ECONSP (exp); exp = SCM_CDR (exp)) for (; SCM_ECONSP (exp); exp = SCM_CDR (exp))
{ {
register scm_ubits_t i; register unsigned long i;
for (i = 0; i < pstate->top; ++i) for (i = 0; i < pstate->top; ++i)
if (SCM_EQ_P (pstate->ref_stack[i], exp)) if (SCM_EQ_P (pstate->ref_stack[i], exp))

20
libguile/procs.c
View file

@ -67,18 +67,18 @@ scm_subr_entry_t *scm_subr_table;
/* Increased to 800 on 2001-05-07 -- Guile now has 779 primitives on /* Increased to 800 on 2001-05-07 -- Guile now has 779 primitives on
startup, 786 with guile-readline. 'martin */ startup, 786 with guile-readline. 'martin */
scm_bits_t scm_subr_table_size = 0; long scm_subr_table_size = 0;
scm_bits_t scm_subr_table_room = 800; long scm_subr_table_room = 800;
SCM SCM
scm_c_make_subr (const char *name, scm_bits_t type, SCM (*fcn) ()) scm_c_make_subr (const char *name, long type, SCM (*fcn) ())
{ {
register SCM z; register SCM z;
scm_bits_t entry; long entry;
if (scm_subr_table_size == scm_subr_table_room) if (scm_subr_table_size == scm_subr_table_room)
{ {
scm_bits_t new_size = scm_subr_table_room * 3 / 2; long new_size = scm_subr_table_room * 3 / 2;
void *new_table void *new_table
= scm_must_realloc ((char *) scm_subr_table, = scm_must_realloc ((char *) scm_subr_table,
sizeof (scm_subr_entry_t) * scm_subr_table_room, sizeof (scm_subr_entry_t) * scm_subr_table_room,
@ -104,7 +104,7 @@ scm_c_make_subr (const char *name, scm_bits_t type, SCM (*fcn) ())
} }
SCM SCM
scm_c_define_subr (const char *name, scm_bits_t type, SCM (*fcn) ()) scm_c_define_subr (const char *name, long type, SCM (*fcn) ())
{ {
SCM subr = scm_c_make_subr (name, type, fcn); SCM subr = scm_c_make_subr (name, type, fcn);
scm_define (SCM_SUBR_ENTRY(subr).name, subr); scm_define (SCM_SUBR_ENTRY(subr).name, subr);
@ -116,7 +116,7 @@ scm_c_define_subr (const char *name, scm_bits_t type, SCM (*fcn) ())
void void
scm_free_subr_entry (SCM subr) scm_free_subr_entry (SCM subr)
{ {
scm_bits_t entry = SCM_SUBRNUM (subr); long entry = SCM_SUBRNUM (subr);
/* Move last entry in table to the free position */ /* Move last entry in table to the free position */
scm_subr_table[entry] = scm_subr_table[scm_subr_table_size - 1]; scm_subr_table[entry] = scm_subr_table[scm_subr_table_size - 1];
SCM_SET_SUBRNUM (scm_subr_table[entry].handle, entry); SCM_SET_SUBRNUM (scm_subr_table[entry].handle, entry);
@ -125,7 +125,7 @@ scm_free_subr_entry (SCM subr)
SCM SCM
scm_c_make_subr_with_generic (const char *name, scm_c_make_subr_with_generic (const char *name,
scm_bits_t type, SCM (*fcn) (), SCM *gf) long type, SCM (*fcn) (), SCM *gf)
{ {
SCM subr = scm_c_make_subr (name, type, fcn); SCM subr = scm_c_make_subr (name, type, fcn);
SCM_SUBR_ENTRY(subr).generic = gf; SCM_SUBR_ENTRY(subr).generic = gf;
@ -134,7 +134,7 @@ scm_c_make_subr_with_generic (const char *name,
SCM SCM
scm_c_define_subr_with_generic (const char *name, scm_c_define_subr_with_generic (const char *name,
scm_bits_t type, SCM (*fcn) (), SCM *gf) long type, SCM (*fcn) (), SCM *gf)
{ {
SCM subr = scm_c_make_subr_with_generic (name, type, fcn, gf); SCM subr = scm_c_make_subr_with_generic (name, type, fcn, gf);
scm_define (SCM_SUBR_ENTRY(subr).name, subr); scm_define (SCM_SUBR_ENTRY(subr).name, subr);
@ -144,7 +144,7 @@ scm_c_define_subr_with_generic (const char *name,
void void
scm_mark_subr_table () scm_mark_subr_table ()
{ {
scm_bits_t i; long i;
for (i = 0; i < scm_subr_table_size; ++i) for (i = 0; i < scm_subr_table_size; ++i)
{ {
SCM_SETGCMARK (scm_subr_table[i].name); SCM_SETGCMARK (scm_subr_table[i].name);

12
libguile/procs.h
View file

@ -158,18 +158,18 @@ typedef struct
#define SCM_SETTER(obj) SCM_CELL_OBJECT_2 (obj) #define SCM_SETTER(obj) SCM_CELL_OBJECT_2 (obj)
extern scm_subr_entry_t *scm_subr_table; extern scm_subr_entry_t *scm_subr_table;
extern scm_bits_t scm_subr_table_size; extern long scm_subr_table_size;
extern scm_bits_t scm_subr_table_room; extern long scm_subr_table_room;
extern void scm_mark_subr_table (void); extern void scm_mark_subr_table (void);
extern void scm_free_subr_entry (SCM subr); extern void scm_free_subr_entry (SCM subr);
extern SCM scm_c_make_subr (const char *name, scm_bits_t type, SCM (*fcn)()); extern SCM scm_c_make_subr (const char *name, long type, SCM (*fcn)());
extern SCM scm_c_make_subr_with_generic (const char *name, scm_bits_t type, extern SCM scm_c_make_subr_with_generic (const char *name, long type,
SCM (*fcn)(), SCM *gf); SCM (*fcn)(), SCM *gf);
extern SCM scm_c_define_subr (const char *name, scm_bits_t type, SCM (*fcn)()); extern SCM scm_c_define_subr (const char *name, long type, SCM (*fcn)());
extern SCM scm_c_define_subr_with_generic (const char *name, scm_bits_t type, extern SCM scm_c_define_subr_with_generic (const char *name, long type,
SCM (*fcn)(), SCM *gf); SCM (*fcn)(), SCM *gf);
extern SCM scm_makcclo (SCM proc, size_t len); extern SCM scm_makcclo (SCM proc, size_t len);
extern SCM scm_procedure_p (SCM obj); extern SCM scm_procedure_p (SCM obj);

221
libguile/ramap.c
View file

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

2
libguile/root.c
View file

@ -171,7 +171,7 @@ scm_make_root (SCM parent)
#if 0 #if 0
SCM scm_exitval; /* INUM with return value */ SCM scm_exitval; /* INUM with return value */
#endif #endif
static scm_bits_t n_dynamic_roots = 0; static long n_dynamic_roots = 0;
/* cwdr fills out both of these structures, and then passes a pointer /* cwdr fills out both of these structures, and then passes a pointer

8
libguile/rw.c
View file

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

12
libguile/smob.c
View file

@ -67,7 +67,7 @@
*/ */
#define MAX_SMOB_COUNT 256 #define MAX_SMOB_COUNT 256
scm_bits_t scm_numsmob; long scm_numsmob;
scm_smob_descriptor scm_smobs[MAX_SMOB_COUNT]; scm_smob_descriptor scm_smobs[MAX_SMOB_COUNT];
/* {Mark} /* {Mark}
@ -119,7 +119,7 @@ scm_smob_free (SCM obj)
int int
scm_smob_print (SCM exp, SCM port, scm_print_state *pstate) scm_smob_print (SCM exp, SCM port, scm_print_state *pstate)
{ {
size_t n = SCM_SMOBNUM (exp); long n = SCM_SMOBNUM (exp);
scm_puts ("#<", port); scm_puts ("#<", port);
scm_puts (SCM_SMOBNAME (n) ? SCM_SMOBNAME (n) : "smob", port); scm_puts (SCM_SMOBNAME (n) ? SCM_SMOBNAME (n) : "smob", port);
scm_putc (' ', port); scm_putc (' ', port);
@ -289,7 +289,7 @@ scm_bits_t
scm_make_smob_type (char *name, size_t size) scm_make_smob_type (char *name, size_t size)
#define FUNC_NAME "scm_make_smob_type" #define FUNC_NAME "scm_make_smob_type"
{ {
size_t new_smob; long new_smob;
SCM_ENTER_A_SECTION; /* scm_numsmob */ SCM_ENTER_A_SECTION; /* scm_numsmob */
new_smob = scm_numsmob; new_smob = scm_numsmob;
@ -453,7 +453,7 @@ scm_set_smob_apply (scm_bits_t tc, SCM (*apply) (),
SCM SCM
scm_make_smob (scm_bits_t tc) scm_make_smob (scm_bits_t tc)
{ {
size_t n = SCM_TC2SMOBNUM (tc); long n = SCM_TC2SMOBNUM (tc);
size_t size = scm_smobs[n].size; size_t size = scm_smobs[n].size;
SCM z; SCM z;
SCM_NEWCELL (z); SCM_NEWCELL (z);
@ -487,7 +487,7 @@ scm_make_smob_type_mfpe (char *name, size_t size,
int (*print) (SCM, SCM, scm_print_state *), int (*print) (SCM, SCM, scm_print_state *),
SCM (*equalp) (SCM, SCM)) SCM (*equalp) (SCM, SCM))
{ {
scm_bits_t answer = scm_make_smob_type (name, size); long answer = scm_make_smob_type (name, size);
scm_set_smob_mfpe (answer, mark, free, print, equalp); scm_set_smob_mfpe (answer, mark, free, print, equalp);
return answer; return answer;
} }
@ -526,7 +526,7 @@ free_print (SCM exp, SCM port, scm_print_state *pstate)
void void
scm_smob_prehistory () scm_smob_prehistory ()
{ {
size_t i; long i;
scm_bits_t tc; scm_bits_t tc;
scm_numsmob = 0; scm_numsmob = 0;

2
libguile/smob.h
View file

@ -124,7 +124,7 @@ do { \
#define SCM_SMOB_APPLY_2(x,a1,a2) (SCM_SMOB_DESCRIPTOR (x).apply_2 (x, (a1), (a2))) #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))) #define SCM_SMOB_APPLY_3(x,a1,a2,rst) (SCM_SMOB_DESCRIPTOR (x).apply_3 (x, (a1), (a2), (rst)))
extern scm_bits_t scm_numsmob; extern long scm_numsmob;
extern scm_smob_descriptor scm_smobs[]; extern scm_smob_descriptor scm_smobs[];

42
libguile/sort.c
View file

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

28
libguile/stacks.c
View file

@ -153,10 +153,10 @@
* is read from a continuation. * is read from a continuation.
*/ */
static scm_bits_t static scm_bits_t
stack_depth (scm_debug_frame_t *dframe,scm_bits_t offset,SCM *id,int *maxp) stack_depth (scm_debug_frame_t *dframe,long offset,SCM *id,int *maxp)
{ {
scm_bits_t n; long n;
scm_bits_t max_depth = SCM_BACKTRACE_MAXDEPTH; long max_depth = SCM_BACKTRACE_MAXDEPTH;
for (n = 0; for (n = 0;
dframe && !SCM_VOIDFRAMEP (*dframe) && n < max_depth; dframe && !SCM_VOIDFRAMEP (*dframe) && n < max_depth;
dframe = RELOC_FRAME (dframe->prev, offset)) dframe = RELOC_FRAME (dframe->prev, offset))
@ -185,7 +185,7 @@ stack_depth (scm_debug_frame_t *dframe,scm_bits_t offset,SCM *id,int *maxp)
/* Read debug info from DFRAME into IFRAME. /* Read debug info from DFRAME into IFRAME.
*/ */
static void static void
read_frame (scm_debug_frame_t *dframe,scm_bits_t offset,scm_info_frame_t *iframe) read_frame (scm_debug_frame_t *dframe,long offset,scm_info_frame_t *iframe)
{ {
scm_bits_t flags = SCM_UNPACK (SCM_INUM0); /* UGh. */ scm_bits_t flags = SCM_UNPACK (SCM_INUM0); /* UGh. */
if (SCM_EVALFRAMEP (*dframe)) if (SCM_EVALFRAMEP (*dframe))
@ -252,7 +252,7 @@ do { \
*/ */
static scm_bits_t static scm_bits_t
read_frames (scm_debug_frame_t *dframe,scm_bits_t offset,scm_bits_t n,scm_info_frame_t *iframes) read_frames (scm_debug_frame_t *dframe,long offset,long n,scm_info_frame_t *iframes)
{ {
scm_info_frame_t *iframe = iframes; scm_info_frame_t *iframe = iframes;
scm_debug_info_t *info; scm_debug_info_t *info;
@ -345,11 +345,11 @@ read_frames (scm_debug_frame_t *dframe,scm_bits_t offset,scm_bits_t n,scm_info_f
*/ */
static void static void
narrow_stack (SCM stack,scm_bits_t inner,SCM inner_key,scm_bits_t outer,SCM outer_key) narrow_stack (SCM stack,long inner,SCM inner_key,long outer,SCM outer_key)
{ {
scm_stack_t *s = SCM_STACK (stack); scm_stack_t *s = SCM_STACK (stack);
scm_bits_t i; long i;
scm_bits_t n = s->length; long n = s->length;
/* Cut inner part. */ /* Cut inner part. */
if (SCM_EQ_P (inner_key, SCM_BOOL_T)) if (SCM_EQ_P (inner_key, SCM_BOOL_T))
@ -421,11 +421,11 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
"resulting stack will be narrowed.") "resulting stack will be narrowed.")
#define FUNC_NAME s_scm_make_stack #define FUNC_NAME s_scm_make_stack
{ {
scm_bits_t n, size; long n, size;
int maxp; int maxp;
scm_debug_frame_t *dframe = scm_last_debug_frame; scm_debug_frame_t *dframe = scm_last_debug_frame;
scm_info_frame_t *iframe; scm_info_frame_t *iframe;
scm_bits_t offset = 0; long offset = 0;
SCM stack, id; SCM stack, id;
SCM inner_cut, outer_cut; SCM inner_cut, outer_cut;
@ -514,7 +514,7 @@ SCM_DEFINE (scm_stack_id, "stack-id", 1, 0, 0,
#define FUNC_NAME s_scm_stack_id #define FUNC_NAME s_scm_stack_id
{ {
scm_debug_frame_t *dframe; scm_debug_frame_t *dframe;
scm_bits_t offset = 0; long offset = 0;
if (SCM_EQ_P (stack, SCM_BOOL_T)) if (SCM_EQ_P (stack, SCM_BOOL_T))
dframe = scm_last_debug_frame; dframe = scm_last_debug_frame;
else else
@ -588,7 +588,7 @@ SCM_DEFINE (scm_last_stack_frame, "last-stack-frame", 1, 0, 0,
#define FUNC_NAME s_scm_last_stack_frame #define FUNC_NAME s_scm_last_stack_frame
{ {
scm_debug_frame_t *dframe; scm_debug_frame_t *dframe;
scm_bits_t offset = 0; long offset = 0;
SCM stack; SCM stack;
SCM_VALIDATE_NIM (1,obj); SCM_VALIDATE_NIM (1,obj);
@ -672,7 +672,7 @@ SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0,
"@var{frame} is the first frame in its stack.") "@var{frame} is the first frame in its stack.")
#define FUNC_NAME s_scm_frame_previous #define FUNC_NAME s_scm_frame_previous
{ {
scm_bits_t n; long n;
SCM_VALIDATE_FRAME (1,frame); SCM_VALIDATE_FRAME (1,frame);
n = SCM_INUM (SCM_CDR (frame)) + 1; n = SCM_INUM (SCM_CDR (frame)) + 1;
if (n >= SCM_STACK_LENGTH (SCM_CAR (frame))) if (n >= SCM_STACK_LENGTH (SCM_CAR (frame)))
@ -688,7 +688,7 @@ SCM_DEFINE (scm_frame_next, "frame-next", 1, 0, 0,
"@var{frame} is the last frame in its stack.") "@var{frame} is the last frame in its stack.")
#define FUNC_NAME s_scm_frame_next #define FUNC_NAME s_scm_frame_next
{ {
scm_bits_t n; long n;
SCM_VALIDATE_FRAME (1,frame); SCM_VALIDATE_FRAME (1,frame);
n = SCM_INUM (SCM_CDR (frame)) - 1; n = SCM_INUM (SCM_CDR (frame)) - 1;
if (n < 0) if (n < 0)

4
libguile/stacks.h
View file

@ -69,8 +69,8 @@ typedef struct scm_info_frame_t {
typedef struct scm_stack_t { typedef struct scm_stack_t {
SCM id; /* Stack id */ SCM id; /* Stack id */
scm_info_frame_t *frames; /* Info frames */ scm_info_frame_t *frames; /* Info frames */
scm_bits_t length; /* Stack length */ unsigned long length; /* Stack length */
scm_bits_t tail_length; unsigned long tail_length;
scm_info_frame_t tail[1]; scm_info_frame_t tail[1];
} scm_stack_t; } scm_stack_t;

16
libguile/strings.c
View file

@ -96,7 +96,7 @@ SCM_DEFINE (scm_string, "string", 0, 0, 1,
SCM result; SCM result;
{ {
scm_bits_t i = scm_ilength (chrs); long i = scm_ilength (chrs);
SCM_ASSERT (i >= 0, chrs, SCM_ARGn, FUNC_NAME); SCM_ASSERT (i >= 0, chrs, SCM_ARGn, FUNC_NAME);
result = scm_allocate_string (i); result = scm_allocate_string (i);
@ -248,7 +248,7 @@ SCM_DEFINE (scm_make_string, "make-string", 1, 1, 0,
{ {
if (SCM_INUMP (k)) if (SCM_INUMP (k))
{ {
scm_bits_t i = SCM_INUM (k); long int i = SCM_INUM (k);
SCM res; SCM res;
SCM_ASSERT_RANGE (1, k, i >= 0); 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}.") "indexing. @var{k} must be a valid index of @var{str}.")
#define FUNC_NAME s_scm_string_ref #define FUNC_NAME s_scm_string_ref
{ {
scm_bits_t idx; long idx;
SCM_VALIDATE_STRING (1, str); SCM_VALIDATE_STRING (1, str);
SCM_VALIDATE_INUM_COPY (2, k, idx); 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}).") "0 <= @var{start} <= @var{end} <= (string-length @var{str}).")
#define FUNC_NAME s_scm_substring #define FUNC_NAME s_scm_substring
{ {
scm_bits_t from; long int from;
scm_bits_t to; long int to;
SCM_VALIDATE_STRING (1, str); SCM_VALIDATE_STRING (1, str);
SCM_VALIDATE_INUM (2, start); SCM_VALIDATE_INUM (2, start);
@ -393,8 +393,8 @@ SCM_DEFINE (scm_make_shared_substring, "make-shared-substring", 1, 2, 0,
"occupies the same storage space as @var{str}.") "occupies the same storage space as @var{str}.")
#define FUNC_NAME s_scm_make_shared_substring #define FUNC_NAME s_scm_make_shared_substring
{ {
scm_bits_t f; long f;
scm_bits_t t; long t;
SCM answer; SCM answer;
SCM len_str; SCM len_str;
@ -411,7 +411,7 @@ SCM_DEFINE (scm_make_shared_substring, "make-shared-substring", 1, 2, 0,
SCM_DEFER_INTS; SCM_DEFER_INTS;
if (SCM_SUBSTRP (str)) if (SCM_SUBSTRP (str))
{ {
scm_bits_t offset; long offset;
offset = SCM_INUM (SCM_SUBSTR_OFFSET (str)); offset = SCM_INUM (SCM_SUBSTR_OFFSET (str));
f += offset; f += offset;
t += offset; t += offset;

28
libguile/strop.c
View file

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

6
libguile/strports.c
View file

@ -101,9 +101,9 @@ st_resize_port (scm_port_t *pt, off_t new_size)
{ {
SCM old_stream = SCM_PACK (pt->stream); SCM old_stream = SCM_PACK (pt->stream);
SCM new_stream = scm_allocate_string (new_size); SCM new_stream = scm_allocate_string (new_size);
size_t old_size = SCM_STRING_LENGTH (old_stream); unsigned long int old_size = SCM_STRING_LENGTH (old_stream);
size_t min_size = min (old_size, new_size); unsigned long int min_size = min (old_size, new_size);
size_t i; unsigned long int i;
off_t index = pt->write_pos - pt->write_buf; off_t index = pt->write_pos - pt->write_buf;

4
libguile/struct.c
View file

@ -736,8 +736,8 @@ SCM_DEFINE (scm_struct_vtable_tag, "struct-vtable-tag", 1, 0, 0,
* how to associate names with vtables. * how to associate names with vtables.
*/ */
scm_bits_t unsigned long
scm_struct_ihashq (SCM obj, scm_bits_t n) scm_struct_ihashq (SCM obj, unsigned long n)
{ {
/* The length of the hash table should be a relative prime it's not /* The length of the hash table should be a relative prime it's not
necessary to shift down the address. */ necessary to shift down the address. */

2
libguile/struct.h
View file

@ -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_set_x (SCM handle, SCM pos, SCM val);
extern SCM scm_struct_vtable (SCM handle); extern SCM scm_struct_vtable (SCM handle);
extern SCM scm_struct_vtable_tag (SCM handle); extern SCM scm_struct_vtable_tag (SCM handle);
extern scm_bits_t scm_struct_ihashq (SCM obj, scm_bits_t n); extern unsigned long scm_struct_ihashq (SCM obj, unsigned long n);
extern SCM scm_struct_create_handle (SCM obj); extern SCM scm_struct_create_handle (SCM obj);
extern SCM scm_struct_vtable_name (SCM vtable); extern SCM scm_struct_vtable_name (SCM vtable);
extern SCM scm_set_struct_vtable_name_x (SCM vtable, SCM name); extern SCM scm_set_struct_vtable_name_x (SCM vtable, SCM name);

6
libguile/symbols.h
View file

@ -55,11 +55,11 @@
*/ */
#define SCM_SYMBOLP(x) (SCM_NIMP (x) && (SCM_TYP7 (x) == scm_tc7_symbol)) #define SCM_SYMBOLP(x) (SCM_NIMP (x) && (SCM_TYP7 (x) == scm_tc7_symbol))
#define SCM_SYMBOL_LENGTH(x) (((scm_ubits_t) SCM_CELL_WORD_0 (x)) >> 8) #define SCM_SYMBOL_LENGTH(x) (((unsigned long) 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_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_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_SET_SYMBOL_CHARS(s, c) (SCM_SET_CELL_WORD_1 ((s), (c)))
#define SCM_SYMBOL_HASH(X) ((scm_ubits_t) SCM_CELL_WORD_2 (X)) #define SCM_SYMBOL_HASH(X) ((unsigned long) SCM_CELL_WORD_2 (X))
#define SCM_SET_SYMBOL_HASH(X, v) (SCM_SET_CELL_WORD_2 ((X), (v))) #define SCM_SET_SYMBOL_HASH(X, v) (SCM_SET_CELL_WORD_2 ((X), (v)))
#define SCM_PROP_SLOTS(X) (SCM_CELL_WORD_3 (X)) #define SCM_PROP_SLOTS(X) (SCM_CELL_WORD_3 (X))
@ -103,7 +103,7 @@ extern void scm_init_symbols (void);
#define SCM_SUBSTR_STR(x) (SCM_CDDR (x)) #define SCM_SUBSTR_STR(x) (SCM_CDDR (x))
#define SCM_SUBSTR_OFFSET(x) (SCM_CADR (x)) #define SCM_SUBSTR_OFFSET(x) (SCM_CADR (x))
#define SCM_LENGTH_MAX (0xffffffL) #define SCM_LENGTH_MAX (0xffffffL)
#define SCM_LENGTH(x) (((scm_ubits_t) SCM_CELL_WORD_0 (x)) >> 8) #define SCM_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8)
#define SCM_SETLENGTH(x, v, t) (SCM_SET_CELL_WORD_0 ((x), ((v) << 8) + (t))) #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) \ #define SCM_ROSTRINGP(x) (SCM_NIMP(x) && ((SCM_TYP7S(x)==scm_tc7_string) \
|| (SCM_TYP7(x) == scm_tc7_symbol))) || (SCM_TYP7(x) == scm_tc7_symbol)))

3
libguile/tags.h
View file

@ -58,8 +58,7 @@
/* In the beginning was the Word: /* In the beginning was the Word:
*/ */
typedef SCM_BITS_T scm_bits_t; typedef long scm_bits_t;
typedef SCM_UBITS_T scm_ubits_t;
/* But as external interface, we use SCM, which may, according to the desired /* But as external interface, we use SCM, which may, according to the desired
* level of type checking, be defined in several ways: * level of type checking, be defined in several ways:

311
libguile/unif.c
View file

@ -101,8 +101,6 @@ scm_uniform_element_size (SCM obj)
switch (SCM_TYP7 (obj)) switch (SCM_TYP7 (obj))
{ {
case scm_tc7_bvect: case scm_tc7_bvect:
result = sizeof (scm_bits_t);
break;
case scm_tc7_uvect: case scm_tc7_uvect:
case scm_tc7_ivect: case scm_tc7_ivect:
result = sizeof (long); result = sizeof (long);
@ -156,32 +154,20 @@ 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
scm_make_uve (scm_bits_t k, SCM prot) scm_make_uve (long k, SCM prot)
#define FUNC_NAME "scm_make_uve" #define FUNC_NAME "scm_make_uve"
{ {
SCM v; SCM v;
size_t i; long i, type;
scm_bits_t type;
scm_ubits_t size_in_bytes;
if (SCM_EQ_P (prot, SCM_BOOL_T)) if (SCM_EQ_P (prot, SCM_BOOL_T))
{ {
SCM_NEWCELL (v); SCM_NEWCELL (v);
if (k > 0) if (k > 0)
{ {
SCM_ASSERT_RANGE (1, scm_bits2num (k), SCM_ASSERT_RANGE (1, scm_long2num (k), k <= SCM_BITVECTOR_MAX_LENGTH);
k <= SCM_BITVECTOR_MAX_LENGTH); i = sizeof (long) * ((k + SCM_LONG_BIT - 1) / SCM_LONG_BIT);
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_BASE (v, (char *) scm_must_malloc (i, "vector"));
SCM_SET_BITVECTOR_LENGTH (v, k); SCM_SET_BITVECTOR_LENGTH (v, k);
} }
@ -194,19 +180,17 @@ scm_make_uve (scm_bits_t k, SCM prot)
} }
else if (SCM_CHARP (prot) && (SCM_CHAR (prot) == '\0')) else if (SCM_CHARP (prot) && (SCM_CHAR (prot) == '\0'))
{ {
size_in_bytes = sizeof (char) * k; i = sizeof (char) * k;
type = scm_tc7_byvect; type = scm_tc7_byvect;
} }
else if (SCM_CHARP (prot)) else if (SCM_CHARP (prot))
{ {
size_in_bytes = sizeof (char) * k; i = sizeof (char) * k;
CHECK_BYTE_SIZE (size_in_bytes, k);
i = (size_t) size_in_bytes;
return scm_allocate_string (i); return scm_allocate_string (i);
} }
else if (SCM_INUMP (prot)) else if (SCM_INUMP (prot))
{ {
size_in_bytes = sizeof (long) * k; i = sizeof (long) * k;
if (SCM_INUM (prot) > 0) if (SCM_INUM (prot) > 0)
type = scm_tc7_uvect; type = scm_tc7_uvect;
else else
@ -219,13 +203,13 @@ scm_make_uve (scm_bits_t k, SCM prot)
s = SCM_SYMBOL_CHARS (prot)[0]; s = SCM_SYMBOL_CHARS (prot)[0];
if (s == 's') if (s == 's')
{ {
size_in_bytes = sizeof (short) * k; i = sizeof (short) * k;
type = scm_tc7_svect; type = scm_tc7_svect;
} }
#ifdef HAVE_LONG_LONGS #ifdef HAVE_LONG_LONGS
else if (s == 'l') else if (s == 'l')
{ {
size_in_bytes = sizeof (long long) * k; i = sizeof (long long) * k;
type = scm_tc7_llvect; type = scm_tc7_llvect;
} }
#endif #endif
@ -233,7 +217,6 @@ scm_make_uve (scm_bits_t k, SCM prot)
{ {
return scm_c_make_vector (k, SCM_UNDEFINED); return scm_c_make_vector (k, SCM_UNDEFINED);
} }
} }
else if (!SCM_INEXACTP (prot)) else if (!SCM_INEXACTP (prot))
/* Huge non-unif vectors are NOT supported. */ /* Huge non-unif vectors are NOT supported. */
@ -241,24 +224,21 @@ scm_make_uve (scm_bits_t k, SCM prot)
return scm_c_make_vector (k, SCM_UNDEFINED); return scm_c_make_vector (k, SCM_UNDEFINED);
else if (singp (prot)) else if (singp (prot))
{ {
size_in_bytes = sizeof (float) * k; i = sizeof (float) * k;
type = scm_tc7_fvect; type = scm_tc7_fvect;
} }
else if (SCM_COMPLEXP (prot)) else if (SCM_COMPLEXP (prot))
{ {
size_in_bytes = 2 * sizeof (double) * k; i = 2 * sizeof (double) * k;
type = scm_tc7_cvect; type = scm_tc7_cvect;
} }
else else
{ {
size_in_bytes = sizeof (double) * k; i = sizeof (double) * k;
type = scm_tc7_dvect; type = scm_tc7_dvect;
} }
CHECK_BYTE_SIZE (size_in_bytes, k); SCM_ASSERT_RANGE (1, scm_long2num (k), k <= SCM_UVECTOR_MAX_LENGTH);
i = (size_t) size_in_bytes;
SCM_ASSERT_RANGE (1, scm_bits2num (k), k <= SCM_UVECTOR_MAX_LENGTH);
SCM_NEWCELL (v); SCM_NEWCELL (v);
SCM_DEFER_INTS; SCM_DEFER_INTS;
@ -503,14 +483,14 @@ SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0,
static char s_bad_ind[] = "Bad scm_array index"; static char s_bad_ind[] = "Bad scm_array index";
scm_bits_t long
scm_aind (SCM ra, SCM args, const char *what) scm_aind (SCM ra, SCM args, const char *what)
#define FUNC_NAME what #define FUNC_NAME what
{ {
SCM ind; SCM ind;
register scm_bits_t j; register long j;
register scm_bits_t pos = SCM_ARRAY_BASE (ra); register unsigned long pos = SCM_ARRAY_BASE (ra);
register size_t k = SCM_ARRAY_NDIM (ra); register unsigned long k = SCM_ARRAY_NDIM (ra);
scm_array_dim_t *s = SCM_ARRAY_DIMS (ra); scm_array_dim_t *s = SCM_ARRAY_DIMS (ra);
if (SCM_INUMP (args)) if (SCM_INUMP (args))
{ {
@ -608,7 +588,7 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1,
#define FUNC_NAME s_scm_dimensions_to_uniform_array #define FUNC_NAME s_scm_dimensions_to_uniform_array
{ {
size_t k; size_t k;
scm_bits_t rlen = 1; unsigned long rlen = 1;
scm_array_dim_t *s; scm_array_dim_t *s;
SCM ra; SCM ra;
@ -634,7 +614,6 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1,
while (k--) while (k--)
{ {
s[k].inc = rlen; s[k].inc = rlen;
SCM_ASSERT_RANGE (1, dims, s[k].inc >= 0);
SCM_ASSERT_RANGE (1, dims, s[k].lbnd <= s[k].ubnd); SCM_ASSERT_RANGE (1, dims, s[k].lbnd <= s[k].ubnd);
rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc; rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
} }
@ -649,7 +628,7 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1,
scm_array_fill_x (ra, prot); scm_array_fill_x (ra, prot);
if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra)) if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra))
if (s[0].ubnd < s[0].lbnd || (0 == s[0].lbnd && 1 == s[0].inc)) if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc))
return SCM_ARRAY_V (ra); return SCM_ARRAY_V (ra);
return ra; return ra;
} }
@ -662,7 +641,7 @@ scm_ra_set_contp (SCM ra)
size_t k = SCM_ARRAY_NDIM (ra); size_t k = SCM_ARRAY_NDIM (ra);
if (k) if (k)
{ {
scm_bits_t inc = SCM_ARRAY_DIMS (ra)[k - 1].inc; /*??*/ long inc = SCM_ARRAY_DIMS (ra)[k - 1].inc;
while (k--) while (k--)
{ {
if (inc != SCM_ARRAY_DIMS (ra)[k].inc) if (inc != SCM_ARRAY_DIMS (ra)[k].inc)
@ -700,9 +679,8 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
SCM ra; SCM ra;
SCM inds, indptr; SCM inds, indptr;
SCM imap; SCM imap;
size_t k; size_t k, i;
scm_bits_t i; long old_min, new_min, old_max, new_max;
scm_bits_t old_min, new_min, old_max, new_max;
scm_array_dim_t *s; scm_array_dim_t *s;
SCM_VALIDATE_REST_ARGUMENT (dims); SCM_VALIDATE_REST_ARGUMENT (dims);
@ -745,7 +723,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
} }
imap = scm_apply (mapfunc, scm_reverse (inds), SCM_EOL); imap = scm_apply (mapfunc, scm_reverse (inds), SCM_EOL);
if (SCM_ARRAYP (oldra)) if (SCM_ARRAYP (oldra))
i = scm_aind (oldra, imap, FUNC_NAME); i = (size_t) scm_aind (oldra, imap, FUNC_NAME);
else else
{ {
if (SCM_NINUMP (imap)) if (SCM_NINUMP (imap))
@ -794,7 +772,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra)) if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (ra))
{ {
SCM v = SCM_ARRAY_V (ra); SCM v = SCM_ARRAY_V (ra);
scm_bits_t length = SCM_INUM (scm_uniform_vector_length (v)); unsigned long int length = SCM_INUM (scm_uniform_vector_length (v));
if (1 == s->inc && 0 == s->lbnd && length == 1 + s->ubnd) if (1 == s->inc && 0 == s->lbnd && length == 1 + s->ubnd)
return v; return v;
if (s->ubnd < s->lbnd) if (s->ubnd < s->lbnd)
@ -1024,9 +1002,9 @@ SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1,
#define FUNC_NAME s_scm_array_in_bounds_p #define FUNC_NAME s_scm_array_in_bounds_p
{ {
SCM ind = SCM_EOL; SCM ind = SCM_EOL;
scm_bits_t pos = 0; long pos = 0;
register size_t k; register size_t k;
register scm_bits_t j; register long j;
scm_array_dim_t *s; scm_array_dim_t *s;
SCM_VALIDATE_REST_ARGUMENT (args); SCM_VALIDATE_REST_ARGUMENT (args);
@ -1090,7 +1068,7 @@ tail:
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect: case scm_tc7_wvect:
{ {
scm_bits_t length = SCM_INUM (scm_uniform_vector_length (v)); unsigned long int length = SCM_INUM (scm_uniform_vector_length (v));
SCM_ASRTGO (SCM_NULLP (args) && SCM_INUMP (ind), wna); SCM_ASRTGO (SCM_NULLP (args) && SCM_INUMP (ind), wna);
return SCM_BOOL(pos >= 0 && pos < length); return SCM_BOOL(pos >= 0 && pos < length);
} }
@ -1109,7 +1087,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
"@var{array}.") "@var{array}.")
#define FUNC_NAME s_scm_uniform_vector_ref #define FUNC_NAME s_scm_uniform_vector_ref
{ {
scm_bits_t pos; long pos;
if (SCM_IMP (v)) if (SCM_IMP (v))
{ {
@ -1123,7 +1101,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
} }
else else
{ {
scm_bits_t length; unsigned long int length;
if (SCM_NIMP (args)) if (SCM_NIMP (args))
{ {
SCM_ASSERT (SCM_CONSP (args) && SCM_INUMP (SCM_CAR (args)), args, SCM_ARG2, FUNC_NAME); SCM_ASSERT (SCM_CONSP (args) && SCM_INUMP (SCM_CAR (args)), args, SCM_ARG2, FUNC_NAME);
@ -1204,7 +1182,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
tries to recycle conses. (Make *sure* you want them recycled.) */ tries to recycle conses. (Make *sure* you want them recycled.) */
SCM SCM
scm_cvref (SCM v, scm_bits_t pos, SCM last) scm_cvref (SCM v, unsigned long pos, SCM last)
#define FUNC_NAME "scm_cvref" #define FUNC_NAME "scm_cvref"
{ {
switch SCM_TYP7 (v) switch SCM_TYP7 (v)
@ -1287,7 +1265,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
"@var{new-value}. The value returned by array-set! is unspecified.") "@var{new-value}. The value returned by array-set! is unspecified.")
#define FUNC_NAME s_scm_array_set_x #define FUNC_NAME s_scm_array_set_x
{ {
scm_bits_t pos = 0; long pos = 0;
SCM_VALIDATE_REST_ARGUMENT (args); SCM_VALIDATE_REST_ARGUMENT (args);
SCM_ASRTGO (SCM_NIMP (v), badarg1); SCM_ASRTGO (SCM_NIMP (v), badarg1);
@ -1298,7 +1276,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
} }
else else
{ {
scm_bits_t length; unsigned long int length;
if (SCM_NIMP (args)) if (SCM_NIMP (args))
{ {
SCM_ASSERT (SCM_CONSP(args) && SCM_INUMP (SCM_CAR (args)), args, SCM_ASSERT (SCM_CONSP(args) && SCM_INUMP (SCM_CAR (args)), args,
@ -1426,8 +1404,7 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
return ra; return ra;
case scm_tc7_smob: case scm_tc7_smob:
{ {
size_t k, ndim = SCM_ARRAY_NDIM (ra); size_t k, ndim = SCM_ARRAY_NDIM (ra), len = 1;
scm_bits_t len = 1;
if (!SCM_ARRAYP (ra) || !SCM_ARRAY_CONTP (ra)) if (!SCM_ARRAYP (ra) || !SCM_ARRAY_CONTP (ra))
return SCM_BOOL_F; return SCM_BOOL_F;
for (k = 0; k < ndim; k++) for (k = 0; k < ndim; k++)
@ -1439,15 +1416,15 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
if (scm_tc7_bvect == SCM_TYP7 (SCM_ARRAY_V (ra))) if (scm_tc7_bvect == SCM_TYP7 (SCM_ARRAY_V (ra)))
{ {
if (len != SCM_BITVECTOR_LENGTH (SCM_ARRAY_V (ra)) || if (len != SCM_BITVECTOR_LENGTH (SCM_ARRAY_V (ra)) ||
SCM_ARRAY_BASE (ra) % SCM_BITS_LENGTH || SCM_ARRAY_BASE (ra) % SCM_LONG_BIT ||
len % SCM_BITS_LENGTH) len % SCM_LONG_BIT)
return SCM_BOOL_F; return SCM_BOOL_F;
} }
} }
{ {
SCM v = SCM_ARRAY_V (ra); SCM v = SCM_ARRAY_V (ra);
scm_bits_t length = SCM_INUM (scm_uniform_vector_length (v)); unsigned long int length = SCM_INUM (scm_uniform_vector_length (v));
if ((len == length) && 0 == SCM_ARRAY_BASE (ra) && SCM_ARRAY_DIMS (ra)->inc) if ((len == length) && 0 == SCM_ARRAY_BASE (ra) && SCM_ARRAY_DIMS (ra)->inc)
return v; return v;
} }
@ -1469,9 +1446,8 @@ SCM
scm_ra2contig (SCM ra, int copy) scm_ra2contig (SCM ra, int copy)
{ {
SCM ret; SCM ret;
scm_bits_t inc = 1; long inc = 1;
size_t k; size_t k, len = 1;
scm_bits_t len = 1;
for (k = SCM_ARRAY_NDIM (ra); k--;) for (k = SCM_ARRAY_NDIM (ra); k--;)
len *= SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd + 1; len *= SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd + 1;
k = SCM_ARRAY_NDIM (ra); k = SCM_ARRAY_NDIM (ra);
@ -1480,8 +1456,8 @@ scm_ra2contig (SCM ra, int copy)
if (scm_tc7_bvect != SCM_TYP7 (SCM_ARRAY_V (ra))) if (scm_tc7_bvect != SCM_TYP7 (SCM_ARRAY_V (ra)))
return ra; return ra;
if ((len == SCM_BITVECTOR_LENGTH (SCM_ARRAY_V (ra)) && if ((len == SCM_BITVECTOR_LENGTH (SCM_ARRAY_V (ra)) &&
0 == SCM_ARRAY_BASE (ra) % SCM_BITS_LENGTH && 0 == SCM_ARRAY_BASE (ra) % SCM_LONG_BIT &&
0 == len % SCM_BITS_LENGTH)) 0 == len % SCM_LONG_BIT))
return ra; return ra;
} }
ret = scm_make_ra (k); ret = scm_make_ra (k);
@ -1519,10 +1495,10 @@ SCM_DEFINE (scm_uniform_array_read_x, "uniform-array-read!", 1, 3, 0,
#define FUNC_NAME s_scm_uniform_array_read_x #define FUNC_NAME s_scm_uniform_array_read_x
{ {
SCM cra = SCM_UNDEFINED, v = ra; SCM cra = SCM_UNDEFINED, v = ra;
int sz; long sz, vlen, ans;
scm_bits_t vlen, ans; long cstart = 0;
scm_bits_t cstart = 0, cend = 0; long cend;
scm_bits_t offset = 0; long offset = 0;
char *base; char *base;
SCM_ASRTGO (SCM_NIMP (v), badarg1); SCM_ASRTGO (SCM_NIMP (v), badarg1);
@ -1553,9 +1529,9 @@ loop:
break; break;
case scm_tc7_bvect: case scm_tc7_bvect:
base = (char *) SCM_BITVECTOR_BASE (v); base = (char *) SCM_BITVECTOR_BASE (v);
vlen = (vlen + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; vlen = (vlen + SCM_LONG_BIT - 1) / SCM_LONG_BIT;
cstart /= SCM_BITS_LENGTH; cstart /= SCM_LONG_BIT;
sz = sizeof (scm_bits_t); sz = sizeof (long);
break; break;
case scm_tc7_byvect: case scm_tc7_byvect:
base = (char *) SCM_UVECTOR_BASE (v); base = (char *) SCM_UVECTOR_BASE (v);
@ -1594,15 +1570,15 @@ loop:
if (!SCM_UNBNDP (start)) if (!SCM_UNBNDP (start))
{ {
offset = offset =
SCM_NUM2BITS (3, start); SCM_NUM2LONG (3, start);
if (offset < 0 || offset >= cend) if (offset < 0 || offset >= cend)
scm_out_of_range (FUNC_NAME, start); scm_out_of_range (FUNC_NAME, start);
if (!SCM_UNBNDP (end)) if (!SCM_UNBNDP (end))
{ {
scm_bits_t tend = long tend =
SCM_NUM2BITS (4, end); SCM_NUM2LONG (4, end);
if (tend <= offset || tend > cend) if (tend <= offset || tend > cend)
scm_out_of_range (FUNC_NAME, end); scm_out_of_range (FUNC_NAME, end);
@ -1658,7 +1634,7 @@ loop:
SCM_SYSERROR; SCM_SYSERROR;
} }
if (SCM_TYP7 (v) == scm_tc7_bvect) if (SCM_TYP7 (v) == scm_tc7_bvect)
ans *= SCM_BITS_LENGTH; ans *= SCM_LONG_BIT;
if (!SCM_EQ_P (v, ra) && !SCM_EQ_P (cra, ra)) if (!SCM_EQ_P (v, ra) && !SCM_EQ_P (cra, ra))
scm_array_copy_x (cra, ra); scm_array_copy_x (cra, ra);
@ -1681,9 +1657,10 @@ SCM_DEFINE (scm_uniform_array_write, "uniform-array-write", 1, 3, 0,
"@code{(current-output-port)}.") "@code{(current-output-port)}.")
#define FUNC_NAME s_scm_uniform_array_write #define FUNC_NAME s_scm_uniform_array_write
{ {
int sz; long sz, vlen, ans;
scm_bits_t vlen, ans; long offset = 0;
scm_bits_t offset = 0, cstart = 0, cend; long cstart = 0;
long cend;
char *base; char *base;
port_or_fd = SCM_COERCE_OUTPORT (port_or_fd); port_or_fd = SCM_COERCE_OUTPORT (port_or_fd);
@ -1716,9 +1693,9 @@ loop:
break; break;
case scm_tc7_bvect: case scm_tc7_bvect:
base = (char *) SCM_BITVECTOR_BASE (v); base = (char *) SCM_BITVECTOR_BASE (v);
vlen = (vlen + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; vlen = (vlen + SCM_LONG_BIT - 1) / SCM_LONG_BIT;
cstart /= SCM_BITS_LENGTH; cstart /= SCM_LONG_BIT;
sz = sizeof (scm_bits_t); sz = sizeof (long);
break; break;
case scm_tc7_byvect: case scm_tc7_byvect:
base = (char *) SCM_UVECTOR_BASE (v); base = (char *) SCM_UVECTOR_BASE (v);
@ -1757,15 +1734,15 @@ loop:
if (!SCM_UNBNDP (start)) if (!SCM_UNBNDP (start))
{ {
offset = offset =
SCM_NUM2BITS (3, start); SCM_NUM2LONG (3, start);
if (offset < 0 || offset >= cend) if (offset < 0 || offset >= cend)
scm_out_of_range (FUNC_NAME, start); scm_out_of_range (FUNC_NAME, start);
if (!SCM_UNBNDP (end)) if (!SCM_UNBNDP (end))
{ {
scm_bits_t tend = long tend =
SCM_NUM2BITS (4, end); SCM_NUM2LONG (4, end);
if (tend <= offset || tend > cend) if (tend <= offset || tend > cend)
scm_out_of_range (FUNC_NAME, end); scm_out_of_range (FUNC_NAME, end);
@ -1789,7 +1766,7 @@ loop:
SCM_SYSERROR; SCM_SYSERROR;
} }
if (SCM_TYP7 (v) == scm_tc7_bvect) if (SCM_TYP7 (v) == scm_tc7_bvect)
ans *= SCM_BITS_LENGTH; ans *= SCM_LONG_BIT;
return SCM_MAKINUM (ans); return SCM_MAKINUM (ans);
} }
@ -1810,13 +1787,13 @@ SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
if (SCM_BITVECTOR_LENGTH (bitvector) == 0) { if (SCM_BITVECTOR_LENGTH (bitvector) == 0) {
return SCM_INUM0; return SCM_INUM0;
} else { } else {
scm_bits_t count = 0; unsigned long int count = 0;
size_t i = (SCM_BITVECTOR_LENGTH (bitvector) - 1) / SCM_BITS_LENGTH; unsigned long int i = (SCM_BITVECTOR_LENGTH (bitvector) - 1) / SCM_LONG_BIT;
scm_ubits_t w = SCM_UNPACK (SCM_VELTS (bitvector)[i]); unsigned long int w = SCM_UNPACK (SCM_VELTS (bitvector)[i]);
if (SCM_FALSEP (b)) { if (SCM_FALSEP (b)) {
w = ~w; w = ~w;
}; };
w <<= SCM_BITS_LENGTH - 1 - ((SCM_BITVECTOR_LENGTH (bitvector) - 1) % SCM_BITS_LENGTH); w <<= SCM_LONG_BIT - 1 - ((SCM_BITVECTOR_LENGTH (bitvector) - 1) % SCM_LONG_BIT);
while (1) { while (1) {
while (w) { while (w) {
count += cnt_tab[w & 0x0f]; count += cnt_tab[w & 0x0f];
@ -1844,11 +1821,8 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
"within the specified range @code{#f} is returned.") "within the specified range @code{#f} is returned.")
#define FUNC_NAME s_scm_bit_position #define FUNC_NAME s_scm_bit_position
{ {
size_t i; long i, lenw, xbits, pos;
scm_bits_t pos; register unsigned long w;
size_t lenw;
int xbits;
register scm_ubits_t w;
SCM_VALIDATE_BOOL (1, item); SCM_VALIDATE_BOOL (1, item);
SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG2, FUNC_NAME); SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG2, FUNC_NAME);
@ -1858,15 +1832,15 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
if (pos == SCM_BITVECTOR_LENGTH (v)) if (pos == SCM_BITVECTOR_LENGTH (v))
return SCM_BOOL_F; return SCM_BOOL_F;
lenw = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_BITS_LENGTH; /* watch for part words */ lenw = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT; /* watch for part words */
i = pos / SCM_BITS_LENGTH; i = pos / SCM_LONG_BIT;
w = SCM_UNPACK (SCM_VELTS (v)[i]); w = SCM_UNPACK (SCM_VELTS (v)[i]);
if (SCM_FALSEP (item)) if (SCM_FALSEP (item))
w = ~w; w = ~w;
xbits = (pos % SCM_BITS_LENGTH); xbits = (pos % SCM_LONG_BIT);
pos -= xbits; pos -= xbits;
w = ((w >> xbits) << xbits); w = ((w >> xbits) << xbits);
xbits = SCM_BITS_LENGTH - 1 - (SCM_BITVECTOR_LENGTH (v) - 1) % SCM_BITS_LENGTH; xbits = SCM_LONG_BIT - 1 - (SCM_BITVECTOR_LENGTH (v) - 1) % SCM_LONG_BIT;
while (!0) while (!0)
{ {
if (w && (i == lenw)) if (w && (i == lenw))
@ -1893,7 +1867,7 @@ SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
} }
if (++i > lenw) if (++i > lenw)
break; break;
pos += SCM_BITS_LENGTH; pos += SCM_LONG_BIT;
w = SCM_UNPACK (SCM_VELTS (v)[i]); w = SCM_UNPACK (SCM_VELTS (v)[i]);
if (SCM_FALSEP (item)) if (SCM_FALSEP (item))
w = ~w; w = ~w;
@ -1915,8 +1889,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
"@var{bool}. The return value is unspecified.") "@var{bool}. The return value is unspecified.")
#define FUNC_NAME s_scm_bit_set_star_x #define FUNC_NAME s_scm_bit_set_star_x
{ {
register size_t i; register long i, k, vlen;
scm_bits_t vlen;
SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG1, FUNC_NAME); SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG1, FUNC_NAME);
SCM_ASRTGO (SCM_NIMP (kv), badarg2); SCM_ASRTGO (SCM_NIMP (kv), badarg2);
switch SCM_TYP7 (kv) switch SCM_TYP7 (kv)
@ -1924,13 +1897,11 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
default: default:
badarg2:SCM_WRONG_TYPE_ARG (2, kv); badarg2:SCM_WRONG_TYPE_ARG (2, kv);
case scm_tc7_uvect: case scm_tc7_uvect:
{
unsigned long k;
vlen = SCM_BITVECTOR_LENGTH (v); vlen = SCM_BITVECTOR_LENGTH (v);
if (SCM_FALSEP (obj)) if (SCM_FALSEP (obj))
for (i = SCM_UVECTOR_LENGTH (kv); i;) for (i = SCM_UVECTOR_LENGTH (kv); i;)
{ {
k = ((unsigned long *) SCM_VELTS (kv))[--i]; k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
if (k >= vlen) if (k >= vlen)
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));
SCM_BITVEC_CLR(v,k); SCM_BITVEC_CLR(v,k);
@ -1938,7 +1909,7 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
else if (SCM_EQ_P (obj, SCM_BOOL_T)) else if (SCM_EQ_P (obj, SCM_BOOL_T))
for (i = SCM_UVECTOR_LENGTH (kv); i;) for (i = SCM_UVECTOR_LENGTH (kv); i;)
{ {
k = ((unsigned long *) SCM_VELTS (kv))[--i]; k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
if (k >= vlen) if (k >= vlen)
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));
SCM_BITVEC_SET(v,k); SCM_BITVEC_SET(v,k);
@ -1946,22 +1917,18 @@ SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
else else
badarg3:SCM_WRONG_TYPE_ARG (3, obj); badarg3:SCM_WRONG_TYPE_ARG (3, obj);
break; break;
}
case scm_tc7_bvect: case scm_tc7_bvect:
{
scm_ubits_t k;
SCM_ASSERT (SCM_BITVECTOR_LENGTH (v) == SCM_BITVECTOR_LENGTH (kv), v, SCM_ARG1, FUNC_NAME); SCM_ASSERT (SCM_BITVECTOR_LENGTH (v) == SCM_BITVECTOR_LENGTH (kv), v, SCM_ARG1, FUNC_NAME);
if (SCM_FALSEP (obj)) if (SCM_FALSEP (obj))
for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; k--;) for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;)
((scm_ubits_t *) SCM_VELTS (v))[k] &= ~ ((scm_ubits_t *) SCM_VELTS (kv))[k]; SCM_UNPACK (SCM_VELTS (v)[k]) &= ~ SCM_UNPACK(SCM_VELTS (kv)[k]);
else if (SCM_EQ_P (obj, SCM_BOOL_T)) else if (SCM_EQ_P (obj, SCM_BOOL_T))
for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; k--;) for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;)
((scm_ubits_t *) SCM_VELTS (v))[k] |= ((scm_ubits_t *) SCM_VELTS (kv))[k]; SCM_UNPACK (SCM_VELTS (v)[k]) |= SCM_UNPACK (SCM_VELTS (kv)[k]);
else else
goto badarg3; goto badarg3;
break; break;
} }
}
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -1976,8 +1943,8 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
"@var{bv} is not modified.") "@var{bv} is not modified.")
#define FUNC_NAME s_scm_bit_count_star #define FUNC_NAME s_scm_bit_count_star
{ {
register size_t i; register long i, vlen, count = 0;
scm_bits_t vlen, count = 0; register unsigned long k;
int fObj = 0; int fObj = 0;
SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG1, FUNC_NAME); SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG1, FUNC_NAME);
@ -1988,13 +1955,11 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
badarg2: badarg2:
SCM_WRONG_TYPE_ARG (2, kv); SCM_WRONG_TYPE_ARG (2, kv);
case scm_tc7_uvect: case scm_tc7_uvect:
{
unsigned long k;
vlen = SCM_BITVECTOR_LENGTH (v); vlen = SCM_BITVECTOR_LENGTH (v);
if (SCM_FALSEP (obj)) if (SCM_FALSEP (obj))
for (i = SCM_UVECTOR_LENGTH (kv); i;) for (i = SCM_UVECTOR_LENGTH (kv); i;)
{ {
k = ((unsigned long *) SCM_VELTS (kv))[--i]; k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
if (k >= vlen) if (k >= vlen)
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));
if (!SCM_BITVEC_REF(v,k)) if (!SCM_BITVEC_REF(v,k))
@ -2003,7 +1968,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
else if (SCM_EQ_P (obj, SCM_BOOL_T)) else if (SCM_EQ_P (obj, SCM_BOOL_T))
for (i = SCM_UVECTOR_LENGTH (kv); i;) for (i = SCM_UVECTOR_LENGTH (kv); i;)
{ {
k = ((unsigned long *) SCM_VELTS (kv))[--i]; k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
if (k >= vlen) if (k >= vlen)
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k)); scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));
if (SCM_BITVEC_REF (v,k)) if (SCM_BITVEC_REF (v,k))
@ -2012,20 +1977,15 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
else else
badarg3:SCM_WRONG_TYPE_ARG (3, obj); badarg3:SCM_WRONG_TYPE_ARG (3, obj);
break; break;
}
case scm_tc7_bvect: case scm_tc7_bvect:
{
scm_ubits_t k;
SCM_ASSERT (SCM_BITVECTOR_LENGTH (v) == SCM_BITVECTOR_LENGTH (kv), v, SCM_ARG1, FUNC_NAME); SCM_ASSERT (SCM_BITVECTOR_LENGTH (v) == SCM_BITVECTOR_LENGTH (kv), v, SCM_ARG1, FUNC_NAME);
if (0 == SCM_BITVECTOR_LENGTH (v)) if (0 == SCM_BITVECTOR_LENGTH (v))
return SCM_INUM0; return SCM_INUM0;
SCM_ASRTGO (SCM_BOOLP (obj), badarg3); SCM_ASRTGO (SCM_BOOLP (obj), badarg3);
fObj = SCM_EQ_P (obj, SCM_BOOL_T); fObj = SCM_EQ_P (obj, SCM_BOOL_T);
i = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_BITS_LENGTH; i = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT;
k = k = SCM_UNPACK (SCM_VELTS (kv)[i]) & (fObj ? SCM_UNPACK (SCM_VELTS (v)[i]) : ~ SCM_UNPACK (SCM_VELTS (v)[i]));
((scm_ubits_t *) SCM_VELTS (kv))[i] k <<= SCM_LONG_BIT - 1 - ((SCM_BITVECTOR_LENGTH (v) - 1) % SCM_LONG_BIT);
& (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) while (1)
{ {
for (; k; k >>= 4) for (; k; k >>= 4)
@ -2034,10 +1994,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
return SCM_MAKINUM (count); return SCM_MAKINUM (count);
/* urg. repetitive (see above.) */ /* urg. repetitive (see above.) */
k = k = SCM_UNPACK (SCM_VELTS (kv)[i]) & (fObj ? SCM_UNPACK(SCM_VELTS (v)[i]) : ~SCM_UNPACK (SCM_VELTS (v)[i]));
((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); return SCM_MAKINUM (count);
@ -2050,13 +2007,13 @@ SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0,
"Modifies @var{bv} by replacing each element with its negation.") "Modifies @var{bv} by replacing each element with its negation.")
#define FUNC_NAME s_scm_bit_invert_x #define FUNC_NAME s_scm_bit_invert_x
{ {
scm_bits_t k; long int k;
SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG1, FUNC_NAME); SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG1, FUNC_NAME);
k = SCM_BITVECTOR_LENGTH (v); k = SCM_BITVECTOR_LENGTH (v);
for (k = (k + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; k--;) for (k = (k + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;)
((scm_ubits_t *) SCM_VELTS (v))[k] = ~((scm_ubits_t *) SCM_VELTS (v))[k]; SCM_UNPACK (SCM_VELTS (v)[k]) = ~SCM_UNPACK (SCM_VELTS (v)[k]);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -2064,19 +2021,19 @@ SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0,
SCM SCM
scm_istr2bve (char *str, scm_bits_t len) scm_istr2bve (char *str, long len)
{ {
SCM v = scm_make_uve (len, SCM_BOOL_T); SCM v = scm_make_uve (len, SCM_BOOL_T);
scm_ubits_t *data = (scm_ubits_t *) SCM_VELTS (v); long *data = (long *) SCM_VELTS (v);
register scm_bits_t mask; register unsigned long mask;
register size_t k; register long k;
register int j; register long j;
for (k = 0; k < (len + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; k++) for (k = 0; k < (len + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k++)
{ {
data[k] = 0L; data[k] = 0L;
j = len - k * SCM_BITS_LENGTH; j = len - k * SCM_LONG_BIT;
if (j > SCM_BITS_LENGTH) if (j > SCM_LONG_BIT)
j = SCM_BITS_LENGTH; j = SCM_LONG_BIT;
for (mask = 1L; j--; mask <<= 1) for (mask = 1L; j--; mask <<= 1)
switch (*str++) switch (*str++)
{ {
@ -2095,11 +2052,11 @@ scm_istr2bve (char *str, scm_bits_t len)
static SCM static SCM
ra2l (SCM ra, scm_bits_t base, size_t k) ra2l (SCM ra,unsigned long base,unsigned long k)
{ {
register SCM res = SCM_EOL; register SCM res = SCM_EOL;
register scm_bits_t inc = SCM_ARRAY_DIMS (ra)[k].inc; register long inc = SCM_ARRAY_DIMS (ra)[k].inc;
register scm_bits_t i; register size_t i;
if (SCM_ARRAY_DIMS (ra)[k].ubnd < SCM_ARRAY_DIMS (ra)[k].lbnd) if (SCM_ARRAY_DIMS (ra)[k].ubnd < SCM_ARRAY_DIMS (ra)[k].lbnd)
return SCM_EOL; return SCM_EOL;
i = base + (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd) * inc; i = base + (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd) * inc;
@ -2130,7 +2087,7 @@ SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0,
#define FUNC_NAME s_scm_array_to_list #define FUNC_NAME s_scm_array_to_list
{ {
SCM res = SCM_EOL; SCM res = SCM_EOL;
register size_t k; register long k;
SCM_ASRTGO (SCM_NIMP (v), badarg1); SCM_ASRTGO (SCM_NIMP (v), badarg1);
switch SCM_TYP7 (v) switch SCM_TYP7 (v)
{ {
@ -2146,35 +2103,35 @@ SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0,
return scm_string_to_list (v); return scm_string_to_list (v);
case scm_tc7_bvect: case scm_tc7_bvect:
{ {
scm_ubits_t *data = (scm_ubits_t *) SCM_VELTS (v); long *data = (long *) SCM_VELTS (v);
register scm_ubits_t mask; register unsigned long mask;
for (k = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_BITS_LENGTH; k > 0; k--) for (k = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT; k > 0; k--)
for (mask = 1UL << (SCM_BITS_LENGTH - 1); mask; mask >>= 1) for (mask = 1UL << (SCM_LONG_BIT - 1); mask; mask >>= 1)
res = scm_cons (SCM_BOOL(data[k] & mask), res); res = scm_cons (SCM_BOOL(((long *) data)[k] & mask), res);
for (mask = 1L << ((SCM_BITVECTOR_LENGTH (v) % SCM_BITS_LENGTH) - 1); mask; mask >>= 1) for (mask = 1L << ((SCM_BITVECTOR_LENGTH (v) % SCM_LONG_BIT) - 1); mask; mask >>= 1)
res = scm_cons (SCM_BOOL(data[k] & mask), res); res = scm_cons (SCM_BOOL(((long *) data)[k] & mask), res);
return res; return res;
} }
case scm_tc7_byvect: case scm_tc7_byvect:
{ {
signed char *data = (signed char *) SCM_VELTS (v); signed char *data = (signed char *) SCM_VELTS (v);
scm_bits_t k = SCM_UVECTOR_LENGTH (v); unsigned long k = SCM_UVECTOR_LENGTH (v);
while (k != 0) while (k != 0)
res = scm_cons (SCM_MAKINUM (data[--k]), res); res = scm_cons (SCM_MAKINUM (data[--k]), res);
return res; return res;
} }
case scm_tc7_uvect: case scm_tc7_uvect:
{ {
scm_ubits_t *data = (scm_ubits_t *) SCM_VELTS(v); long *data = (long *)SCM_VELTS(v);
for (k = SCM_UVECTOR_LENGTH(v) - 1; k >= 0; k--) for (k = SCM_UVECTOR_LENGTH(v) - 1; k >= 0; k--)
res = scm_cons(scm_ubits2num(data[k]), res); res = scm_cons(scm_ulong2num(data[k]), res);
return res; return res;
} }
case scm_tc7_ivect: case scm_tc7_ivect:
{ {
scm_bits_t *data = (scm_bits_t *) SCM_VELTS(v); long *data = (long *)SCM_VELTS(v);
for (k = SCM_UVECTOR_LENGTH(v) - 1; k >= 0; k--) for (k = SCM_UVECTOR_LENGTH(v) - 1; k >= 0; k--)
res = scm_cons(scm_bits2num(data[k]), res); res = scm_cons(scm_long2num(data[k]), res);
return res; return res;
} }
case scm_tc7_svect: case scm_tc7_svect:
@ -2219,7 +2176,7 @@ SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0,
#undef FUNC_NAME #undef FUNC_NAME
static int l2ra (SCM lst, SCM ra, scm_bits_t base, size_t k); static int l2ra(SCM lst, SCM ra, unsigned long base, unsigned long k);
SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0, SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0,
(SCM ndim, SCM prot, SCM lst), (SCM ndim, SCM prot, SCM lst),
@ -2233,7 +2190,7 @@ SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0,
SCM shp = SCM_EOL; SCM shp = SCM_EOL;
SCM row = lst; SCM row = lst;
SCM ra; SCM ra;
scm_bits_t k; unsigned long k;
long n; long n;
SCM_VALIDATE_INUM_COPY (1,ndim,k); SCM_VALIDATE_INUM_COPY (1,ndim,k);
while (k--) while (k--)
@ -2254,7 +2211,7 @@ SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0,
} }
if (!SCM_ARRAYP (ra)) if (!SCM_ARRAYP (ra))
{ {
scm_bits_t length = SCM_INUM (scm_uniform_vector_length (ra)); unsigned long int length = SCM_INUM (scm_uniform_vector_length (ra));
for (k = 0; k < length; k++, lst = SCM_CDR (lst)) for (k = 0; k < length; k++, lst = SCM_CDR (lst))
scm_array_set_x (ra, SCM_CAR (lst), SCM_MAKINUM (k)); scm_array_set_x (ra, SCM_CAR (lst), SCM_MAKINUM (k));
return ra; return ra;
@ -2267,10 +2224,10 @@ SCM_DEFINE (scm_list_to_uniform_array, "list->uniform-array", 3, 0, 0,
#undef FUNC_NAME #undef FUNC_NAME
static int static int
l2ra (SCM lst, SCM ra, scm_bits_t base, size_t k) l2ra (SCM lst, SCM ra, unsigned long base, unsigned long k)
{ {
register scm_bits_t inc = SCM_ARRAY_DIMS (ra)[k].inc; register long 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); register long n = (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd);
int ok = 1; int ok = 1;
if (n <= 0) if (n <= 0)
return (SCM_NULLP (lst)); return (SCM_NULLP (lst));
@ -2305,10 +2262,10 @@ l2ra (SCM lst, SCM ra, scm_bits_t base, size_t k)
static void static void
rapr1 (SCM ra, scm_bits_t j, size_t k, SCM port, scm_print_state *pstate) rapr1 (SCM ra,unsigned long j,unsigned long k,SCM port,scm_print_state *pstate)
{ {
scm_bits_t inc = 1; long inc = 1;
scm_bits_t n = (SCM_TYP7 (ra) == scm_tc7_smob long n = (SCM_TYP7 (ra) == scm_tc7_smob
? 0 ? 0
: SCM_INUM (scm_uniform_vector_length (ra))); : SCM_INUM (scm_uniform_vector_length (ra)));
int enclosed = 0; int enclosed = 0;
@ -2331,7 +2288,7 @@ tail:
} }
if (k + 1 < SCM_ARRAY_NDIM (ra)) if (k + 1 < SCM_ARRAY_NDIM (ra))
{ {
scm_bits_t i; long i;
inc = SCM_ARRAY_DIMS (ra)[k].inc; inc = SCM_ARRAY_DIMS (ra)[k].inc;
for (i = SCM_ARRAY_DIMS (ra)[k].lbnd; i < SCM_ARRAY_DIMS (ra)[k].ubnd; i++) for (i = SCM_ARRAY_DIMS (ra)[k].lbnd; i < SCM_ARRAY_DIMS (ra)[k].ubnd; i++)
{ {
@ -2484,7 +2441,7 @@ int
scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate) scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate)
{ {
SCM v = exp; SCM v = exp;
scm_bits_t base = 0; unsigned long base = 0;
scm_putc ('#', port); scm_putc ('#', port);
tail: tail:
switch SCM_TYP7 (v) switch SCM_TYP7 (v)
@ -2511,23 +2468,21 @@ tail:
case scm_tc7_bvect: case scm_tc7_bvect:
if (SCM_EQ_P (exp, v)) if (SCM_EQ_P (exp, v))
{ /* a uve, not an scm_array */ { /* a uve, not an scm_array */
register size_t i; register long i, j, w;
register int j;
scm_ubits_t w;
scm_putc ('*', port); scm_putc ('*', port);
for (i = 0; i < (SCM_BITVECTOR_LENGTH (exp) / SCM_BITS_LENGTH); i++) for (i = 0; i < (SCM_BITVECTOR_LENGTH (exp)) / SCM_LONG_BIT; i++)
{ {
w = SCM_UNPACK (SCM_VELTS (exp)[i]); scm_bits_t w = SCM_UNPACK (SCM_VELTS (exp)[i]);
for (j = SCM_BITS_LENGTH; j; j--) for (j = SCM_LONG_BIT; j; j--)
{ {
scm_putc (w & 1 ? '1' : '0', port); scm_putc (w & 1 ? '1' : '0', port);
w >>= 1; w >>= 1;
} }
} }
j = SCM_BITVECTOR_LENGTH (exp) % SCM_BITS_LENGTH; j = SCM_BITVECTOR_LENGTH (exp) % SCM_LONG_BIT;
if (j) if (j)
{ {
w = SCM_UNPACK (SCM_VELTS (exp)[SCM_BITVECTOR_LENGTH (exp) / SCM_BITS_LENGTH]); w = SCM_UNPACK (SCM_VELTS (exp)[SCM_BITVECTOR_LENGTH (exp) / SCM_LONG_BIT]);
for (; j; j--) for (; j; j--)
{ {
scm_putc (w & 1 ? '1' : '0', port); scm_putc (w & 1 ? '1' : '0', port);

24
libguile/unif.h
View file

@ -64,14 +64,14 @@
typedef struct scm_array_t typedef struct scm_array_t
{ {
SCM v; /* the contents of the array, e.g., a vector or uniform vector. */ SCM v; /* the contents of the array, e.g., a vector or uniform vector. */
scm_bits_t base; unsigned long base;
} scm_array_t; } scm_array_t;
typedef struct scm_array_dim_t typedef struct scm_array_dim_t
{ {
scm_bits_t lbnd; long lbnd;
scm_bits_t ubnd; long ubnd;
scm_bits_t inc; long inc;
} scm_array_dim_t; } scm_array_dim_t;
#if (SCM_DEBUG_DEPRECATED == 0) #if (SCM_DEBUG_DEPRECATED == 0)
@ -88,7 +88,7 @@ extern scm_bits_t scm_tc16_array;
#endif #endif
#define SCM_ARRAYP(a) SCM_TYP16_PREDICATE (scm_tc16_array, a) #define SCM_ARRAYP(a) SCM_TYP16_PREDICATE (scm_tc16_array, a)
#define SCM_ARRAY_NDIM(x) ((size_t) ((scm_ubits_t) (SCM_CELL_WORD_0 (x)) >> 17)) #define SCM_ARRAY_NDIM(x) ((size_t) (SCM_CELL_WORD_0 (x)) >> 17)
#define SCM_ARRAY_CONTP(x) (SCM_CELL_WORD_0 (x) & SCM_ARRAY_FLAG_CONTIGUOUS) #define SCM_ARRAY_CONTP(x) (SCM_CELL_WORD_0 (x) & SCM_ARRAY_FLAG_CONTIGUOUS)
#define SCM_SET_ARRAY_CONTIGUOUS_FLAG(x) \ #define SCM_SET_ARRAY_CONTIGUOUS_FLAG(x) \
(SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) | SCM_ARRAY_FLAG_CONTIGUOUS)) (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) | SCM_ARRAY_FLAG_CONTIGUOUS))
@ -100,25 +100,25 @@ extern scm_bits_t scm_tc16_array;
#define SCM_ARRAY_BASE(a) (SCM_ARRAY_MEM (a)->base) #define SCM_ARRAY_BASE(a) (SCM_ARRAY_MEM (a)->base)
#define SCM_ARRAY_DIMS(a) ((scm_array_dim_t *)((char *) SCM_ARRAY_MEM (a) + sizeof (scm_array_t))) #define SCM_ARRAY_DIMS(a) ((scm_array_dim_t *)((char *) SCM_ARRAY_MEM (a) + sizeof (scm_array_t)))
#define SCM_I_MAX_LENGTH ((scm_ubits_t)((scm_bits_t)-1) >> 8) #define SCM_I_MAX_LENGTH ((unsigned long) (-1L) >> 8)
#define SCM_UVECTOR_BASE(x) ((void *) (SCM_CELL_WORD_1 (x))) #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_SET_UVECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b)))
#define SCM_UVECTOR_MAX_LENGTH SCM_I_MAX_LENGTH #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_UVECTOR_LENGTH(x) (((unsigned long) 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_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_P(x) (!SCM_IMP (x) && (SCM_TYP7 (x) == scm_tc7_bvect))
#define SCM_BITVECTOR_BASE(x) ((void *) (SCM_CELL_WORD_1 (x))) #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_SET_BITVECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b)))
#define SCM_BITVECTOR_MAX_LENGTH SCM_I_MAX_LENGTH #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_BITVECTOR_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8)
#define SCM_SET_BITVECTOR_LENGTH(v, l) (SCM_SET_CELL_WORD_0 ((v), ((l) << 8) + scm_tc7_bvect)) #define SCM_SET_BITVECTOR_LENGTH(v, l) (SCM_SET_CELL_WORD_0 ((v), ((l) << 8) + scm_tc7_bvect))
extern size_t scm_uniform_element_size (SCM obj); extern size_t scm_uniform_element_size (SCM obj);
extern SCM scm_make_uve (scm_bits_t k, SCM prot); extern SCM scm_make_uve (long k, SCM prot);
extern SCM scm_uniform_vector_length (SCM v); extern SCM scm_uniform_vector_length (SCM v);
extern SCM scm_array_p (SCM v, SCM prot); extern SCM scm_array_p (SCM v, SCM prot);
extern SCM scm_array_rank (SCM ra); extern SCM scm_array_rank (SCM ra);
@ -126,7 +126,7 @@ extern SCM scm_array_dimensions (SCM ra);
extern SCM scm_shared_array_root (SCM ra); extern SCM scm_shared_array_root (SCM ra);
extern SCM scm_shared_array_offset (SCM ra); extern SCM scm_shared_array_offset (SCM ra);
extern SCM scm_shared_array_increments (SCM ra); extern SCM scm_shared_array_increments (SCM ra);
extern scm_bits_t scm_aind (SCM ra, SCM args, const char *what); extern long scm_aind (SCM ra, SCM args, const char *what);
extern SCM scm_make_ra (int ndim); extern SCM scm_make_ra (int ndim);
extern SCM scm_shap2ra (SCM args, const char *what); extern SCM scm_shap2ra (SCM args, const char *what);
extern SCM scm_dimensions_to_uniform_array (SCM dims, SCM prot, SCM fill); extern SCM scm_dimensions_to_uniform_array (SCM dims, SCM prot, SCM fill);
@ -136,7 +136,7 @@ extern SCM scm_transpose_array (SCM ra, SCM args);
extern SCM scm_enclose_array (SCM ra, SCM axes); extern SCM scm_enclose_array (SCM ra, SCM axes);
extern SCM scm_array_in_bounds_p (SCM v, SCM args); extern SCM scm_array_in_bounds_p (SCM v, SCM args);
extern SCM scm_uniform_vector_ref (SCM v, SCM args); extern SCM scm_uniform_vector_ref (SCM v, SCM args);
extern SCM scm_cvref (SCM v, scm_bits_t pos, SCM last); extern SCM scm_cvref (SCM v, unsigned long pos, SCM last);
extern SCM scm_array_set_x (SCM v, SCM obj, SCM args); extern SCM scm_array_set_x (SCM v, SCM obj, SCM args);
extern SCM scm_array_contents (SCM ra, SCM strict); extern SCM scm_array_contents (SCM ra, SCM strict);
extern SCM scm_ra2contig (SCM ra, int copy); extern SCM scm_ra2contig (SCM ra, int copy);
@ -147,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_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_count_star (SCM v, SCM kv, SCM obj);
extern SCM scm_bit_invert_x (SCM v); extern SCM scm_bit_invert_x (SCM v);
extern SCM scm_istr2bve (char *str, scm_bits_t len); extern SCM scm_istr2bve (char *str, long len);
extern SCM scm_array_to_list (SCM v); extern SCM scm_array_to_list (SCM v);
extern SCM scm_list_to_uniform_array (SCM ndim, SCM prot, SCM lst); 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); extern int scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate);

12
libguile/validate.h
View file

@ -1,4 +1,4 @@
/* $Id: validate.h,v 1.32 2001-05-24 00:50:51 cmm Exp $ */ /* $Id: validate.h,v 1.33 2001-05-26 20:51:22 cmm Exp $ */
/* Copyright (C) 1999,2000,2001 Free Software Foundation, Inc. /* Copyright (C) 1999,2000,2001 Free Software Foundation, Inc.
* *
* This program is free software; you can redistribute it and/or modify * This program is free software; you can redistribute it and/or modify
@ -81,16 +81,6 @@
#define SCM_NUM2USHORT_DEF(pos, arg, def) \ #define SCM_NUM2USHORT_DEF(pos, arg, def) \
(SCM_UNBNDP (arg) ? def : scm_num2ushort (arg, pos, FUNC_NAME)) (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(pos, arg) (scm_num2int (arg, pos, FUNC_NAME))
#define SCM_NUM2INT_DEF(pos, arg, def) \ #define SCM_NUM2INT_DEF(pos, arg, def) \

2
libguile/values.c
View file

@ -77,7 +77,7 @@ SCM_DEFINE (scm_values, "values", 0, 0, 1,
"were not created by @code{call-with-values} is unspecified.") "were not created by @code{call-with-values} is unspecified.")
#define FUNC_NAME s_scm_values #define FUNC_NAME s_scm_values
{ {
scm_bits_t n; long n;
SCM result; SCM result;
SCM_VALIDATE_LIST_COPYLEN (1, args, n); SCM_VALIDATE_LIST_COPYLEN (1, args, n);

34
libguile/vectors.c
View file

@ -73,7 +73,7 @@ static char s_vector_set_length_x[] = "vector-set-length!";
SCM SCM
scm_vector_set_length_x (SCM vect, SCM len) scm_vector_set_length_x (SCM vect, SCM len)
{ {
scm_bits_t l; long l;
size_t siz; size_t siz;
size_t sz; size_t sz;
char *base; char *base;
@ -84,7 +84,7 @@ scm_vector_set_length_x (SCM vect, SCM len)
#ifdef HAVE_ARRAYS #ifdef HAVE_ARRAYS
if (SCM_TYP7 (vect) == scm_tc7_bvect) if (SCM_TYP7 (vect) == scm_tc7_bvect)
{ {
l = (l + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; l = (l + SCM_LONG_BIT - 1) / SCM_LONG_BIT;
} }
sz = scm_uniform_element_size (vect); sz = scm_uniform_element_size (vect);
if (sz != 0) if (sz != 0)
@ -180,7 +180,7 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1,
{ {
SCM res; SCM res;
SCM *data; SCM *data;
scm_bits_t i; long i;
/* Dirk:FIXME:: In case of multiple threads, the list might get corrupted /* Dirk:FIXME:: In case of multiple threads, the list might get corrupted
while the vector is being created. */ while the vector is being created. */
@ -222,7 +222,7 @@ scm_vector_ref (SCM v, SCM k)
SCM_GASSERT2 (SCM_INUMP (k), SCM_GASSERT2 (SCM_INUMP (k),
g_vector_ref, v, k, SCM_ARG2, s_vector_ref); 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); SCM_ASSERT_RANGE (2, k, SCM_INUM (k) < SCM_VECTOR_LENGTH (v) && SCM_INUM (k) >= 0);
return SCM_VELTS (v)[(ptrdiff_t) SCM_INUM (k)]; return SCM_VELTS (v)[(long) SCM_INUM (k)];
} }
#undef FUNC_NAME #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), g_vector_set_x, SCM_LIST3 (v, k, obj),
SCM_ARG2, s_vector_set_x); SCM_ARG2, s_vector_set_x);
SCM_ASSERT_RANGE (2, k, SCM_INUM (k) < SCM_VECTOR_LENGTH (v) && SCM_INUM (k) >= 0); SCM_ASSERT_RANGE (2, k, SCM_INUM (k) < SCM_VECTOR_LENGTH (v) && SCM_INUM (k) >= 0);
SCM_VELTS(v)[(ptrdiff_t) SCM_INUM(k)] = obj; SCM_VELTS(v)[(long) SCM_INUM(k)] = obj;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -281,7 +281,7 @@ SCM_DEFINE (scm_make_vector, "make-vector", 1, 1, 0,
SCM SCM
scm_c_make_vector (size_t k, SCM fill) scm_c_make_vector (unsigned long int k, SCM fill)
#define FUNC_NAME s_scm_make_vector #define FUNC_NAME s_scm_make_vector
{ {
SCM v; SCM v;
@ -289,9 +289,9 @@ scm_c_make_vector (size_t k, SCM fill)
if (k > 0) if (k > 0)
{ {
size_t j; unsigned long int j;
SCM_ASSERT_RANGE (1, scm_size2num (k), k <= SCM_VECTOR_MAX_LENGTH); SCM_ASSERT_RANGE (1, scm_ulong2num (k), k <= SCM_VECTOR_MAX_LENGTH);
base = scm_must_malloc (k * sizeof (scm_bits_t), FUNC_NAME); base = scm_must_malloc (k * sizeof (scm_bits_t), FUNC_NAME);
for (j = 0; j != k; ++j) 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 #define FUNC_NAME s_scm_vector_to_list
{ {
SCM res = SCM_EOL; SCM res = SCM_EOL;
scm_bits_t i; long i;
SCM *data; SCM *data;
SCM_VALIDATE_VECTOR (1,v); SCM_VALIDATE_VECTOR (1,v);
data = SCM_VELTS(v); data = SCM_VELTS(v);
@ -338,7 +338,7 @@ SCM_DEFINE (scm_vector_fill_x, "vector-fill!", 2, 0, 0,
"returned by @code{vector-fill!} is unspecified.") "returned by @code{vector-fill!} is unspecified.")
#define FUNC_NAME s_scm_vector_fill_x #define FUNC_NAME s_scm_vector_fill_x
{ {
register scm_bits_t i; register long i;
register SCM *data; register SCM *data;
SCM_VALIDATE_VECTOR (1, v); SCM_VALIDATE_VECTOR (1, v);
data = SCM_VELTS (v); data = SCM_VELTS (v);
@ -352,7 +352,7 @@ SCM_DEFINE (scm_vector_fill_x, "vector-fill!", 2, 0, 0,
SCM SCM
scm_vector_equal_p(SCM x, SCM y) scm_vector_equal_p(SCM x, SCM y)
{ {
scm_bits_t i; long i;
for(i = SCM_VECTOR_LENGTH (x) - 1; i >= 0; 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]))) if (SCM_FALSEP (scm_equal_p (SCM_VELTS (x)[i], SCM_VELTS (y)[i])))
return SCM_BOOL_F; return SCM_BOOL_F;
@ -365,9 +365,9 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0,
"Vector version of @code{substring-move-left!}.") "Vector version of @code{substring-move-left!}.")
#define FUNC_NAME s_scm_vector_move_left_x #define FUNC_NAME s_scm_vector_move_left_x
{ {
scm_bits_t i; long i;
scm_bits_t j; long j;
scm_bits_t e; long e;
SCM_VALIDATE_VECTOR (1,vec1); SCM_VALIDATE_VECTOR (1,vec1);
SCM_VALIDATE_INUM_COPY (2,start1,i); 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!}.") "Vector version of @code{substring-move-right!}.")
#define FUNC_NAME s_scm_vector_move_right_x #define FUNC_NAME s_scm_vector_move_right_x
{ {
scm_bits_t i; long i;
scm_bits_t j; long j;
scm_bits_t e; long e;
SCM_VALIDATE_VECTOR (1,vec1); SCM_VALIDATE_VECTOR (1,vec1);
SCM_VALIDATE_INUM_COPY (2,start1,i); SCM_VALIDATE_INUM_COPY (2,start1,i);

10
libguile/vectors.h
View file

@ -55,7 +55,7 @@
#define SCM_VECTOR_BASE(x) ((scm_bits_t *) SCM_CELL_WORD_1 (x)) #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_SET_VECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b)))
#define SCM_VECTOR_MAX_LENGTH ((1L << 24) - 1) #define SCM_VECTOR_MAX_LENGTH ((1L << 24) - 1)
#define SCM_VECTOR_LENGTH(x) (((scm_ubits_t) SCM_CELL_WORD_0 (x)) >> 8) #define SCM_VECTOR_LENGTH(x) (((unsigned long) 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_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)) #define SCM_VELTS(x) ((SCM *) SCM_CELL_WORD_1 (x))
@ -67,14 +67,14 @@
/* /*
bit vectors bit vectors
*/ */
#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_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_BITS_LENGTH]) |= (1L<<((i)%SCM_BITS_LENGTH)) #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_BITS_LENGTH]) &= ~(1L<<((i)%SCM_BITS_LENGTH)) #define SCM_BITVEC_CLR(a, i) SCM_UNPACK(SCM_VELTS(a)[(i)/SCM_LONG_BIT]) &= ~(1L<<((i)%SCM_LONG_BIT))
extern SCM scm_c_make_vector (size_t k, SCM fill); extern SCM scm_c_make_vector (unsigned long int k, SCM fill);
extern SCM scm_vector_p (SCM x); extern SCM scm_vector_p (SCM x);
extern SCM scm_vector_length (SCM v); extern SCM scm_vector_length (SCM v);

9
libguile/weaks.c
View file

@ -90,7 +90,7 @@ SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1,
{ {
SCM res; SCM res;
SCM *data; SCM *data;
scm_bits_t i; long i;
/* Dirk:FIXME:: In case of multiple threads, the list might get corrupted /* Dirk:FIXME:: In case of multiple threads, the list might get corrupted
while the vector is being created. */ while the vector is being created. */
@ -235,7 +235,8 @@ scm_mark_weak_vector_spines (void *dummy1, void *dummy2, void *dummy3)
{ {
SCM *ptr; SCM *ptr;
SCM obj; SCM obj;
scm_bits_t j, n; long j;
long n;
obj = w; obj = w;
ptr = SCM_VELTS (w); ptr = SCM_VELTS (w);
@ -279,8 +280,8 @@ scm_scan_weak_vectors (void *dummy1, void *dummy2, void *dummy3)
else /* if (SCM_IS_WHVEC_ANY (scm_weak_vectors[i])) */ else /* if (SCM_IS_WHVEC_ANY (scm_weak_vectors[i])) */
{ {
SCM obj = w; SCM obj = w;
register scm_bits_t n = SCM_VECTOR_LENGTH (w); register long n = SCM_VECTOR_LENGTH (w);
register scm_bits_t j; register long j;
int weak_keys = SCM_IS_WHVEC (obj) || SCM_IS_WHVEC_B (obj); 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); int weak_values = SCM_IS_WHVEC_V (obj) || SCM_IS_WHVEC_B (obj);