mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00
Code Activity

2002-07-20 Han-Wen <hanwen@cs.uu.nl>

Browse source 
* *.c: add space after commas everywhere.

* *.c: use SCM_VECTOR_SET everywhere, where a vector is written.
Document cases where SCM_WRITABLE_VELTS() is used.

* vectors.h (SCM_VELTS): prepare for write barrier, and let
SCM_VELTS() return a const pointer
(SCM_VECTOR_SET): add macro.

* autogen.sh (mscripts): find and check version number of
autoconf. Complain if 2.53 is not found.
This commit is contained in:
Han-Wen Nienhuys 2002-07-20 14:08:34 +00:00
parent dd897aafbd
commit 34d19ef643
67 changed files with 739 additions and 615 deletions
Download patch file Download diff file Expand all files Collapse all files

5
ChangeLog
View file

@ -1,3 +1,8 @@
2002-07-20 Han-Wen <hanwen@cs.uu.nl>
* autogen.sh (mscripts): find and check version number of
autoconf. Complain if 2.53 is not found.
2002-07-20 Dirk Herrmann <D.Herrmann@tu-bs.de> 2002-07-20 Dirk Herrmann <D.Herrmann@tu-bs.de>
* benchmark-guile.in: Copied from check-guile.in and adapted for * benchmark-guile.in: Copied from check-guile.in and adapted for

22
autogen.sh
View file

@ -85,8 +85,26 @@ fi
###################################################################### ######################################################################
autoheader
autoconf # configure.in reqs autoconf-2.53; try to find it
for suf in "-2.53" "2.53" "" false; do
version=`autoconf$suf --version 2>/dev/null | head -1 | awk '{print $NF}' | awk -F. '{print $1 * 100 + $2}'`
if test "0$version" -eq 253; then
autoconf=autoconf$suf
autoheader=autoheader$suf
break
fi
done
if test -z "$autoconf"; then
echo "ERROR: Please install autoconf 2.53"
exit 1
fi
################################################################
$autoheader
$autoconf
# Automake has a bug that will let it only add one copy of a missing # Automake has a bug that will let it only add one copy of a missing
# file. We need two mdate-sh, tho, one in doc/ref/ and one in # file. We need two mdate-sh, tho, one in doc/ref/ and one in

11
libguile/ChangeLog
View file

@ -1,3 +1,14 @@
2002-07-20 Han-Wen <hanwen@cs.uu.nl>
* *.c: add space after commas everywhere.
* *.c: use SCM_VECTOR_SET everywhere, where a vector is written.
Document cases where SCM_WRITABLE_VELTS() is used.
* vectors.h (SCM_VELTS): prepare for write barrier, and let
SCM_VELTS() return a const pointer
(SCM_VECTOR_SET): add macro.
2002-07-15 Dirk Herrmann <D.Herrmann@tu-bs.de> 2002-07-15 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (SCM_CEVAL), macros.c (macro_print, scm_makmacro, * eval.c (SCM_CEVAL), macros.c (macro_print, scm_makmacro,

8
libguile/convert.i.c
View file

@ -245,17 +245,17 @@ SCM
CTYPES2SCM (const CTYPE *data, long n) CTYPES2SCM (const CTYPE *data, long n)
{ {
long i; long i;
SCM v, *velts; SCM v;
SCM_ASSERT_RANGE (SCM_ARG2, scm_long2num (n), SCM_ASSERT_RANGE (SCM_ARG2, scm_long2num (n),
n > 0 && n <= SCM_VECTOR_MAX_LENGTH); n > 0 && n <= SCM_VECTOR_MAX_LENGTH);
v = scm_c_make_vector (n, SCM_UNSPECIFIED); v = scm_c_make_vector (n, SCM_UNSPECIFIED);
velts = SCM_VELTS (v);
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
#ifdef FLOATTYPE #ifdef FLOATTYPE
velts[i] = scm_make_real ((double) data[i]); SCM_VECTOR_SET (v, i, scm_make_real ((double) data[i]));
#else #else
velts[i] = SCM_MAKINUM (data[i]); SCM_VECTOR_SET (v, i, SCM_MAKINUM (data[i]));
#endif #endif
return v; return v;
} }

74
libguile/environments.c
View file

@ -533,7 +533,7 @@ obarray_enter (SCM obarray, SCM symbol, SCM data)
size_t hash = SCM_SYMBOL_HASH (symbol) % SCM_VECTOR_LENGTH (obarray); size_t hash = SCM_SYMBOL_HASH (symbol) % SCM_VECTOR_LENGTH (obarray);
SCM entry = scm_cons (symbol, data); SCM entry = scm_cons (symbol, data);
SCM slot = scm_cons (entry, SCM_VELTS (obarray)[hash]); SCM slot = scm_cons (entry, SCM_VELTS (obarray)[hash]);
SCM_VELTS (obarray)[hash] = slot; SCM_VECTOR_SET (obarray, hash, slot);
return entry; return entry;
} }
@ -562,7 +562,7 @@ obarray_replace (SCM obarray, SCM symbol, SCM data)
} }
slot = scm_cons (new_entry, SCM_VELTS (obarray)[hash]); slot = scm_cons (new_entry, SCM_VELTS (obarray)[hash]);
SCM_VELTS (obarray)[hash] = slot; SCM_VECTOR_SET (obarray, hash, slot);
return SCM_BOOL_F; return SCM_BOOL_F;
} }
@ -587,6 +587,46 @@ obarray_retrieve (SCM obarray, SCM sym)
return SCM_UNDEFINED; return SCM_UNDEFINED;
} }
/*
Remove first occurance of KEY from (cdr ALIST),
return (KEY . VAL) if found, otherwise return #f
PRECONDITION:
length (ALIST) >= 1
*/
static
SCM
remove_key_from_alist (SCM alist, SCM key)
{
SCM cell_cdr = alist;
alist =SCM_CDR (alist);
/*
inv: cdr(cell_cdr) == alist
*/
while (!SCM_NULLP (alist))
{
if (SCM_EQ_P(SCM_CAAR (alist), key))
{
SCM entry = SCM_CAR(alist);
SCM_SETCDR(cell_cdr, SCM_CDR (alist));
return entry;
}
else
{
cell_cdr = SCM_CDR (cell_cdr);
}
if (!SCM_NULLP(alist))
alist = SCM_CDR (alist);
}
return SCM_BOOL_F;
}
/* /*
* Remove entry from obarray. If the symbol was found and removed, the old * Remove entry from obarray. If the symbol was found and removed, the old
@ -596,22 +636,20 @@ static SCM
obarray_remove (SCM obarray, SCM sym) obarray_remove (SCM obarray, SCM sym)
{ {
size_t hash = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (obarray); size_t hash = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (obarray);
SCM lsym; SCM table_entry = SCM_VELTS (obarray)[hash];
SCM *lsymp;
/* Dirk:FIXME:: gc problem due to use of &SCM_VELTS[hash] */ if (SCM_NULLP(table_entry))
for (lsym = *(lsymp = &SCM_VELTS (obarray)[hash]);
!SCM_NULLP (lsym);
lsym = *(lsymp = SCM_CDRLOC (lsym)))
{
SCM entry = SCM_CAR (lsym);
if (SCM_EQ_P (SCM_CAR (entry), sym))
{
*lsymp = SCM_CDR (lsym);
return entry;
}
}
return SCM_BOOL_F; return SCM_BOOL_F;
if (SCM_EQ_P (SCM_CAAR (table_entry), sym))
{
SCM_VECTOR_SET (obarray, hash, SCM_CDR(table_entry));
return SCM_CAR(table_entry);
}
else
{
return remove_key_from_alist (table_entry, sym);
}
} }
@ -623,7 +661,7 @@ obarray_remove_all (SCM obarray)
for (i = 0; i < size; i++) for (i = 0; i < size; i++)
{ {
SCM_VELTS (obarray)[i] = SCM_EOL; SCM_VECTOR_SET (obarray, i, SCM_EOL);
} }
} }
@ -655,7 +693,7 @@ struct core_environments_base {
#define CORE_ENVIRONMENT_WEAK_OBSERVERS(env) \ #define CORE_ENVIRONMENT_WEAK_OBSERVERS(env) \
(SCM_VELTS (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env)) [0]) (SCM_VELTS (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env)) [0])
#define SCM_SET_CORE_ENVIRONMENT_WEAK_OBSERVERS(env, v) \ #define SCM_SET_CORE_ENVIRONMENT_WEAK_OBSERVERS(env, v) \
(SCM_VELTS (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env)) [0] = (v)) (SCM_VECTOR_SET (CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env), 0, (v)))

14
libguile/eval.c
View file

@ -798,7 +798,7 @@ iqq (SCM form, SCM env, unsigned long int depth)
else if (SCM_VECTORP (form)) else if (SCM_VECTORP (form))
{ {
size_t i = SCM_VECTOR_LENGTH (form); size_t i = SCM_VECTOR_LENGTH (form);
SCM *data = SCM_VELTS (form); SCM const *data = SCM_VELTS (form);
SCM tmp = SCM_EOL; SCM tmp = SCM_EOL;
while (i != 0) while (i != 0)
tmp = scm_cons (data[--i], tmp); tmp = scm_cons (data[--i], tmp);
@ -3792,7 +3792,7 @@ check_map_args (SCM argv,
SCM args, SCM args,
const char *who) const char *who)
{ {
SCM *ve = SCM_VELTS (argv); SCM const *ve = SCM_VELTS (argv);
long i; long i;
for (i = SCM_VECTOR_LENGTH (argv) - 1; i >= 1; i--) for (i = SCM_VECTOR_LENGTH (argv) - 1; i >= 1; i--)
@ -3831,7 +3831,7 @@ scm_map (SCM proc, SCM arg1, SCM args)
long i, len; long i, len;
SCM res = SCM_EOL; SCM res = SCM_EOL;
SCM *pres = &res; SCM *pres = &res;
SCM *ve = &args; /* Keep args from being optimized away. */ SCM const *ve = &args; /* Keep args from being optimized away. */
len = scm_ilength (arg1); len = scm_ilength (arg1);
SCM_GASSERTn (len >= 0, SCM_GASSERTn (len >= 0,
@ -3858,7 +3858,7 @@ scm_map (SCM proc, SCM arg1, SCM args)
if (SCM_IMP (ve[i])) if (SCM_IMP (ve[i]))
return res; return res;
arg1 = scm_cons (SCM_CAR (ve[i]), arg1); arg1 = scm_cons (SCM_CAR (ve[i]), arg1);
ve[i] = SCM_CDR (ve[i]); SCM_VECTOR_SET (args, i, SCM_CDR (ve[i]));
} }
*pres = scm_list_1 (scm_apply (proc, arg1, SCM_EOL)); *pres = scm_list_1 (scm_apply (proc, arg1, SCM_EOL));
pres = SCM_CDRLOC (*pres); pres = SCM_CDRLOC (*pres);
@ -3873,7 +3873,7 @@ SCM
scm_for_each (SCM proc, SCM arg1, SCM args) scm_for_each (SCM proc, SCM arg1, SCM args)
#define FUNC_NAME s_for_each #define FUNC_NAME s_for_each
{ {
SCM *ve = &args; /* Keep args from being optimized away. */ SCM const *ve = &args; /* Keep args from being optimized away. */
long i, len; long i, len;
len = scm_ilength (arg1); len = scm_ilength (arg1);
SCM_GASSERTn (len >= 0, g_for_each, scm_cons2 (proc, arg1, args), SCM_GASSERTn (len >= 0, g_for_each, scm_cons2 (proc, arg1, args),
@ -3899,7 +3899,7 @@ scm_for_each (SCM proc, SCM arg1, SCM args)
if (SCM_IMP (ve[i])) if (SCM_IMP (ve[i]))
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
arg1 = scm_cons (SCM_CAR (ve[i]), arg1); arg1 = scm_cons (SCM_CAR (ve[i]), arg1);
ve[i] = SCM_CDR (ve[i]); SCM_VECTOR_SET (args, i, SCM_CDR (ve[i]));
} }
scm_apply (proc, arg1, SCM_EOL); scm_apply (proc, arg1, SCM_EOL);
} }
@ -4011,7 +4011,7 @@ SCM_DEFINE (scm_copy_tree, "copy-tree", 1, 0, 0,
unsigned long i = SCM_VECTOR_LENGTH (obj); unsigned long i = SCM_VECTOR_LENGTH (obj);
ans = scm_c_make_vector (i, SCM_UNSPECIFIED); ans = scm_c_make_vector (i, SCM_UNSPECIFIED);
while (i--) while (i--)
SCM_VELTS (ans)[i] = scm_copy_tree (SCM_VELTS (obj)[i]); SCM_VECTOR_SET (ans, i, scm_copy_tree (SCM_VELTS (obj)[i]));
return ans; return ans;
} }
if (!SCM_CONSP (obj)) if (!SCM_CONSP (obj))

57
libguile/filesys.c
View file

@ -448,58 +448,57 @@ static SCM
scm_stat2scm (struct stat *stat_temp) scm_stat2scm (struct stat *stat_temp)
{ {
SCM ans = scm_c_make_vector (15, SCM_UNSPECIFIED); SCM ans = scm_c_make_vector (15, SCM_UNSPECIFIED);
SCM *ve = SCM_VELTS (ans);
ve[0] = scm_ulong2num ((unsigned long) stat_temp->st_dev); SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) stat_temp->st_dev));
ve[1] = scm_ulong2num ((unsigned long) stat_temp->st_ino); SCM_VECTOR_SET(ans, 1, scm_ulong2num ((unsigned long) stat_temp->st_ino));
ve[2] = scm_ulong2num ((unsigned long) stat_temp->st_mode); SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) stat_temp->st_mode));
ve[3] = scm_ulong2num ((unsigned long) stat_temp->st_nlink); SCM_VECTOR_SET(ans, 3, scm_ulong2num ((unsigned long) stat_temp->st_nlink));
ve[4] = scm_ulong2num ((unsigned long) stat_temp->st_uid); SCM_VECTOR_SET(ans, 4, scm_ulong2num ((unsigned long) stat_temp->st_uid));
ve[5] = scm_ulong2num ((unsigned long) stat_temp->st_gid); SCM_VECTOR_SET(ans, 5, scm_ulong2num ((unsigned long) stat_temp->st_gid));
#ifdef HAVE_STRUCT_STAT_ST_RDEV #ifdef HAVE_STRUCT_STAT_ST_RDEV
ve[6] = scm_ulong2num ((unsigned long) stat_temp->st_rdev); SCM_VECTOR_SET(ans, 6, scm_ulong2num ((unsigned long) stat_temp->st_rdev));
#else #else
ve[6] = SCM_BOOL_F; SCM_VECTOR_SET(ans, 6, SCM_BOOL_F);
#endif #endif
ve[7] = scm_ulong2num ((unsigned long) stat_temp->st_size); SCM_VECTOR_SET(ans, 7, scm_ulong2num ((unsigned long) stat_temp->st_size));
ve[8] = scm_ulong2num ((unsigned long) stat_temp->st_atime); SCM_VECTOR_SET(ans, 8, scm_ulong2num ((unsigned long) stat_temp->st_atime));
ve[9] = scm_ulong2num ((unsigned long) stat_temp->st_mtime); SCM_VECTOR_SET(ans, 9, scm_ulong2num ((unsigned long) stat_temp->st_mtime));
ve[10] = scm_ulong2num ((unsigned long) stat_temp->st_ctime); SCM_VECTOR_SET(ans, 10, scm_ulong2num ((unsigned long) stat_temp->st_ctime));
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
ve[11] = scm_ulong2num ((unsigned long) stat_temp->st_blksize); SCM_VECTOR_SET(ans, 11, scm_ulong2num ((unsigned long) stat_temp->st_blksize));
#else #else
ve[11] = scm_ulong2num (4096L); SCM_VECTOR_SET(ans, 11, scm_ulong2num (4096L));
#endif #endif
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS #ifdef HAVE_STRUCT_STAT_ST_BLOCKS
ve[12] = scm_ulong2num ((unsigned long) stat_temp->st_blocks); SCM_VECTOR_SET(ans, 12, scm_ulong2num ((unsigned long) stat_temp->st_blocks));
#else #else
ve[12] = SCM_BOOL_F; SCM_VECTOR_SET(ans, 12, SCM_BOOL_F);
#endif #endif
{ {
int mode = stat_temp->st_mode; int mode = stat_temp->st_mode;
if (S_ISREG (mode)) if (S_ISREG (mode))
ve[13] = scm_sym_regular; SCM_VECTOR_SET(ans, 13, scm_sym_regular);
else if (S_ISDIR (mode)) else if (S_ISDIR (mode))
ve[13] = scm_sym_directory; SCM_VECTOR_SET(ans, 13, scm_sym_directory);
#ifdef HAVE_S_ISLNK #ifdef HAVE_S_ISLNK
else if (S_ISLNK (mode)) else if (S_ISLNK (mode))
ve[13] = scm_sym_symlink; SCM_VECTOR_SET(ans, 13, scm_sym_symlink);
#endif #endif
else if (S_ISBLK (mode)) else if (S_ISBLK (mode))
ve[13] = scm_sym_block_special; SCM_VECTOR_SET(ans, 13, scm_sym_block_special);
else if (S_ISCHR (mode)) else if (S_ISCHR (mode))
ve[13] = scm_sym_char_special; SCM_VECTOR_SET(ans, 13, scm_sym_char_special);
else if (S_ISFIFO (mode)) else if (S_ISFIFO (mode))
ve[13] = scm_sym_fifo; SCM_VECTOR_SET(ans, 13, scm_sym_fifo);
#ifdef S_ISSOCK #ifdef S_ISSOCK
else if (S_ISSOCK (mode)) else if (S_ISSOCK (mode))
ve[13] = scm_sym_sock; SCM_VECTOR_SET(ans, 13, scm_sym_sock);
#endif #endif
else else
ve[13] = scm_sym_unknown; SCM_VECTOR_SET(ans, 13, scm_sym_unknown);
ve[14] = SCM_MAKINUM ((~S_IFMT) & mode); SCM_VECTOR_SET(ans, 14, SCM_MAKINUM ((~S_IFMT) & mode));
/* the layout of the bits in ve[14] is intended to be portable. /* the layout of the bits in ve[14] is intended to be portable.
If there are systems that don't follow the usual convention, If there are systems that don't follow the usual convention,
@ -528,7 +527,7 @@ scm_stat2scm (struct stat *stat_temp)
tmp <<= 1; tmp <<= 1;
if (S_IXOTH & mode) tmp += 1; if (S_IXOTH & mode) tmp += 1;
ve[14] = SCM_MAKINUM (tmp); SCM_VECTOR_SET(ans, 14, SCM_MAKINUM (tmp));
*/ */
} }
@ -1021,7 +1020,7 @@ fill_select_type (SELECT_TYPE *set, SCM *ports_ready, SCM list_or_vec, int pos)
if (SCM_VECTORP (list_or_vec)) if (SCM_VECTORP (list_or_vec))
{ {
int i = SCM_VECTOR_LENGTH (list_or_vec); int i = SCM_VECTOR_LENGTH (list_or_vec);
SCM *ve = SCM_VELTS (list_or_vec); SCM const *ve = SCM_VELTS (list_or_vec);
while (--i >= 0) while (--i >= 0)
{ {
@ -1082,7 +1081,7 @@ retrieve_select_type (SELECT_TYPE *set, SCM ports_ready, SCM list_or_vec)
if (SCM_VECTORP (list_or_vec)) if (SCM_VECTORP (list_or_vec))
{ {
int i = SCM_VECTOR_LENGTH (list_or_vec); int i = SCM_VECTOR_LENGTH (list_or_vec);
SCM *ve = SCM_VELTS (list_or_vec); SCM const *ve = SCM_VELTS (list_or_vec);
while (--i >= 0) while (--i >= 0)
{ {

6
libguile/fluids.c
View file

@ -76,12 +76,12 @@ grow_fluids (scm_root_state *root_state, int new_length)
i = 0; i = 0;
while (i < old_length) while (i < old_length)
{ {
SCM_VELTS(new_fluids)[i] = SCM_VELTS(old_fluids)[i]; SCM_VECTOR_SET (new_fluids, i, SCM_VELTS(old_fluids)[i]);
i++; i++;
} }
while (i < new_length) while (i < new_length)
{ {
SCM_VELTS(new_fluids)[i] = SCM_BOOL_F; SCM_VECTOR_SET (new_fluids, i, SCM_BOOL_F);
i++; i++;
} }
@ -171,7 +171,7 @@ SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0,
if (SCM_VECTOR_LENGTH (scm_root->fluids) <= n) if (SCM_VECTOR_LENGTH (scm_root->fluids) <= n)
grow_fluids (scm_root, n+1); grow_fluids (scm_root, n+1);
SCM_VELTS (scm_root->fluids)[n] = value; SCM_VECTOR_SET (scm_root->fluids, n, value);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME

19
libguile/gc.h
View file

@ -80,9 +80,24 @@ typedef scm_t_cell * SCM_CELLPTR;
# define PTR2SCM(x) (SCM_PACK ((scm_t_bits) (x))) # define PTR2SCM(x) (SCM_PACK ((scm_t_bits) (x)))
#endif /* def _UNICOS */ #endif /* def _UNICOS */
#ifdef GENGC
/*
TODO
*/
#else /* ! genGC */
#define SCM_GC_CARD_N_HEADER_CELLS 1 #define SCM_GC_CARD_N_HEADER_CELLS 1
#define SCM_GC_CARD_N_CELLS 256 #define SCM_GC_CARD_N_CELLS 256
#define SCM_GC_CARD_GENERATION(card)
#define SCM_GC_FLAG_OBJECT_WRITE(x)
#define SCM_GC_CARD_BVEC(card) ((scm_t_c_bvec_limb *) ((card)->word_0))
#define SCM_GC_SET_CARD_BVEC(card, bvec) \
((card)->word_0 = (scm_t_bits) (bvec))
#endif
#define SCM_GC_CARD_SIZE (SCM_GC_CARD_N_CELLS * sizeof (scm_t_cell)) #define SCM_GC_CARD_SIZE (SCM_GC_CARD_N_CELLS * sizeof (scm_t_cell))
#define SCM_GC_CARD_N_DATA_CELLS (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS) #define SCM_GC_CARD_N_DATA_CELLS (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS)
@ -92,10 +107,6 @@ typedef scm_t_cell * SCM_CELLPTR;
#define SCM_GC_IN_CARD_HEADERP(x) \ #define SCM_GC_IN_CARD_HEADERP(x) \
SCM_PTR_LT ((scm_t_cell *) (x), SCM_GC_CELL_CARD (x) + SCM_GC_CARD_N_HEADER_CELLS) SCM_PTR_LT ((scm_t_cell *) (x), SCM_GC_CELL_CARD (x) + SCM_GC_CARD_N_HEADER_CELLS)
#define SCM_GC_CARD_BVEC(card) ((scm_t_c_bvec_limb *) ((card)->word_0))
#define SCM_GC_SET_CARD_BVEC(card, bvec) \
((card)->word_0 = (scm_t_bits) (bvec))
#define SCM_GC_GET_CARD_FLAGS(card) ((long) ((card)->word_1)) #define SCM_GC_GET_CARD_FLAGS(card) ((long) ((card)->word_1))
#define SCM_GC_SET_CARD_FLAGS(card, flags) \ #define SCM_GC_SET_CARD_FLAGS(card, flags) \
((card)->word_1 = (scm_t_bits) (flags)) ((card)->word_1 = (scm_t_bits) (flags))

7
libguile/gh_data.c
View file

@ -122,10 +122,8 @@ gh_ints2scm (const int *d, long n)
{ {
long i; long i;
SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED); SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED);
SCM *velts = SCM_VELTS(v);
for (i = 0; i < n; ++i) for (i = 0; i < n; ++i)
velts[i] = (SCM_FIXABLE (d[i]) ? SCM_MAKINUM (d[i]) : scm_i_long2big (d[i])); SCM_VECTOR_SET (v, i, (SCM_FIXABLE (d[i]) ? SCM_MAKINUM (d[i]) : scm_i_long2big (d[i])));
return v; return v;
} }
@ -135,10 +133,9 @@ gh_doubles2scm (const double *d, long n)
{ {
long i; long i;
SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED); SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED);
SCM *velts = SCM_VELTS(v);
for(i = 0; i < n; i++) for(i = 0; i < n; i++)
velts[i] = scm_make_real (d[i]); SCM_VECTOR_SET (v, i, scm_make_real (d[i]));
return v; return v;
} }

32
libguile/goops.c
View file

@ -1684,7 +1684,7 @@ applicablep (SCM actual, SCM formal)
} }
static int static int
more_specificp (SCM m1, SCM m2, SCM *targs) more_specificp (SCM m1, SCM m2, SCM const *targs)
{ {
register SCM s1, s2; register SCM s1, s2;
register long i; register long i;
@ -1731,13 +1731,13 @@ scm_i_vector2list (SCM l, long len)
SCM z = scm_c_make_vector (len, SCM_UNDEFINED); SCM z = scm_c_make_vector (len, SCM_UNDEFINED);
for (j = 0; j < len; j++, l = SCM_CDR (l)) { for (j = 0; j < len; j++, l = SCM_CDR (l)) {
SCM_VELTS (z)[j] = SCM_CAR (l); SCM_VECTOR_SET (z, j, SCM_CAR (l));
} }
return z; return z;
} }
static SCM static SCM
sort_applicable_methods (SCM method_list, long size, SCM *targs) sort_applicable_methods (SCM method_list, long size, SCM const *targs)
{ {
long i, j, incr; long i, j, incr;
SCM *v, vector = SCM_EOL; SCM *v, vector = SCM_EOL;
@ -1761,7 +1761,13 @@ sort_applicable_methods (SCM method_list, long size, SCM *targs)
{ {
/* Too many elements in method_list to keep everything locally */ /* Too many elements in method_list to keep everything locally */
vector = scm_i_vector2list (save, size); vector = scm_i_vector2list (save, size);
v = SCM_VELTS (vector);
/*
This is a new vector. Don't worry about the write barrier.
We're not allocating elements in this routine, so this should
pose no problem.
*/
v = SCM_WRITABLE_VELTS (vector);
} }
/* Use a simple shell sort since it is generally faster than qsort on /* Use a simple shell sort since it is generally faster than qsort on
@ -1807,8 +1813,10 @@ scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p)
long count = 0; long count = 0;
SCM l, fl, applicable = SCM_EOL; SCM l, fl, applicable = SCM_EOL;
SCM save = args; SCM save = args;
SCM buffer[BUFFSIZE], *types, *p; SCM buffer[BUFFSIZE];
SCM tmp; SCM const *types;
SCM *p;
SCM tmp = SCM_EOL;
/* Build the list of arguments types */ /* Build the list of arguments types */
if (len >= BUFFSIZE) { if (len >= BUFFSIZE) {
@ -1816,7 +1824,13 @@ scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p)
/* NOTE: Using pointers to malloced memory won't work if we /* NOTE: Using pointers to malloced memory won't work if we
1. have preemtive threading, and, 1. have preemtive threading, and,
2. have a GC which moves objects. */ 2. have a GC which moves objects. */
types = p = SCM_VELTS(tmp); types = p = SCM_WRITABLE_VELTS(tmp);
/*
note that we don't have to work to reset the generation
count. TMP is a new vector anyway, and it is found
conservatively.
*/
} }
else else
types = p = buffer; types = p = buffer;
@ -1857,6 +1871,8 @@ scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p)
/* if we are here, it's because no-applicable-method hasn't signaled an error */ /* if we are here, it's because no-applicable-method hasn't signaled an error */
return SCM_BOOL_F; return SCM_BOOL_F;
} }
scm_remember_upto_here (tmp);
return (count == 1 return (count == 1
? applicable ? applicable
: sort_applicable_methods (applicable, count, types)); : sort_applicable_methods (applicable, count, types));
@ -2135,7 +2151,7 @@ SCM_DEFINE (scm_sys_method_more_specific_p, "%method-more-specific?", 3, 0, 0,
for (i = 0, l = targs; !SCM_NULLP (l); i++, l = SCM_CDR (l)) { for (i = 0, l = targs; !SCM_NULLP (l); i++, l = SCM_CDR (l)) {
SCM_ASSERT (SCM_CLASSP (SCM_CAR (l)), targs, SCM_ARG3, FUNC_NAME); SCM_ASSERT (SCM_CLASSP (SCM_CAR (l)), targs, SCM_ARG3, FUNC_NAME);
SCM_VELTS(v)[i] = SCM_CAR(l); SCM_VECTOR_SET (v, i, SCM_CAR(l));
} }
return more_specificp (m1, m2, SCM_VELTS(v)) ? SCM_BOOL_T: SCM_BOOL_F; return more_specificp (m1, m2, SCM_VELTS(v)) ? SCM_BOOL_T: SCM_BOOL_F;
} }

2
libguile/hash.c
View file

@ -145,7 +145,7 @@ scm_hasher(SCM obj, unsigned long n, size_t d)
case scm_tc7_vector: case scm_tc7_vector:
{ {
size_t len = SCM_VECTOR_LENGTH(obj); size_t len = SCM_VECTOR_LENGTH(obj);
SCM *data = SCM_VELTS(obj); SCM const *data = SCM_VELTS(obj);
if (len > 5) if (len > 5)
{ {
size_t i = d/2; size_t i = d/2;

4
libguile/hashtab.c
View file

@ -107,7 +107,7 @@ scm_hash_fn_create_handle_x (SCM table,SCM obj,SCM init,unsigned long (*hash_fn)
SCM old_bucket; SCM old_bucket;
old_bucket = SCM_VELTS (table)[k]; old_bucket = SCM_VELTS (table)[k];
new_bucket = scm_acons (obj, init, old_bucket); new_bucket = scm_acons (obj, init, old_bucket);
SCM_VELTS(table)[k] = new_bucket; SCM_VECTOR_SET (table, k, new_bucket);
SCM_REALLOW_INTS; SCM_REALLOW_INTS;
return SCM_CAR (new_bucket); return SCM_CAR (new_bucket);
} }
@ -158,7 +158,7 @@ scm_hash_fn_remove_x (SCM table,SCM obj,unsigned long (*hash_fn)(),SCM (*assoc_f
if (k >= SCM_VECTOR_LENGTH (table)) if (k >= SCM_VECTOR_LENGTH (table))
scm_out_of_range ("hash_fn_remove_x", scm_ulong2num (k)); scm_out_of_range ("hash_fn_remove_x", scm_ulong2num (k));
h = assoc_fn (obj, SCM_VELTS (table)[k], closure); h = assoc_fn (obj, SCM_VELTS (table)[k], closure);
SCM_VELTS(table)[k] = delete_fn (h, SCM_VELTS(table)[k]); SCM_VECTOR_SET (table, k, delete_fn (h, SCM_VELTS(table)[k]));
return h; return h;
} }

43
libguile/net_db.c
View file

@ -154,7 +154,7 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
#define FUNC_NAME s_scm_gethost #define FUNC_NAME s_scm_gethost
{ {
SCM ans = scm_c_make_vector (5, SCM_UNSPECIFIED); SCM ans = scm_c_make_vector (5, SCM_UNSPECIFIED);
SCM *ve = SCM_VELTS (ans); SCM *ve = SCM_WRITABLE_VELTS (ans);
SCM lst = SCM_EOL; SCM lst = SCM_EOL;
struct hostent *entry; struct hostent *entry;
struct in_addr inad; struct in_addr inad;
@ -190,13 +190,13 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
if (!entry) if (!entry)
scm_resolv_error (FUNC_NAME, host); scm_resolv_error (FUNC_NAME, host);
ve[0] = scm_mem2string (entry->h_name, strlen (entry->h_name)); SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->h_name, strlen (entry->h_name)));
ve[1] = scm_makfromstrs (-1, entry->h_aliases); SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->h_aliases));
ve[2] = SCM_MAKINUM (entry->h_addrtype + 0L); SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (entry->h_addrtype + 0L));
ve[3] = SCM_MAKINUM (entry->h_length + 0L); SCM_VECTOR_SET(ans, 3, SCM_MAKINUM (entry->h_length + 0L));
if (sizeof (struct in_addr) != entry->h_length) if (sizeof (struct in_addr) != entry->h_length)
{ {
ve[4] = SCM_BOOL_F; SCM_VECTOR_SET(ans, 4, SCM_BOOL_F);
return ans; return ans;
} }
for (argv = entry->h_addr_list; argv[i]; i++); for (argv = entry->h_addr_list; argv[i]; i++);
@ -205,7 +205,7 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
inad = *(struct in_addr *) argv[i]; inad = *(struct in_addr *) argv[i];
lst = scm_cons (scm_ulong2num (ntohl (inad.s_addr)), lst); lst = scm_cons (scm_ulong2num (ntohl (inad.s_addr)), lst);
} }
ve[4] = lst; SCM_VECTOR_SET(ans, 4, lst);
return ans; return ans;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -237,7 +237,8 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0,
struct netent *entry; struct netent *entry;
ans = scm_c_make_vector (4, SCM_UNSPECIFIED); ans = scm_c_make_vector (4, SCM_UNSPECIFIED);
ve = SCM_VELTS (ans); ve = SCM_WRITABLE_VELTS (ans);
if (SCM_UNBNDP (net)) if (SCM_UNBNDP (net))
{ {
entry = getnetent (); entry = getnetent ();
@ -261,10 +262,10 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0,
} }
if (!entry) if (!entry)
SCM_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), errno); SCM_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), errno);
ve[0] = scm_mem2string (entry->n_name, strlen (entry->n_name)); SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->n_name, strlen (entry->n_name)));
ve[1] = scm_makfromstrs (-1, entry->n_aliases); SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->n_aliases));
ve[2] = SCM_MAKINUM (entry->n_addrtype + 0L); SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (entry->n_addrtype + 0L));
ve[3] = scm_ulong2num (entry->n_net + 0L); SCM_VECTOR_SET(ans, 3, scm_ulong2num (entry->n_net + 0L));
return ans; return ans;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -286,7 +287,7 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
struct protoent *entry; struct protoent *entry;
ans = scm_c_make_vector (3, SCM_UNSPECIFIED); ans = scm_c_make_vector (3, SCM_UNSPECIFIED);
ve = SCM_VELTS (ans); ve = SCM_WRITABLE_VELTS (ans);
if (SCM_UNBNDP (protocol)) if (SCM_UNBNDP (protocol))
{ {
entry = getprotoent (); entry = getprotoent ();
@ -310,9 +311,9 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
} }
if (!entry) if (!entry)
SCM_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), errno); SCM_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), errno);
ve[0] = scm_mem2string (entry->p_name, strlen (entry->p_name)); SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->p_name, strlen (entry->p_name)));
ve[1] = scm_makfromstrs (-1, entry->p_aliases); SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->p_aliases));
ve[2] = SCM_MAKINUM (entry->p_proto + 0L); SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (entry->p_proto + 0L));
return ans; return ans;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -326,11 +327,11 @@ scm_return_entry (struct servent *entry)
SCM *ve; SCM *ve;
ans = scm_c_make_vector (4, SCM_UNSPECIFIED); ans = scm_c_make_vector (4, SCM_UNSPECIFIED);
ve = SCM_VELTS (ans); ve = SCM_WRITABLE_VELTS (ans);
ve[0] = scm_mem2string (entry->s_name, strlen (entry->s_name)); SCM_VECTOR_SET(ans, 0, scm_mem2string (entry->s_name, strlen (entry->s_name)));
ve[1] = scm_makfromstrs (-1, entry->s_aliases); SCM_VECTOR_SET(ans, 1, scm_makfromstrs (-1, entry->s_aliases));
ve[2] = SCM_MAKINUM (ntohs (entry->s_port) + 0L); SCM_VECTOR_SET(ans, 2, SCM_MAKINUM (ntohs (entry->s_port) + 0L));
ve[3] = scm_mem2string (entry->s_proto, strlen (entry->s_proto)); SCM_VECTOR_SET(ans, 3, scm_mem2string (entry->s_proto, strlen (entry->s_proto)));
return ans; return ans;
} }

62
libguile/posix.c
View file

@ -236,9 +236,13 @@ SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0,
getgroups (ngroups, groups); getgroups (ngroups, groups);
ans = scm_c_make_vector (ngroups, SCM_UNDEFINED); ans = scm_c_make_vector (ngroups, SCM_UNDEFINED);
while (--ngroups >= 0)
SCM_VELTS (ans) [ngroups] = SCM_MAKINUM (groups [ngroups]);
{
SCM * ve = SCM_WRITABLE_VELTS(ans);
while (--ngroups >= 0)
ve[ngroups] = SCM_MAKINUM (groups [ngroups]);
}
free (groups); free (groups);
return ans; return ans;
} }
@ -253,12 +257,9 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0,
"or getpwent respectively.") "or getpwent respectively.")
#define FUNC_NAME s_scm_getpwuid #define FUNC_NAME s_scm_getpwuid
{ {
SCM result;
struct passwd *entry; struct passwd *entry;
SCM *ve;
result = scm_c_make_vector (7, SCM_UNSPECIFIED); SCM ans = scm_c_make_vector (7, SCM_UNSPECIFIED);
ve = SCM_VELTS (result);
if (SCM_UNBNDP (user) || SCM_FALSEP (user)) if (SCM_UNBNDP (user) || SCM_FALSEP (user))
{ {
SCM_SYSCALL (entry = getpwent ()); SCM_SYSCALL (entry = getpwent ());
@ -279,20 +280,20 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0,
if (!entry) if (!entry)
SCM_MISC_ERROR ("entry not found", SCM_EOL); SCM_MISC_ERROR ("entry not found", SCM_EOL);
ve[0] = scm_makfrom0str (entry->pw_name); SCM_VECTOR_SET(ans, 0, scm_makfrom0str (entry->pw_name));
ve[1] = scm_makfrom0str (entry->pw_passwd); SCM_VECTOR_SET(ans, 1, scm_makfrom0str (entry->pw_passwd));
ve[2] = scm_ulong2num ((unsigned long) entry->pw_uid); SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) entry->pw_uid));
ve[3] = scm_ulong2num ((unsigned long) entry->pw_gid); SCM_VECTOR_SET(ans, 3, scm_ulong2num ((unsigned long) entry->pw_gid));
ve[4] = scm_makfrom0str (entry->pw_gecos); SCM_VECTOR_SET(ans, 4, scm_makfrom0str (entry->pw_gecos));
if (!entry->pw_dir) if (!entry->pw_dir)
ve[5] = scm_makfrom0str (""); SCM_VECTOR_SET(ans, 5, scm_makfrom0str (""));
else else
ve[5] = scm_makfrom0str (entry->pw_dir); SCM_VECTOR_SET(ans, 5, scm_makfrom0str (entry->pw_dir));
if (!entry->pw_shell) if (!entry->pw_shell)
ve[6] = scm_makfrom0str (""); SCM_VECTOR_SET(ans, 6, scm_makfrom0str (""));
else else
ve[6] = scm_makfrom0str (entry->pw_shell); SCM_VECTOR_SET(ans, 6, scm_makfrom0str (entry->pw_shell));
return result; return ans;
} }
#undef FUNC_NAME #undef FUNC_NAME
#endif /* HAVE_GETPWENT */ #endif /* HAVE_GETPWENT */
@ -325,11 +326,9 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0,
"or getgrent respectively.") "or getgrent respectively.")
#define FUNC_NAME s_scm_getgrgid #define FUNC_NAME s_scm_getgrgid
{ {
SCM result;
struct group *entry; struct group *entry;
SCM *ve; SCM ans = scm_c_make_vector (4, SCM_UNSPECIFIED);
result = scm_c_make_vector (4, SCM_UNSPECIFIED);
ve = SCM_VELTS (result);
if (SCM_UNBNDP (name) || SCM_FALSEP (name)) if (SCM_UNBNDP (name) || SCM_FALSEP (name))
{ {
SCM_SYSCALL (entry = getgrent ()); SCM_SYSCALL (entry = getgrent ());
@ -348,11 +347,11 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0,
if (!entry) if (!entry)
SCM_SYSERROR; SCM_SYSERROR;
ve[0] = scm_makfrom0str (entry->gr_name); SCM_VECTOR_SET(ans, 0, scm_makfrom0str (entry->gr_name));
ve[1] = scm_makfrom0str (entry->gr_passwd); SCM_VECTOR_SET(ans, 1, scm_makfrom0str (entry->gr_passwd));
ve[2] = scm_ulong2num ((unsigned long) entry->gr_gid); SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) entry->gr_gid));
ve[3] = scm_makfromstrs (-1, entry->gr_mem); SCM_VECTOR_SET(ans, 3, scm_makfromstrs (-1, entry->gr_mem));
return result; return ans;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -984,17 +983,16 @@ SCM_DEFINE (scm_uname, "uname", 0, 0, 0,
{ {
struct utsname buf; struct utsname buf;
SCM ans = scm_c_make_vector (5, SCM_UNSPECIFIED); SCM ans = scm_c_make_vector (5, SCM_UNSPECIFIED);
SCM *ve = SCM_VELTS (ans);
if (uname (&buf) < 0) if (uname (&buf) < 0)
SCM_SYSERROR; SCM_SYSERROR;
ve[0] = scm_makfrom0str (buf.sysname); SCM_VECTOR_SET(ans, 0, scm_makfrom0str (buf.sysname));
ve[1] = scm_makfrom0str (buf.nodename); SCM_VECTOR_SET(ans, 1, scm_makfrom0str (buf.nodename));
ve[2] = scm_makfrom0str (buf.release); SCM_VECTOR_SET(ans, 2, scm_makfrom0str (buf.release));
ve[3] = scm_makfrom0str (buf.version); SCM_VECTOR_SET(ans, 3, scm_makfrom0str (buf.version));
ve[4] = scm_makfrom0str (buf.machine); SCM_VECTOR_SET(ans, 4, scm_makfrom0str (buf.machine));
/* /*
a linux special? a linux special?
ve[5] = scm_makfrom0str (buf.domainname); SCM_VECTOR_SET(ans, 5, scm_makfrom0str (buf.domainname));
*/ */
return ans; return ans;
} }

9
libguile/print.c
View file

@ -216,7 +216,7 @@ make_print_state (void)
= scm_make_struct (scm_print_state_vtable, SCM_INUM0, SCM_EOL); = scm_make_struct (scm_print_state_vtable, SCM_INUM0, SCM_EOL);
scm_print_state *pstate = SCM_PRINT_STATE (print_state); scm_print_state *pstate = SCM_PRINT_STATE (print_state);
pstate->ref_vect = scm_c_make_vector (PSTATE_SIZE, SCM_UNDEFINED); pstate->ref_vect = scm_c_make_vector (PSTATE_SIZE, SCM_UNDEFINED);
pstate->ref_stack = SCM_VELTS (pstate->ref_vect); pstate->ref_stack = SCM_WRITABLE_VELTS (pstate->ref_vect);
pstate->ceiling = SCM_VECTOR_LENGTH (pstate->ref_vect); pstate->ceiling = SCM_VECTOR_LENGTH (pstate->ref_vect);
return print_state; return print_state;
} }
@ -260,17 +260,16 @@ static void
grow_ref_stack (scm_print_state *pstate) grow_ref_stack (scm_print_state *pstate)
{ {
unsigned long int old_size = SCM_VECTOR_LENGTH (pstate->ref_vect); unsigned long int old_size = SCM_VECTOR_LENGTH (pstate->ref_vect);
SCM *old_elts = SCM_VELTS (pstate->ref_vect); SCM const *old_elts = SCM_VELTS (pstate->ref_vect);
unsigned long int new_size = 2 * pstate->ceiling; unsigned long int new_size = 2 * pstate->ceiling;
SCM new_vect = scm_c_make_vector (new_size, SCM_UNDEFINED); SCM new_vect = scm_c_make_vector (new_size, SCM_UNDEFINED);
SCM *new_elts = SCM_VELTS (new_vect);
unsigned long int i; unsigned long int i;
for (i = 0; i != old_size; ++i) for (i = 0; i != old_size; ++i)
new_elts [i] = old_elts [i]; SCM_VECTOR_SET (new_vect, i, old_elts [i]);
pstate->ref_vect = new_vect; pstate->ref_vect = new_vect;
pstate->ref_stack = new_elts; pstate->ref_stack = SCM_WRITABLE_VELTS(new_vect);
pstate->ceiling = new_size; pstate->ceiling = new_size;
} }

12
libguile/ramap.c
View file

@ -488,7 +488,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect: case scm_tc7_wvect:
for (i = base; n--; i += inc) for (i = base; n--; i += inc)
SCM_VELTS (ra)[i] = fill; SCM_VECTOR_SET (ra, i, fill);
break; break;
case scm_tc7_string: case scm_tc7_string:
SCM_ASRTGO (SCM_CHARP (fill), badarg2); SCM_ASRTGO (SCM_CHARP (fill), badarg2);
@ -1243,7 +1243,8 @@ ramap (SCM ra0,SCM proc,SCM ras)
else else
{ {
SCM ra1 = SCM_CAR (ras); SCM ra1 = SCM_CAR (ras);
SCM args, *ve = &ras; SCM args;
SCM const *ve = &ras;
unsigned long k, i1 = SCM_ARRAY_BASE (ra1); unsigned long k, i1 = SCM_ARRAY_BASE (ra1);
long inc1 = SCM_ARRAY_DIMS (ra1)->inc; long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1); ra1 = SCM_ARRAY_V (ra1);
@ -1255,6 +1256,7 @@ ramap (SCM ra0,SCM proc,SCM ras)
ras = scm_vector (ras); ras = scm_vector (ras);
ve = SCM_VELTS (ras); ve = SCM_VELTS (ras);
} }
for (; i <= n; i++, i1 += inc1) for (; i <= n; i++, i1 += inc1)
{ {
args = SCM_EOL; args = SCM_EOL;
@ -1637,7 +1639,8 @@ rafe (SCM ra0,SCM proc,SCM ras)
else else
{ {
SCM ra1 = SCM_CAR (ras); SCM ra1 = SCM_CAR (ras);
SCM args, *ve = &ras; SCM args;
SCM const*ve = &ras;
unsigned long k, i1 = SCM_ARRAY_BASE (ra1); unsigned long k, i1 = SCM_ARRAY_BASE (ra1);
long inc1 = SCM_ARRAY_DIMS (ra1)->inc; long inc1 = SCM_ARRAY_DIMS (ra1)->inc;
ra1 = SCM_ARRAY_V (ra1); ra1 = SCM_ARRAY_V (ra1);
@ -1706,9 +1709,8 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect: case scm_tc7_wvect:
{ {
SCM *ve = SCM_VELTS (ra);
for (i = 0; i < SCM_VECTOR_LENGTH (ra); i++) for (i = 0; i < SCM_VECTOR_LENGTH (ra); i++)
ve[i] = scm_call_1 (proc, SCM_MAKINUM (i)); SCM_VECTOR_SET(ra, i, scm_call_1 (proc, SCM_MAKINUM (i)));
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
case scm_tc7_string: case scm_tc7_string:

2
libguile/random.c
View file

@ -545,7 +545,7 @@ SCM_DEFINE (scm_random_normal_vector_x, "random:normal-vector!", 1, 1, 0,
n = SCM_INUM (scm_uniform_vector_length (v)); n = SCM_INUM (scm_uniform_vector_length (v));
if (SCM_VECTORP (v)) if (SCM_VECTORP (v))
while (--n >= 0) while (--n >= 0)
SCM_VELTS (v)[n] = scm_make_real (scm_c_normal01 (SCM_RSTATE (state))); SCM_VECTOR_SET (v, n, scm_make_real (scm_c_normal01 (SCM_RSTATE (state))));
else else
while (--n >= 0) while (--n >= 0)
((double *) SCM_VELTS (v))[n] = scm_c_normal01 (SCM_RSTATE (state)); ((double *) SCM_VELTS (v))[n] = scm_c_normal01 (SCM_RSTATE (state));

19
libguile/scmsigs.c
View file

@ -192,7 +192,7 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
#endif #endif
int query_only = 0; int query_only = 0;
int save_handler = 0; int save_handler = 0;
SCM *scheme_handlers = SCM_VELTS (*signal_handlers);
SCM old_handler; SCM old_handler;
SCM_VALIDATE_INUM_COPY (1, signum, csig); SCM_VALIDATE_INUM_COPY (1, signum, csig);
@ -213,7 +213,7 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
sigemptyset (&action.sa_mask); sigemptyset (&action.sa_mask);
#endif #endif
SCM_DEFER_INTS; SCM_DEFER_INTS;
old_handler = scheme_handlers[csig]; old_handler = SCM_VELTS(*signal_handlers)[csig];
if (SCM_UNBNDP (handler)) if (SCM_UNBNDP (handler))
query_only = 1; query_only = 1;
else if (SCM_EQ_P (scm_integer_p (handler), SCM_BOOL_T)) else if (SCM_EQ_P (scm_integer_p (handler), SCM_BOOL_T))
@ -226,7 +226,7 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
#else #else
chandler = (SIGRETTYPE (*) (int)) SCM_INUM (handler); chandler = (SIGRETTYPE (*) (int)) SCM_INUM (handler);
#endif #endif
scheme_handlers[csig] = SCM_BOOL_F; SCM_VECTOR_SET (*signal_handlers, csig, SCM_BOOL_F);
} }
else else
SCM_OUT_OF_RANGE (2, handler); SCM_OUT_OF_RANGE (2, handler);
@ -241,7 +241,8 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
{ {
action = orig_handlers[csig]; action = orig_handlers[csig];
orig_handlers[csig].sa_handler = SIG_ERR; orig_handlers[csig].sa_handler = SIG_ERR;
scheme_handlers[csig] = SCM_BOOL_F; SCM_VECTOR_SET (*signal_handlers, csig, SCM_BOOL_F);
} }
#else #else
if (orig_handlers[csig] == SIG_ERR) if (orig_handlers[csig] == SIG_ERR)
@ -250,7 +251,7 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
{ {
chandler = orig_handlers[csig]; chandler = orig_handlers[csig];
orig_handlers[csig] = SIG_ERR; orig_handlers[csig] = SIG_ERR;
scheme_handlers[csig] = SCM_BOOL_F; SCM_VECTOR_SET (*signal_handlers, csig, SCM_BOOL_F);
} }
#endif #endif
} }
@ -266,7 +267,7 @@ SCM_DEFINE (scm_sigaction, "sigaction", 1, 2, 0,
if (orig_handlers[csig] == SIG_ERR) if (orig_handlers[csig] == SIG_ERR)
save_handler = 1; save_handler = 1;
#endif #endif
scheme_handlers[csig] = handler; SCM_VECTOR_SET (*signal_handlers, csig, handler);
} }
/* XXX - Silently ignore setting handlers for `program error signals' /* XXX - Silently ignore setting handlers for `program error signals'
@ -346,8 +347,6 @@ SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0,
#define FUNC_NAME s_scm_restore_signals #define FUNC_NAME s_scm_restore_signals
{ {
int i; int i;
SCM *scheme_handlers = SCM_VELTS (*signal_handlers);
for (i = 0; i < NSIG; i++) for (i = 0; i < NSIG; i++)
{ {
#ifdef HAVE_SIGACTION #ifdef HAVE_SIGACTION
@ -356,7 +355,7 @@ SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0,
if (sigaction (i, &orig_handlers[i], NULL) == -1) if (sigaction (i, &orig_handlers[i], NULL) == -1)
SCM_SYSERROR; SCM_SYSERROR;
orig_handlers[i].sa_handler = SIG_ERR; orig_handlers[i].sa_handler = SIG_ERR;
scheme_handlers[i] = SCM_BOOL_F; SCM_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
} }
#else #else
if (orig_handlers[i] != SIG_ERR) if (orig_handlers[i] != SIG_ERR)
@ -364,7 +363,7 @@ SCM_DEFINE (scm_restore_signals, "restore-signals", 0, 0, 0,
if (signal (i, orig_handlers[i]) == SIG_ERR) if (signal (i, orig_handlers[i]) == SIG_ERR)
SCM_SYSERROR; SCM_SYSERROR;
orig_handlers[i] = SIG_ERR; orig_handlers[i] = SIG_ERR;
scheme_handlers[i] = SCM_BOOL_F; SCM_VECTOR_SET (*signal_handlers, i, SCM_BOOL_F);
} }
#endif #endif
} }

39
libguile/socket.c
View file

@ -925,8 +925,8 @@ static SCM
scm_addr_vector (const struct sockaddr *address, const char *proc) scm_addr_vector (const struct sockaddr *address, const char *proc)
{ {
short int fam = address->sa_family; short int fam = address->sa_family;
SCM result; SCM ans =SCM_EOL;
SCM *ve;
switch (fam) switch (fam)
{ {
@ -934,11 +934,11 @@ scm_addr_vector (const struct sockaddr *address, const char *proc)
{ {
const struct sockaddr_in *nad = (struct sockaddr_in *) address; const struct sockaddr_in *nad = (struct sockaddr_in *) address;
result = scm_c_make_vector (3, SCM_UNSPECIFIED); ans = scm_c_make_vector (3, SCM_UNSPECIFIED);
ve = SCM_VELTS (result);
ve[0] = scm_ulong2num ((unsigned long) fam); SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) fam));
ve[1] = scm_ulong2num (ntohl (nad->sin_addr.s_addr)); SCM_VECTOR_SET(ans, 1, scm_ulong2num (ntohl (nad->sin_addr.s_addr)));
ve[2] = scm_ulong2num ((unsigned long) ntohs (nad->sin_port)); SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) ntohs (nad->sin_port)));
} }
break; break;
#ifdef HAVE_IPV6 #ifdef HAVE_IPV6
@ -946,16 +946,15 @@ scm_addr_vector (const struct sockaddr *address, const char *proc)
{ {
const struct sockaddr_in6 *nad = (struct sockaddr_in6 *) address; const struct sockaddr_in6 *nad = (struct sockaddr_in6 *) address;
result = scm_c_make_vector (5, SCM_UNSPECIFIED); ans = scm_c_make_vector (5, SCM_UNSPECIFIED);
ve = SCM_VELTS (result); SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) fam));
ve[0] = scm_ulong2num ((unsigned long) fam); SCM_VECTOR_SET(ans, 1, ipv6_net_to_num (nad->sin6_addr.s6_addr));
ve[1] = ipv6_net_to_num (nad->sin6_addr.s6_addr); SCM_VECTOR_SET(ans, 2, scm_ulong2num ((unsigned long) ntohs (nad->sin6_port)));
ve[2] = scm_ulong2num ((unsigned long) ntohs (nad->sin6_port)); SCM_VECTOR_SET(ans, 3, scm_ulong2num ((unsigned long) nad->sin6_flowinfo));
ve[3] = scm_ulong2num ((unsigned long) nad->sin6_flowinfo);
#ifdef HAVE_SIN6_SCOPE_ID #ifdef HAVE_SIN6_SCOPE_ID
ve[4] = scm_ulong2num ((unsigned long) nad->sin6_scope_id); SCM_VECTOR_SET(ans, 4, scm_ulong2num ((unsigned long) nad->sin6_scope_id));
#else #else
ve[4] = SCM_INUM0; SCM_VECTOR_SET(ans, 4, SCM_INUM0);
#endif #endif
} }
break; break;
@ -965,10 +964,10 @@ scm_addr_vector (const struct sockaddr *address, const char *proc)
{ {
const struct sockaddr_un *nad = (struct sockaddr_un *) address; const struct sockaddr_un *nad = (struct sockaddr_un *) address;
result = scm_c_make_vector (2, SCM_UNSPECIFIED); ans = scm_c_make_vector (2, SCM_UNSPECIFIED);
ve = SCM_VELTS (result);
ve[0] = scm_ulong2num ((unsigned long) fam); SCM_VECTOR_SET(ans, 0, scm_ulong2num ((unsigned long) fam));
ve[1] = scm_mem2string (nad->sun_path, strlen (nad->sun_path)); SCM_VECTOR_SET(ans, 1, scm_mem2string (nad->sun_path, strlen (nad->sun_path)));
} }
break; break;
#endif #endif
@ -976,7 +975,7 @@ scm_addr_vector (const struct sockaddr *address, const char *proc)
scm_misc_error (proc, "Unrecognised address family: ~A", scm_misc_error (proc, "Unrecognised address family: ~A",
scm_list_1 (SCM_MAKINUM (fam))); scm_list_1 (SCM_MAKINUM (fam)));
} }
return result; return ans;
} }
/* calculate the size of a buffer large enough to hold any supported /* calculate the size of a buffer large enough to hold any supported

22
libguile/sort.c
View file

@ -428,7 +428,7 @@ SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0,
SCM_VALIDATE_VECTOR (1, vec); SCM_VALIDATE_VECTOR (1, vec);
SCM_VALIDATE_NIM (2, less); SCM_VALIDATE_NIM (2, less);
vp = SCM_VELTS (vec); /* vector pointer */ vp = SCM_WRITABLE_VELTS (vec); /* vector pointer */
vlen = SCM_VECTOR_LENGTH (vec); vlen = SCM_VECTOR_LENGTH (vec);
SCM_VALIDATE_INUM_MIN_COPY (3, startpos, 0, spos); SCM_VALIDATE_INUM_MIN_COPY (3, startpos, 0, spos);
@ -437,6 +437,8 @@ SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0,
len = SCM_INUM (endpos) - spos; len = SCM_INUM (endpos) - spos;
quicksort (&vp[spos], len, size, scm_cmp_function (less), less); quicksort (&vp[spos], len, size, scm_cmp_function (less), less);
SCM_GC_FLAG_OBJECT_WRITE(vec);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
/* return vec; */ /* return vec; */
} }
@ -455,7 +457,7 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0,
{ {
long len, j; /* list/vector length, temp j */ long len, j; /* list/vector length, temp j */
SCM item, rest; /* rest of items loop variable */ SCM item, rest; /* rest of items loop variable */
SCM *vp; SCM const *vp;
cmp_fun_t cmp = scm_cmp_function (less); cmp_fun_t cmp = scm_cmp_function (less);
if (SCM_NULL_OR_NIL_P (items)) if (SCM_NULL_OR_NIL_P (items))
@ -861,7 +863,14 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0,
SCM *temp, *vp; SCM *temp, *vp;
len = SCM_VECTOR_LENGTH (items); len = SCM_VECTOR_LENGTH (items);
temp = malloc (len * sizeof(SCM)); temp = malloc (len * sizeof(SCM));
vp = SCM_VELTS (items);
vp = SCM_WRITABLE_VELTS (items);
/*
This routine modifies VP
*/
SCM_GC_FLAG_OBJECT_WRITE(items);
scm_merge_vector_step (vp, scm_merge_vector_step (vp,
temp, temp,
scm_cmp_function (less), scm_cmp_function (less),
@ -906,7 +915,12 @@ SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0,
retvec = scm_make_uve (len, scm_array_prototype (items)); retvec = scm_make_uve (len, scm_array_prototype (items));
scm_array_copy_x (items, retvec); scm_array_copy_x (items, retvec);
temp = malloc (len * sizeof (SCM)); temp = malloc (len * sizeof (SCM));
vp = SCM_VELTS (retvec);
/*
don't worry about write barrier: retvec is new anyway.
*/
vp = SCM_WRITABLE_VELTS (retvec);
scm_merge_vector_step (vp, scm_merge_vector_step (vp,
temp, temp,
scm_cmp_function (less), scm_cmp_function (less),

34
libguile/stime.c
View file

@ -195,11 +195,11 @@ SCM_DEFINE (scm_times, "times", 0, 0, 0,
rv = times (&t); rv = times (&t);
if (rv == -1) if (rv == -1)
SCM_SYSERROR; SCM_SYSERROR;
SCM_VELTS (result)[0] = scm_long2num (rv); SCM_VECTOR_SET (result, 0, scm_long2num (rv));
SCM_VELTS (result)[1] = scm_long2num (t.tms_utime); SCM_VECTOR_SET (result, 1, scm_long2num (t.tms_utime));
SCM_VELTS (result)[2] = scm_long2num (t.tms_stime); SCM_VECTOR_SET (result, 2, scm_long2num (t.tms_stime));
SCM_VELTS (result)[3] = scm_long2num (t.tms_cutime); SCM_VECTOR_SET (result ,3, scm_long2num (t.tms_cutime));
SCM_VELTS (result)[4] = scm_long2num (t.tms_cstime); SCM_VECTOR_SET (result, 4, scm_long2num (t.tms_cstime));
return result; return result;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -282,17 +282,17 @@ filltime (struct tm *bd_time, int zoff, char *zname)
{ {
SCM result = scm_c_make_vector (11, SCM_UNDEFINED); SCM result = scm_c_make_vector (11, SCM_UNDEFINED);
SCM_VELTS (result)[0] = SCM_MAKINUM (bd_time->tm_sec); SCM_VECTOR_SET (result,0, SCM_MAKINUM (bd_time->tm_sec));
SCM_VELTS (result)[1] = SCM_MAKINUM (bd_time->tm_min); SCM_VECTOR_SET (result,1, SCM_MAKINUM (bd_time->tm_min));
SCM_VELTS (result)[2] = SCM_MAKINUM (bd_time->tm_hour); SCM_VECTOR_SET (result,2, SCM_MAKINUM (bd_time->tm_hour));
SCM_VELTS (result)[3] = SCM_MAKINUM (bd_time->tm_mday); SCM_VECTOR_SET (result,3, SCM_MAKINUM (bd_time->tm_mday));
SCM_VELTS (result)[4] = SCM_MAKINUM (bd_time->tm_mon); SCM_VECTOR_SET (result,4, SCM_MAKINUM (bd_time->tm_mon));
SCM_VELTS (result)[5] = SCM_MAKINUM (bd_time->tm_year); SCM_VECTOR_SET (result,5, SCM_MAKINUM (bd_time->tm_year));
SCM_VELTS (result)[6] = SCM_MAKINUM (bd_time->tm_wday); SCM_VECTOR_SET (result,6, SCM_MAKINUM (bd_time->tm_wday));
SCM_VELTS (result)[7] = SCM_MAKINUM (bd_time->tm_yday); SCM_VECTOR_SET (result,7, SCM_MAKINUM (bd_time->tm_yday));
SCM_VELTS (result)[8] = SCM_MAKINUM (bd_time->tm_isdst); SCM_VECTOR_SET (result,8, SCM_MAKINUM (bd_time->tm_isdst));
SCM_VELTS (result)[9] = SCM_MAKINUM (zoff); SCM_VECTOR_SET (result,9, SCM_MAKINUM (zoff));
SCM_VELTS (result)[10] = zname ? scm_makfrom0str (zname) : SCM_BOOL_F; SCM_VECTOR_SET (result,10, zname ? scm_makfrom0str (zname) : SCM_BOOL_F);
return result; return result;
} }
@ -439,7 +439,7 @@ SCM_DEFINE (scm_gmtime, "gmtime", 1, 0, 0,
static void static void
bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr) bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr)
{ {
SCM *velts; SCM const *velts;
int i; int i;
SCM_ASSERT (SCM_VECTORP (sbd_time) SCM_ASSERT (SCM_VECTORP (sbd_time)

2
libguile/symbols.c
View file

@ -133,7 +133,7 @@ scm_mem2symbol (const char *name, size_t len)
slot = SCM_VELTS (symbols) [hash]; slot = SCM_VELTS (symbols) [hash];
cell = scm_cons (symbol, SCM_UNDEFINED); cell = scm_cons (symbol, SCM_UNDEFINED);
SCM_VELTS (symbols) [hash] = scm_cons (cell, slot); SCM_VECTOR_SET (symbols, hash, scm_cons (cell, slot));
return symbol; return symbol;
} }

5
libguile/unif.c
View file

@ -802,7 +802,8 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
"@end lisp") "@end lisp")
#define FUNC_NAME s_scm_transpose_array #define FUNC_NAME s_scm_transpose_array
{ {
SCM res, vargs, *ve = &vargs; SCM res, vargs;
SCM const *ve = &vargs;
scm_t_array_dim *s, *r; scm_t_array_dim *s, *r;
int ndim, i, k; int ndim, i, k;
@ -1350,7 +1351,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
break; break;
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect: case scm_tc7_wvect:
SCM_VELTS (v)[pos] = obj; SCM_VECTOR_SET (v, pos, obj);
break; break;
} }
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;

22
libguile/vectors.c
View file

@ -101,7 +101,11 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1,
while the vector is being created. */ while the vector is being created. */
SCM_VALIDATE_LIST_COPYLEN (1, l, i); SCM_VALIDATE_LIST_COPYLEN (1, l, i);
res = scm_c_make_vector (i, SCM_UNSPECIFIED); res = scm_c_make_vector (i, SCM_UNSPECIFIED);
data = SCM_VELTS (res);
/*
this code doesn't alloc. -- accessing RES is safe.
*/
data = SCM_WRITABLE_VELTS (res);
while (!SCM_NULL_OR_NIL_P (l)) while (!SCM_NULL_OR_NIL_P (l))
{ {
*data++ = SCM_CAR (l); *data++ = SCM_CAR (l);
@ -165,7 +169,7 @@ scm_vector_set_x (SCM v, SCM k, SCM obj)
g_vector_set_x, scm_list_3 (v, k, obj), g_vector_set_x, scm_list_3 (v, k, obj),
SCM_ARG2, s_vector_set_x); SCM_ARG2, s_vector_set_x);
SCM_ASSERT_RANGE (2, k, SCM_INUM (k) < SCM_VECTOR_LENGTH (v) && SCM_INUM (k) >= 0); SCM_ASSERT_RANGE (2, k, SCM_INUM (k) < SCM_VECTOR_LENGTH (v) && SCM_INUM (k) >= 0);
SCM_VELTS(v)[(long) SCM_INUM(k)] = obj; SCM_VECTOR_SET (v, (long) SCM_INUM(k), obj);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -235,7 +239,7 @@ SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0,
{ {
SCM res = SCM_EOL; SCM res = SCM_EOL;
long i; long i;
SCM *data; SCM const *data;
SCM_VALIDATE_VECTOR (1, v); SCM_VALIDATE_VECTOR (1, v);
data = SCM_VELTS(v); data = SCM_VELTS(v);
for(i = SCM_VECTOR_LENGTH(v)-1;i >= 0;i--) res = scm_cons(data[i], res); for(i = SCM_VECTOR_LENGTH(v)-1;i >= 0;i--) res = scm_cons(data[i], res);
@ -251,11 +255,10 @@ SCM_DEFINE (scm_vector_fill_x, "vector-fill!", 2, 0, 0,
#define FUNC_NAME s_scm_vector_fill_x #define FUNC_NAME s_scm_vector_fill_x
{ {
register long i; register long i;
register SCM *data;
SCM_VALIDATE_VECTOR (1, v); SCM_VALIDATE_VECTOR (1, v);
data = SCM_VELTS (v);
for(i = SCM_VECTOR_LENGTH (v) - 1; i >= 0; i--) for(i = SCM_VECTOR_LENGTH (v) - 1; i >= 0; i--)
data[i] = fill; SCM_VECTOR_SET(v, i, fill);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -296,7 +299,10 @@ SCM_DEFINE (scm_vector_move_left_x, "vector-move-left!", 5, 0, 0,
SCM_ASSERT_RANGE (5, start2, j <= SCM_VECTOR_LENGTH (vec2) && j >= 0); SCM_ASSERT_RANGE (5, start2, j <= SCM_VECTOR_LENGTH (vec2) && j >= 0);
SCM_ASSERT_RANGE (3, end1, e <= SCM_VECTOR_LENGTH (vec1) && e >= 0); SCM_ASSERT_RANGE (3, end1, e <= SCM_VECTOR_LENGTH (vec1) && e >= 0);
SCM_ASSERT_RANGE (5, start2, e-i+j <= SCM_VECTOR_LENGTH (vec2)); SCM_ASSERT_RANGE (5, start2, e-i+j <= SCM_VECTOR_LENGTH (vec2));
while (i<e) SCM_VELTS (vec2)[j++] = SCM_VELTS (vec1)[i++];
while (i<e)
SCM_VECTOR_SET (vec2, j++, SCM_VELTS (vec1)[i++]);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -327,7 +333,7 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
j = e - i + j; j = e - i + j;
SCM_ASSERT_RANGE (5, start2, j <= SCM_VECTOR_LENGTH (vec2)); SCM_ASSERT_RANGE (5, start2, j <= SCM_VECTOR_LENGTH (vec2));
while (i < e) while (i < e)
SCM_VELTS (vec2)[--j] = SCM_VELTS (vec1)[--e]; SCM_VECTOR_SET (vec2, --j, SCM_VELTS (vec1)[--e]);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME

9
libguile/vectors.h
View file

@ -58,10 +58,17 @@
#define SCM_MAKE_VECTOR_TAG(l, t) (((l) << 8) + (t)) #define SCM_MAKE_VECTOR_TAG(l, t) (((l) << 8) + (t))
#define SCM_SET_VECTOR_LENGTH(v, l, t) (SCM_SET_CELL_WORD_0 ((v), SCM_MAKE_VECTOR_TAG(l, t))) #define SCM_SET_VECTOR_LENGTH(v, l, t) (SCM_SET_CELL_WORD_0 ((v), SCM_MAKE_VECTOR_TAG(l, t)))
#define SCM_VELTS(x) ((SCM *) SCM_CELL_WORD_1 (x)) #define SCM_VELTS(x) ((const SCM *) SCM_CELL_WORD_1 (x))
#define SCM_VELTS_AS_STACKITEMS(x) ((SCM_STACKITEM *) SCM_CELL_WORD_1 (x)) #define SCM_VELTS_AS_STACKITEMS(x) ((SCM_STACKITEM *) SCM_CELL_WORD_1 (x))
#define SCM_SETVELTS(x, v) (SCM_SET_CELL_WORD_1 ((x), (v))) #define SCM_SETVELTS(x, v) (SCM_SET_CELL_WORD_1 ((x), (v)))
#define SCM_VECTOR_SET(x, idx, val) (((SCM*)SCM_CELL_WORD_1 (x))[(idx)] = (val))
#define SCM_GC_WRITABLE_VELTS(x) ((SCM*) SCM_VELTS(x))
/*
no WB yet.
*/
#define SCM_WRITABLE_VELTS(x) ((SCM*) SCM_VELTS(x))
/* /*

11
libguile/weaks.c
View file

@ -141,8 +141,11 @@ SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1,
i = scm_ilength (l); i = scm_ilength (l);
SCM_ASSERT (i >= 0, l, SCM_ARG1, FUNC_NAME); SCM_ASSERT (i >= 0, l, SCM_ARG1, FUNC_NAME);
res = scm_make_weak_vector (SCM_MAKINUM (i), SCM_UNSPECIFIED); res = scm_make_weak_vector (SCM_MAKINUM (i), SCM_UNSPECIFIED);
data = SCM_VELTS (res);
/*
no alloc, so this loop is safe.
*/
data = SCM_WRITABLE_VELTS (res);
while (!SCM_NULL_OR_NIL_P (l)) while (!SCM_NULL_OR_NIL_P (l))
{ {
*data++ = SCM_CAR (l); *data++ = SCM_CAR (l);
@ -261,7 +264,7 @@ scm_mark_weak_vector_spines (void *dummy1 SCM_UNUSED,
{ {
if (SCM_IS_WHVEC_ANY (w)) if (SCM_IS_WHVEC_ANY (w))
{ {
SCM *ptr; SCM const *ptr;
SCM obj; SCM obj;
long j; long j;
long n; long n;
@ -302,7 +305,7 @@ scm_scan_weak_vectors (void *dummy1 SCM_UNUSED,
{ {
register long j, n; register long j, n;
ptr = SCM_VELTS (w); ptr = SCM_GC_WRITABLE_VELTS (w);
n = SCM_VECTOR_LENGTH (w); n = SCM_VECTOR_LENGTH (w);
for (j = 0; j < n; ++j) for (j = 0; j < n; ++j)
if (SCM_FREE_CELL_P (ptr[j])) if (SCM_FREE_CELL_P (ptr[j]))
@ -316,7 +319,7 @@ scm_scan_weak_vectors (void *dummy1 SCM_UNUSED,
int weak_keys = SCM_IS_WHVEC (obj) || SCM_IS_WHVEC_B (obj); int weak_keys = SCM_IS_WHVEC (obj) || SCM_IS_WHVEC_B (obj);
int weak_values = SCM_IS_WHVEC_V (obj) || SCM_IS_WHVEC_B (obj); int weak_values = SCM_IS_WHVEC_V (obj) || SCM_IS_WHVEC_B (obj);
ptr = SCM_VELTS (w); ptr = SCM_GC_WRITABLE_VELTS (w);
for (j = 0; j < n; ++j) for (j = 0; j < n; ++j)
{ {