mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-10 22:10:21 +02:00
* Fix SCM <--> scm_t_bits related typing problems.
Thanks to Matthias Koeppe for the bug report.
This commit is contained in:
Dirk Herrmann
parent
e81d98ec2d
commit
dcb410ec07
6 changed files with 119 additions and 91 deletions
|
|
@ -1,3 +1,34 @@
|
|||
2001-06-08 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||
|
||||
* goops.c (SCM_CLASS_REDEF): Removed.
|
||||
|
||||
* vectors.h (VECTORSH, SCM_VECTORS_H): Renamed <foo>H to
|
||||
SCM_<foo>_H.
|
||||
|
||||
Thanks to Matthias Koeppe for reporting the bugs that correspond
|
||||
to the following set of patches.
|
||||
|
||||
* goops.c (scm_sys_prep_layout_x, scm_basic_basic_make_class,
|
||||
create_basic_classes, scm_sys_fast_slot_set_x, set_slot_value,
|
||||
scm_sys_allocate_instance, clear_method_cache,
|
||||
scm_sys_invalidate_method_cache_x, scm_make,
|
||||
create_standard_classes, scm_make_port_classes, scm_make_class,
|
||||
scm_add_slot): Use SCM_SET_SLOT to set slot values.
|
||||
|
||||
(prep_hashsets): Use SCM_SET_HASHSET to set class hash values.
|
||||
|
||||
* goops.h (SCM_SET_SLOT, SCM_SET_HASHSET): New macros.
|
||||
|
||||
* ramap.c (BINARY_ELTS_CODE, BINARY_PAIR_ELTS_CODE,
|
||||
UNARY_ELTS_CODE): Remove bogus break statement.
|
||||
|
||||
* vectors.h (SCM_BITVEC_REF, SCM_BITVEC_SET, SCM_BITVEC_CLR):
|
||||
Don't access bit vectors elements as SCM objects.
|
||||
|
||||
* weaks.c (scm_make_weak_vector, scm_make_weak_key_hash_table,
|
||||
scm_make_weak_value_hash_table, scm_make_doubly_weak_hash_table):
|
||||
Don't assign to an unpacked value.
|
||||
|
||||
2001-06-07 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||
|
||||
* __scm.h (SCM_NORETURN): Moved here from error.h.
|
||||
|
|
|
|||
152
libguile/goops.c
152
libguile/goops.c
|
|
@ -111,7 +111,6 @@
|
|||
h1.
|
||||
*/
|
||||
|
||||
#define SCM_CLASS_REDEF(c) SCM_SLOT (c, scm_si_redefined)
|
||||
/* The following definition is located in libguile/objects.h:
|
||||
#define SCM_OBJ_CLASS_REDEF(x) (SCM_STRUCT_VTABLE_DATA(x)[scm_si_redefined])
|
||||
*/
|
||||
|
|
@ -168,7 +167,7 @@ static SCM scm_sys_goops_loaded (void);
|
|||
* Compute-cpl
|
||||
*
|
||||
* This version doesn't handle multiple-inheritance. It serves only for
|
||||
* booting classes and will be overaloaded in Scheme
|
||||
* booting classes and will be overloaded in Scheme
|
||||
*
|
||||
******************************************************************************/
|
||||
|
||||
|
|
@ -302,7 +301,7 @@ SCM_DEFINE (scm_sys_compute_slots, "%compute-slots", 1, 0, 0,
|
|||
* compute-getters-n-setters
|
||||
*
|
||||
* This version doesn't handle slot options. It serves only for booting
|
||||
* classes and will be overaloaded in Scheme.
|
||||
* classes and will be overloaded in Scheme.
|
||||
*
|
||||
******************************************************************************/
|
||||
|
||||
|
|
@ -528,7 +527,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0,
|
|||
s[i + 1] = a;
|
||||
slots = SCM_CDR (slots);
|
||||
}
|
||||
SCM_SLOT (class, scm_si_layout) = scm_mem2symbol (s, n);
|
||||
SCM_SET_SLOT (class, scm_si_layout, scm_mem2symbol (s, n));
|
||||
if (s)
|
||||
scm_must_free (s);
|
||||
return SCM_UNSPECIFIED;
|
||||
|
|
@ -589,11 +588,10 @@ SCM_DEFINE (scm_sys_inherit_magic_x, "%inherit-magic!", 2, 0, 0,
|
|||
void
|
||||
prep_hashsets (SCM class)
|
||||
{
|
||||
int i;
|
||||
unsigned int i;
|
||||
|
||||
for (i = 0; i < 7; ++i)
|
||||
SCM_SLOT (class, scm_si_hashsets + i)
|
||||
= SCM_PACK (scm_c_uniform32 (goops_rstate));
|
||||
SCM_SET_HASHSET (class, i, scm_c_uniform32 (goops_rstate));
|
||||
}
|
||||
|
||||
/******************************************************************************/
|
||||
|
|
@ -610,30 +608,31 @@ scm_basic_basic_make_class (SCM class, SCM name, SCM dsupers, SCM dslots)
|
|||
#if 0
|
||||
cpl = compute_cpl (dsupers, SCM_LIST1(z));
|
||||
#endif
|
||||
SCM_SLOT (z, scm_si_direct_supers) = dsupers;
|
||||
SCM_SET_SLOT (z, scm_si_direct_supers, dsupers);
|
||||
cpl = compute_cpl (z);
|
||||
slots = build_slots_list (maplist (dslots), cpl);
|
||||
nfields = SCM_MAKINUM (scm_ilength (slots));
|
||||
g_n_s = compute_getters_n_setters (slots);
|
||||
|
||||
SCM_SLOT(z, scm_si_name) = name;
|
||||
SCM_SLOT(z, scm_si_direct_slots) = dslots;
|
||||
SCM_SLOT(z, scm_si_direct_subclasses) = SCM_EOL;
|
||||
SCM_SLOT(z, scm_si_direct_methods) = SCM_EOL;
|
||||
SCM_SLOT(z, scm_si_cpl) = cpl;
|
||||
SCM_SLOT(z, scm_si_slots) = slots;
|
||||
SCM_SLOT(z, scm_si_nfields) = nfields;
|
||||
SCM_SLOT(z, scm_si_getters_n_setters) = g_n_s;
|
||||
SCM_SLOT(z, scm_si_redefined) = SCM_BOOL_F;
|
||||
SCM_SLOT(z, scm_si_environment)
|
||||
= scm_top_level_env (SCM_TOP_LEVEL_LOOKUP_CLOSURE);
|
||||
SCM_SET_SLOT (z, scm_si_name, name);
|
||||
SCM_SET_SLOT (z, scm_si_direct_slots, dslots);
|
||||
SCM_SET_SLOT (z, scm_si_direct_subclasses, SCM_EOL);
|
||||
SCM_SET_SLOT (z, scm_si_direct_methods, SCM_EOL);
|
||||
SCM_SET_SLOT (z, scm_si_cpl, cpl);
|
||||
SCM_SET_SLOT (z, scm_si_slots, slots);
|
||||
SCM_SET_SLOT (z, scm_si_nfields, nfields);
|
||||
SCM_SET_SLOT (z, scm_si_getters_n_setters, g_n_s);
|
||||
SCM_SET_SLOT (z, scm_si_redefined, SCM_BOOL_F);
|
||||
SCM_SET_SLOT (z, scm_si_environment,
|
||||
scm_top_level_env (SCM_TOP_LEVEL_LOOKUP_CLOSURE));
|
||||
|
||||
/* Add this class in the direct-subclasses slot of dsupers */
|
||||
{
|
||||
SCM tmp;
|
||||
for (tmp = dsupers; SCM_NNULLP(tmp); tmp = SCM_CDR(tmp))
|
||||
SCM_SLOT(SCM_CAR(tmp), scm_si_direct_subclasses)
|
||||
= scm_cons(z, SCM_SLOT(SCM_CAR(tmp), scm_si_direct_subclasses));
|
||||
for (tmp = dsupers; !SCM_NULLP (tmp); tmp = SCM_CDR (tmp))
|
||||
SCM_SET_SLOT (SCM_CAR (tmp), scm_si_direct_subclasses,
|
||||
scm_cons (z, SCM_SLOT (SCM_CAR (tmp),
|
||||
scm_si_direct_subclasses)));
|
||||
}
|
||||
|
||||
/* Support for the underlying structs: */
|
||||
|
|
@ -733,19 +732,19 @@ create_basic_classes (void)
|
|||
SCM_SET_CLASS_FLAGS (scm_class_class, (SCM_CLASSF_GOOPS_OR_VALID
|
||||
| SCM_CLASSF_METACLASS));
|
||||
|
||||
SCM_SLOT(scm_class_class, scm_si_name) = name;
|
||||
SCM_SLOT(scm_class_class, scm_si_direct_supers) = SCM_EOL; /* will be changed */
|
||||
/* SCM_SLOT(scm_class_class, scm_si_direct_slots) = slots_of_class; */
|
||||
SCM_SLOT(scm_class_class, scm_si_direct_subclasses)= SCM_EOL;
|
||||
SCM_SLOT(scm_class_class, scm_si_direct_methods) = SCM_EOL;
|
||||
SCM_SLOT(scm_class_class, scm_si_cpl) = SCM_EOL; /* will be changed */
|
||||
/* SCM_SLOT(scm_class_class, scm_si_slots) = slots_of_class; */
|
||||
SCM_SLOT(scm_class_class, scm_si_nfields) = SCM_MAKINUM (SCM_N_CLASS_SLOTS);
|
||||
/* SCM_SLOT(scm_class_class, scm_si_getters_n_setters)
|
||||
= compute_getters_n_setters (slots_of_class); */
|
||||
SCM_SLOT(scm_class_class, scm_si_redefined) = SCM_BOOL_F;
|
||||
SCM_SLOT(scm_class_class, scm_si_environment)
|
||||
= scm_top_level_env (SCM_TOP_LEVEL_LOOKUP_CLOSURE);
|
||||
SCM_SET_SLOT (scm_class_class, scm_si_name, name);
|
||||
SCM_SET_SLOT (scm_class_class, scm_si_direct_supers, SCM_EOL); /* will be changed */
|
||||
/* SCM_SET_SLOT (scm_class_class, scm_si_direct_slots, slots_of_class); */
|
||||
SCM_SET_SLOT (scm_class_class, scm_si_direct_subclasses, SCM_EOL);
|
||||
SCM_SET_SLOT (scm_class_class, scm_si_direct_methods, SCM_EOL);
|
||||
SCM_SET_SLOT (scm_class_class, scm_si_cpl, SCM_EOL); /* will be changed */
|
||||
/* SCM_SET_SLOT (scm_class_class, scm_si_slots, slots_of_class); */
|
||||
SCM_SET_SLOT (scm_class_class, scm_si_nfields, SCM_MAKINUM (SCM_N_CLASS_SLOTS));
|
||||
/* SCM_SET_SLOT (scm_class_class, scm_si_getters_n_setters,
|
||||
compute_getters_n_setters (slots_of_class)); */
|
||||
SCM_SET_SLOT (scm_class_class, scm_si_redefined, SCM_BOOL_F);
|
||||
SCM_SET_SLOT (scm_class_class, scm_si_environment,
|
||||
scm_top_level_env (SCM_TOP_LEVEL_LOOKUP_CLOSURE));
|
||||
|
||||
prep_hashsets (scm_class_class);
|
||||
|
||||
|
|
@ -770,10 +769,10 @@ create_basic_classes (void)
|
|||
DEFVAR (name, scm_class_object);
|
||||
|
||||
/* <top> <object> and <class> were partially initialized. Correct them here */
|
||||
SCM_SLOT (scm_class_object, scm_si_direct_subclasses) = SCM_LIST1 (scm_class_class);
|
||||
SCM_SET_SLOT (scm_class_object, scm_si_direct_subclasses, SCM_LIST1 (scm_class_class));
|
||||
|
||||
SCM_SLOT (scm_class_class, scm_si_direct_supers) = SCM_LIST1 (scm_class_object);
|
||||
SCM_SLOT (scm_class_class, scm_si_cpl) = SCM_LIST3 (scm_class_class, scm_class_object, scm_class_top);
|
||||
SCM_SET_SLOT (scm_class_class, scm_si_direct_supers, SCM_LIST1 (scm_class_object));
|
||||
SCM_SET_SLOT (scm_class_class, scm_si_cpl, SCM_LIST3 (scm_class_class, scm_class_object, scm_class_top));
|
||||
}
|
||||
|
||||
/******************************************************************************/
|
||||
|
|
@ -1021,7 +1020,7 @@ SCM_DEFINE (scm_sys_fast_slot_set_x, "%fast-slot-set!", 3, 0, 0,
|
|||
SCM_VALIDATE_INUM (2, index);
|
||||
i = SCM_INUM (index);
|
||||
SCM_ASSERT_RANGE (2, index, i >= 0 && i < SCM_NUMBER_OF_SLOTS (obj));
|
||||
SCM_SLOT (obj, i) = value;
|
||||
SCM_SET_SLOT (obj, i, value);
|
||||
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
|
@ -1092,7 +1091,7 @@ set_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef, SCM value)
|
|||
* - otherwise (cadr access) is the setter function to apply
|
||||
*/
|
||||
if (SCM_INUMP (access))
|
||||
SCM_SLOT (obj, SCM_INUM (access)) = value;
|
||||
SCM_SET_SLOT (obj, SCM_INUM (access), value);
|
||||
else
|
||||
{
|
||||
/* We must evaluate (apply (cadr l) (list obj value))
|
||||
|
|
@ -1349,9 +1348,9 @@ SCM_DEFINE (scm_sys_allocate_instance, "%allocate-instance", 2, 0, 0,
|
|||
/* allocate class object */
|
||||
SCM z = scm_make_struct (class, SCM_INUM0, SCM_EOL);
|
||||
|
||||
SCM_SLOT (z, scm_si_print) = SCM_GOOPS_UNBOUND;
|
||||
SCM_SET_SLOT (z, scm_si_print, SCM_GOOPS_UNBOUND);
|
||||
for (i = scm_si_goops_fields; i < n; i++)
|
||||
SCM_SLOT (z, i) = SCM_GOOPS_UNBOUND;
|
||||
SCM_SET_SLOT (z, i, SCM_GOOPS_UNBOUND);
|
||||
|
||||
if (SCM_SUBCLASSP (class, scm_class_entity_class))
|
||||
SCM_SET_CLASS_FLAGS (z, SCM_CLASSF_OPERATOR | SCM_CLASSF_ENTITY);
|
||||
|
|
@ -1564,7 +1563,7 @@ clear_method_cache (SCM gf)
|
|||
{
|
||||
SCM cache = scm_make_method_cache (gf);
|
||||
SCM_SET_ENTITY_PROCEDURE (gf, cache);
|
||||
SCM_SLOT (gf, scm_si_used_by) = SCM_BOOL_F;
|
||||
SCM_SET_SLOT (gf, scm_si_used_by, SCM_BOOL_F);
|
||||
}
|
||||
|
||||
SCM_DEFINE (scm_sys_invalidate_method_cache_x, "%invalidate-method-cache!", 1, 0, 0,
|
||||
|
|
@ -1582,7 +1581,7 @@ SCM_DEFINE (scm_sys_invalidate_method_cache_x, "%invalidate-method-cache!", 1, 0
|
|||
scm_sys_invalidate_method_cache_x (SCM_CAR (used_by));
|
||||
clear_method_cache (gf);
|
||||
for (; SCM_CONSP (methods); methods = SCM_CDR (methods))
|
||||
SCM_SLOT (SCM_CAR (methods), scm_si_code_table) = SCM_EOL;
|
||||
SCM_SET_SLOT (SCM_CAR (methods), scm_si_code_table, SCM_EOL);
|
||||
}
|
||||
{
|
||||
SCM n = SCM_SLOT (gf, scm_si_n_specialized);
|
||||
|
|
@ -1692,7 +1691,7 @@ more_specificp (SCM m1, SCM m2, SCM *targs)
|
|||
if (SCM_CAR(s1) != SCM_CAR(s2)) {
|
||||
register SCM l, cs1 = SCM_CAR(s1), cs2 = SCM_CAR(s2);
|
||||
|
||||
for (l = SCM_SLOT(targs[i], scm_si_cpl); ; l = SCM_CDR(l)) {
|
||||
for (l = SCM_SLOT (targs[i], scm_si_cpl); ; l = SCM_CDR(l)) {
|
||||
if (cs1 == SCM_CAR(l))
|
||||
return 1;
|
||||
if (cs2 == SCM_CAR(l))
|
||||
|
|
@ -2032,47 +2031,47 @@ SCM_DEFINE (scm_make, "make", 0, 0, 1,
|
|||
|| class == scm_class_simple_method
|
||||
|| class == scm_class_accessor)
|
||||
{
|
||||
SCM_SLOT (z, scm_si_generic_function) =
|
||||
SCM_SET_SLOT (z, scm_si_generic_function,
|
||||
scm_i_get_keyword (k_gf,
|
||||
args,
|
||||
len - 1,
|
||||
SCM_BOOL_F,
|
||||
FUNC_NAME);
|
||||
SCM_SLOT (z, scm_si_specializers) =
|
||||
FUNC_NAME));
|
||||
SCM_SET_SLOT (z, scm_si_specializers,
|
||||
scm_i_get_keyword (k_specializers,
|
||||
args,
|
||||
len - 1,
|
||||
SCM_EOL,
|
||||
FUNC_NAME);
|
||||
SCM_SLOT (z, scm_si_procedure) =
|
||||
FUNC_NAME));
|
||||
SCM_SET_SLOT (z, scm_si_procedure,
|
||||
scm_i_get_keyword (k_procedure,
|
||||
args,
|
||||
len - 1,
|
||||
SCM_EOL,
|
||||
FUNC_NAME);
|
||||
SCM_SLOT (z, scm_si_code_table) = SCM_EOL;
|
||||
FUNC_NAME));
|
||||
SCM_SET_SLOT (z, scm_si_code_table, SCM_EOL);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* In all the others case, make a new class .... No instance here */
|
||||
SCM_SLOT (z, scm_si_name) =
|
||||
SCM_SET_SLOT (z, scm_si_name,
|
||||
scm_i_get_keyword (k_name,
|
||||
args,
|
||||
len - 1,
|
||||
scm_str2symbol ("???"),
|
||||
FUNC_NAME);
|
||||
SCM_SLOT (z, scm_si_direct_supers) =
|
||||
FUNC_NAME));
|
||||
SCM_SET_SLOT (z, scm_si_direct_supers,
|
||||
scm_i_get_keyword (k_dsupers,
|
||||
args,
|
||||
len - 1,
|
||||
SCM_EOL,
|
||||
FUNC_NAME);
|
||||
SCM_SLOT (z, scm_si_direct_slots) =
|
||||
FUNC_NAME));
|
||||
SCM_SET_SLOT (z, scm_si_direct_slots,
|
||||
scm_i_get_keyword (k_slots,
|
||||
args,
|
||||
len - 1,
|
||||
SCM_EOL,
|
||||
FUNC_NAME);
|
||||
FUNC_NAME));
|
||||
}
|
||||
}
|
||||
return z;
|
||||
|
|
@ -2210,10 +2209,10 @@ create_standard_classes (void)
|
|||
/* Continue initialization of class <class> */
|
||||
|
||||
slots = build_class_class_slots ();
|
||||
SCM_SLOT (scm_class_class, scm_si_direct_slots) = slots;
|
||||
SCM_SLOT (scm_class_class, scm_si_slots) = slots;
|
||||
SCM_SLOT (scm_class_class, scm_si_getters_n_setters)
|
||||
= compute_getters_n_setters (slots);
|
||||
SCM_SET_SLOT (scm_class_class, scm_si_direct_slots, slots);
|
||||
SCM_SET_SLOT (scm_class_class, scm_si_slots, slots);
|
||||
SCM_SET_SLOT (scm_class_class, scm_si_getters_n_setters,
|
||||
compute_getters_n_setters (slots));
|
||||
|
||||
make_stdcls (&scm_class_foreign_class, "<foreign-class>",
|
||||
scm_class_class, scm_class_class,
|
||||
|
|
@ -2258,12 +2257,12 @@ create_standard_classes (void)
|
|||
SCM_EOL);
|
||||
#if 0
|
||||
/* Patch cpl since compute_cpl doesn't support multiple inheritance. */
|
||||
SCM_SLOT (scm_class_generic_with_setter, scm_si_cpl) =
|
||||
SCM_SET_SLOT (scm_class_generic_with_setter, scm_si_cpl,
|
||||
scm_append (SCM_LIST3 (SCM_LIST2 (scm_class_generic_with_setter,
|
||||
scm_class_generic),
|
||||
SCM_SLOT (scm_class_entity_with_setter,
|
||||
scm_si_cpl),
|
||||
SCM_EOL));
|
||||
SCM_EOL)));
|
||||
#endif
|
||||
SCM_SET_CLASS_FLAGS (scm_class_generic_with_setter, SCM_CLASSF_PURE_GENERIC);
|
||||
|
||||
|
|
@ -2395,8 +2394,8 @@ scm_make_port_classes (long ptobnum, char *type_name)
|
|||
SCM_LIST2 (class,
|
||||
scm_class_input_output_port));
|
||||
/* Patch cpl (since this tree is too complex for the C level compute-cpl) */
|
||||
SCM_SLOT (c, scm_si_cpl)
|
||||
= scm_cons2 (c, class, SCM_SLOT (scm_class_input_output_port, scm_si_cpl));
|
||||
SCM_SET_SLOT (c, scm_si_cpl,
|
||||
scm_cons2 (c, class, SCM_SLOT (scm_class_input_output_port, scm_si_cpl)));
|
||||
}
|
||||
|
||||
static void
|
||||
|
|
@ -2478,7 +2477,7 @@ scm_make_class (SCM meta, char *s_name, SCM supers, size_t size,
|
|||
|
||||
if (destructor != 0)
|
||||
{
|
||||
SCM_SLOT (class, scm_si_destructor) = (SCM) destructor;
|
||||
SCM_SET_SLOT (class, scm_si_destructor, (SCM) destructor);
|
||||
SCM_SET_CLASS_DESTRUCTOR (class, scm_free_foreign_object);
|
||||
}
|
||||
else if (size > 0)
|
||||
|
|
@ -2487,8 +2486,8 @@ scm_make_class (SCM meta, char *s_name, SCM supers, size_t size,
|
|||
SCM_SET_CLASS_INSTANCE_SIZE (class, size);
|
||||
}
|
||||
|
||||
SCM_SLOT (class, scm_si_layout) = scm_str2symbol ("");
|
||||
SCM_SLOT (class, scm_si_constructor) = (SCM) constructor;
|
||||
SCM_SET_SLOT (class, scm_si_layout, scm_str2symbol (""));
|
||||
SCM_SET_SLOT (class, scm_si_constructor, (SCM) constructor);
|
||||
|
||||
return class;
|
||||
}
|
||||
|
|
@ -2544,19 +2543,18 @@ scm_add_slot (SCM class, char *slot_name, SCM slot_class,
|
|||
k_procedure, setm)));
|
||||
DEFVAR (aname, gf);
|
||||
|
||||
SCM_SLOT (class, scm_si_slots)
|
||||
= scm_append_x (SCM_LIST2 (SCM_SLOT (class, scm_si_slots),
|
||||
SCM_LIST1 (slot)));
|
||||
SCM_SLOT (class, scm_si_getters_n_setters)
|
||||
= scm_append_x (SCM_LIST2 (SCM_SLOT (class, scm_si_getters_n_setters),
|
||||
SCM_LIST1 (gns)));
|
||||
SCM_SET_SLOT (class, scm_si_slots,
|
||||
scm_append_x (SCM_LIST2 (SCM_SLOT (class, scm_si_slots),
|
||||
SCM_LIST1 (slot))));
|
||||
SCM_SET_SLOT (class, scm_si_getters_n_setters,
|
||||
scm_append_x (SCM_LIST2 (SCM_SLOT (class, scm_si_getters_n_setters),
|
||||
SCM_LIST1 (gns))));
|
||||
}
|
||||
}
|
||||
{
|
||||
long n = SCM_INUM (SCM_SLOT (class, scm_si_nfields));
|
||||
|
||||
SCM_SLOT (class, scm_si_nfields)
|
||||
= SCM_MAKINUM (n + 1);
|
||||
SCM_SET_SLOT (class, scm_si_nfields, SCM_MAKINUM (n + 1));
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -141,6 +141,8 @@ typedef struct scm_method_t {
|
|||
| SCM_CLASSF_SIMPLE_METHOD))
|
||||
|
||||
#define SCM_SLOT(x, i) (SCM_PACK (SCM_INST (x) [i]))
|
||||
#define SCM_SET_SLOT(x, i, v) (SCM_INST (x) [i] = SCM_UNPACK (v))
|
||||
#define SCM_SET_HASHSET(c, i, h) (SCM_INST (c) [scm_si_hashsets + (i)] = (h))
|
||||
#define SCM_SUBCLASSP(c1, c2) (!SCM_FALSEP (scm_c_memq (c2, SCM_SLOT (c1, scm_si_cpl))))
|
||||
#define SCM_IS_A_P(x, c) (SCM_NIMP (x) \
|
||||
&& SCM_INSTANCEP (x) \
|
||||
|
|
|
|||
|
|
@ -129,7 +129,6 @@ do { type *v0 = (type*)SCM_VELTS (ra0);\
|
|||
IVDEP (ra0 != ra1, \
|
||||
for (; n-- > 0; i0 += inc0, i1 += inc1) \
|
||||
v0[i0] OPERATOR v1[i1];) \
|
||||
break; \
|
||||
} while (0)
|
||||
|
||||
/* This macro is used for all but binary division and
|
||||
|
|
@ -143,14 +142,12 @@ do { type (*v0)[2] = (type (*)[2]) SCM_VELTS (ra0);\
|
|||
v0[i0][0] OPERATOR v1[i1][0]; \
|
||||
v0[i0][1] OPERATOR v1[i1][1]; \
|
||||
}) \
|
||||
break; \
|
||||
} while (0)
|
||||
|
||||
#define UNARY_ELTS_CODE(OPERATOR, type) \
|
||||
do { type *v0 = (type *) SCM_VELTS (ra0);\
|
||||
for (; n-- > 0; i0 += inc0) \
|
||||
v0[i0] OPERATOR v0[i0];\
|
||||
break;\
|
||||
} while (0)
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
/* classes: h_files */
|
||||
|
||||
#ifndef VECTORSH
|
||||
#define VECTORSH
|
||||
/* Copyright (C) 1995, 1996, 1998, 2000 Free Software Foundation, Inc.
|
||||
#ifndef SCM_VECTORS_H
|
||||
#define SCM_VECTORS_H
|
||||
/* Copyright (C) 1995,1996,1998,2000,2001 Free Software Foundation, Inc.
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
|
|
@ -67,9 +67,9 @@
|
|||
/*
|
||||
bit vectors
|
||||
*/
|
||||
#define SCM_BITVEC_REF(a, i) ((SCM_UNPACK(SCM_VELTS(a)[(i)/SCM_LONG_BIT]) & (1L<<((i)%SCM_LONG_BIT))) ? 1 : 0)
|
||||
#define SCM_BITVEC_SET(a, i) SCM_UNPACK(SCM_VELTS(a)[(i)/SCM_LONG_BIT]) |= (1L<<((i)%SCM_LONG_BIT))
|
||||
#define SCM_BITVEC_CLR(a, i) SCM_UNPACK(SCM_VELTS(a)[(i)/SCM_LONG_BIT]) &= ~(1L<<((i)%SCM_LONG_BIT))
|
||||
#define SCM_BITVEC_REF(a, i) ((SCM_VECTOR_BASE (a) [(i) / SCM_LONG_BIT] & (1L << ((i) % SCM_LONG_BIT))) ? 1 : 0)
|
||||
#define SCM_BITVEC_SET(a, i) SCM_VECTOR_BASE (a) [(i) / SCM_LONG_BIT] |= (1L << ((i) % SCM_LONG_BIT))
|
||||
#define SCM_BITVEC_CLR(a, i) SCM_VECTOR_BASE (a) [(i) / SCM_LONG_BIT] &= ~(1L << ((i) % SCM_LONG_BIT))
|
||||
|
||||
|
||||
|
||||
|
|
@ -99,7 +99,7 @@ extern SCM scm_vector_set_length_x (SCM vect, SCM len);
|
|||
|
||||
#endif /* SCM_DEBUG_DEPRECATED == 0 */
|
||||
|
||||
#endif /* VECTORSH */
|
||||
#endif /* SCM_VECTORS_H */
|
||||
|
||||
/*
|
||||
Local Variables:
|
||||
|
|
|
|||
|
|
@ -70,7 +70,7 @@ SCM_DEFINE (scm_make_weak_vector, "make-weak-vector", 1, 1, 0,
|
|||
SCM_SET_VECTOR_LENGTH (v, SCM_INUM (size), scm_tc7_wvect);
|
||||
SCM_SETVELTS(v, SCM_VELTS(v) + 2);
|
||||
SCM_VELTS(v)[-2] = SCM_EOL;
|
||||
SCM_UNPACK (SCM_VELTS (v)[-1]) = 0;
|
||||
SCM_VECTOR_BASE (v) [-1] = 0;
|
||||
SCM_ALLOW_INTS;
|
||||
return v;
|
||||
}
|
||||
|
|
@ -142,7 +142,7 @@ SCM_DEFINE (scm_make_weak_key_hash_table, "make-weak-key-hash-table", 1, 0, 0,
|
|||
SCM_VALIDATE_INUM (1, size);
|
||||
v = scm_make_weak_vector (size, SCM_EOL);
|
||||
SCM_DEFER_INTS;
|
||||
SCM_UNPACK (SCM_VELTS (v)[-1]) = 1;
|
||||
SCM_VECTOR_BASE (v) [-1] = 1;
|
||||
SCM_ALLOW_INTS;
|
||||
return v;
|
||||
}
|
||||
|
|
@ -159,7 +159,7 @@ SCM_DEFINE (scm_make_weak_value_hash_table, "make-weak-value-hash-table", 1, 0,
|
|||
SCM_VALIDATE_INUM (1, size);
|
||||
v = scm_make_weak_vector (size, SCM_EOL);
|
||||
SCM_DEFER_INTS;
|
||||
SCM_UNPACK (SCM_VELTS (v)[-1]) = 2;
|
||||
SCM_VECTOR_BASE (v) [-1] = 2;
|
||||
SCM_ALLOW_INTS;
|
||||
return v;
|
||||
}
|
||||
|
|
@ -177,7 +177,7 @@ SCM_DEFINE (scm_make_doubly_weak_hash_table, "make-doubly-weak-hash-table", 1, 0
|
|||
SCM_VALIDATE_INUM (1, size);
|
||||
v = scm_make_weak_vector (size, SCM_EOL);
|
||||
SCM_DEFER_INTS;
|
||||
SCM_UNPACK (SCM_VELTS (v)[-1]) = 3;
|
||||
SCM_VECTOR_BASE (v) [-1] = 3;
|
||||
SCM_ALLOW_INTS;
|
||||
return v;
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue