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

The struct data is now an array of scm_bits_t variables.

Browse source
This commit is contained in:
Dirk Herrmann 2000-04-12 01:19:49 +00:00
parent 1c3e63f06d
commit d8c40b9f49
6 changed files with 57 additions and 52 deletions
Download patch file Download diff file Expand all files Collapse all files

17
libguile/ChangeLog
View file

@ -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> 2000-04-11 Dirk Herrmann <D.Herrmann@tu-bs.de>
* objects.h (SCM_OBJ_CLASS_FLAGS, SCM_OBJ_CLASS_REDEF), struct.h * objects.h (SCM_OBJ_CLASS_FLAGS, SCM_OBJ_CLASS_REDEF), struct.h

10
libguile/eval.c
View file

@ -2299,8 +2299,8 @@ dispatch:
if (SCM_NIMP (t.arg1)) if (SCM_NIMP (t.arg1))
do do
{ {
i += SCM_UNPACK ((SCM_STRUCT_DATA (scm_class_of (SCM_CAR (t.arg1)))) i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (t.arg1)))
[scm_si_hashsets + hashset]); [scm_si_hashsets + hashset];
t.arg1 = SCM_CDR (t.arg1); t.arg1 = SCM_CDR (t.arg1);
} }
while (--j && SCM_NIMP (t.arg1)); while (--j && SCM_NIMP (t.arg1));
@ -2344,15 +2344,15 @@ dispatch:
case (SCM_ISYMNUM (SCM_IM_SLOT_REF)): case (SCM_ISYMNUM (SCM_IM_SLOT_REF)):
x = SCM_CDR (x); x = SCM_CDR (x);
t.arg1 = EVALCAR (x, env); 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)): case (SCM_ISYMNUM (SCM_IM_SLOT_SET_X)):
x = SCM_CDR (x); x = SCM_CDR (x);
t.arg1 = EVALCAR (x, env); t.arg1 = EVALCAR (x, env);
x = SCM_CDR (x); x = SCM_CDR (x);
proc = SCM_CDR (x); proc = SCM_CDR (x);
SCM_STRUCT_DATA (t.arg1)[SCM_INUM (SCM_CAR (x))] SCM_STRUCT_DATA (t.arg1) [SCM_INUM (SCM_CAR (x))]
= EVALCAR (proc, env); = SCM_UNPACK (EVALCAR (proc, env));
RETURN (SCM_UNSPECIFIED) RETURN (SCM_UNSPECIFIED)
case (SCM_ISYMNUM (SCM_IM_NIL_COND)): case (SCM_ISYMNUM (SCM_IM_NIL_COND)):

8
libguile/objects.c
View file

@ -276,8 +276,8 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
if (SCM_NIMP (ls)) if (SCM_NIMP (ls))
do do
{ {
i += SCM_UNPACK (SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls))) i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls)))
[scm_si_hashsets + hashset]); [scm_si_hashsets + hashset];
ls = SCM_CDR (ls); ls = SCM_CDR (ls);
} }
while (--j && SCM_NIMP (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); FUNC_NAME);
SCM_VALIDATE_PROC (2,proc); SCM_VALIDATE_PROC (2,proc);
if (SCM_I_ENTITYP (obj)) if (SCM_I_ENTITYP (obj))
SCM_ENTITY_PROCEDURE (obj) = proc; SCM_SET_ENTITY_PROCEDURE (obj, proc);
else else
SCM_OPERATOR_CLASS (obj)->procedure = proc; SCM_OPERATOR_CLASS (obj)->procedure = proc;
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -455,7 +455,7 @@ SCM_DEFINE (scm_make_subclass_object, "make-subclass-object", 2, 0, 0,
SCM pl; SCM pl;
SCM_VALIDATE_STRUCT (1,class); SCM_VALIDATE_STRUCT (1,class);
SCM_VALIDATE_STRING (2,layout); 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 */ /* Convert symbol->string */
pl = scm_makfromstr (SCM_CHARS (pl), (scm_sizet) SCM_LENGTH (pl), 0); pl = scm_makfromstr (SCM_CHARS (pl), (scm_sizet) SCM_LENGTH (pl), 0);
return scm_i_make_class_object (SCM_STRUCT_VTABLE (class), return scm_i_make_class_object (SCM_STRUCT_VTABLE (class),

12
libguile/objects.h
View file

@ -67,10 +67,8 @@
* certain class or its subclasses when traversal of the inheritance * certain class or its subclasses when traversal of the inheritance
* graph would be too costly. * graph would be too costly.
*/ */
#define SCM_CLASS_FLAGS(class)\ #define SCM_CLASS_FLAGS(class) (SCM_STRUCT_DATA (class) [scm_struct_i_flags])
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_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_SET_CLASS_FLAGS(c, f) (SCM_CLASS_FLAGS (c) |= (f))
#define SCM_CLEAR_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 #define SCM_CLASSF_MASK SCM_STRUCTF_MASK
@ -92,8 +90,10 @@
#define SCM_I_ENTITYP(obj)\ #define SCM_I_ENTITYP(obj)\
((SCM_OBJ_CLASS_FLAGS (obj) & SCM_CLASSF_ENTITY) != 0) ((SCM_OBJ_CLASS_FLAGS (obj) & SCM_CLASSF_ENTITY) != 0)
#define SCM_ENTITY_PROCEDURE(obj) \ #define SCM_ENTITY_PROCEDURE(obj) \
(SCM_STRUCT_DATA (obj)[scm_struct_i_procedure]) (SCM_PACK (SCM_STRUCT_DATA (obj) [scm_struct_i_procedure]))
#define SCM_ENTITY_SETTER(obj) (SCM_STRUCT_DATA (obj)[scm_struct_i_setter]) #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_DESTRUCTOR(c, d) SCM_SET_VTABLE_DESTRUCTOR (c, d)
#define SCM_SET_CLASS_INSTANCE_SIZE(c, s) \ #define SCM_SET_CLASS_INSTANCE_SIZE(c, s) \

56
libguile/struct.c
View file

@ -151,19 +151,13 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
void void
scm_struct_init (SCM handle, int tail_elts, SCM inits) scm_struct_init (SCM handle, int tail_elts, SCM inits)
{ {
SCM layout; SCM layout = SCM_STRUCT_LAYOUT (handle);
SCM * data; unsigned char * fields_desc = (unsigned char *) SCM_CHARS (layout) - 2;
unsigned char * fields_desc;
unsigned char prot = 0; unsigned char prot = 0;
int n_fields; int n_fields = SCM_LENGTH (layout) / 2;
SCM * mem; scm_bits_t * mem = SCM_STRUCT_DATA (handle);
int tailp = 0; 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) while (n_fields)
{ {
if (!tailp) if (!tailp)
@ -174,7 +168,7 @@ scm_struct_init (SCM handle, int tail_elts, SCM inits)
{ {
tailp = 1; tailp = 1;
prot = prot == 'R' ? 'r' : prot == 'W' ? 'w' : 'o'; prot = prot == 'R' ? 'r' : prot == 'W' ? 'w' : 'o';
*mem++ = SCM_PACK (tail_elts); *mem++ = tail_elts;
n_fields += tail_elts - 1; n_fields += tail_elts - 1;
if (n_fields == 0) if (n_fields == 0)
break; break;
@ -200,19 +194,19 @@ scm_struct_init (SCM handle, int tail_elts, SCM inits)
*mem = 0; *mem = 0;
else else
{ {
*mem = SCM_PACK (scm_num2ulong (SCM_CAR (inits), *mem = scm_num2ulong (SCM_CAR (inits),
SCM_ARGn, SCM_ARGn,
"scm_struct_init")); "scm_struct_init");
inits = SCM_CDR (inits); inits = SCM_CDR (inits);
} }
break; break;
case 'p': case 'p':
if ((prot != 'r' && prot != 'w') || SCM_NULLP (inits)) if ((prot != 'r' && prot != 'w') || SCM_NULLP (inits))
*mem = SCM_BOOL_F; *mem = SCM_UNPACK (SCM_BOOL_F);
else else
{ {
*mem = SCM_CAR (inits); *mem = SCM_UNPACK (SCM_CAR (inits));
inits = SCM_CDR (inits); inits = SCM_CDR (inits);
} }
@ -232,7 +226,7 @@ scm_struct_init (SCM handle, int tail_elts, SCM inits)
#endif #endif
case 's': case 's':
*mem = handle; *mem = SCM_UNPACK (handle);
break; break;
} }
@ -257,10 +251,7 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
#define FUNC_NAME s_scm_struct_vtable_p #define FUNC_NAME s_scm_struct_vtable_p
{ {
SCM layout; SCM layout;
SCM * mem; scm_bits_t * mem;
if (SCM_IMP (x))
return SCM_BOOL_F;
if (!SCM_STRUCTP (x)) if (!SCM_STRUCTP (x))
return SCM_BOOL_F; return SCM_BOOL_F;
@ -279,10 +270,7 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
if (mem[1] != 0) if (mem[1] != 0)
return SCM_BOOL_F; return SCM_BOOL_F;
if (SCM_IMP (mem[0])) return SCM_BOOL (SCM_SYMBOLP (SCM_PACK (mem[0])));
return SCM_BOOL_F;
return SCM_BOOL(SCM_SYMBOLP (mem[0]));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -392,12 +380,12 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
SCM_VALIDATE_VTABLE (1,vtable); SCM_VALIDATE_VTABLE (1,vtable);
SCM_VALIDATE_INUM (2,tail_array_size); 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; basic_size = SCM_LENGTH (layout) / 2;
tail_elts = SCM_INUM (tail_array_size); tail_elts = SCM_INUM (tail_array_size);
SCM_NEWCELL (handle); SCM_NEWCELL (handle);
SCM_DEFER_INTS; 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, data = scm_alloc_struct (basic_size + tail_elts,
scm_struct_entity_n_extra_words, 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 #define FUNC_NAME s_scm_struct_ref
{ {
SCM answer = SCM_UNDEFINED; SCM answer = SCM_UNDEFINED;
SCM * data; scm_bits_t * data;
SCM layout; SCM layout;
int p; int p;
scm_bits_t n_fields; scm_bits_t n_fields;
@ -536,7 +524,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
p = SCM_INUM (pos); p = SCM_INUM (pos);
fields_desc = (unsigned char *) SCM_CHARS (layout); 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); 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) switch (field_type)
{ {
case 'u': case 'u':
answer = scm_ulong2num (SCM_UNPACK (data[p])); answer = scm_ulong2num (data[p]);
break; break;
#if 0 #if 0
@ -579,7 +567,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
case 's': case 's':
case 'p': case 'p':
answer = data[p]; answer = SCM_PACK (data[p]);
break; break;
@ -598,7 +586,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
"") "")
#define FUNC_NAME s_scm_struct_set_x #define FUNC_NAME s_scm_struct_set_x
{ {
SCM * data; scm_bits_t * data;
SCM layout; SCM layout;
int p; int p;
int n_fields; int n_fields;
@ -613,7 +601,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
p = SCM_INUM (pos); p = SCM_INUM (pos);
fields_desc = (unsigned char *)SCM_CHARS (layout); 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); 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) switch (field_type)
{ {
case 'u': case 'u':
data[p] = SCM_PACK (SCM_NUM2ULONG (3, val)); data[p] = SCM_NUM2ULONG (3, val);
break; break;
#if 0 #if 0
@ -650,7 +638,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
#endif #endif
case 'p': case 'p':
data[p] = val; data[p] = SCM_UNPACK (val);
break; break;
case 's': case 's':

2
libguile/struct.h
View file

@ -78,7 +78,7 @@ typedef scm_sizet (*scm_struct_free_t) (SCM *vtable, SCM *data);
(no hidden words) */ (no hidden words) */
#define SCM_STRUCTP(X) (SCM_NIMP(X) && (SCM_TYP3(X) == scm_tc3_cons_gloc)) #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_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])) #define SCM_STRUCT_LAYOUT(X) (SCM_PACK (SCM_STRUCT_VTABLE_DATA (X) [scm_vtable_index_layout]))