mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-02 04:40:29 +02:00
The struct data is now an array of scm_bits_t variables.
This commit is contained in:
Dirk Herrmann
parent
1c3e63f06d
commit
d8c40b9f49
6 changed files with 57 additions and 52 deletions
|
|
@ -1,3 +1,20 @@
|
|||
2000-04-11 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||
|
||||
* eval.c (SCM_CEVAL), objects.c (scm_mcache_lookup_cmethod,
|
||||
scm_make_subclass_object), objects.h (SCM_CLASS_FLAGS,
|
||||
SCM_ENTITY_PROCEDURE, SCM_ENTITY_SETTER), struct.c
|
||||
(scm_struct_init, scm_struct_vtable_p, scm_make_struct,
|
||||
scm_struct_ref, scm_struct_set_x), struct.h (SCM_STRUCT_DATA):
|
||||
The struct data is now an array of scm_bits_t variables.
|
||||
|
||||
* objects.h (SCM_SET_ENTITY_PROCEDURE): New macro.
|
||||
|
||||
* objects.c (scm_set_object_procedure_x): Use it.
|
||||
|
||||
* struct.c (scm_struct_init): Unused variable 'data' removed.
|
||||
|
||||
(scm_struct_vtable_p): Redundant SCM_IMP tests removed.
|
||||
|
||||
2000-04-11 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||
|
||||
* objects.h (SCM_OBJ_CLASS_FLAGS, SCM_OBJ_CLASS_REDEF), struct.h
|
||||
|
|
|
|||
|
|
@ -2299,8 +2299,8 @@ dispatch:
|
|||
if (SCM_NIMP (t.arg1))
|
||||
do
|
||||
{
|
||||
i += SCM_UNPACK ((SCM_STRUCT_DATA (scm_class_of (SCM_CAR (t.arg1))))
|
||||
[scm_si_hashsets + hashset]);
|
||||
i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (t.arg1)))
|
||||
[scm_si_hashsets + hashset];
|
||||
t.arg1 = SCM_CDR (t.arg1);
|
||||
}
|
||||
while (--j && SCM_NIMP (t.arg1));
|
||||
|
|
@ -2344,15 +2344,15 @@ dispatch:
|
|||
case (SCM_ISYMNUM (SCM_IM_SLOT_REF)):
|
||||
x = SCM_CDR (x);
|
||||
t.arg1 = EVALCAR (x, env);
|
||||
RETURN (SCM_STRUCT_DATA (t.arg1)[SCM_INUM (SCM_CADR (x))])
|
||||
RETURN (SCM_PACK (SCM_STRUCT_DATA (t.arg1) [SCM_INUM (SCM_CADR (x))]))
|
||||
|
||||
case (SCM_ISYMNUM (SCM_IM_SLOT_SET_X)):
|
||||
x = SCM_CDR (x);
|
||||
t.arg1 = EVALCAR (x, env);
|
||||
x = SCM_CDR (x);
|
||||
proc = SCM_CDR (x);
|
||||
SCM_STRUCT_DATA (t.arg1)[SCM_INUM (SCM_CAR (x))]
|
||||
= EVALCAR (proc, env);
|
||||
SCM_STRUCT_DATA (t.arg1) [SCM_INUM (SCM_CAR (x))]
|
||||
= SCM_UNPACK (EVALCAR (proc, env));
|
||||
RETURN (SCM_UNSPECIFIED)
|
||||
|
||||
case (SCM_ISYMNUM (SCM_IM_NIL_COND)):
|
||||
|
|
|
|||
|
|
@ -276,8 +276,8 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
|
|||
if (SCM_NIMP (ls))
|
||||
do
|
||||
{
|
||||
i += SCM_UNPACK (SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls)))
|
||||
[scm_si_hashsets + hashset]);
|
||||
i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls)))
|
||||
[scm_si_hashsets + hashset];
|
||||
ls = SCM_CDR (ls);
|
||||
}
|
||||
while (--j && SCM_NIMP (ls));
|
||||
|
|
@ -390,7 +390,7 @@ SCM_DEFINE (scm_set_object_procedure_x, "set-object-procedure!", 2, 0, 0,
|
|||
FUNC_NAME);
|
||||
SCM_VALIDATE_PROC (2,proc);
|
||||
if (SCM_I_ENTITYP (obj))
|
||||
SCM_ENTITY_PROCEDURE (obj) = proc;
|
||||
SCM_SET_ENTITY_PROCEDURE (obj, proc);
|
||||
else
|
||||
SCM_OPERATOR_CLASS (obj)->procedure = proc;
|
||||
return SCM_UNSPECIFIED;
|
||||
|
|
@ -455,7 +455,7 @@ SCM_DEFINE (scm_make_subclass_object, "make-subclass-object", 2, 0, 0,
|
|||
SCM pl;
|
||||
SCM_VALIDATE_STRUCT (1,class);
|
||||
SCM_VALIDATE_STRING (2,layout);
|
||||
pl = SCM_STRUCT_DATA (class)[scm_vtable_index_layout];
|
||||
pl = SCM_PACK (SCM_STRUCT_DATA (class) [scm_vtable_index_layout]);
|
||||
/* Convert symbol->string */
|
||||
pl = scm_makfromstr (SCM_CHARS (pl), (scm_sizet) SCM_LENGTH (pl), 0);
|
||||
return scm_i_make_class_object (SCM_STRUCT_VTABLE (class),
|
||||
|
|
|
|||
|
|
@ -67,10 +67,8 @@
|
|||
* certain class or its subclasses when traversal of the inheritance
|
||||
* graph would be too costly.
|
||||
*/
|
||||
#define SCM_CLASS_FLAGS(class)\
|
||||
SCM_UNPACK (SCM_STRUCT_DATA (class)[scm_struct_i_flags])
|
||||
#define SCM_OBJ_CLASS_FLAGS(obj)\
|
||||
(SCM_STRUCT_VTABLE_DATA (obj) [scm_struct_i_flags])
|
||||
#define SCM_CLASS_FLAGS(class) (SCM_STRUCT_DATA (class) [scm_struct_i_flags])
|
||||
#define SCM_OBJ_CLASS_FLAGS(obj) (SCM_STRUCT_VTABLE_DATA (obj) [scm_struct_i_flags])
|
||||
#define SCM_SET_CLASS_FLAGS(c, f) (SCM_CLASS_FLAGS (c) |= (f))
|
||||
#define SCM_CLEAR_CLASS_FLAGS(c, f) (SCM_CLASS_FLAGS (c) &= ~(f))
|
||||
#define SCM_CLASSF_MASK SCM_STRUCTF_MASK
|
||||
|
|
@ -92,8 +90,10 @@
|
|||
#define SCM_I_ENTITYP(obj)\
|
||||
((SCM_OBJ_CLASS_FLAGS (obj) & SCM_CLASSF_ENTITY) != 0)
|
||||
#define SCM_ENTITY_PROCEDURE(obj) \
|
||||
(SCM_STRUCT_DATA (obj)[scm_struct_i_procedure])
|
||||
#define SCM_ENTITY_SETTER(obj) (SCM_STRUCT_DATA (obj)[scm_struct_i_setter])
|
||||
(SCM_PACK (SCM_STRUCT_DATA (obj) [scm_struct_i_procedure]))
|
||||
#define SCM_SET_ENTITY_PROCEDURE(obj,v) \
|
||||
(SCM_STRUCT_DATA (obj) [scm_struct_i_procedure] = SCM_UNPACK (v))
|
||||
#define SCM_ENTITY_SETTER(obj) (SCM_PACK (SCM_STRUCT_DATA (obj)[scm_struct_i_setter]))
|
||||
|
||||
#define SCM_SET_CLASS_DESTRUCTOR(c, d) SCM_SET_VTABLE_DESTRUCTOR (c, d)
|
||||
#define SCM_SET_CLASS_INSTANCE_SIZE(c, s) \
|
||||
|
|
|
|||
|
|
@ -151,19 +151,13 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
|
|||
void
|
||||
scm_struct_init (SCM handle, int tail_elts, SCM inits)
|
||||
{
|
||||
SCM layout;
|
||||
SCM * data;
|
||||
unsigned char * fields_desc;
|
||||
SCM layout = SCM_STRUCT_LAYOUT (handle);
|
||||
unsigned char * fields_desc = (unsigned char *) SCM_CHARS (layout) - 2;
|
||||
unsigned char prot = 0;
|
||||
int n_fields;
|
||||
SCM * mem;
|
||||
int n_fields = SCM_LENGTH (layout) / 2;
|
||||
scm_bits_t * mem = SCM_STRUCT_DATA (handle);
|
||||
int tailp = 0;
|
||||
|
||||
layout = SCM_STRUCT_LAYOUT (handle);
|
||||
data = SCM_STRUCT_DATA (handle);
|
||||
fields_desc = (unsigned char *) SCM_CHARS (layout) - 2;
|
||||
n_fields = SCM_LENGTH (layout) / 2;
|
||||
mem = SCM_STRUCT_DATA (handle);
|
||||
while (n_fields)
|
||||
{
|
||||
if (!tailp)
|
||||
|
|
@ -174,7 +168,7 @@ scm_struct_init (SCM handle, int tail_elts, SCM inits)
|
|||
{
|
||||
tailp = 1;
|
||||
prot = prot == 'R' ? 'r' : prot == 'W' ? 'w' : 'o';
|
||||
*mem++ = SCM_PACK (tail_elts);
|
||||
*mem++ = tail_elts;
|
||||
n_fields += tail_elts - 1;
|
||||
if (n_fields == 0)
|
||||
break;
|
||||
|
|
@ -200,19 +194,19 @@ scm_struct_init (SCM handle, int tail_elts, SCM inits)
|
|||
*mem = 0;
|
||||
else
|
||||
{
|
||||
*mem = SCM_PACK (scm_num2ulong (SCM_CAR (inits),
|
||||
SCM_ARGn,
|
||||
"scm_struct_init"));
|
||||
*mem = scm_num2ulong (SCM_CAR (inits),
|
||||
SCM_ARGn,
|
||||
"scm_struct_init");
|
||||
inits = SCM_CDR (inits);
|
||||
}
|
||||
break;
|
||||
|
||||
case 'p':
|
||||
if ((prot != 'r' && prot != 'w') || SCM_NULLP (inits))
|
||||
*mem = SCM_BOOL_F;
|
||||
*mem = SCM_UNPACK (SCM_BOOL_F);
|
||||
else
|
||||
{
|
||||
*mem = SCM_CAR (inits);
|
||||
*mem = SCM_UNPACK (SCM_CAR (inits));
|
||||
inits = SCM_CDR (inits);
|
||||
}
|
||||
|
||||
|
|
@ -232,7 +226,7 @@ scm_struct_init (SCM handle, int tail_elts, SCM inits)
|
|||
#endif
|
||||
|
||||
case 's':
|
||||
*mem = handle;
|
||||
*mem = SCM_UNPACK (handle);
|
||||
break;
|
||||
}
|
||||
|
||||
|
|
@ -257,10 +251,7 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
|
|||
#define FUNC_NAME s_scm_struct_vtable_p
|
||||
{
|
||||
SCM layout;
|
||||
SCM * mem;
|
||||
|
||||
if (SCM_IMP (x))
|
||||
return SCM_BOOL_F;
|
||||
scm_bits_t * mem;
|
||||
|
||||
if (!SCM_STRUCTP (x))
|
||||
return SCM_BOOL_F;
|
||||
|
|
@ -279,10 +270,7 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
|
|||
if (mem[1] != 0)
|
||||
return SCM_BOOL_F;
|
||||
|
||||
if (SCM_IMP (mem[0]))
|
||||
return SCM_BOOL_F;
|
||||
|
||||
return SCM_BOOL(SCM_SYMBOLP (mem[0]));
|
||||
return SCM_BOOL (SCM_SYMBOLP (SCM_PACK (mem[0])));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -392,12 +380,12 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
|
|||
SCM_VALIDATE_VTABLE (1,vtable);
|
||||
SCM_VALIDATE_INUM (2,tail_array_size);
|
||||
|
||||
layout = SCM_STRUCT_DATA (vtable)[scm_vtable_index_layout];
|
||||
layout = SCM_PACK (SCM_STRUCT_DATA (vtable) [scm_vtable_index_layout]);
|
||||
basic_size = SCM_LENGTH (layout) / 2;
|
||||
tail_elts = SCM_INUM (tail_array_size);
|
||||
SCM_NEWCELL (handle);
|
||||
SCM_DEFER_INTS;
|
||||
if (SCM_UNPACK (SCM_STRUCT_DATA (vtable)[scm_struct_i_flags]) & SCM_STRUCTF_ENTITY)
|
||||
if (SCM_STRUCT_DATA (vtable)[scm_struct_i_flags] & SCM_STRUCTF_ENTITY)
|
||||
{
|
||||
data = scm_alloc_struct (basic_size + tail_elts,
|
||||
scm_struct_entity_n_extra_words,
|
||||
|
|
@ -520,7 +508,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
|
|||
#define FUNC_NAME s_scm_struct_ref
|
||||
{
|
||||
SCM answer = SCM_UNDEFINED;
|
||||
SCM * data;
|
||||
scm_bits_t * data;
|
||||
SCM layout;
|
||||
int p;
|
||||
scm_bits_t n_fields;
|
||||
|
|
@ -536,7 +524,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
|
|||
p = SCM_INUM (pos);
|
||||
|
||||
fields_desc = (unsigned char *) SCM_CHARS (layout);
|
||||
n_fields = SCM_UNPACK (data[scm_struct_i_n_words]);
|
||||
n_fields = data[scm_struct_i_n_words];
|
||||
|
||||
SCM_ASSERT_RANGE(1,pos, p < n_fields);
|
||||
|
||||
|
|
@ -564,7 +552,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
|
|||
switch (field_type)
|
||||
{
|
||||
case 'u':
|
||||
answer = scm_ulong2num (SCM_UNPACK (data[p]));
|
||||
answer = scm_ulong2num (data[p]);
|
||||
break;
|
||||
|
||||
#if 0
|
||||
|
|
@ -579,7 +567,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
|
|||
|
||||
case 's':
|
||||
case 'p':
|
||||
answer = data[p];
|
||||
answer = SCM_PACK (data[p]);
|
||||
break;
|
||||
|
||||
|
||||
|
|
@ -598,7 +586,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
|
|||
"")
|
||||
#define FUNC_NAME s_scm_struct_set_x
|
||||
{
|
||||
SCM * data;
|
||||
scm_bits_t * data;
|
||||
SCM layout;
|
||||
int p;
|
||||
int n_fields;
|
||||
|
|
@ -613,7 +601,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
|
|||
p = SCM_INUM (pos);
|
||||
|
||||
fields_desc = (unsigned char *)SCM_CHARS (layout);
|
||||
n_fields = SCM_UNPACK (data[scm_struct_i_n_words]);
|
||||
n_fields = data[scm_struct_i_n_words];
|
||||
|
||||
SCM_ASSERT_RANGE (1,pos, p < n_fields);
|
||||
|
||||
|
|
@ -636,7 +624,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
|
|||
switch (field_type)
|
||||
{
|
||||
case 'u':
|
||||
data[p] = SCM_PACK (SCM_NUM2ULONG (3, val));
|
||||
data[p] = SCM_NUM2ULONG (3, val);
|
||||
break;
|
||||
|
||||
#if 0
|
||||
|
|
@ -650,7 +638,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
|
|||
#endif
|
||||
|
||||
case 'p':
|
||||
data[p] = val;
|
||||
data[p] = SCM_UNPACK (val);
|
||||
break;
|
||||
|
||||
case 's':
|
||||
|
|
|
|||
|
|
@ -78,7 +78,7 @@ typedef scm_sizet (*scm_struct_free_t) (SCM *vtable, SCM *data);
|
|||
(no hidden words) */
|
||||
|
||||
#define SCM_STRUCTP(X) (SCM_NIMP(X) && (SCM_TYP3(X) == scm_tc3_cons_gloc))
|
||||
#define SCM_STRUCT_DATA(X) ((SCM *) SCM_UNPACK (SCM_CDR (X)))
|
||||
#define SCM_STRUCT_DATA(X) ((scm_bits_t *) SCM_CELL_WORD_1 (X))
|
||||
#define SCM_STRUCT_VTABLE_DATA(X) ((scm_bits_t *) (SCM_CELL_WORD_0 (X) - 1))
|
||||
|
||||
#define SCM_STRUCT_LAYOUT(X) (SCM_PACK (SCM_STRUCT_VTABLE_DATA (X) [scm_vtable_index_layout]))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue