+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>
* modules.c (scm_env_module): Exported to Scheme.
# define SCM_LONG_BIT (SCM_CHAR_BIT * sizeof (long) / sizeof (char))
#endif
-#define SCM_BITS_LENGTH (SCM_CHAR_BIT * SCM_SIZEOF_BITS_T)
-
#ifdef UCHAR_MAX
# define SCM_CHAR_CODE_LIMIT (UCHAR_MAX + 1L)
#else
volatile SCM cont;
scm_contregs_t *continuation;
scm_contregs_t *rootcont = SCM_CONTREGS (scm_rootcont);
- scm_bits_t stack_size;
+ long stack_size;
SCM_STACKITEM * src;
SCM_ENTER_A_SECTION;
jmp_buf jmpbuf;
SCM dynenv;
SCM_STACKITEM *base; /* base of the live stack, before it was saved. */
- scm_bits_t num_stack_items; /* size of the saved stack. */
- scm_ubits_t seq; /* dynamic root identifier. */
+ size_t num_stack_items; /* size of the saved stack. */
+ unsigned long seq; /* dynamic root identifier. */
#ifdef DEBUG_EXTENSIONS
/* the most recently created debug frame on the live stack, before
SCM id;
} scm_debug_info_t;
-extern scm_bits_t scm_debug_eframe_size;
+extern long scm_debug_eframe_size;
typedef struct scm_debug_frame_t
{
\f
-#if SCM_DEBUG_DEPRECATED == 0
+#if (SCM_DEBUG_DEPRECATED == 0)
/* This is either a boolean (when a summary should be printed) or a
hashtab (when detailed warnings shouold be printed).
}
void
-scm_dowinds (SCM to, scm_bits_t delta)
+scm_dowinds (SCM to, long delta)
{
tail:
if (SCM_EQ_P (to, scm_dynwinds));
scm_guard_t after,
void *inner_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);
#ifdef GUILE_DEBUG
static int
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_puts ("#<observer ", port);
static int
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_puts ("#<leaf environment ", port);
if (!SCM_ENVIRONMENT_BOUND_P (local, symbol))
{
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 data = SCM_CDDR (extended_data);
{
SCM local = EVAL_ENVIRONMENT (env)->local;
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 tmp_result = scm_c_environment_fold (imported, eval_environment_folder, extended_data, init);
static int
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_puts ("#<eval environment ", port);
SCM imported_env = SCM_CADR (extended_data);
SCM owner = import_environment_lookup (import_env, symbol);
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 data = SCM_CDDDR (extended_data);
static SCM
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 l;
static int
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_puts ("#<import environment ", port);
static int
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_puts ("#<export environment ", port);
SCM *
scm_ilookup (SCM iloc, SCM env)
{
- register scm_bits_t ir = SCM_IFRAME (iloc);
+ register long ir = SCM_IFRAME (iloc);
register SCM er = env;
for (; 0 != ir; --ir)
er = SCM_CDR (er);
#ifdef DEBUG_EXTENSIONS
else if (SCM_ILOCP (c))
{
- scm_bits_t ir;
+ long ir;
for (ir = SCM_IFRAME (c); ir != 0; --ir)
env = SCM_CDR (env);
SCM
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");
return scm_cons (SCM_IM_IF, SCM_CDR (xorig));
}
SCM
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);
if (len >= 1)
return scm_cons (SCM_IM_AND, SCM_CDR (xorig));
SCM
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);
if (len >= 1)
return scm_cons (SCM_IM_OR, SCM_CDR (xorig));
scm_m_cond (SCM xorig, SCM env)
{
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);
while (SCM_NIMP (x))
{
scm_m_letstar (SCM xorig, SCM env)
{
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);
proc = SCM_CAR (x);
SCM_ASSYNT (scm_ilength (proc) >= 0, scm_s_bindings, s_letstar);
SCM x = SCM_CDR (xorig), arg1, proc;
SCM vars = SCM_EOL, inits = SCM_EOL, steps = SCM_EOL;
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");
proc = SCM_CAR (x);
SCM_ASSYNT (scm_ilength (proc) >= 0, scm_s_bindings, "do");
#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_GLOBAL_SYMBOL(scm_sym_quasiquote, s_quasiquote);
static SCM
-iqq (SCM form, SCM env, scm_bits_t depth)
+iqq (SCM form, SCM env, long depth)
{
SCM tmp;
- scm_bits_t edepth = depth;
+ long edepth = depth;
if (SCM_IMP (form))
return form;
if (SCM_VECTORP (form))
{
- scm_bits_t i = SCM_VECTOR_LENGTH (form);
+ long i = SCM_VECTOR_LENGTH (form);
SCM *data = SCM_VELTS (form);
tmp = SCM_EOL;
for (; --i >= 0;)
SCM
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");
return scm_cons (SCM_IM_NIL_COND, SCM_CDR (xorig));
}
SCM
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");
return scm_cons (SCM_IM_0_COND, SCM_CDR (xorig));
}
* 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;
-scm_bits_t scm_eval_stack;
+long scm_eval_stack;
scm_option_t scm_eval_opts[] = {
{ SCM_OPTION_INTEGER, "stack", 22000, "Size of thread stacks (in machine words)." }
* 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);
n = SCM_INUM (SCM_CAR (z)); /* maximum number of specializers */
proc = SCM_CADR (z);
else
{
/* Compute a hash value */
- scm_bits_t hashset = SCM_INUM (proc);
- scm_bits_t j = n;
+ long hashset = SCM_INUM (proc);
+ long j = n;
mask = SCM_INUM (SCM_CAR (z = SCM_CDDR (z)));
proc = SCM_CADR (z);
i = 0;
/* Search for match */
do
{
- scm_bits_t j = n;
+ long j = n;
z = SCM_VELTS (proc)[i];
t.arg1 = arg2; /* list of arguments */
if (SCM_NIMP (t.arg1))
and claim that the i'th element of ARGV is WHO's i+2'th argument. */
static inline void
check_map_args (SCM argv,
- scm_bits_t len,
+ long len,
SCM gf,
SCM proc,
SCM args,
const char *who)
{
SCM *ve = SCM_VELTS (argv);
- scm_bits_t i;
+ long 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)
{
scm_map (SCM proc, SCM arg1, SCM args)
#define FUNC_NAME s_map
{
- scm_bits_t i, len;
+ long i, len;
SCM res = SCM_EOL;
SCM *pres = &res;
SCM *ve = &args; /* Keep args from being optimized away. */
#define FUNC_NAME s_for_each
{
SCM *ve = &args; /* Keep args from being optimized away. */
- scm_bits_t i, len;
+ long i, len;
len = scm_ilength (arg1);
SCM_GASSERTn (len >= 0, g_for_each, scm_cons2 (proc, arg1, args),
SCM_ARG2, s_for_each);
return 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);
while (i--)
SCM_VELTS (ans)[i] = scm_copy_tree (SCM_VELTS (obj)[i]);
#define SCM_EVAL_STACK scm_eval_opts[0].val
#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[];
#define SCM_ICDR (0x00080000L)
#define SCM_IFRINC (0x00000100L)
#define SCM_IDSTMSK (-SCM_IDINC)
-#define SCM_IFRAME(n) ((scm_bits_t)((SCM_ICDR-SCM_IFRINC)>>8) \
- & (SCM_UNPACK (n)) >> 8)
+#define SCM_IFRAME(n) ((long)((SCM_ICDR-SCM_IFRINC)>>8) \
+ & (SCM_UNPACK (n) >> 8))
#define SCM_IDIST(n) (SCM_UNPACK (n) >> 20)
#define SCM_ICDRP(n) (SCM_ICDR & SCM_UNPACK (n))
#define INITIAL_FLUIDS 10
#include "libguile/validate.h"
-static volatile scm_bits_t n_fluids;
+static volatile long n_fluids;
scm_bits_t scm_tc16_fluid;
SCM
grow_fluids (scm_root_state *root_state, int new_length)
{
SCM old_fluids, new_fluids;
- scm_bits_t old_length, i;
+ long old_length, i;
old_fluids = root_state->fluids;
old_length = SCM_VECTOR_LENGTH (old_fluids);
return 1;
}
-static scm_bits_t
+static long
next_fluid_num ()
{
- scm_bits_t n;
+ long n;
SCM_CRITICAL_SECTION_START;
n = n_fluids++;
SCM_CRITICAL_SECTION_END;
"in its own dynamic root, you can use fluids for thread local storage.")
#define FUNC_NAME s_scm_make_fluid
{
- scm_bits_t n;
+ long n;
n = next_fluid_num ();
SCM_RETURN_NEWSMOB (scm_tc16_fluid, n);
"@code{#f}.")
#define FUNC_NAME s_scm_fluid_ref
{
- scm_bits_t n;
+ long n;
SCM_VALIDATE_FLUID (1, fluid);
"Set the value associated with @var{fluid} in the current dynamic root.")
#define FUNC_NAME s_scm_fluid_set_x
{
- scm_bits_t n;
+ long n;
SCM_VALIDATE_FLUID (1, fluid);
n = SCM_FLUID_NUM (fluid);
#define FUNC_NAME "scm_c_with_fluids"
{
SCM ans;
- scm_bits_t flen, vlen;
+ long flen, vlen;
SCM_VALIDATE_LIST_COPYLEN (1, fluids, flen);
SCM_VALIDATE_LIST_COPYLEN (2, values, vlen);
/* create FPORT buffer with specified sizes (or -1 to use default size or
0 for no buffer. */
static void
-scm_fport_buffer_add (SCM port, 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"
{
scm_fport_t *fp = SCM_FSTREAM (port);
#define FUNC_NAME s_scm_setvbuf
{
int cmode;
- scm_bits_t csize;
+ long csize;
scm_port_t *pt;
port = SCM_COERCE_OUTPORT (port);
void
scm_evict_ports (int fd)
{
- scm_bits_t i;
+ long i;
for (i = 0; i < scm_port_table_size; i++)
{
static int
fport_fill_input (SCM port)
{
- scm_bits_t count;
+ long count;
scm_port_t *pt = SCM_PTAB_ENTRY (port);
scm_fport_t *fp = SCM_FSTREAM (port);
scm_port_t *pt = SCM_PTAB_ENTRY (port);
scm_fport_t *fp = SCM_FSTREAM (port);
unsigned char *ptr = pt->write_buf;
- scm_bits_t init_size = pt->write_pos - pt->write_buf;
- scm_bits_t remaining = init_size;
+ long init_size = pt->write_pos - pt->write_buf;
+ long remaining = init_size;
while (remaining > 0)
{
- scm_bits_t count;
+ long count;
SCM_SYSCALL (count = write (fp->fdes, ptr, remaining));
if (count < 0)
{
/* error. assume nothing was written this call, but
fix up the buffer for any previous successful writes. */
- scm_bits_t done = init_size - remaining;
+ long done = init_size - remaining;
if (done > 0)
{
# define CELL_DN(p, span) MK_FP(FP_SEG(p), ~(8*(span)-1)&FP_OFF(p))
#else
# ifdef _UNICOS
-# define CELL_UP(p, span) (SCM_CELLPTR)(~(span) & ((scm_ubits_t)(p)+(span)))
-# define CELL_DN(p, span) (SCM_CELLPTR)(~(span) & (scm_ubits_t)(p))
+# define CELL_UP(p, span) (SCM_CELLPTR)(~(span) & ((long)(p)+(span)))
+# define CELL_DN(p, span) (SCM_CELLPTR)(~(span) & (long)(p))
# else
-# define CELL_UP(p, span) (SCM_CELLPTR)(~(sizeof(scm_cell)*(span)-1L) & ((scm_ubits_t)(p)+sizeof(scm_cell)*(span)-1L))
-# define CELL_DN(p, span) (SCM_CELLPTR)(~(sizeof(scm_cell)*(span)-1L) & (scm_ubits_t)(p))
+# define CELL_UP(p, span) (SCM_CELLPTR)(~(sizeof(scm_cell)*(span)-1L) & ((long)(p)+sizeof(scm_cell)*(span)-1L))
+# define CELL_DN(p, span) (SCM_CELLPTR)(~(sizeof(scm_cell)*(span)-1L) & (long)(p))
# endif /* UNICOS */
#endif /* PROT386 */
/* number of cells per object on this list */
int span;
/* number of collected cells during last GC */
- scm_ubits_t collected;
+ unsigned long collected;
/* number of collected cells during penultimate GC */
- scm_ubits_t collected_1;
+ unsigned long collected_1;
/* total number of cells in heap segments
* belonging to this list.
*/
- scm_ubits_t heap_size;
+ unsigned long heap_size;
} scm_freelist_t;
SCM scm_freelist = SCM_EOL;
/* scm_mtrigger
* 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
* If set, don't expand the heap. Set only during gc, during which no allocation
/* GC Statistics Keeping
*/
-scm_ubits_t scm_cells_allocated = 0;
-scm_ubits_t scm_mallocated = 0;
-scm_ubits_t scm_gc_cells_collected;
-scm_ubits_t scm_gc_yield;
-static scm_ubits_t scm_gc_yield_1 = 0; /* previous GC yield */
-scm_ubits_t scm_gc_malloc_collected;
-scm_ubits_t scm_gc_ports_collected;
+unsigned long scm_cells_allocated = 0;
+unsigned long scm_mallocated = 0;
+unsigned long scm_gc_cells_collected;
+unsigned long scm_gc_yield;
+static unsigned long scm_gc_yield_1 = 0; /* previous GC yield */
+unsigned long scm_gc_malloc_collected;
+unsigned long scm_gc_ports_collected;
unsigned long scm_gc_time_taken = 0;
-static scm_ubits_t t_before_gc;
-static scm_ubits_t t_before_sweep;
+static unsigned long t_before_gc;
+static unsigned long t_before_sweep;
unsigned long scm_gc_mark_time_taken = 0;
unsigned long scm_gc_sweep_time_taken = 0;
-scm_ubits_t scm_gc_times = 0;
-scm_ubits_t scm_gc_cells_swept = 0;
+unsigned long scm_gc_times = 0;
+unsigned long scm_gc_cells_swept = 0;
double scm_gc_cells_marked_acc = 0.;
double scm_gc_cells_swept_acc = 0.;
#if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST)
/* Return the number of the heap segment containing CELL. */
-static scm_bits_t
+static long
which_seg (SCM cell)
{
- scm_bits_t i;
+ long i;
for (i = 0; i < scm_n_heap_segs; i++)
if (SCM_PTR_LE (scm_heap_table[i].bounds[0], SCM2PTR (cell))
static void
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;
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)
{
"@code{--enable-guile-debug} builds of Guile.")
#define FUNC_NAME s_scm_map_free_list
{
- scm_bits_t i;
+ long i;
fprintf (stderr, "%ld segments total (%d:%ld",
(long) scm_n_heap_segs,
scm_heap_table[0].span,
}
#undef FUNC_NAME
-static scm_bits_t last_cluster;
-static scm_bits_t last_size;
+static long last_cluster;
+static long last_size;
-static scm_bits_t
-free_list_length (char *title, scm_bits_t i, SCM freelist)
+static long
+free_list_length (char *title, long i, SCM freelist)
{
SCM ls;
- scm_bits_t n = 0;
+ long n = 0;
for (ls = freelist; !SCM_NULLP (ls); ls = SCM_FREE_CELL_CDR (ls))
if (SCM_FREE_CELL_P (ls))
++n;
free_list_lengths (char *title, scm_freelist_t *master, SCM freelist)
{
SCM clusters;
- scm_bits_t i = 0, len, n = 0;
+ long i = 0, len, n = 0;
fprintf (stderr, "%s\n\n", title);
n += free_list_length ("free list", -1, freelist);
for (clusters = master->clusters;
static int scm_debug_check_freelist = 0;
/* Number of calls to SCM_NEWCELL since startup. */
-static scm_ubits_t scm_newcell_count;
-static scm_ubits_t scm_newcell2_count;
+static unsigned long scm_newcell_count;
+static unsigned long scm_newcell2_count;
/* Search freelist for anything that isn't marked as a free cell.
Abort if we find something. */
scm_check_freelist (SCM freelist)
{
SCM f;
- scm_bits_t i = 0;
+ long i = 0;
for (f = freelist; !SCM_NULLP (f); f = SCM_FREE_CELL_CDR (f), i++)
if (!SCM_FREE_CELL_P (f))
\f
-static scm_ubits_t
+static unsigned long
master_cells_allocated (scm_freelist_t *master)
{
/* 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))
objects -= master->left_to_collect;
return master->span * objects;
}
-static scm_ubits_t
+static unsigned long
freelist_length (SCM freelist)
{
- scm_bits_t n;
+ long n;
for (n = 0; !SCM_NULLP (freelist); freelist = SCM_FREE_CELL_CDR (freelist))
++n;
return n;
}
-static scm_ubits_t
+static unsigned long
compute_cells_allocated ()
{
return (scm_cells_allocated
"use of storage.")
#define FUNC_NAME s_scm_gc_stats
{
- scm_bits_t i;
- scm_bits_t n;
+ long i;
+ long n;
SCM heap_segs;
- scm_ubits_t local_scm_mtrigger;
- scm_ubits_t local_scm_mallocated;
- scm_ubits_t local_scm_heap_size;
- scm_ubits_t local_scm_cells_allocated;
- unsigned long local_scm_gc_time_taken;
- scm_ubits_t local_scm_gc_times;
- unsigned long local_scm_gc_mark_time_taken;
- unsigned long local_scm_gc_sweep_time_taken;
+ unsigned long int local_scm_mtrigger;
+ unsigned long int local_scm_mallocated;
+ unsigned long int local_scm_heap_size;
+ unsigned long int local_scm_cells_allocated;
+ unsigned long int local_scm_gc_time_taken;
+ unsigned long int local_scm_gc_times;
+ unsigned long int local_scm_gc_mark_time_taken;
+ unsigned long int local_scm_gc_sweep_time_taken;
double local_scm_gc_cells_swept;
double local_scm_gc_cells_marked;
SCM answer;
heap_segs = SCM_EOL;
n = scm_n_heap_segs;
for (i = scm_n_heap_segs; i--; )
- heap_segs = scm_cons (scm_cons (scm_ubits2num ((scm_ubits_t)scm_heap_table[i].bounds[1]),
- scm_ubits2num ((scm_ubits_t)scm_heap_table[i].bounds[0])),
+ heap_segs = scm_cons (scm_cons (scm_ulong2num ((unsigned long)scm_heap_table[i].bounds[1]),
+ scm_ulong2num ((unsigned long)scm_heap_table[i].bounds[0])),
heap_segs);
if (scm_n_heap_segs != n)
goto retry;
local_scm_gc_cells_marked = scm_gc_cells_marked_acc;
answer = scm_listify (scm_cons (sym_gc_time_taken, scm_ulong2num (local_scm_gc_time_taken)),
- scm_cons (sym_cells_allocated, scm_ubits2num (local_scm_cells_allocated)),
- scm_cons (sym_heap_size, scm_ubits2num (local_scm_heap_size)),
- scm_cons (sym_mallocated, scm_ubits2num (local_scm_mallocated)),
- scm_cons (sym_mtrigger, scm_ubits2num (local_scm_mtrigger)),
- scm_cons (sym_times, scm_ubits2num (local_scm_gc_times)),
+ scm_cons (sym_cells_allocated, scm_ulong2num (local_scm_cells_allocated)),
+ scm_cons (sym_heap_size, scm_ulong2num (local_scm_heap_size)),
+ scm_cons (sym_mallocated, scm_ulong2num (local_scm_mallocated)),
+ scm_cons (sym_mtrigger, scm_ulong2num (local_scm_mtrigger)),
+ scm_cons (sym_times, scm_ulong2num (local_scm_gc_times)),
scm_cons (sym_gc_mark_time_taken, scm_ulong2num (local_scm_gc_mark_time_taken)),
scm_cons (sym_gc_sweep_time_taken, scm_ulong2num (local_scm_gc_sweep_time_taken)),
scm_cons (sym_cells_marked, scm_i_dbl2big (local_scm_gc_cells_marked)),
"returned by this function for @var{obj}")
#define FUNC_NAME s_scm_object_address
{
- return scm_ubits2num (SCM_UNPACK (obj));
+ return scm_ulong2num ((unsigned long) SCM_UNPACK (obj));
}
#undef FUNC_NAME
fprintf (stderr, "allocated = %lu, ",
(long) (scm_cells_allocated
+ master_cells_allocated (&scm_master_freelist)
- + master_cells_allocated (&scm_master_freelist2)));
+ + master_cells_allocated (&scm_master_freelist2)));
#endif
scm_igc ("cells");
adjust_min_yield (master);
void
scm_igc (const char *what)
{
- scm_bits_t j;
+ long j;
++scm_gc_running_p;
scm_c_hook_run (&scm_before_gc_c_hook, 0);
/* flush dead entries from the continuation stack */
{
- scm_bits_t x;
- scm_bits_t bound;
+ long x;
+ long bound;
SCM * elts;
elts = SCM_VELTS (scm_continuation_stack);
bound = SCM_VECTOR_LENGTH (scm_continuation_stack);
MARK (SCM p)
#define FUNC_NAME FNAME
{
- register scm_bits_t i;
+ register long i;
register SCM ptr;
scm_bits_t cell_type;
{
/* ptr is a struct */
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);
scm_bits_t * struct_data = (scm_bits_t *) SCM_STRUCT_DATA (ptr);
}
if (len)
{
- scm_bits_t x;
+ long x;
for (x = 0; x < len - 2; x += 2, ++struct_data)
if (fields_desc[x] == 'p')
scm_weak_vectors = ptr;
if (SCM_IS_WHVEC_ANY (ptr))
{
- scm_bits_t x;
- scm_bits_t len;
+ long x;
+ long len;
int weak_keys;
int weak_values;
*/
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)
{
if (SCM_CELLP (obj))
{
SCM_CELLPTR ptr = SCM2PTR (obj);
- scm_bits_t i = 0;
- scm_bits_t j = scm_n_heap_segs - 1;
+ long i = 0;
+ long j = scm_n_heap_segs - 1;
if (SCM_PTR_LE (scm_heap_table[i].bounds[0], ptr)
&& SCM_PTR_GT (scm_heap_table[j].bounds[1], ptr))
{
while (i <= j)
{
- scm_bits_t seg_id;
+ long seg_id;
seg_id = -1;
if ((i == j)
|| SCM_PTR_GT (scm_heap_table[i].bounds[1], ptr))
seg_id = j;
else
{
- scm_bits_t k;
+ long k;
k = (i + j) / 2;
if (k == i)
break;
{
if (SCM_CELLP (value)) {
scm_cell * ptr = SCM2PTR (value);
- scm_bits_t i = 0;
- scm_bits_t j = scm_n_heap_segs - 1;
+ unsigned long i = 0;
+ unsigned long j = scm_n_heap_segs - 1;
if (SCM_GC_IN_CARD_HEADERP (ptr))
return 0;
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)) {
j = k;
} else if (SCM_PTR_LE (scm_heap_table[k].bounds[0], ptr)) {
static void
gc_sweep_freelist_finish (scm_freelist_t *freelist)
{
- scm_bits_t collected;
+ long collected;
*freelist->clustertail = freelist->cells;
if (!SCM_NULLP (freelist->cells))
{
register SCM_CELLPTR ptr;
register SCM nfreelist;
register scm_freelist_t *freelist;
- register scm_ubits_t m;
+ register unsigned long m;
register int span;
- scm_bits_t i;
+ long i;
size_t seg_size;
m = 0;
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;
/* Unmarked cells go onto the front of the freelist this heap
break;
case scm_tc7_vector:
{
- scm_ubits_t length = SCM_VECTOR_LENGTH (scmptr);
+ unsigned long int length = SCM_VECTOR_LENGTH (scmptr);
if (length > 0)
{
m += length * sizeof (scm_bits_t);
#ifdef HAVE_ARRAYS
case scm_tc7_bvect:
{
- size_t length = SCM_BITVECTOR_LENGTH (scmptr);
+ unsigned long int length = SCM_BITVECTOR_LENGTH (scmptr);
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));
}
}
#ifdef GC_FREE_SEGMENTS
if (n == seg_size)
{
- register scm_bits_t j;
+ register long j;
freelist->heap_size -= seg_size;
free ((char *) scm_heap_table[i].bounds[0]);
scm_must_malloc (size_t size, const char *what)
{
void *ptr;
- scm_ubits_t nm = scm_mallocated + size;
+ unsigned long nm = scm_mallocated + size;
if (nm < size)
/* The byte count of allocated objects has overflowed. This is
const char *what)
{
void *ptr;
- scm_ubits_t nm;
+ unsigned long nm;
if (size <= old_size)
return where;
* eh? Or even better, call scm_done_free. */
void
-scm_done_malloc (scm_bits_t size)
+scm_done_malloc (long size)
{
if (size < 0) {
if (scm_mallocated < size)
scm_mallocated, which underflowed. */
abort ();
} else {
- scm_ubits_t nm = scm_mallocated + size;
+ unsigned long nm = scm_mallocated + size;
if (nm < size)
/* The byte count of allocated objects has overflowed. This is
probably because you forgot to report the correct size of freed
}
void
-scm_done_free (scm_bits_t size)
+scm_done_free (long size)
{
if (size >= 0) {
if (scm_mallocated < size)
scm_mallocated, which underflowed. */
abort ();
} else {
- scm_ubits_t nm = scm_mallocated + size;
+ unsigned long nm = scm_mallocated + size;
if (nm < size)
/* The byte count of allocated objects has overflowed. This is
probably because you forgot to report the correct size of freed
{
register SCM_CELLPTR ptr;
SCM_CELLPTR seg_end;
- scm_bits_t new_seg_index;
+ long new_seg_index;
ptrdiff_t n_new_cells;
int span = freelist->span;
* This gives dh > (f * h - y) / (1 - f)
*/
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);
len = SCM_EXPHEAP (freelist->heap_size);
#ifdef DEBUGINFO
static void
init_freelist (scm_freelist_t *freelist,
int span,
- scm_bits_t cluster_size,
+ long cluster_size,
int min_yield)
{
freelist->clusters = SCM_EOL;
#define SCM_GC_SET_CARD_BVEC(card, 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) \
((card)->word_1 = (scm_bits_t) (flags))
#define SCM_GC_CLR_CARD_FLAGS(card) (SCM_GC_SET_CARD_FLAGS (card, 0L))
#define SCM_GC_CARD_SIZE_MASK (SCM_GC_CARD_SIZE - 1)
#define SCM_GC_CARD_ADDR_MASK (~SCM_GC_CARD_SIZE_MASK)
-#define SCM_GC_CELL_CARD(x) ((SCM_CELLPTR) ((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_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_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))
extern struct scm_freelist_t scm_master_freelist;
extern SCM scm_freelist2;
extern struct scm_freelist_t scm_master_freelist2;
-extern scm_ubits_t scm_gc_cells_collected;
-extern scm_ubits_t scm_gc_yield;
-extern scm_ubits_t scm_gc_malloc_collected;
-extern scm_ubits_t scm_gc_ports_collected;
-extern scm_ubits_t scm_cells_allocated;
-extern scm_ubits_t scm_mallocated;
-extern scm_ubits_t scm_mtrigger;
+extern unsigned long scm_gc_cells_collected;
+extern unsigned long scm_gc_yield;
+extern unsigned long scm_gc_malloc_collected;
+extern unsigned long scm_gc_ports_collected;
+extern unsigned long scm_cells_allocated;
+extern unsigned long scm_mallocated;
+extern unsigned long scm_mtrigger;
extern SCM scm_after_gc_hook;
extern void scm_igc (const char *what);
extern void scm_gc_mark (SCM p);
extern void scm_gc_mark_dependencies (SCM p);
-extern void scm_mark_locations (SCM_STACKITEM x[], scm_ubits_t n);
+extern void scm_mark_locations (SCM_STACKITEM x[], unsigned long n);
extern int scm_cellp (SCM value);
extern void scm_gc_sweep (void);
extern void * scm_must_malloc (size_t len, const char *what);
extern void * scm_must_realloc (void *where,
size_t olen, size_t len,
const char *what);
-extern void scm_done_malloc (scm_bits_t size);
-extern void scm_done_free (scm_bits_t size);
extern char *scm_must_strdup (const char *str);
extern char *scm_must_strndup (const char *str, 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_remember_upto_here_1 (SCM obj);
extern void scm_remember_upto_here_2 (SCM obj1, SCM obj2);
SCM gh_char2scm(char c);
SCM gh_str2scm(const char *s, size_t len);
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_ints2scm(const int *d, scm_bits_t n);
+SCM gh_ints2scm(const int *d, long n);
#ifdef HAVE_ARRAYS
-SCM gh_chars2byvect(const char *d, scm_bits_t n);
-SCM gh_shorts2svect(const short *d, scm_bits_t n);
-SCM gh_longs2ivect(const long *d, scm_bits_t n);
-SCM gh_ulongs2uvect(const unsigned long *d, scm_bits_t n);
-SCM gh_floats2fvect(const float *d, scm_bits_t n);
-SCM gh_doubles2dvect(const double *d, scm_bits_t n);
+SCM gh_chars2byvect(const char *d, long n);
+SCM gh_shorts2svect(const short *d, long n);
+SCM gh_longs2ivect(const long *d, long n);
+SCM gh_ulongs2uvect(const unsigned long *d, long n);
+SCM gh_floats2fvect(const float *d, long n);
+SCM gh_doubles2dvect(const double *d, long n);
#endif
-SCM gh_doubles2scm(const double *d, scm_bits_t n);
+SCM gh_doubles2scm(const double *d, long n);
/* Scheme to C conversion */
int gh_scm2bool(SCM obj);
char gh_scm2char(SCM obj);
double gh_scm2double(SCM obj);
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_scm2chars(SCM vector, char *result);
short *gh_scm2shorts(SCM vector, short *result);
SCM gh_make_vector(SCM length, SCM val);
SCM gh_vector_set_x(SCM vec, SCM pos, SCM val);
SCM gh_vector_ref(SCM vec, SCM pos);
-scm_bits_t gh_vector_length (SCM v);
-scm_ubits_t gh_uniform_vector_length (SCM v);
+unsigned long gh_vector_length (SCM v);
+unsigned long gh_uniform_vector_length (SCM v);
SCM gh_uniform_vector_ref (SCM v, SCM ilist);
#define gh_list_to_vector(ls) scm_vector(ls)
#define gh_vector_to_list(v) scm_vector_to_list(v)
SCM gh_cons(SCM x, SCM y);
#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_append2(SCM l1, SCM l2);
SCM gh_append3(SCM l1, SCM l2, SCM l3);
If START + LEN is off the end of DST, signal an out-of-range
error. */
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;
size_t dst_len;
}
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 *velts = SCM_VELTS(v);
}
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 *velts = SCM_VELTS(v);
}
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");
memcpy (m, d, n * sizeof (char));
}
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");
memcpy (m, d, n * sizeof (short));
}
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");
memcpy (m, d, n * sizeof (long));
}
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");
memcpy (m, d, n * sizeof (unsigned long));
}
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");
memcpy (m, d, n * sizeof (float));
}
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");
memcpy (m, d, n * sizeof (double));
char *
gh_scm2chars (SCM obj, char *m)
{
- scm_bits_t i, n;
- scm_bits_t v;
+ long i, n;
+ long v;
SCM val;
if (SCM_IMP (obj))
scm_wrong_type_arg (0, 0, obj);
short *
gh_scm2shorts (SCM obj, short *m)
{
- scm_bits_t i, n;
- scm_bits_t v;
+ long i, n;
+ long v;
SCM val;
if (SCM_IMP (obj))
scm_wrong_type_arg (0, 0, obj);
long *
gh_scm2longs (SCM obj, long *m)
{
- scm_bits_t i, n;
+ long i, n;
SCM val;
if (SCM_IMP (obj))
scm_wrong_type_arg (0, 0, obj);
float *
gh_scm2floats (SCM obj, float *m)
{
- scm_bits_t i, n;
+ long i, n;
SCM val;
if (SCM_IMP (obj))
scm_wrong_type_arg (0, 0, obj);
double *
gh_scm2doubles (SCM obj, double *m)
{
- scm_bits_t i, n;
+ long i, n;
SCM val;
if (SCM_IMP (obj))
scm_wrong_type_arg (0, 0, obj);
region to fit the string. If truncation occurs, the corresponding
area of DST is left unchanged. */
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;
SCM_ASSERT (SCM_STRINGP (src), src, SCM_ARG3, "gh_get_substr");
}
/* returns the length of the given vector */
-scm_bits_t
+unsigned long
gh_vector_length (SCM v)
{
- return (size_t) SCM_VECTOR_LENGTH (v);
+ return (unsigned long) SCM_VECTOR_LENGTH (v);
}
#ifdef HAVE_ARRAYS
/* uniform vector support */
/* returns the length as a C unsigned long integer */
-scm_ubits_t
+unsigned long
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
#include "libguile/gh.h"
/* returns the length of a list */
-scm_bits_t
+unsigned long
gh_length (SCM l)
{
return gh_scm2ulong (scm_length (l));
{
SCM res = SCM_EOL;
SCM *cdrloc = &res;
- scm_bits_t i = 0;
+ long i = 0;
for ( ; SCM_NNULLP(slots); slots = SCM_CDR(slots))
{
/*fixme* Manufacture keywords in advance */
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)
{
"@var{default_value} is returned.")
#define FUNC_NAME s_scm_get_keyword
{
- scm_bits_t len;
+ long len;
SCM_ASSERT (SCM_KEYWORDP (key), key, SCM_ARG1, FUNC_NAME);
len = scm_ilength (l);
{
SCM tmp, get_n_set, slots;
SCM class = SCM_CLASS_OF (obj);
- scm_bits_t n_initargs;
+ long n_initargs;
SCM_VALIDATE_INSTANCE (1, obj);
n_initargs = scm_ilength (initargs);
if (SCM_NIMP (SCM_CDR (slot_name)))
{
/* 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 */
SCM_MISC_ERROR ("class contains bogus slot definition: ~S",
SCM_LIST1 (slot_name));
"")
#define FUNC_NAME s_scm_sys_prep_layout_x
{
- scm_bits_t i, n, len;
+ long i, n, len;
char *s, p, a;
SCM nfields, slots, type;
#define FUNC_NAME s_scm_sys_inherit_magic_x
{
SCM ls = dsupers;
- scm_bits_t flags = 0;
+ long flags = 0;
SCM_VALIDATE_INSTANCE (1, class);
while (SCM_NNULLP (ls))
{
SCM_SET_CLASS_DESTRUCTOR (class, scm_struct_free_entity);
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
/*
* We could avoid calling scm_must_malloc in the allocation code
"Return the slot value with index @var{index} from @var{obj}.")
#define FUNC_NAME s_scm_sys_fast_slot_ref
{
- register scm_bits_t i;
+ register long i;
SCM_VALIDATE_INSTANCE (1, obj);
SCM_VALIDATE_INUM (2, index);
"@var{value}.")
#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_INUM (2, index);
static void clear_method_cache (SCM);
static SCM
-wrap_init (SCM class, SCM *m, scm_bits_t n)
+wrap_init (SCM class, SCM *m, long n)
{
SCM z;
- scm_bits_t i;
+ long i;
/* Set all slots to unbound */
for (i = 0; i < n; i++)
#define FUNC_NAME s_scm_sys_allocate_instance
{
SCM *m;
- scm_bits_t n;
+ long n;
SCM_VALIDATE_CLASS (1, class);
/* Class objects */
if (SCM_CLASS_FLAGS (class) & SCM_CLASSF_METACLASS)
{
- scm_bits_t i;
+ long i;
/* allocate class object */
SCM z = scm_make_struct (class, SCM_INUM0, SCM_EOL);
*/
static SCM **hell;
-static scm_bits_t n_hell = 1; /* one place for the evil one himself */
-static scm_bits_t hell_size = 4;
+static long n_hell = 1; /* one place for the evil one himself */
+static long hell_size = 4;
#ifdef USE_THREADS
static scm_mutex_t hell_mutex;
#endif
-static scm_bits_t
+static long
burnin (SCM o)
{
- scm_bits_t i;
+ long i;
for (i = 1; i < n_hell; ++i)
if (SCM_INST (o) == hell[i])
return i;
#endif
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_size = new_size;
}
more_specificp (SCM m1, SCM m2, SCM *targs)
{
register SCM s1, s2;
- register scm_bits_t i;
+ register long i;
/*
* Note:
* m1 and m2 can have != length (i.e. one can be one element longer than the
#define BUFFSIZE 32 /* big enough for most uses */
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);
for (j = 0; j < len; j++, l = SCM_CDR (l)) {
}
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 buffer[BUFFSIZE];
SCM save = method_list;
}
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;
- scm_bits_t count = 0;
+ register long i;
+ long count = 0;
SCM l, fl, applicable = SCM_EOL;
SCM save = args;
SCM buffer[BUFFSIZE], *types, *p;
scm_sys_compute_applicable_methods (SCM gf, SCM args)
#define FUNC_NAME s_sys_compute_applicable_methods
{
- scm_bits_t n;
+ long n;
SCM_VALIDATE_GENERIC (1, gf);
n = scm_ilength (args);
SCM_ASSERT (n >= 0, args, SCM_ARG2, FUNC_NAME);
#define FUNC_NAME s_scm_make
{
SCM class, z;
- scm_bits_t len = scm_ilength (args);
+ long len = scm_ilength (args);
if (len <= 0 || (len & 1) == 0)
SCM_WRONG_NUM_ARGS ();
#define FUNC_NAME s_scm_find_method
{
SCM gf;
- scm_bits_t len = scm_ilength (l);
+ long len = scm_ilength (l);
if (len == 0)
SCM_WRONG_NUM_ARGS ();
#define FUNC_NAME s_scm_sys_method_more_specific_p
{
SCM l, v;
- scm_bits_t i, len;
+ long i, len;
SCM_VALIDATE_METHOD (1, m1);
SCM_VALIDATE_METHOD (2, m2);
static void
create_smob_classes (void)
{
- scm_bits_t i;
+ long i;
scm_smob_class = (SCM *) malloc (255 * sizeof (SCM));
for (i = 0; i < 255; ++i)
}
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>",
type_name,
static void
create_port_classes (void)
{
- scm_bits_t i;
+ long i;
scm_port_class = (SCM *) malloc (3 * 256 * sizeof (SCM));
for (i = 0; i < 3 * 256; ++i)
}
}
{
- 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_MAKINUM (n + 1);
SCM scm_slot_ref (SCM obj, SCM slot_name);
SCM scm_slot_set_x (SCM obj, SCM slot_name, SCM value);
-SCM scm_compute_applicable_methods (SCM gf, SCM args, 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_m_atslot_ref (SCM xorig, SCM env);
SCM scm_m_atslot_set_x (SCM xorig, SCM env);
#endif
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_sys_initialize_object (SCM obj, SCM initargs);
SCM scm_sys_prep_layout_x (SCM c);
SCM self = SCM_CAR (args);
SCM (*fcn)() = SCM_SUBRF (SCM_GSUBR_PROC (self));
SCM v[SCM_GSUBR_MAX];
- scm_bits_t typ = SCM_INUM (SCM_GSUBR_TYPE (self));
- scm_bits_t i, n = SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ) + SCM_GSUBR_REST (typ);
+ long typ = SCM_INUM (SCM_GSUBR_TYPE (self));
+ long i, n = SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ) + SCM_GSUBR_REST (typ);
#if 0
if (n > SCM_GSUBR_MAX)
scm_misc_error (FUNC_NAME,
\f
#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_OPT(x) (((scm_bits_t)(x)&0xf0)>>4)
-#define SCM_GSUBR_REST(x) ((scm_bits_t)(x)>>8)
+#define SCM_GSUBR_REQ(x) ((long)(x)&0xf)
+#define SCM_GSUBR_OPT(x) (((long)(x)&0xf0)>>4)
+#define SCM_GSUBR_REST(x) ((long)(x)>>8)
#define SCM_GSUBR_MAX 10
#define SCM_GSUBR_TYPE(cclo) (SCM_CCLO_REF ((cclo), 1))
#endif
-scm_bits_t
+unsigned long
scm_string_hash (const unsigned char *str, size_t len)
{
if (len > 5)
{
size_t i = 5;
- scm_bits_t h = 264;
+ unsigned long h = 264;
while (i--)
h = (h << 8) + (unsigned) str[h % len];
return h;
else
{
size_t i = len;
- scm_bits_t h = 0;
+ unsigned long h = 0;
while (i)
h = (h << 8) + (unsigned) str[--i];
return h;
/* Dirk:FIXME:: scm_hasher could be made static. */
-scm_bits_t
-scm_hasher (SCM obj, scm_bits_t n, size_t d)
+unsigned long
+scm_hasher(SCM obj, unsigned long n, size_t d)
{
switch (SCM_ITAG3 (obj)) {
case scm_tc3_int_1:
return SCM_INUM(obj) % n; /* SCM_INUMP(obj) */
case scm_tc3_imm24:
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)) {
#ifndef SICP
case SCM_EOL:
if (len > 5)
{
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;
return h;
}
else
{
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;
return h;
}
\f
-scm_bits_t
-scm_ihashq (SCM obj, scm_bits_t n)
+unsigned long
+scm_ihashq (SCM obj, unsigned long n)
{
return (SCM_UNPACK (obj) >> 1) % n;
}
\f
-scm_bits_t
-scm_ihashv (SCM obj, scm_bits_t n)
+unsigned long
+scm_ihashv (SCM obj, unsigned long n)
{
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))
- return (scm_bits_t) scm_hasher(obj, n, 10);
+ return (unsigned long) scm_hasher(obj, n, 10);
else
return SCM_UNPACK (obj) % n;
}
\f
-scm_bits_t
-scm_ihash (SCM obj, scm_bits_t n)
+unsigned long
+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,
\f
-extern scm_bits_t scm_string_hash (const unsigned char *str, size_t len);
-extern scm_bits_t scm_hasher (SCM obj, scm_bits_t n, size_t d);
-extern scm_bits_t scm_ihashq (SCM obj, scm_bits_t n);
+extern unsigned long scm_string_hash (const unsigned char *str, size_t len);
+extern unsigned long scm_hasher (SCM obj, unsigned long n, size_t d);
+extern unsigned long scm_ihashq (SCM obj, unsigned long 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_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 void scm_init_hash (void);
\f
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);
}
SCM
-scm_hash_fn_get_handle (SCM table, SCM obj,
- scm_bits_t (*hash_fn) (),
- SCM (*assoc_fn) (),
- void *closure)
+scm_hash_fn_get_handle (SCM table,SCM obj,unsigned long (*hash_fn)(),SCM (*assoc_fn)(),void * closure)
#define FUNC_NAME "scm_hash_fn_get_handle"
{
- scm_bits_t k;
+ unsigned long k;
SCM h;
SCM_VALIDATE_VECTOR (1, table);
SCM
-scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init,
- scm_bits_t (*hash_fn) (),
- SCM (*assoc_fn) (),
- void *closure)
+scm_hash_fn_create_handle_x (SCM table,SCM obj,SCM init,unsigned long (*hash_fn)(),
+ SCM (*assoc_fn)(),void * closure)
#define FUNC_NAME "scm_hash_fn_create_handle_x"
{
- scm_bits_t k;
+ unsigned long k;
SCM it;
SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_create_handle_x");
SCM
-scm_hash_fn_ref (SCM table, SCM obj, SCM dflt,
- scm_bits_t (*hash_fn) (),
- SCM (*assoc_fn) (),
- void *closure)
+scm_hash_fn_ref (SCM table,SCM obj,SCM dflt,unsigned long (*hash_fn)(),
+ SCM (*assoc_fn)(),void * closure)
{
SCM it = scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure);
if (SCM_CONSP (it))
SCM
-scm_hash_fn_set_x (SCM table, SCM obj, SCM val,
- scm_bits_t (*hash_fn) (),
- SCM (*assoc_fn) (),
- void * closure)
+scm_hash_fn_set_x (SCM table,SCM obj,SCM val,unsigned long (*hash_fn)(),
+ SCM (*assoc_fn)(),void * closure)
{
SCM it;
SCM
-scm_hash_fn_remove_x (SCM table, SCM obj,
- scm_bits_t (*hash_fn) (),
- SCM (*assoc_fn) (),
- SCM (*delete_fn) (),
- void *closure)
+scm_hash_fn_remove_x (SCM table,SCM obj,unsigned long (*hash_fn)(),SCM (*assoc_fn)(),
+ SCM (*delete_fn)(),void * closure)
{
- scm_bits_t k;
+ unsigned long k;
SCM h;
SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_remove_x");
-static scm_bits_t
-scm_ihashx (SCM obj, scm_bits_t n, scm_ihashx_closure_t *closure)
+static unsigned long
+scm_ihashx (SCM obj, unsigned long n, scm_ihashx_closure_t *closure)
{
SCM answer;
SCM_DEFER_INTS;
answer = scm_apply (closure->hash,
- SCM_LIST2 (obj, scm_bits2num (n)),
+ SCM_LIST2 (obj, scm_ulong2num ((unsigned long)n)),
SCM_EOL);
SCM_ALLOW_INTS;
return SCM_INUM (answer);
SCM
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;
for (i = 0; i < n; ++i)
{
typedef SCM scm_delete_fn_t (SCM elt, SCM list);
#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_create_handle_x (SCM table, SCM obj, SCM init, scm_bits_t (*hash_fn) (), SCM (*assoc_fn) (), void * closure);
-extern SCM scm_hash_fn_ref (SCM table, SCM obj, SCM dflt, scm_bits_t (*hash_fn) (), SCM (*assoc_fn) (), void * closure);
-extern SCM scm_hash_fn_set_x (SCM table, SCM obj, SCM val, scm_bits_t (*hash_fn) (), SCM (*assoc_fn) (), void * closure);
-extern SCM scm_hash_fn_remove_x (SCM table, SCM obj, scm_bits_t (*hash_fn) (), SCM (*assoc_fn) (), SCM (*delete_fn) (), void * closure);
+extern SCM scm_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, unsigned long (*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, unsigned long (*hash_fn) (), SCM (*assoc_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_hashq_get_handle (SCM table, SCM obj);
{
SCM result = SCM_EOL;
int int_fd;
- scm_bits_t i;
+ long i;
SCM_VALIDATE_INUM_COPY (1,fd,int_fd);
This uses the "tortoise and hare" algorithm to detect "infinitely
long" lists (i.e. lists with cycles in their cdrs), and returns -1
if it does find one. */
-scm_bits_t
-scm_ilength (SCM sx)
+long
+scm_ilength(SCM sx)
{
- scm_bits_t i = 0;
+ long i = 0;
SCM tortoise = sx;
SCM hare = sx;
"Return the number of elements in list @var{lst}.")
#define FUNC_NAME s_scm_length
{
- scm_bits_t i;
+ long i;
SCM_VALIDATE_LIST_COPYLEN (1,lst,i);
return SCM_MAKINUM (i);
}
#define FUNC_NAME s_scm_list_ref
{
SCM lst = list;
- register scm_bits_t i;
+ unsigned long int i;
SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
while (SCM_CONSP (lst)) {
if (i == 0)
#define FUNC_NAME s_scm_list_set_x
{
SCM lst = list;
- register scm_bits_t i;
+ unsigned long int i;
SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
while (SCM_CONSP (lst)) {
if (i == 0) {
"or returning the results of cdring @var{k} times down @var{lst}.")
#define FUNC_NAME s_scm_list_tail
{
- register scm_bits_t i;
+ register long i;
SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
while (i-- > 0) {
SCM_VALIDATE_CONS (1,lst);
#define FUNC_NAME s_scm_list_cdr_set_x
{
SCM lst = list;
- scm_bits_t i;
+ unsigned long int i;
SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
while (SCM_CONSP (lst)) {
if (i == 0) {
{
SCM answer;
SCM * pos;
- register scm_bits_t i;
+ register long i;
SCM_VALIDATE_INUM_MIN_COPY (2,k,0,i);
answer = SCM_EOL;
extern SCM scm_cons_star (SCM arg, SCM objs);
extern SCM scm_null_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_append (SCM args);
extern SCM scm_append_x (SCM args);
{
static struct { char *name; char *value; } info[] = SCM_BUILD_INFO;
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++)
*loc = scm_acons (scm_str2symbol (info[i].name),
#define FUNC_NAME "module-reverse-lookup"
{
SCM obarray;
- scm_bits_t i, n;
+ long i, n;
if (module == SCM_BOOL_F)
obarray = scm_pre_modules_obarray;
#define MAX_VALUE ULONG_MAX
#include "libguile/num2integral.i.c"
-#define NUM2INTEGRAL scm_num2bits
-#define INTEGRAL2NUM scm_bits2num
-#define INTEGRAL2BIG scm_i_bits2big
-#define ITYPE scm_bits_t
-#define MIN_VALUE ((scm_bits_t) ((scm_ubits_t)1 << (sizeof (scm_bits_t) - 1)))
-#define MAX_VALUE (~MIN_VALUE)
-#include "libguile/num2integral.i.c"
-
-#define NUM2INTEGRAL scm_num2ubits
-#define INTEGRAL2NUM scm_ubits2num
-#define INTEGRAL2BIG scm_i_ubits2big
-#define UNSIGNED
-#define ITYPE scm_ubits_t
-#define MAX_VALUE ((scm_ubits_t) ((scm_bits_t) (-1)))
-#include "libguile/num2integral.i.c"
-
#define NUM2INTEGRAL scm_num2ptrdiff
#define INTEGRAL2NUM scm_ptrdiff2num
#define INTEGRAL2BIG scm_i_ptrdiff2big
* 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_NEGATIVE_FIXNUM (-SCM_MOST_POSITIVE_FIXNUM - 1)
/* SCM_INTBUFLEN is the maximum number of characters neccessary for the
* printed or scm_string representation of an exact immediate.
*/
-#define SCM_INTBUFLEN (5 + SCM_BITS_LENGTH)
+#define SCM_INTBUFLEN (5 + SCM_LONG_BIT)
\f
#define SCM_BIGSIGN(x) (SCM_CELL_WORD_0 (x) & SCM_BIGSIGNFLAG)
#define SCM_BDIGITS(x) ((SCM_BIGDIG *) (SCM_CELL_WORD_1 (x)))
#define SCM_SET_BIGNUM_BASE(n, b) (SCM_SET_CELL_WORD_1 ((n), (b)))
-#define SCM_NUMDIGS(x) ((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) \
SCM_SET_CELL_WORD_0 (x, \
scm_tc16_big \
extern SCM scm_i_uint2big (unsigned int n);
extern SCM scm_i_long2big (long n);
extern SCM scm_i_ulong2big (unsigned long n);
-extern SCM scm_i_bits2big (scm_bits_t n);
-extern SCM scm_i_ubits2big (scm_ubits_t n);
extern SCM scm_i_size2big (size_t n);
extern SCM scm_i_ptrdiff2big (ptrdiff_t n);
extern SCM scm_uint2num (unsigned int n);
extern SCM scm_long2num (long n);
extern SCM scm_ulong2num (unsigned long n);
-extern SCM scm_bits2num (scm_bits_t n);
-extern SCM scm_ubits2num (scm_ubits_t n);
extern SCM scm_size2num (size_t n);
extern SCM scm_ptrdiff2num (ptrdiff_t n);
extern short scm_num2short (SCM num, unsigned long int pos,
const char *s_caller);
extern unsigned long scm_num2ulong (SCM num, unsigned long int pos,
const char *s_caller);
-extern scm_bits_t scm_num2bits (SCM num, unsigned long int pos,
- const char *s_caller);
-extern scm_ubits_t scm_num2ubits (SCM num, unsigned long int pos,
- const char *s_caller);
extern ptrdiff_t scm_num2ptrdiff (SCM num, unsigned long int pos,
const char *s_caller);
extern size_t scm_num2size (SCM num, unsigned long int pos,
case scm_tc7_smob:
{
- scm_bits_t type = SCM_TYP16 (x);
+ long type = SCM_TYP16 (x);
if (type != scm_tc16_port_with_ps)
return scm_smob_class[SCM_TC2SMOBNUM (type)];
x = SCM_PORT_WITH_PS_PORT (x);
SCM
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);
n = SCM_INUM (SCM_CAR (z)); /* maximum number of specializers */
methods = SCM_CADR (z);
else
{
/* Compute a hash value */
- scm_bits_t hashset = SCM_INUM (methods);
- scm_bits_t j = n;
+ long hashset = SCM_INUM (methods);
+ long j = n;
mask = SCM_INUM (SCM_CAR (z = SCM_CDDR (z)));
methods = SCM_CADR (z);
i = 0;
/* Search for match */
do
{
- scm_bits_t j = n;
+ long j = n;
z = SCM_VELTS (methods)[i];
ls = args; /* list of arguments */
if (SCM_NIMP (ls))
SCM
scm_i_make_class_object (SCM meta,
SCM layout_string,
- scm_ubits_t flags)
+ unsigned long flags)
{
SCM c;
SCM layout = scm_make_struct_layout (layout_string);
"slot layout specified by @var{layout}.")
#define FUNC_NAME s_scm_make_class_object
{
- scm_ubits_t flags = 0;
+ unsigned long flags = 0;
SCM_VALIDATE_STRUCT (1,metaclass);
SCM_VALIDATE_STRING (2,layout);
if (SCM_EQ_P (metaclass, scm_metaclass_operator))
/* Goops functions. */
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 SCM scm_memoize_method (SCM x, SCM args);
extern SCM scm_make_subclass_object (SCM c, SCM layout);
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);
#endif /* OBJECTSH */
/*
schizophrenic use: both SCM and int
*/
- scm_bits_t val;
+ unsigned long val;
/* SCM val */
char *doc;
} scm_option_t;
* tags for smobjects (if you know a tag you can get an index and conversely).
*/
scm_ptob_descriptor_t *scm_ptobs;
-scm_bits_t scm_numptob;
+long scm_numptob;
/* GC marker for a port with stream of SCM type. */
SCM
{
SCM result;
scm_port_t *pt = SCM_PTAB_ENTRY (port);
- scm_bits_t count;
+ long count;
SCM_VALIDATE_OPINPORT (1,port);
scm_port_t **scm_port_table;
-scm_bits_t scm_port_table_size = 0; /* Number of ports in scm_port_table. */
-scm_bits_t scm_port_table_room = 20; /* Size of the array. */
+long scm_port_table_size = 0; /* Number of ports in scm_port_table. */
+long scm_port_table_room = 20; /* Size of the array. */
/* Add a port to the table. */
#define FUNC_NAME "scm_remove_from_port_table"
{
scm_port_t *p = SCM_PTAB_ENTRY (port);
- scm_bits_t i = p->entry;
+ long i = p->entry;
if (i >= scm_port_table_size)
SCM_MISC_ERROR ("Port not in table: ~S", SCM_LIST1 (port));
"@code{--enable-guile-debug} builds.")
#define FUNC_NAME s_scm_pt_member
{
- scm_bits_t i;
+ long i;
SCM_VALIDATE_INUM_COPY (1,index,i);
if (i < 0 || i >= scm_port_table_size)
return SCM_BOOL_F;
"have no effect as far as @var{port-for-each} is concerned.\n")
#define FUNC_NAME s_scm_port_for_each
{
- scm_bits_t i;
+ long i;
SCM ports;
SCM_VALIDATE_PROC (1, proc);
"Use port-for-each instead.")
#define FUNC_NAME s_scm_close_all_ports_except
{
- scm_bits_t i = 0;
+ long i = 0;
SCM_VALIDATE_REST_ARGUMENT (ports);
while (i < scm_port_table_size)
{
void
scm_flush (SCM port)
{
- scm_bits_t i = SCM_PTOBNUM (port);
+ long i = SCM_PTOBNUM (port);
(scm_ptobs[i].flush) (port);
}
void
scm_end_input (SCM port)
{
- scm_bits_t offset;
+ long offset;
scm_port_t *pt = SCM_PTAB_ENTRY (port);
if (pt->read_buf == pt->putback_buf)
typedef struct
{
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.
* Revealed ports do not get GC'd.
*/
} scm_port_t;
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)
\f
extern scm_ptob_descriptor_t *scm_ptobs;
-extern scm_bits_t scm_numptob;
-extern scm_bits_t scm_port_table_room;
+extern long scm_numptob;
+extern long scm_port_table_room;
\f
static void
print_circref (SCM port,scm_print_state *pstate,SCM ref)
{
- register scm_bits_t i;
- scm_bits_t self = pstate->top - 1;
+ register long i;
+ long self = pstate->top - 1;
i = pstate->top - 1;
if (SCM_CONSP (pstate->ref_stack[i]))
{
scm_puts ("#(", port);
common_vector_printer:
{
- register scm_bits_t i;
- scm_bits_t last = SCM_VECTOR_LENGTH (exp) - 1;
+ register long i;
+ long last = SCM_VECTOR_LENGTH (exp) - 1;
int cutp = 0;
if (pstate->fancyp && SCM_VECTOR_LENGTH (exp) > pstate->length)
{
scm_iprlist (char *hdr,SCM exp,int tlr,SCM port,scm_print_state *pstate)
{
register SCM hare, tortoise;
- scm_bits_t floor = pstate->top - 2;
+ long floor = pstate->top - 2;
scm_puts (hdr, port);
/* CHECK_INTS; */
if (pstate->fancyp)
scm_iprin1 (SCM_CAR (exp), port, pstate);
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)
if (SCM_EQ_P (pstate->ref_stack[i], exp))
fancy_printing:
{
- scm_bits_t n = pstate->length;
+ long n = pstate->length;
scm_iprin1 (SCM_CAR (exp), port, pstate);
exp = SCM_CDR (exp); --n;
for (; SCM_ECONSP (exp); exp = SCM_CDR (exp))
{
- register scm_ubits_t i;
+ register unsigned long i;
for (i = 0; i < pstate->top; ++i)
if (SCM_EQ_P (pstate->ref_stack[i], exp))
/* Increased to 800 on 2001-05-07 -- Guile now has 779 primitives on
startup, 786 with guile-readline. 'martin */
-scm_bits_t scm_subr_table_size = 0;
-scm_bits_t scm_subr_table_room = 800;
+long scm_subr_table_size = 0;
+long scm_subr_table_room = 800;
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;
- scm_bits_t entry;
+ long entry;
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
= scm_must_realloc ((char *) scm_subr_table,
sizeof (scm_subr_entry_t) * scm_subr_table_room,
}
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_define (SCM_SUBR_ENTRY(subr).name, subr);
void
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 */
scm_subr_table[entry] = scm_subr_table[scm_subr_table_size - 1];
SCM_SET_SUBRNUM (scm_subr_table[entry].handle, entry);
SCM
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_ENTRY(subr).generic = gf;
SCM
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_define (SCM_SUBR_ENTRY(subr).name, subr);
void
scm_mark_subr_table ()
{
- scm_bits_t i;
+ long i;
for (i = 0; i < scm_subr_table_size; ++i)
{
SCM_SETGCMARK (scm_subr_table[i].name);
#define SCM_SETTER(obj) SCM_CELL_OBJECT_2 (obj)
extern scm_subr_entry_t *scm_subr_table;
-extern scm_bits_t scm_subr_table_size;
-extern scm_bits_t scm_subr_table_room;
+extern long scm_subr_table_size;
+extern long scm_subr_table_room;
\f
extern void scm_mark_subr_table (void);
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_with_generic (const char *name, scm_bits_t type,
+extern SCM scm_c_make_subr (const char *name, long type, SCM (*fcn)());
+extern SCM scm_c_make_subr_with_generic (const char *name, long type,
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_with_generic (const char *name, scm_bits_t type,
+extern SCM scm_c_define_subr (const char *name, long type, SCM (*fcn)());
+extern SCM scm_c_define_subr_with_generic (const char *name, long type,
SCM (*fcn)(), SCM *gf);
extern SCM scm_makcclo (SCM proc, size_t len);
extern SCM scm_procedure_p (SCM obj);
break;\
} while (0)
-static scm_bits_t
+static unsigned long
cind (SCM ra, SCM inds)
{
- scm_bits_t i;
+ unsigned long i;
int k;
- scm_bits_t *ve = (scm_bits_t *) SCM_VELTS (inds);
+ long *ve = (long*) SCM_VELTS (inds);
if (!SCM_ARRAYP (ra))
return *ve;
i = SCM_ARRAY_BASE (ra);
scm_array_dim_t dims;
scm_array_dim_t *s0 = &dims;
scm_array_dim_t *s1;
- scm_bits_t bas0 = 0;
+ unsigned long bas0 = 0;
int i, ndim = 1;
int exact = 2 /* 4 */ ; /* Don't care about values >2 (yet?) */
if (SCM_IMP (ra0)) return 0;
case scm_tc7_dvect:
case scm_tc7_cvect:
{
- scm_bits_t length;
+ unsigned long int length;
if (1 != ndim)
return 0;
SCM inds, z;
SCM vra0, ra1, vra1;
SCM lvra, *plvra;
- scm_bits_t *vinds;
+ long *vinds;
int k, kmax;
switch (scm_ra_matchp (ra0, lra))
{
if (SCM_IMP (vra0)) goto gencase;
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);
SCM_ARRAY_BASE (vra1) = 0;
SCM_ARRAY_DIMS (vra1)->lbnd = 0;
}
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;
SCM_ARRAY_DIMS (vra0)->lbnd = 0;
SCM_ARRAY_DIMS (vra0)->ubnd = length - 1;
plvra = SCM_CDRLOC (*plvra);
}
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++)
vinds[k] = SCM_ARRAY_DIMS (ra0)[k].lbnd;
k = kmax;
scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
#define FUNC_NAME s_scm_array_fill_x
{
- scm_bits_t i;
- scm_bits_t n = SCM_ARRAY_DIMS (ra)->ubnd - SCM_ARRAY_DIMS (ra)->lbnd + 1;
- scm_bits_t inc = SCM_ARRAY_DIMS (ra)->inc;
- scm_bits_t base = SCM_ARRAY_BASE (ra);
+ unsigned long i;
+ unsigned long n = SCM_ARRAY_DIMS (ra)->ubnd - SCM_ARRAY_DIMS (ra)->lbnd + 1;
+ long inc = SCM_ARRAY_DIMS (ra)->inc;
+ unsigned long base = SCM_ARRAY_BASE (ra);
ra = SCM_ARRAY_V (ra);
switch SCM_TYP7 (ra)
break;
case scm_tc7_bvect:
{ /* scope */
- scm_bits_t *ve = (scm_bits_t *) SCM_VELTS (ra);
- if (1 == inc && (n >= SCM_BITS_LENGTH || n == SCM_BITVECTOR_LENGTH (ra)))
+ long *ve = (long *) SCM_VELTS (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 (base % SCM_BITS_LENGTH) /* leading partial word */
- ve[i++] &= ~(~0L << (base % SCM_BITS_LENGTH));
- for (; i < (base + n) / SCM_BITS_LENGTH; i++)
+ if (base % SCM_LONG_BIT) /* leading partial word */
+ ve[i++] &= ~(~0L << (base % SCM_LONG_BIT));
+ for (; i < (base + n) / SCM_LONG_BIT; i++)
ve[i] = 0L;
- if ((base + n) % SCM_BITS_LENGTH) /* trailing partial word */
- ve[i] &= (~0L << ((base + n) % SCM_BITS_LENGTH));
+ if ((base + n) % SCM_LONG_BIT) /* trailing partial word */
+ ve[i] &= (~0L << ((base + n) % SCM_LONG_BIT));
}
else if (SCM_EQ_P (fill, SCM_BOOL_T))
{
- if (base % SCM_BITS_LENGTH)
- ve[i++] |= ~0L << (base % SCM_BITS_LENGTH);
- for (; i < (base + n) / SCM_BITS_LENGTH; i++)
+ if (base % SCM_LONG_BIT)
+ ve[i++] |= ~0L << (base % SCM_LONG_BIT);
+ for (; i < (base + n) / SCM_LONG_BIT; i++)
ve[i] = ~0L;
- if ((base + n) % SCM_BITS_LENGTH)
- ve[i] |= ~(~0L << ((base + n) % SCM_BITS_LENGTH));
+ if ((base + n) % SCM_LONG_BIT)
+ ve[i] |= ~(~0L << ((base + n) % SCM_LONG_BIT));
}
else
badarg2:SCM_WRONG_TYPE_ARG (2, fill);
{
if (SCM_FALSEP (fill))
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))
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
goto badarg2;
}
static int
racp (SCM src, SCM dst)
{
- scm_bits_t n = (SCM_ARRAY_DIMS (src)->ubnd - SCM_ARRAY_DIMS (src)->lbnd + 1);
- scm_bits_t inc_d, inc_s = SCM_ARRAY_DIMS (src)->inc;
- scm_bits_t i_d, i_s = SCM_ARRAY_BASE (src);
+ long n = (SCM_ARRAY_DIMS (src)->ubnd - SCM_ARRAY_DIMS (src)->lbnd + 1);
+ long inc_d, inc_s = SCM_ARRAY_DIMS (src)->inc;
+ unsigned long i_d, i_s = SCM_ARRAY_BASE (src);
dst = SCM_CAR (dst);
inc_d = SCM_ARRAY_DIMS (dst)->inc;
i_d = SCM_ARRAY_BASE (dst);
case scm_tc7_bvect:
if (SCM_TYP7 (src) != scm_tc7_bvect)
goto gencase;
- if (1 == inc_d && 1 == inc_s && i_s % SCM_BITS_LENGTH == i_d % SCM_BITS_LENGTH
- && n >= SCM_BITS_LENGTH)
+ if (1 == inc_d && 1 == inc_s && i_s % SCM_LONG_BIT == i_d % SCM_LONG_BIT && n >= SCM_LONG_BIT)
{
- scm_bits_t *sv = (scm_bits_t *) SCM_VELTS (src);
- scm_bits_t *dv = (scm_bits_t *) SCM_VELTS (dst);
- sv += i_s / SCM_BITS_LENGTH;
- dv += i_d / SCM_BITS_LENGTH;
- if (i_s % SCM_BITS_LENGTH)
+ long *sv = (long *) SCM_VELTS (src);
+ long *dv = (long *) SCM_VELTS (dst);
+ sv += i_s / SCM_LONG_BIT;
+ dv += i_d / SCM_LONG_BIT;
+ if (i_s % SCM_LONG_BIT)
{ /* 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++;
sv++;
- n -= SCM_BITS_LENGTH - (i_s % SCM_BITS_LENGTH);
+ n -= SCM_LONG_BIT - (i_s % SCM_LONG_BIT);
}
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;)
if (n) /* trailing partial word */
*dv = (*dv & (~0L << n)) | (*sv & ~(~0L << n));
scm_ra_eqp (SCM ra0, SCM 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;
- scm_bits_t i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2);
- scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc;
- scm_bits_t inc1 = SCM_ARRAY_DIMS (ra1)->inc;
- scm_bits_t inc2 = SCM_ARRAY_DIMS (ra1)->inc;
+ long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
+ unsigned long i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2);
+ long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
+ long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+ long inc2 = SCM_ARRAY_DIMS (ra1)->inc;
ra0 = SCM_ARRAY_V (ra0);
ra1 = SCM_ARRAY_V (ra1);
ra2 = SCM_ARRAY_V (ra2);
static int
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;
- scm_bits_t i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2);
- scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc;
- scm_bits_t inc1 = SCM_ARRAY_DIMS (ra1)->inc;
- scm_bits_t inc2 = SCM_ARRAY_DIMS (ra1)->inc;
+ long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
+ unsigned long i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2);
+ long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
+ long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+ long inc2 = SCM_ARRAY_DIMS (ra1)->inc;
ra0 = SCM_ARRAY_V (ra0);
ra1 = SCM_ARRAY_V (ra1);
ra2 = SCM_ARRAY_V (ra2);
int
scm_ra_sum (SCM ra0, SCM ras)
{
- scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
- scm_bits_t i0 = SCM_ARRAY_BASE (ra0);
- scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc;
+ long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
+ unsigned long i0 = SCM_ARRAY_BASE (ra0);
+ long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0);
if (SCM_NNULLP(ras))
{
SCM ra1 = SCM_CAR (ras);
- scm_bits_t i1 = SCM_ARRAY_BASE (ra1);
- scm_bits_t inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+ unsigned long i1 = SCM_ARRAY_BASE (ra1);
+ long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1);
switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
{
int
scm_ra_difference (SCM ra0, SCM ras)
{
- scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
- scm_bits_t i0 = SCM_ARRAY_BASE (ra0);
- scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc;
+ long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
+ unsigned long i0 = SCM_ARRAY_BASE (ra0);
+ long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0);
if (SCM_NULLP (ras))
{
else
{
SCM ra1 = SCM_CAR (ras);
- scm_bits_t i1 = SCM_ARRAY_BASE (ra1);
- scm_bits_t inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+ unsigned long i1 = SCM_ARRAY_BASE (ra1);
+ long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1);
switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
{
int
scm_ra_product (SCM ra0, SCM ras)
{
- scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
- scm_bits_t i0 = SCM_ARRAY_BASE (ra0);
- scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc;
+ long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
+ unsigned long i0 = SCM_ARRAY_BASE (ra0);
+ long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0);
if (SCM_NNULLP (ras))
{
SCM ra1 = SCM_CAR (ras);
- scm_bits_t i1 = SCM_ARRAY_BASE (ra1);
- scm_bits_t inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+ unsigned long i1 = SCM_ARRAY_BASE (ra1);
+ long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1);
switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
{
int
scm_ra_divide (SCM ra0, SCM ras)
{
- scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
- scm_bits_t i0 = SCM_ARRAY_BASE (ra0);
- scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc;
+ long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
+ unsigned long i0 = SCM_ARRAY_BASE (ra0);
+ long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0);
if (SCM_NULLP (ras))
{
else
{
SCM ra1 = SCM_CAR (ras);
- scm_bits_t i1 = SCM_ARRAY_BASE (ra1);
- scm_bits_t inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+ unsigned long i1 = SCM_ARRAY_BASE (ra1);
+ long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1);
switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
{
static int
ramap (SCM ra0,SCM proc,SCM ras)
{
- scm_bits_t i = SCM_ARRAY_DIMS (ra0)->lbnd;
- scm_bits_t inc = SCM_ARRAY_DIMS (ra0)->inc;
- scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd;
- scm_bits_t base = SCM_ARRAY_BASE (ra0) - i * inc;
+ long i = SCM_ARRAY_DIMS (ra0)->lbnd;
+ long inc = SCM_ARRAY_DIMS (ra0)->inc;
+ long n = SCM_ARRAY_DIMS (ra0)->ubnd;
+ long base = SCM_ARRAY_BASE (ra0) - i * inc;
ra0 = SCM_ARRAY_V (ra0);
if (SCM_NULLP (ras))
for (; i <= n; i++)
{
SCM ra1 = SCM_CAR (ras);
SCM args, *ve = &ras;
- scm_bits_t k, i1 = SCM_ARRAY_BASE (ra1);
- scm_bits_t inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+ unsigned long k, i1 = SCM_ARRAY_BASE (ra1);
+ long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1);
ras = SCM_CDR (ras);
if (SCM_NULLP(ras))
{
SCM ra1 = SCM_CAR (ras);
SCM e1 = SCM_UNDEFINED;
- scm_bits_t i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1);
- scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc;
- scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra1)->lbnd + 1;
+ unsigned long i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1);
+ long inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+ long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra1)->lbnd + 1;
ra0 = SCM_ARRAY_V (ra0);
ra1 = SCM_ARRAY_V (ra1);
switch (SCM_TYP7 (ra0))
{
SCM ra1 = SCM_CAR (ras), ra2 = SCM_CAR (SCM_CDR (ras));
SCM e1 = SCM_UNDEFINED, e2 = SCM_UNDEFINED;
- scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
- scm_bits_t i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2);
- scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc;
- scm_bits_t inc1 = SCM_ARRAY_DIMS (ra1)->inc;
- scm_bits_t inc2 = SCM_ARRAY_DIMS (ra1)->inc;
+ long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
+ unsigned long i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1), i2 = SCM_ARRAY_BASE (ra2);
+ long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
+ long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+ long inc2 = SCM_ARRAY_DIMS (ra1)->inc;
ra0 = SCM_ARRAY_V (ra0);
ra1 = SCM_ARRAY_V (ra1);
ra2 = SCM_ARRAY_V (ra2);
{
SCM ra1 = SCM_CAR (ras);
SCM e1 = SCM_UNDEFINED;
- scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
- scm_bits_t i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1);
- scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+ long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
+ unsigned long i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1);
+ long inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra0 = SCM_ARRAY_V (ra0);
ra1 = SCM_ARRAY_V (ra1);
if (scm_tc7_vector == SCM_TYP7 (ra0) || scm_tc7_wvect == SCM_TYP7 (ra0))
{
SCM ra1 = SCM_CAR (ras);
SCM e1 = SCM_UNDEFINED;
- scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
- scm_bits_t i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1);
- scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+ long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
+ unsigned long i0 = SCM_ARRAY_BASE (ra0), i1 = SCM_ARRAY_BASE (ra1);
+ long inc0 = SCM_ARRAY_DIMS (ra0)->inc, inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra0 = SCM_ARRAY_V (ra0);
ra1 = SCM_ARRAY_V (ra1);
ras = SCM_CDR (ras);
{
SCM ra2 = SCM_CAR (ras);
SCM e2 = SCM_UNDEFINED;
- scm_bits_t i2 = SCM_ARRAY_BASE (ra2);
- scm_bits_t inc2 = SCM_ARRAY_DIMS (ra2)->inc;
+ unsigned long i2 = SCM_ARRAY_BASE (ra2);
+ long inc2 = SCM_ARRAY_DIMS (ra2)->inc;
ra2 = SCM_ARRAY_V (ra2);
if (scm_tc7_vector == SCM_TYP7 (ra0) || scm_tc7_wvect == SCM_TYP7 (ra0))
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
ramap_a (SCM ra0,SCM proc,SCM ras)
{
SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED;
- scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
- scm_bits_t i0 = SCM_ARRAY_BASE (ra0);
- scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc;
+ long n = SCM_ARRAY_DIMS (ra0)->ubnd - SCM_ARRAY_DIMS (ra0)->lbnd + 1;
+ unsigned long i0 = SCM_ARRAY_BASE (ra0);
+ long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0);
if (SCM_NULLP (ras))
for (; n-- > 0; i0 += inc0)
else
{
SCM ra1 = SCM_CAR (ras);
- scm_bits_t i1 = SCM_ARRAY_BASE (ra1);
- scm_bits_t inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+ unsigned long i1 = SCM_ARRAY_BASE (ra1);
+ long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1);
for (; n-- > 0; i0 += inc0, i1 += inc1)
scm_array_set_x (ra0, SCM_SUBRF (proc) (RVREF (ra0, i0, e0), RVREF (ra1, i1, e1)),
static int
rafe (SCM ra0,SCM proc,SCM ras)
{
- scm_bits_t i = SCM_ARRAY_DIMS (ra0)->lbnd;
- scm_bits_t i0 = SCM_ARRAY_BASE (ra0);
- scm_bits_t inc0 = SCM_ARRAY_DIMS (ra0)->inc;
- scm_bits_t n = SCM_ARRAY_DIMS (ra0)->ubnd;
+ long i = SCM_ARRAY_DIMS (ra0)->lbnd;
+ unsigned long i0 = SCM_ARRAY_BASE (ra0);
+ long inc0 = SCM_ARRAY_DIMS (ra0)->inc;
+ long n = SCM_ARRAY_DIMS (ra0)->ubnd;
ra0 = SCM_ARRAY_V (ra0);
if (SCM_NULLP (ras))
for (; i <= n; i++, i0 += inc0)
{
SCM ra1 = SCM_CAR (ras);
SCM args, *ve = &ras;
- scm_bits_t k, i1 = SCM_ARRAY_BASE (ra1);
- scm_bits_t inc1 = SCM_ARRAY_DIMS (ra1)->inc;
+ unsigned long k, i1 = SCM_ARRAY_BASE (ra1);
+ long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1);
ras = SCM_CDR (ras);
if (SCM_NULLP(ras))
"@end lisp")
#define FUNC_NAME s_scm_array_index_map_x
{
- scm_bits_t i;
+ unsigned long i;
SCM_VALIDATE_NIM (1,ra);
SCM_VALIDATE_PROC (2,proc);
switch (SCM_TYP7(ra))
case scm_tc7_dvect:
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++)
scm_array_set_x (ra, scm_apply (proc, SCM_MAKINUM (i), scm_listofnull),
SCM_MAKINUM (i));
{
SCM args = SCM_EOL;
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;
if (kmax < 0)
return scm_array_set_x (ra, scm_apply(proc, SCM_EOL, SCM_EOL),
raeql_1 (SCM ra0,SCM as_equal,SCM ra1)
{
SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED;
- scm_bits_t i0 = 0, i1 = 0;
- scm_bits_t inc0 = 1, inc1 = 1;
- scm_bits_t n;
+ unsigned long i0 = 0, i1 = 0;
+ long inc0 = 1, inc1 = 1;
+ unsigned long n;
ra1 = SCM_CAR (ra1);
if (SCM_ARRAYP(ra0))
{
SCM v0 = ra0, v1 = ra1;
scm_array_dim_t dim0, 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;
if (SCM_ARRAYP (ra0))
{
#if 0
SCM scm_exitval; /* INUM with return value */
#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
#define FUNC_NAME s_scm_read_string_x_partial
{
char *dest;
- scm_bits_t read_len;
- scm_bits_t chars_read = 0;
+ long read_len;
+ long chars_read = 0;
int fdes;
{
- scm_bits_t offset;
- scm_bits_t last;
+ long offset;
+ long last;
SCM_VALIDATE_SUBSTRING_SPEC_COPY (1, str, dest, 3, start, offset,
4, end, last);
*/
#define MAX_SMOB_COUNT 256
-scm_bits_t scm_numsmob;
+long scm_numsmob;
scm_smob_descriptor scm_smobs[MAX_SMOB_COUNT];
/* {Mark}
int
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 (SCM_SMOBNAME (n) ? SCM_SMOBNAME (n) : "smob", port);
scm_putc (' ', port);
scm_make_smob_type (char *name, size_t size)
#define FUNC_NAME "scm_make_smob_type"
{
- size_t new_smob;
+ long new_smob;
SCM_ENTER_A_SECTION; /* scm_numsmob */
new_smob = scm_numsmob;
SCM
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;
SCM z;
SCM_NEWCELL (z);
int (*print) (SCM, SCM, scm_print_state *),
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);
return answer;
}
void
scm_smob_prehistory ()
{
- size_t i;
+ long i;
scm_bits_t tc;
scm_numsmob = 0;
#define SCM_SMOB_APPLY_2(x,a1,a2) (SCM_SMOB_DESCRIPTOR (x).apply_2 (x, (a1), (a2)))
#define SCM_SMOB_APPLY_3(x,a1,a2,rst) (SCM_SMOB_DESCRIPTOR (x).apply_3 (x, (a1), (a2), (rst)))
-extern scm_bits_t scm_numsmob;
+extern long scm_numsmob;
extern scm_smob_descriptor scm_smobs[];
\f
"applied to all elements i - 1 and i")
#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 *vp;
cmp_fun_t cmp = scm_cmp_function (less);
"Note: this does _not_ accept vectors.")
#define FUNC_NAME s_scm_merge
{
- scm_bits_t alen, blen; /* list lengths */
+ long alen, blen; /* list lengths */
SCM build, last;
cmp_fun_t cmp = scm_cmp_function (less);
SCM_VALIDATE_NIM (3,less);
"Note: this does _not_ accept vectors.")
#define FUNC_NAME s_scm_merge_x
{
- scm_bits_t alen, blen; /* list lengths */
+ long alen, blen; /* list lengths */
SCM_VALIDATE_NIM (3,less);
if (SCM_NULLP (alist))
scm_merge_list_step (SCM * seq,
cmp_fun_t cmp,
SCM less,
- scm_bits_t n)
+ long n)
{
SCM a, b;
if (n > 2)
{
- scm_bits_t mid = n / 2;
+ long mid = n / 2;
a = scm_merge_list_step (seq, cmp, less, mid);
b = scm_merge_list_step (seq, cmp, less, n - mid);
return scm_merge_list_x (a, b, mid, n - mid, cmp, less);
"This is not a stable sort.")
#define FUNC_NAME s_scm_sort_x
{
- scm_bits_t len; /* list/vector length */
+ long len; /* list/vector length */
if (SCM_NULLP(items))
return SCM_EOL;
SCM_VALIDATE_NIM (2,less);
if (SCM_CONSP (items))
{
- scm_bits_t len;
+ long len;
SCM_VALIDATE_LIST_COPYLEN (1,items,len);
items = scm_list_copy (items);
/* support ordinary vectors even if arrays not available? */
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_array_copy_x (items, sortvec);
void *const tempbase,
cmp_fun_t cmp,
SCM less,
- scm_bits_t low,
- scm_bits_t mid,
- scm_bits_t high)
+ long low,
+ long mid,
+ long high)
{
register SCM *vp = (SCM *) vecbase;
register SCM *temp = (SCM *) tempbase;
- scm_bits_t it; /* Index for temp vector */
- scm_bits_t i1 = low; /* Index for lower vector segment */
- scm_bits_t i2 = mid + 1; /* Index for upper vector segment */
+ long it; /* Index for temp vector */
+ long i1 = low; /* Index for lower vector segment */
+ long i2 = mid + 1; /* Index for upper vector segment */
/* Copy while both segments contain more characters */
for (it = low; (i1 <= mid) && (i2 <= high); ++it)
void *const temp,
cmp_fun_t cmp,
SCM less,
- scm_bits_t low,
- scm_bits_t high)
+ long low,
+ long high)
{
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, mid+1, high);
scm_merge_vector_x (vp, temp, cmp, less, low, mid, high);
"This is a stable sort.")
#define FUNC_NAME s_scm_stable_sort_x
{
- scm_bits_t len; /* list/vector length */
+ long len; /* list/vector length */
if (SCM_NULLP (items))
return SCM_EOL;
"This is a 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))
return SCM_EOL;
"This is a stable sort.")
#define FUNC_NAME s_scm_sort_list_x
{
- scm_bits_t len;
+ long len;
SCM_VALIDATE_LIST_COPYLEN (1,items,len);
SCM_VALIDATE_NIM (2,less);
return scm_merge_list_step (&items, scm_cmp_function (less), less, len);
"list elements. This is a stable sort.")
#define FUNC_NAME s_scm_sort_list
{
- scm_bits_t len;
+ long len;
SCM_VALIDATE_LIST_COPYLEN (1,items,len);
SCM_VALIDATE_NIM (2,less);
items = scm_list_copy (items);
* is read from a continuation.
*/
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;
- scm_bits_t max_depth = SCM_BACKTRACE_MAXDEPTH;
+ long n;
+ long max_depth = SCM_BACKTRACE_MAXDEPTH;
for (n = 0;
dframe && !SCM_VOIDFRAMEP (*dframe) && n < max_depth;
dframe = RELOC_FRAME (dframe->prev, offset))
/* Read debug info from DFRAME into IFRAME.
*/
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. */
if (SCM_EVALFRAMEP (*dframe))
*/
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_debug_info_t *info;
*/
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_bits_t i;
- scm_bits_t n = s->length;
+ long i;
+ long n = s->length;
/* Cut inner part. */
if (SCM_EQ_P (inner_key, SCM_BOOL_T))
"resulting stack will be narrowed.")
#define FUNC_NAME s_scm_make_stack
{
- scm_bits_t n, size;
+ long n, size;
int maxp;
scm_debug_frame_t *dframe = scm_last_debug_frame;
scm_info_frame_t *iframe;
- scm_bits_t offset = 0;
+ long offset = 0;
SCM stack, id;
SCM inner_cut, outer_cut;
#define FUNC_NAME s_scm_stack_id
{
scm_debug_frame_t *dframe;
- scm_bits_t offset = 0;
+ long offset = 0;
if (SCM_EQ_P (stack, SCM_BOOL_T))
dframe = scm_last_debug_frame;
else
#define FUNC_NAME s_scm_last_stack_frame
{
scm_debug_frame_t *dframe;
- scm_bits_t offset = 0;
+ long offset = 0;
SCM stack;
SCM_VALIDATE_NIM (1,obj);
"@var{frame} is the first frame in its stack.")
#define FUNC_NAME s_scm_frame_previous
{
- scm_bits_t n;
+ long n;
SCM_VALIDATE_FRAME (1,frame);
n = SCM_INUM (SCM_CDR (frame)) + 1;
if (n >= SCM_STACK_LENGTH (SCM_CAR (frame)))
"@var{frame} is the last frame in its stack.")
#define FUNC_NAME s_scm_frame_next
{
- scm_bits_t n;
+ long n;
SCM_VALIDATE_FRAME (1,frame);
n = SCM_INUM (SCM_CDR (frame)) - 1;
if (n < 0)
typedef struct scm_stack_t {
SCM id; /* Stack id */
scm_info_frame_t *frames; /* Info frames */
- scm_bits_t length; /* Stack length */
- scm_bits_t tail_length;
+ unsigned long length; /* Stack length */
+ unsigned long tail_length;
scm_info_frame_t tail[1];
} scm_stack_t;
SCM result;
{
- scm_bits_t i = scm_ilength (chrs);
+ long i = scm_ilength (chrs);
SCM_ASSERT (i >= 0, chrs, SCM_ARGn, FUNC_NAME);
result = scm_allocate_string (i);
{
if (SCM_INUMP (k))
{
- scm_bits_t i = SCM_INUM (k);
+ long int i = SCM_INUM (k);
SCM res;
SCM_ASSERT_RANGE (1, k, i >= 0);
"indexing. @var{k} must be a valid index of @var{str}.")
#define FUNC_NAME s_scm_string_ref
{
- scm_bits_t idx;
+ long idx;
SCM_VALIDATE_STRING (1, str);
SCM_VALIDATE_INUM_COPY (2, k, idx);
"0 <= @var{start} <= @var{end} <= (string-length @var{str}).")
#define FUNC_NAME s_scm_substring
{
- scm_bits_t from;
- scm_bits_t to;
+ long int from;
+ long int to;
SCM_VALIDATE_STRING (1, str);
SCM_VALIDATE_INUM (2, start);
"occupies the same storage space as @var{str}.")
#define FUNC_NAME s_scm_make_shared_substring
{
- scm_bits_t f;
- scm_bits_t t;
+ long f;
+ long t;
SCM answer;
SCM len_str;
SCM_DEFER_INTS;
if (SCM_SUBSTRP (str))
{
- scm_bits_t offset;
+ long offset;
offset = SCM_INUM (SCM_SUBSTR_OFFSET (str));
f += offset;
t += offset;
"@code{rindex} function, depending on the value of @var{direction}."
*/
/* 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 sub_end, const char *why)
{
unsigned char * p;
- scm_bits_t x;
- scm_bits_t lower;
- scm_bits_t upper;
+ long x;
+ long lower;
+ long upper;
int ch;
SCM_ASSERT (SCM_STRINGP (*str), *str, SCM_ARG1, why);
"@end lisp")
#define FUNC_NAME s_scm_string_index
{
- scm_bits_t pos;
+ long pos;
if (SCM_UNBNDP (frm))
frm = SCM_BOOL_F;
"@end lisp")
#define FUNC_NAME s_scm_string_rindex
{
- scm_bits_t pos;
+ long pos;
if (SCM_UNBNDP (frm))
frm = SCM_BOOL_F;
"are different strings, it does not matter which function you use.")
#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_INUM_COPY (2,start1,s1);
"@end lisp")
#define FUNC_NAME s_scm_substring_fill_x
{
- scm_bits_t i, e;
+ long i, e;
char c;
SCM_VALIDATE_STRING (1,str);
SCM_VALIDATE_INUM_COPY (2,start,i);
"concerned.")
#define FUNC_NAME s_scm_string_to_list
{
- scm_bits_t i;
+ long i;
SCM res = SCM_EOL;
unsigned char *src;
SCM_VALIDATE_STRING (1,str);
#define FUNC_NAME s_scm_string_fill_x
{
register char *dst, c;
- register scm_bits_t k;
+ register long k;
SCM_VALIDATE_STRING_COPY (1,str,dst);
SCM_VALIDATE_CHAR_COPY (2,chr,c);
for (k = SCM_STRING_LENGTH (str)-1;k >= 0;k--) dst[k] = c;
static SCM
string_upcase_x (SCM v)
{
- scm_bits_t k;
+ unsigned long k;
for (k = 0; k < SCM_STRING_LENGTH (v); ++k)
SCM_STRING_UCHARS (v) [k] = scm_upcase (SCM_STRING_UCHARS (v) [k]);
static SCM
string_downcase_x (SCM v)
{
- scm_bits_t k;
+ unsigned long k;
for (k = 0; k < SCM_STRING_LENGTH (v); ++k)
SCM_STRING_UCHARS (v) [k] = scm_downcase (SCM_STRING_UCHARS (v) [k]);
string_capitalize_x (SCM str)
{
char *sz;
- scm_bits_t i, len;
+ long i, len;
int in_word=0;
len = SCM_STRING_LENGTH(str);
"@end lisp")
#define FUNC_NAME s_scm_string_split
{
- scm_bits_t idx, last_idx;
+ long idx, last_idx;
char * p;
int ch;
SCM res = SCM_EOL;
{
SCM old_stream = SCM_PACK (pt->stream);
SCM new_stream = scm_allocate_string (new_size);
- size_t old_size = SCM_STRING_LENGTH (old_stream);
- size_t min_size = min (old_size, new_size);
- size_t i;
+ unsigned long int old_size = SCM_STRING_LENGTH (old_stream);
+ unsigned long int min_size = min (old_size, new_size);
+ unsigned long int i;
off_t index = pt->write_pos - pt->write_buf;
* how to associate names with vtables.
*/
-scm_bits_t
-scm_struct_ihashq (SCM obj, scm_bits_t n)
+unsigned long
+scm_struct_ihashq (SCM obj, unsigned long n)
{
/* The length of the hash table should be a relative prime it's not
necessary to shift down the address. */
extern SCM scm_struct_set_x (SCM handle, SCM pos, SCM val);
extern SCM scm_struct_vtable (SCM handle);
extern SCM scm_struct_vtable_tag (SCM handle);
-extern 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_vtable_name (SCM vtable);
extern SCM scm_set_struct_vtable_name_x (SCM vtable, SCM name);
*/
#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_SYMBOL_CHARS(x) ((char *) (SCM_CELL_WORD_1 (x)))
#define SCM_SET_SYMBOL_CHARS(s, c) (SCM_SET_CELL_WORD_1 ((s), (c)))
-#define SCM_SYMBOL_HASH(X) ((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_PROP_SLOTS(X) (SCM_CELL_WORD_3 (X))
#define SCM_SUBSTR_STR(x) (SCM_CDDR (x))
#define SCM_SUBSTR_OFFSET(x) (SCM_CADR (x))
#define SCM_LENGTH_MAX (0xffffffL)
-#define SCM_LENGTH(x) (((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_ROSTRINGP(x) (SCM_NIMP(x) && ((SCM_TYP7S(x)==scm_tc7_string) \
|| (SCM_TYP7(x) == scm_tc7_symbol)))
/* In the beginning was the Word:
*/
-typedef SCM_BITS_T scm_bits_t;
-typedef SCM_UBITS_T scm_ubits_t;
+typedef long scm_bits_t;
/* But as external interface, we use SCM, which may, according to the desired
* level of type checking, be defined in several ways:
switch (SCM_TYP7 (obj))
{
case scm_tc7_bvect:
- result = sizeof (scm_bits_t);
- break;
case scm_tc7_uvect:
case scm_tc7_ivect:
result = sizeof (long);
}
}
-#if (SIZEOF_SIZE_T < SCM_SIZEOF_BITS_T)
-# define CHECK_BYTE_SIZE(s,k) SCM_ASSERT_RANGE (1, scm_bits2num (k), k <= (size_t)(~(size_t)0))
-#else
-# define CHECK_BYTE_SIZE(s,k)
-#endif
-
SCM
-scm_make_uve (scm_bits_t k, SCM prot)
+scm_make_uve (long k, SCM prot)
#define FUNC_NAME "scm_make_uve"
{
SCM v;
- size_t i;
- scm_bits_t type;
- scm_ubits_t size_in_bytes;
+ long i, type;
if (SCM_EQ_P (prot, SCM_BOOL_T))
{
SCM_NEWCELL (v);
if (k > 0)
{
- SCM_ASSERT_RANGE (1, scm_bits2num (k),
- k <= SCM_BITVECTOR_MAX_LENGTH);
- size_in_bytes = sizeof (scm_bits_t) * ((k + SCM_BITS_LENGTH - 1) /
- SCM_BITS_LENGTH);
- CHECK_BYTE_SIZE (size_in_bytes, k);
- i = (size_t) size_in_bytes;
+ SCM_ASSERT_RANGE (1, scm_long2num (k), k <= SCM_BITVECTOR_MAX_LENGTH);
+ i = sizeof (long) * ((k + SCM_LONG_BIT - 1) / SCM_LONG_BIT);
SCM_SET_BITVECTOR_BASE (v, (char *) scm_must_malloc (i, "vector"));
SCM_SET_BITVECTOR_LENGTH (v, k);
}
}
else if (SCM_CHARP (prot) && (SCM_CHAR (prot) == '\0'))
{
- size_in_bytes = sizeof (char) * k;
+ i = sizeof (char) * k;
type = scm_tc7_byvect;
}
else if (SCM_CHARP (prot))
{
- size_in_bytes = sizeof (char) * k;
- CHECK_BYTE_SIZE (size_in_bytes, k);
- i = (size_t) size_in_bytes;
+ i = sizeof (char) * k;
return scm_allocate_string (i);
}
else if (SCM_INUMP (prot))
{
- size_in_bytes = sizeof (long) * k;
+ i = sizeof (long) * k;
if (SCM_INUM (prot) > 0)
type = scm_tc7_uvect;
else
s = SCM_SYMBOL_CHARS (prot)[0];
if (s == 's')
{
- size_in_bytes = sizeof (short) * k;
+ i = sizeof (short) * k;
type = scm_tc7_svect;
}
#ifdef HAVE_LONG_LONGS
else if (s == 'l')
{
- size_in_bytes = sizeof (long long) * k;
+ i = sizeof (long long) * k;
type = scm_tc7_llvect;
}
#endif
{
return scm_c_make_vector (k, SCM_UNDEFINED);
}
-
}
else if (!SCM_INEXACTP (prot))
/* Huge non-unif vectors are NOT supported. */
return scm_c_make_vector (k, SCM_UNDEFINED);
else if (singp (prot))
{
- size_in_bytes = sizeof (float) * k;
+ i = sizeof (float) * k;
type = scm_tc7_fvect;
}
else if (SCM_COMPLEXP (prot))
{
- size_in_bytes = 2 * sizeof (double) * k;
+ i = 2 * sizeof (double) * k;
type = scm_tc7_cvect;
}
else
{
- size_in_bytes = sizeof (double) * k;
+ i = sizeof (double) * k;
type = scm_tc7_dvect;
}
- CHECK_BYTE_SIZE (size_in_bytes, k);
- i = (size_t) size_in_bytes;
-
- SCM_ASSERT_RANGE (1, scm_bits2num (k), k <= SCM_UVECTOR_MAX_LENGTH);
+ SCM_ASSERT_RANGE (1, scm_long2num (k), k <= SCM_UVECTOR_MAX_LENGTH);
SCM_NEWCELL (v);
SCM_DEFER_INTS;
static char s_bad_ind[] = "Bad scm_array index";
-scm_bits_t
+long
scm_aind (SCM ra, SCM args, const char *what)
#define FUNC_NAME what
{
SCM ind;
- register scm_bits_t j;
- register scm_bits_t pos = SCM_ARRAY_BASE (ra);
- register size_t k = SCM_ARRAY_NDIM (ra);
+ register long j;
+ register unsigned long pos = SCM_ARRAY_BASE (ra);
+ register unsigned long k = SCM_ARRAY_NDIM (ra);
scm_array_dim_t *s = SCM_ARRAY_DIMS (ra);
if (SCM_INUMP (args))
{
#define FUNC_NAME s_scm_dimensions_to_uniform_array
{
size_t k;
- scm_bits_t rlen = 1;
+ unsigned long rlen = 1;
scm_array_dim_t *s;
SCM ra;
while (k--)
{
s[k].inc = rlen;
- SCM_ASSERT_RANGE (1, dims, s[k].inc >= 0);
SCM_ASSERT_RANGE (1, dims, s[k].lbnd <= s[k].ubnd);
rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
}
scm_array_fill_x (ra, prot);
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 ra;
}
size_t k = SCM_ARRAY_NDIM (ra);
if (k)
{
- scm_bits_t inc = SCM_ARRAY_DIMS (ra)[k - 1].inc; /*??*/
+ long inc = SCM_ARRAY_DIMS (ra)[k - 1].inc;
while (k--)
{
if (inc != SCM_ARRAY_DIMS (ra)[k].inc)
SCM ra;
SCM inds, indptr;
SCM imap;
- size_t k;
- scm_bits_t i;
- scm_bits_t old_min, new_min, old_max, new_max;
+ size_t k, i;
+ long old_min, new_min, old_max, new_max;
scm_array_dim_t *s;
SCM_VALIDATE_REST_ARGUMENT (dims);
}
imap = scm_apply (mapfunc, scm_reverse (inds), SCM_EOL);
if (SCM_ARRAYP (oldra))
- i = scm_aind (oldra, imap, FUNC_NAME);
+ i = (size_t) scm_aind (oldra, imap, FUNC_NAME);
else
{
if (SCM_NINUMP (imap))
if (1 == SCM_ARRAY_NDIM (ra) && 0 == SCM_ARRAY_BASE (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)
return v;
if (s->ubnd < s->lbnd)
#define FUNC_NAME s_scm_array_in_bounds_p
{
SCM ind = SCM_EOL;
- scm_bits_t pos = 0;
+ long pos = 0;
register size_t k;
- register scm_bits_t j;
+ register long j;
scm_array_dim_t *s;
SCM_VALIDATE_REST_ARGUMENT (args);
case scm_tc7_vector:
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);
return SCM_BOOL(pos >= 0 && pos < length);
}
"@var{array}.")
#define FUNC_NAME s_scm_uniform_vector_ref
{
- scm_bits_t pos;
+ long pos;
if (SCM_IMP (v))
{
}
else
{
- scm_bits_t length;
+ unsigned long int length;
if (SCM_NIMP (args))
{
SCM_ASSERT (SCM_CONSP (args) && SCM_INUMP (SCM_CAR (args)), args, SCM_ARG2, FUNC_NAME);
tries to recycle conses. (Make *sure* you want them recycled.) */
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"
{
switch SCM_TYP7 (v)
"@var{new-value}. The value returned by array-set! is unspecified.")
#define FUNC_NAME s_scm_array_set_x
{
- scm_bits_t pos = 0;
+ long pos = 0;
SCM_VALIDATE_REST_ARGUMENT (args);
SCM_ASRTGO (SCM_NIMP (v), badarg1);
}
else
{
- scm_bits_t length;
+ unsigned long int length;
if (SCM_NIMP (args))
{
SCM_ASSERT (SCM_CONSP(args) && SCM_INUMP (SCM_CAR (args)), args,
return ra;
case scm_tc7_smob:
{
- size_t k, ndim = SCM_ARRAY_NDIM (ra);
- scm_bits_t len = 1;
+ size_t k, ndim = SCM_ARRAY_NDIM (ra), len = 1;
if (!SCM_ARRAYP (ra) || !SCM_ARRAY_CONTP (ra))
return SCM_BOOL_F;
for (k = 0; k < ndim; k++)
if (scm_tc7_bvect == SCM_TYP7 (SCM_ARRAY_V (ra)))
{
if (len != SCM_BITVECTOR_LENGTH (SCM_ARRAY_V (ra)) ||
- SCM_ARRAY_BASE (ra) % SCM_BITS_LENGTH ||
- len % SCM_BITS_LENGTH)
+ SCM_ARRAY_BASE (ra) % SCM_LONG_BIT ||
+ len % SCM_LONG_BIT)
return SCM_BOOL_F;
}
}
{
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)
return v;
}
scm_ra2contig (SCM ra, int copy)
{
SCM ret;
- scm_bits_t inc = 1;
- size_t k;
- scm_bits_t len = 1;
+ long inc = 1;
+ size_t k, len = 1;
for (k = SCM_ARRAY_NDIM (ra); k--;)
len *= SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd + 1;
k = SCM_ARRAY_NDIM (ra);
if (scm_tc7_bvect != SCM_TYP7 (SCM_ARRAY_V (ra)))
return ra;
if ((len == SCM_BITVECTOR_LENGTH (SCM_ARRAY_V (ra)) &&
- 0 == SCM_ARRAY_BASE (ra) % SCM_BITS_LENGTH &&
- 0 == len % SCM_BITS_LENGTH))
+ 0 == SCM_ARRAY_BASE (ra) % SCM_LONG_BIT &&
+ 0 == len % SCM_LONG_BIT))
return ra;
}
ret = scm_make_ra (k);
#define FUNC_NAME s_scm_uniform_array_read_x
{
SCM cra = SCM_UNDEFINED, v = ra;
- int sz;
- scm_bits_t vlen, ans;
- scm_bits_t cstart = 0, cend = 0;
- scm_bits_t offset = 0;
+ long sz, vlen, ans;
+ long cstart = 0;
+ long cend;
+ long offset = 0;
char *base;
SCM_ASRTGO (SCM_NIMP (v), badarg1);
break;
case scm_tc7_bvect:
base = (char *) SCM_BITVECTOR_BASE (v);
- vlen = (vlen + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH;
- cstart /= SCM_BITS_LENGTH;
- sz = sizeof (scm_bits_t);
+ vlen = (vlen + SCM_LONG_BIT - 1) / SCM_LONG_BIT;
+ cstart /= SCM_LONG_BIT;
+ sz = sizeof (long);
break;
case scm_tc7_byvect:
base = (char *) SCM_UVECTOR_BASE (v);
if (!SCM_UNBNDP (start))
{
offset =
- SCM_NUM2BITS (3, start);
+ SCM_NUM2LONG (3, start);
if (offset < 0 || offset >= cend)
scm_out_of_range (FUNC_NAME, start);
if (!SCM_UNBNDP (end))
{
- scm_bits_t tend =
- SCM_NUM2BITS (4, end);
+ long tend =
+ SCM_NUM2LONG (4, end);
if (tend <= offset || tend > cend)
scm_out_of_range (FUNC_NAME, end);
SCM_SYSERROR;
}
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))
scm_array_copy_x (cra, ra);
"@code{(current-output-port)}.")
#define FUNC_NAME s_scm_uniform_array_write
{
- int sz;
- scm_bits_t vlen, ans;
- scm_bits_t offset = 0, cstart = 0, cend;
+ long sz, vlen, ans;
+ long offset = 0;
+ long cstart = 0;
+ long cend;
char *base;
port_or_fd = SCM_COERCE_OUTPORT (port_or_fd);
break;
case scm_tc7_bvect:
base = (char *) SCM_BITVECTOR_BASE (v);
- vlen = (vlen + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH;
- cstart /= SCM_BITS_LENGTH;
- sz = sizeof (scm_bits_t);
+ vlen = (vlen + SCM_LONG_BIT - 1) / SCM_LONG_BIT;
+ cstart /= SCM_LONG_BIT;
+ sz = sizeof (long);
break;
case scm_tc7_byvect:
base = (char *) SCM_UVECTOR_BASE (v);
if (!SCM_UNBNDP (start))
{
offset =
- SCM_NUM2BITS (3, start);
+ SCM_NUM2LONG (3, start);
if (offset < 0 || offset >= cend)
scm_out_of_range (FUNC_NAME, start);
if (!SCM_UNBNDP (end))
{
- scm_bits_t tend =
- SCM_NUM2BITS (4, end);
+ long tend =
+ SCM_NUM2LONG (4, end);
if (tend <= offset || tend > cend)
scm_out_of_range (FUNC_NAME, end);
SCM_SYSERROR;
}
if (SCM_TYP7 (v) == scm_tc7_bvect)
- ans *= SCM_BITS_LENGTH;
+ ans *= SCM_LONG_BIT;
return SCM_MAKINUM (ans);
}
if (SCM_BITVECTOR_LENGTH (bitvector) == 0) {
return SCM_INUM0;
} else {
- scm_bits_t count = 0;
- size_t i = (SCM_BITVECTOR_LENGTH (bitvector) - 1) / SCM_BITS_LENGTH;
- scm_ubits_t w = SCM_UNPACK (SCM_VELTS (bitvector)[i]);
+ unsigned long int count = 0;
+ unsigned long int i = (SCM_BITVECTOR_LENGTH (bitvector) - 1) / SCM_LONG_BIT;
+ unsigned long int w = SCM_UNPACK (SCM_VELTS (bitvector)[i]);
if (SCM_FALSEP (b)) {
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 (w) {
count += cnt_tab[w & 0x0f];
"within the specified range @code{#f} is returned.")
#define FUNC_NAME s_scm_bit_position
{
- size_t i;
- scm_bits_t pos;
- size_t lenw;
- int xbits;
- register scm_ubits_t w;
+ long i, lenw, xbits, pos;
+ register unsigned long w;
SCM_VALIDATE_BOOL (1, item);
SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG2, FUNC_NAME);
if (pos == SCM_BITVECTOR_LENGTH (v))
return SCM_BOOL_F;
- lenw = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_BITS_LENGTH; /* watch for part words */
- i = pos / SCM_BITS_LENGTH;
+ lenw = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT; /* watch for part words */
+ i = pos / SCM_LONG_BIT;
w = SCM_UNPACK (SCM_VELTS (v)[i]);
if (SCM_FALSEP (item))
w = ~w;
- xbits = (pos % SCM_BITS_LENGTH);
+ xbits = (pos % SCM_LONG_BIT);
pos -= 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)
{
if (w && (i == lenw))
}
if (++i > lenw)
break;
- pos += SCM_BITS_LENGTH;
+ pos += SCM_LONG_BIT;
w = SCM_UNPACK (SCM_VELTS (v)[i]);
if (SCM_FALSEP (item))
w = ~w;
"@var{bool}. The return value is unspecified.")
#define FUNC_NAME s_scm_bit_set_star_x
{
- register size_t i;
- scm_bits_t vlen;
+ register long i, k, vlen;
SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG1, FUNC_NAME);
SCM_ASRTGO (SCM_NIMP (kv), badarg2);
switch SCM_TYP7 (kv)
default:
badarg2:SCM_WRONG_TYPE_ARG (2, kv);
case scm_tc7_uvect:
- {
- unsigned long k;
vlen = SCM_BITVECTOR_LENGTH (v);
if (SCM_FALSEP (obj))
for (i = SCM_UVECTOR_LENGTH (kv); i;)
{
- k = ((unsigned long *) SCM_VELTS (kv))[--i];
+ k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
if (k >= vlen)
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));
SCM_BITVEC_CLR(v,k);
else if (SCM_EQ_P (obj, SCM_BOOL_T))
for (i = SCM_UVECTOR_LENGTH (kv); i;)
{
- k = ((unsigned long *) SCM_VELTS (kv))[--i];
+ k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
if (k >= vlen)
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));
SCM_BITVEC_SET(v,k);
else
badarg3:SCM_WRONG_TYPE_ARG (3, obj);
break;
- }
case scm_tc7_bvect:
- {
- scm_ubits_t k;
SCM_ASSERT (SCM_BITVECTOR_LENGTH (v) == SCM_BITVECTOR_LENGTH (kv), v, SCM_ARG1, FUNC_NAME);
if (SCM_FALSEP (obj))
- for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; k--;)
- ((scm_ubits_t *) SCM_VELTS (v))[k] &= ~ ((scm_ubits_t *) SCM_VELTS (kv))[k];
+ for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;)
+ SCM_UNPACK (SCM_VELTS (v)[k]) &= ~ SCM_UNPACK(SCM_VELTS (kv)[k]);
else if (SCM_EQ_P (obj, SCM_BOOL_T))
- for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; k--;)
- ((scm_ubits_t *) SCM_VELTS (v))[k] |= ((scm_ubits_t *) SCM_VELTS (kv))[k];
+ for (k = (SCM_BITVECTOR_LENGTH (v) + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;)
+ SCM_UNPACK (SCM_VELTS (v)[k]) |= SCM_UNPACK (SCM_VELTS (kv)[k]);
else
goto badarg3;
break;
}
- }
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
"@var{bv} is not modified.")
#define FUNC_NAME s_scm_bit_count_star
{
- register size_t i;
- scm_bits_t vlen, count = 0;
+ register long i, vlen, count = 0;
+ register unsigned long k;
int fObj = 0;
SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG1, FUNC_NAME);
badarg2:
SCM_WRONG_TYPE_ARG (2, kv);
case scm_tc7_uvect:
- {
- unsigned long k;
vlen = SCM_BITVECTOR_LENGTH (v);
if (SCM_FALSEP (obj))
for (i = SCM_UVECTOR_LENGTH (kv); i;)
{
- k = ((unsigned long *) SCM_VELTS (kv))[--i];
+ k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
if (k >= vlen)
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));
if (!SCM_BITVEC_REF(v,k))
else if (SCM_EQ_P (obj, SCM_BOOL_T))
for (i = SCM_UVECTOR_LENGTH (kv); i;)
{
- k = ((unsigned long *) SCM_VELTS (kv))[--i];
+ k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
if (k >= vlen)
scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));
if (SCM_BITVEC_REF (v,k))
else
badarg3:SCM_WRONG_TYPE_ARG (3, obj);
break;
- }
case scm_tc7_bvect:
- {
- scm_ubits_t k;
SCM_ASSERT (SCM_BITVECTOR_LENGTH (v) == SCM_BITVECTOR_LENGTH (kv), v, SCM_ARG1, FUNC_NAME);
if (0 == SCM_BITVECTOR_LENGTH (v))
return SCM_INUM0;
SCM_ASRTGO (SCM_BOOLP (obj), badarg3);
fObj = SCM_EQ_P (obj, SCM_BOOL_T);
- i = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_BITS_LENGTH;
- k =
- ((scm_ubits_t *) SCM_VELTS (kv))[i]
- & (fObj ? ((scm_ubits_t *) SCM_VELTS (v))[i] : ~ ((scm_ubits_t *) SCM_VELTS (v))[i]);
- k <<= SCM_BITS_LENGTH - 1 - ((SCM_BITVECTOR_LENGTH (v) - 1) % SCM_BITS_LENGTH);
+ i = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT;
+ k = SCM_UNPACK (SCM_VELTS (kv)[i]) & (fObj ? SCM_UNPACK (SCM_VELTS (v)[i]) : ~ SCM_UNPACK (SCM_VELTS (v)[i]));
+ k <<= SCM_LONG_BIT - 1 - ((SCM_BITVECTOR_LENGTH (v) - 1) % SCM_LONG_BIT);
while (1)
{
for (; k; k >>= 4)
return SCM_MAKINUM (count);
/* urg. repetitive (see above.) */
- k =
- ((scm_ubits_t *) SCM_VELTS (kv))[i]
- & (fObj ? ((scm_ubits_t *) SCM_VELTS (v))[i] : ~ ((scm_ubits_t *) SCM_VELTS (v))[i]);
- }
+ k = SCM_UNPACK (SCM_VELTS (kv)[i]) & (fObj ? SCM_UNPACK(SCM_VELTS (v)[i]) : ~SCM_UNPACK (SCM_VELTS (v)[i]));
}
}
return SCM_MAKINUM (count);
"Modifies @var{bv} by replacing each element with its negation.")
#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);
k = SCM_BITVECTOR_LENGTH (v);
- for (k = (k + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; k--;)
- ((scm_ubits_t *) SCM_VELTS (v))[k] = ~((scm_ubits_t *) SCM_VELTS (v))[k];
+ for (k = (k + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k--;)
+ SCM_UNPACK (SCM_VELTS (v)[k]) = ~SCM_UNPACK (SCM_VELTS (v)[k]);
return SCM_UNSPECIFIED;
}
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_ubits_t *data = (scm_ubits_t *) SCM_VELTS (v);
- register scm_bits_t mask;
- register size_t k;
- register int j;
- for (k = 0; k < (len + SCM_BITS_LENGTH - 1) / SCM_BITS_LENGTH; k++)
+ long *data = (long *) SCM_VELTS (v);
+ register unsigned long mask;
+ register long k;
+ register long j;
+ for (k = 0; k < (len + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k++)
{
data[k] = 0L;
- j = len - k * SCM_BITS_LENGTH;
- if (j > SCM_BITS_LENGTH)
- j = SCM_BITS_LENGTH;
+ j = len - k * SCM_LONG_BIT;
+ if (j > SCM_LONG_BIT)
+ j = SCM_LONG_BIT;
for (mask = 1L; j--; mask <<= 1)
switch (*str++)
{
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_bits_t inc = SCM_ARRAY_DIMS (ra)[k].inc;
- register scm_bits_t i;
+ register long inc = SCM_ARRAY_DIMS (ra)[k].inc;
+ register size_t i;
if (SCM_ARRAY_DIMS (ra)[k].ubnd < SCM_ARRAY_DIMS (ra)[k].lbnd)
return SCM_EOL;
i = base + (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd) * inc;
#define FUNC_NAME s_scm_array_to_list
{
SCM res = SCM_EOL;
- register size_t k;
+ register long k;
SCM_ASRTGO (SCM_NIMP (v), badarg1);
switch SCM_TYP7 (v)
{
return scm_string_to_list (v);
case scm_tc7_bvect:
{
- scm_ubits_t *data = (scm_ubits_t *) SCM_VELTS (v);
- register scm_ubits_t mask;
- for (k = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_BITS_LENGTH; k > 0; k--)
- for (mask = 1UL << (SCM_BITS_LENGTH - 1); mask; mask >>= 1)
- res = scm_cons (SCM_BOOL(data[k] & mask), res);
- for (mask = 1L << ((SCM_BITVECTOR_LENGTH (v) % SCM_BITS_LENGTH) - 1); mask; mask >>= 1)
- res = scm_cons (SCM_BOOL(data[k] & mask), res);
+ long *data = (long *) SCM_VELTS (v);
+ register unsigned long mask;
+ for (k = (SCM_BITVECTOR_LENGTH (v) - 1) / SCM_LONG_BIT; k > 0; k--)
+ for (mask = 1UL << (SCM_LONG_BIT - 1); mask; mask >>= 1)
+ res = scm_cons (SCM_BOOL(((long *) data)[k] & mask), res);
+ for (mask = 1L << ((SCM_BITVECTOR_LENGTH (v) % SCM_LONG_BIT) - 1); mask; mask >>= 1)
+ res = scm_cons (SCM_BOOL(((long *) data)[k] & mask), res);
return res;
}
case scm_tc7_byvect:
{
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)
res = scm_cons (SCM_MAKINUM (data[--k]), res);
return res;
}
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--)
- res = scm_cons(scm_ubits2num(data[k]), res);
+ res = scm_cons(scm_ulong2num(data[k]), res);
return res;
}
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--)
- res = scm_cons(scm_bits2num(data[k]), res);
+ res = scm_cons(scm_long2num(data[k]), res);
return res;
}
case scm_tc7_svect:
#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 ndim, SCM prot, SCM lst),
SCM shp = SCM_EOL;
SCM row = lst;
SCM ra;
- scm_bits_t k;
+ unsigned long k;
long n;
SCM_VALIDATE_INUM_COPY (1,ndim,k);
while (k--)
}
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))
scm_array_set_x (ra, SCM_CAR (lst), SCM_MAKINUM (k));
return ra;
#undef FUNC_NAME
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 scm_bits_t n = (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd);
+ register long inc = SCM_ARRAY_DIMS (ra)[k].inc;
+ register long n = (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd);
int ok = 1;
if (n <= 0)
return (SCM_NULLP (lst));
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;
- scm_bits_t n = (SCM_TYP7 (ra) == scm_tc7_smob
+ long inc = 1;
+ long n = (SCM_TYP7 (ra) == scm_tc7_smob
? 0
: SCM_INUM (scm_uniform_vector_length (ra)));
int enclosed = 0;
}
if (k + 1 < SCM_ARRAY_NDIM (ra))
{
- scm_bits_t i;
+ long i;
inc = SCM_ARRAY_DIMS (ra)[k].inc;
for (i = SCM_ARRAY_DIMS (ra)[k].lbnd; i < SCM_ARRAY_DIMS (ra)[k].ubnd; i++)
{
scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate)
{
SCM v = exp;
- scm_bits_t base = 0;
+ unsigned long base = 0;
scm_putc ('#', port);
tail:
switch SCM_TYP7 (v)
case scm_tc7_bvect:
if (SCM_EQ_P (exp, v))
{ /* a uve, not an scm_array */
- register size_t i;
- register int j;
- scm_ubits_t w;
+ register long i, j, w;
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]);
- for (j = SCM_BITS_LENGTH; j; j--)
+ scm_bits_t w = SCM_UNPACK (SCM_VELTS (exp)[i]);
+ for (j = SCM_LONG_BIT; j; j--)
{
scm_putc (w & 1 ? '1' : '0', port);
w >>= 1;
}
}
- j = SCM_BITVECTOR_LENGTH (exp) % SCM_BITS_LENGTH;
+ j = SCM_BITVECTOR_LENGTH (exp) % SCM_LONG_BIT;
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--)
{
scm_putc (w & 1 ? '1' : '0', port);
typedef struct scm_array_t
{
SCM v; /* the contents of the array, e.g., a vector or uniform vector. */
- scm_bits_t base;
+ unsigned long base;
} scm_array_t;
typedef struct scm_array_dim_t
{
- scm_bits_t lbnd;
- scm_bits_t ubnd;
- scm_bits_t inc;
+ long lbnd;
+ long ubnd;
+ long inc;
} scm_array_dim_t;
#if (SCM_DEBUG_DEPRECATED == 0)
#endif
#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_SET_ARRAY_CONTIGUOUS_FLAG(x) \
(SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) | SCM_ARRAY_FLAG_CONTIGUOUS))
#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_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_SET_UVECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b)))
#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_BITVECTOR_P(x) (!SCM_IMP (x) && (SCM_TYP7 (x) == scm_tc7_bvect))
#define SCM_BITVECTOR_BASE(x) ((void *) (SCM_CELL_WORD_1 (x)))
#define SCM_SET_BITVECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b)))
#define SCM_BITVECTOR_MAX_LENGTH 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))
\f
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_array_p (SCM v, SCM prot);
extern SCM scm_array_rank (SCM ra);
extern SCM scm_shared_array_root (SCM ra);
extern SCM scm_shared_array_offset (SCM ra);
extern SCM scm_shared_array_increments (SCM ra);
-extern 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_shap2ra (SCM args, const char *what);
extern SCM scm_dimensions_to_uniform_array (SCM dims, SCM prot, SCM fill);
extern SCM scm_enclose_array (SCM ra, SCM axes);
extern SCM scm_array_in_bounds_p (SCM v, SCM args);
extern SCM scm_uniform_vector_ref (SCM v, SCM args);
-extern SCM scm_cvref (SCM v, scm_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_contents (SCM ra, SCM strict);
extern SCM scm_ra2contig (SCM ra, int copy);
extern SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj);
extern SCM scm_bit_count_star (SCM v, SCM kv, SCM obj);
extern SCM scm_bit_invert_x (SCM v);
-extern SCM scm_istr2bve (char *str, scm_bits_t len);
+extern SCM scm_istr2bve (char *str, long len);
extern SCM scm_array_to_list (SCM v);
extern SCM scm_list_to_uniform_array (SCM ndim, SCM prot, SCM lst);
extern int scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate);
-/* $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.
*
* This program is free software; you can redistribute it and/or modify
#define SCM_NUM2USHORT_DEF(pos, arg, def) \
(SCM_UNBNDP (arg) ? def : scm_num2ushort (arg, pos, FUNC_NAME))
-#define SCM_NUM2BITS(pos, arg) (scm_num2bits (arg, pos, FUNC_NAME))
-
-#define SCM_NUM2BITS_DEF(pos, arg, def) \
- (SCM_UNBNDP (arg) ? def : scm_num2bits (arg, pos, FUNC_NAME))
-
-#define SCM_NUM2UBITS(pos, arg) (scm_num2ubits (arg, pos, FUNC_NAME))
-
-#define SCM_NUM2UBITS_DEF(pos, arg, def) \
- (SCM_UNBNDP (arg) ? def : scm_num2ubits (arg, pos, FUNC_NAME))
-
#define SCM_NUM2INT(pos, arg) (scm_num2int (arg, pos, FUNC_NAME))
#define SCM_NUM2INT_DEF(pos, arg, def) \
"were not created by @code{call-with-values} is unspecified.")
#define FUNC_NAME s_scm_values
{
- scm_bits_t n;
+ long n;
SCM result;
SCM_VALIDATE_LIST_COPYLEN (1, args, n);
SCM
scm_vector_set_length_x (SCM vect, SCM len)
{
- scm_bits_t l;
+ long l;
size_t siz;
size_t sz;
char *base;
#ifdef HAVE_ARRAYS
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);
if (sz != 0)
{
SCM res;
SCM *data;
- scm_bits_t i;
+ long i;
/* Dirk:FIXME:: In case of multiple threads, the list might get corrupted
while the vector is being created. */
SCM_GASSERT2 (SCM_INUMP (k),
g_vector_ref, v, k, SCM_ARG2, s_vector_ref);
SCM_ASSERT_RANGE (2, k, SCM_INUM (k) < SCM_VECTOR_LENGTH (v) && SCM_INUM (k) >= 0);
- return SCM_VELTS (v)[(ptrdiff_t) SCM_INUM (k)];
+ return SCM_VELTS (v)[(long) SCM_INUM (k)];
}
#undef FUNC_NAME
g_vector_set_x, SCM_LIST3 (v, k, obj),
SCM_ARG2, s_vector_set_x);
SCM_ASSERT_RANGE (2, k, SCM_INUM (k) < SCM_VECTOR_LENGTH (v) && SCM_INUM (k) >= 0);
- SCM_VELTS(v)[(ptrdiff_t) SCM_INUM(k)] = obj;
+ SCM_VELTS(v)[(long) SCM_INUM(k)] = obj;
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
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
{
SCM v;
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);
for (j = 0; j != k; ++j)
#define FUNC_NAME s_scm_vector_to_list
{
SCM res = SCM_EOL;
- scm_bits_t i;
+ long i;
SCM *data;
SCM_VALIDATE_VECTOR (1,v);
data = SCM_VELTS(v);
"returned by @code{vector-fill!} is unspecified.")
#define FUNC_NAME s_scm_vector_fill_x
{
- register scm_bits_t i;
+ register long i;
register SCM *data;
SCM_VALIDATE_VECTOR (1, v);
data = SCM_VELTS (v);
SCM
scm_vector_equal_p(SCM x, SCM y)
{
- scm_bits_t i;
+ long i;
for(i = SCM_VECTOR_LENGTH (x) - 1; i >= 0; i--)
if (SCM_FALSEP (scm_equal_p (SCM_VELTS (x)[i], SCM_VELTS (y)[i])))
return SCM_BOOL_F;
"Vector version of @code{substring-move-left!}.")
#define FUNC_NAME s_scm_vector_move_left_x
{
- scm_bits_t i;
- scm_bits_t j;
- scm_bits_t e;
+ long i;
+ long j;
+ long e;
SCM_VALIDATE_VECTOR (1,vec1);
SCM_VALIDATE_INUM_COPY (2,start1,i);
"Vector version of @code{substring-move-right!}.")
#define FUNC_NAME s_scm_vector_move_right_x
{
- scm_bits_t i;
- scm_bits_t j;
- scm_bits_t e;
+ long i;
+ long j;
+ long e;
SCM_VALIDATE_VECTOR (1,vec1);
SCM_VALIDATE_INUM_COPY (2,start1,i);
#define SCM_VECTOR_BASE(x) ((scm_bits_t *) SCM_CELL_WORD_1 (x))
#define SCM_SET_VECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b)))
#define SCM_VECTOR_MAX_LENGTH ((1L << 24) - 1)
-#define SCM_VECTOR_LENGTH(x) (((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_VELTS(x) ((SCM *) SCM_CELL_WORD_1 (x))
/*
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_SET(a, i) SCM_UNPACK(SCM_VELTS(a)[(i)/SCM_BITS_LENGTH]) |= (1L<<((i)%SCM_BITS_LENGTH))
-#define SCM_BITVEC_CLR(a, i) SCM_UNPACK(SCM_VELTS(a)[(i)/SCM_BITS_LENGTH]) &= ~(1L<<((i)%SCM_BITS_LENGTH))
+#define SCM_BITVEC_REF(a, i) ((SCM_UNPACK(SCM_VELTS(a)[(i)/SCM_LONG_BIT]) & (1L<<((i)%SCM_LONG_BIT))) ? 1 : 0)
+#define SCM_BITVEC_SET(a, i) SCM_UNPACK(SCM_VELTS(a)[(i)/SCM_LONG_BIT]) |= (1L<<((i)%SCM_LONG_BIT))
+#define SCM_BITVEC_CLR(a, i) SCM_UNPACK(SCM_VELTS(a)[(i)/SCM_LONG_BIT]) &= ~(1L<<((i)%SCM_LONG_BIT))
\f
-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_length (SCM v);
{
SCM res;
SCM *data;
- scm_bits_t i;
+ long i;
/* Dirk:FIXME:: In case of multiple threads, the list might get corrupted
while the vector is being created. */
{
SCM *ptr;
SCM obj;
- scm_bits_t j, n;
+ long j;
+ long n;
obj = w;
ptr = SCM_VELTS (w);
else /* if (SCM_IS_WHVEC_ANY (scm_weak_vectors[i])) */
{
SCM obj = w;
- register scm_bits_t n = SCM_VECTOR_LENGTH (w);
- register scm_bits_t j;
+ register long n = SCM_VECTOR_LENGTH (w);
+ register long j;
int weak_keys = SCM_IS_WHVEC (obj) || SCM_IS_WHVEC_B (obj);
int weak_values = SCM_IS_WHVEC_V (obj) || SCM_IS_WHVEC_B (obj);
HCoop / bpt / guile.git / commitdiff