mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-17 09:10:22 +02:00
a very big commit cleaning up structs & goops. also applicable structs.
I tried to split this one, and I know it's a bit disruptive, but this stuff really is one big cobweb. So instead we'll pretend like these are separate commits, by separating the changelog. Applicable struct runtime support. * libguile/debug.c (scm_procedure_source): * libguile/eval.c (scm_trampoline_0, scm_trampoline_1) (scm_trampoline_2): * libguile/eval.i.c (CEVAL): * libguile/goops.c (scm_class_of): * libguile/procprop.c (scm_i_procedure_arity): * libguile/procs.c (scm_procedure_p, scm_procedure, scm_setter): Allow for applicable structs. Whee! * libguile/deprecated.h (scm_vtable_index_vtable): Define as a synonym for scm_vtable_index_self. (scm_vtable_index_printer): Alias scm_vtable_index_instance_printer. (scm_struct_i_free): Alias scm_vtable_index_instance_finalize. (scm_struct_i_flags): Alias scm_vtable_index_flags. (SCM_STRUCTF_FLAGS): Be a -1 mask, we have a whole word now. (SCM_SET_VTABLE_DESTRUCTOR): Implement by hand. Hidden slots. * libguile/struct.c (scm_make_struct_layout): Add support for "hidden" fields, writable fields that are not visible to make-struct. This allows us to add fields to vtables and not break existing make-struct invocations. (scm_struct_ref, scm_struct_set_x): Always get struct length from the vtable. Support hidden fields. * libguile/goops.c (scm_class_hidden, scm_class_protected_hidden): New slot classes, to correspond to the new vtable slots. (scm_sys_prep_layout_x): Turn hidden slots into 'h'. (build_class_class_slots): Reorder the class slots to account for vtable fields coming out of negative-land, for name as a vtable slot, and for hidden fields. (create_standard_classes): Define <hidden-slot> and <protected-hidden-slot>. Clean up struct.h. * libguile/struct.h: Lay things out cleaner. There are no more hidden (negative) words. Names are nicer. The exposition is nicer. But the basics are the same. The incompatibilities are that <vtable> has more slots now, and that scm_alloc_struct's signature has changed. The former is ameliorated by the "hidden" slots mentioned before, and the latter, well, it was always a very internal thing... (scm_t_struct_finalize): New type, a finalizer function to be run when instances of a vtable are collected. (scm_t_struct_free): Removed, structs' data is managed by the GC now, and not freed by vtable functions. * libguile/struct.c: (scm_vtable_p): Now we keep flags on vtable-vtables, so this check is cheaper. (scm_alloc_struct): No hidden words. Yippee. (struct_finalizer_trampoline): Entersify. (scm_make_struct): No need to babysit extra words, though now we have to babysit flags. Propagate the vtable, applicable, and setter flags appropriately. (scm_make_vtable_vtable): Update for new simplicity. (scm_print_struct): A better printer. (scm_init_struct): Define <applicable-struct-vtable>, a magical vtable like CL's funcallable-standard-class. Also define <applicable-struct-with-setter-vtable>. Remove foreign object implementation. * libguile/goops.h: * libguile/goops.c (scm_make_foreign_object, scm_make_class) (scm_add_slot, scm_wrap_object, scm_wrap_component): Remove, these were undocumented and unworking. Clean up goops.h, a little. * libguile/goops.h: * libguile/goops.c: Also clean up. * module/oop/goops/dispatch.scm (hashset-index): Adapt for new hashset index.
This commit is contained in:
Andy Wingo
parent
9bd48cb17b
commit
b6cf4d0265
11 changed files with 491 additions and 582 deletions
|
|
@ -28,48 +28,112 @@
|
|||
|
||||
|
||||
|
||||
/* Number of words with negative index */
|
||||
#define scm_struct_n_extra_words 4
|
||||
#define scm_struct_entity_n_extra_words 6
|
||||
/* The relationship between a struct and its vtable is a bit complicated,
|
||||
because we want structs to be used as GOOPS' native representation -- which
|
||||
in turn means we need support for changing the "class" (vtable) of an
|
||||
"instance" (struct). This necessitates some indirection and trickery.
|
||||
|
||||
/* These are how the initial words of a vtable are allocated. */
|
||||
#define scm_struct_i_setter -6 /* Setter */
|
||||
#define scm_struct_i_procedure -5 /* Optional procedure slot */
|
||||
#define scm_struct_i_free -4 /* Destructor */
|
||||
#define scm_struct_i_ptr -3 /* Start of block (see alloc_struct) */
|
||||
#define scm_struct_i_n_words -2 /* How many words allocated to this struct? */
|
||||
#define scm_struct_i_flags -1 /* Upper 12 bits used as flags */
|
||||
I would like to write this all up here, but for now:
|
||||
|
||||
/* These indices must correspond to required_vtable_fields in
|
||||
struct.c. */
|
||||
#define scm_vtable_index_layout 0 /* A symbol describing the physical arrangement of this type. */
|
||||
#define scm_vtable_index_vtable 1 /* A pointer to the handle for this vtable. */
|
||||
#define scm_vtable_index_printer 2 /* A printer for this struct type. */
|
||||
#define scm_vtable_offset_user 3 /* Where do user fields start? */
|
||||
http://wingolog.org/pub/goops-class-redefinition-3.png
|
||||
*/
|
||||
|
||||
typedef void (*scm_t_struct_free) (scm_t_bits * vtable, scm_t_bits * data);
|
||||
/* All vtables have the following fields. */
|
||||
#define SCM_VTABLE_BASE_LAYOUT \
|
||||
"pr" /* layout */ \
|
||||
"uh" /* flags */ \
|
||||
"sr" /* self */ \
|
||||
"uh" /* finalizer */ \
|
||||
"pw" /* printer */ \
|
||||
"ph" /* name (hidden from make-struct for back-compat reasons) */ \
|
||||
"uh" /* reserved */ \
|
||||
"uh" /* reserved */
|
||||
|
||||
#define SCM_STRUCTF_MASK (0xFFF << 20)
|
||||
#define SCM_STRUCTF_GOOPS_HACK (0x010 << 20) /* FIXME -- PURE_GENERIC */
|
||||
#define SCM_STRUCTF_LIGHT (1L << 31) /* Light representation
|
||||
(no hidden words) */
|
||||
#define scm_vtable_index_layout 0 /* A symbol describing the physical arrangement of this type. */
|
||||
#define scm_vtable_index_flags 1 /* Class flags */
|
||||
#define scm_vtable_index_self 2 /* A pointer to the vtable itself */
|
||||
#define scm_vtable_index_instance_finalize 3 /* Finalizer for instances of this struct type. */
|
||||
#define scm_vtable_index_instance_printer 4 /* A printer for this struct type. */
|
||||
#define scm_vtable_index_name 5 /* Name of this vtable. */
|
||||
#define scm_vtable_index_reserved_6 6
|
||||
#define scm_vtable_index_reserved_7 7
|
||||
#define scm_vtable_offset_user 8 /* Where do user fields start in the vtable? */
|
||||
|
||||
/* All applicable structs have the following fields. */
|
||||
#define SCM_APPLICABLE_BASE_LAYOUT \
|
||||
"pw" /* procedure */
|
||||
#define SCM_APPLICABLE_WITH_SETTER_BASE_LAYOUT \
|
||||
"pw" /* procedure */ \
|
||||
"pw" /* setter */
|
||||
#define scm_applicable_struct_index_procedure 0 /* The procedure of an applicable
|
||||
struct. Only valid if the
|
||||
struct's vtable has the
|
||||
applicable flag set. */
|
||||
#define scm_applicable_struct_index_setter 1 /* The setter of an applicable
|
||||
struct. Only valid if the
|
||||
struct's vtable has the
|
||||
setter flag set. */
|
||||
|
||||
#define SCM_VTABLE_FLAG_VTABLE (1L << 0) /* instances of this vtable are themselves vtables? */
|
||||
#define SCM_VTABLE_FLAG_APPLICABLE_VTABLE (1L << 1) /* instances of this vtable are applicable vtables? */
|
||||
#define SCM_VTABLE_FLAG_APPLICABLE (1L << 2) /* instances of this vtable are applicable? */
|
||||
#define SCM_VTABLE_FLAG_SETTER_VTABLE (1L << 3) /* instances of this vtable are applicable-with-setter vtables? */
|
||||
#define SCM_VTABLE_FLAG_SETTER (1L << 4) /* instances of this vtable are applicable-with-setters? */
|
||||
#define SCM_VTABLE_FLAG_RESERVED_0 (1L << 5)
|
||||
#define SCM_VTABLE_FLAG_RESERVED_1 (1L << 6)
|
||||
#define SCM_VTABLE_FLAG_RESERVED_2 (1L << 7)
|
||||
#define SCM_VTABLE_FLAG_GOOPS_0 (1L << 8)
|
||||
#define SCM_VTABLE_FLAG_GOOPS_1 (1L << 9)
|
||||
#define SCM_VTABLE_FLAG_GOOPS_2 (1L << 10)
|
||||
#define SCM_VTABLE_FLAG_GOOPS_3 (1L << 11)
|
||||
#define SCM_VTABLE_FLAG_GOOPS_4 (1L << 12)
|
||||
#define SCM_VTABLE_FLAG_GOOPS_5 (1L << 13)
|
||||
#define SCM_VTABLE_FLAG_GOOPS_6 (1L << 14)
|
||||
#define SCM_VTABLE_FLAG_GOOPS_7 (1L << 15)
|
||||
#define SCM_VTABLE_USER_FLAG_SHIFT 16
|
||||
|
||||
typedef void (*scm_t_struct_finalize) (SCM obj);
|
||||
|
||||
#define SCM_STRUCTP(X) (!SCM_IMP(X) && (SCM_TYP3(X) == scm_tc3_struct))
|
||||
#define SCM_STRUCT_DATA(X) ((scm_t_bits *) SCM_CELL_WORD_1 (X))
|
||||
#define SCM_STRUCT_VTABLE_DATA(X) ((scm_t_bits *) (SCM_CELL_WORD_0 (X) - scm_tc3_struct))
|
||||
#define SCM_STRUCT_SLOTS(X) ((SCM*)SCM_CELL_WORD_1 ((X)))
|
||||
#define SCM_STRUCT_SLOT_REF(X,I) (SCM_STRUCT_SLOTS (X)[(I)])
|
||||
#define SCM_STRUCT_SLOT_SET(X,I,V) SCM_STRUCT_SLOTS (X)[(I)]=(V)
|
||||
#define SCM_STRUCT_DATA(X) ((scm_t_bits*)SCM_CELL_WORD_1 (X))
|
||||
#define SCM_STRUCT_DATA_REF(X,I) (SCM_STRUCT_DATA (X)[(I)])
|
||||
#define SCM_STRUCT_DATA_SET(X,I,V) SCM_STRUCT_DATA (X)[(I)]=(V)
|
||||
|
||||
#define SCM_STRUCT_LAYOUT(X) (SCM_PACK (SCM_STRUCT_VTABLE_DATA (X) [scm_vtable_index_layout]))
|
||||
#define SCM_SET_STRUCT_LAYOUT(X, v) (SCM_STRUCT_VTABLE_DATA (X) [scm_vtable_index_layout] = SCM_UNPACK (v))
|
||||
/* The SCM_VTABLE_* macros assume that you're passing them a struct which is a
|
||||
valid vtable. */
|
||||
#define SCM_VTABLE_LAYOUT(X) (SCM_STRUCT_SLOT_REF ((X), scm_vtable_index_layout))
|
||||
#define SCM_SET_VTABLE_LAYOUT(X,L) (SCM_STRUCT_SLOT_SET ((X), scm_vtable_index_layout, L))
|
||||
#define SCM_VTABLE_FLAGS(X) (SCM_STRUCT_DATA_REF (X, scm_vtable_index_flags))
|
||||
#define SCM_SET_VTABLE_FLAGS(X,F) (SCM_STRUCT_DATA_REF (X, scm_vtable_index_flags) |= (F))
|
||||
#define SCM_CLEAR_VTABLE_FLAGS(X,F) (SCM_STRUCT_DATA_REF (X, scm_vtable_index_flags) &= (~(F)))
|
||||
#define SCM_VTABLE_FLAG_IS_SET(X,F) (SCM_STRUCT_DATA_REF (X, scm_vtable_index_flags) & (F))
|
||||
#define SCM_VTABLE_INSTANCE_FINALIZER(X) ((scm_t_struct_finalize)SCM_STRUCT_SLOT_REF (X, scm_vtable_index_instance_finalize))
|
||||
#define SCM_VTABLE_INSTANCE_PRINTER(X) (SCM_STRUCT_SLOT_REF (X, scm_vtable_index_instance_printer))
|
||||
#define SCM_VTABLE_NAME(X) (SCM_STRUCT_SLOT_REF (X, scm_vtable_index_name))
|
||||
#define SCM_SET_VTABLE_NAME(X,V) (SCM_STRUCT_SLOT_SET (X, scm_vtable_index_name, V))
|
||||
|
||||
#define SCM_STRUCT_VTABLE(X) (SCM_PACK (SCM_STRUCT_VTABLE_DATA (X) [scm_vtable_index_vtable]))
|
||||
#define SCM_STRUCT_VTABLE_FLAGS(X) \
|
||||
(SCM_STRUCT_VTABLE_DATA (X) [scm_struct_i_flags])
|
||||
#define SCM_STRUCT_PRINTER(X) (SCM_PACK (SCM_STRUCT_VTABLE_DATA (X) [scm_vtable_index_printer]))
|
||||
#define SCM_SET_STRUCT_PRINTER(x, v)\
|
||||
(SCM_STRUCT_VTABLE_DATA (x) [scm_vtable_index_printer] = SCM_UNPACK (v))
|
||||
#define SCM_SET_VTABLE_DESTRUCTOR(X, D) (SCM_STRUCT_DATA (X) [scm_struct_i_free] = (scm_t_bits) (D))
|
||||
/* Efficiency is important in the following macro, since it's used in GC */
|
||||
#define SCM_LAYOUT_TAILP(X) (((X) & 32) == 0) /* R, W or O */
|
||||
/* Structs hold a pointer to their vtable's data, not the vtable itself. To get
|
||||
the vtable we have to do an indirection through the self slot. */
|
||||
#define SCM_STRUCT_VTABLE_DATA(X) ((scm_t_bits*)(SCM_CELL_WORD_0 (X) - scm_tc3_struct))
|
||||
#define SCM_STRUCT_VTABLE_SLOTS(X) ((SCM*)(SCM_CELL_WORD_0 (X) - scm_tc3_struct))
|
||||
#define SCM_STRUCT_VTABLE(X) (SCM_STRUCT_VTABLE_SLOTS(X)[scm_vtable_index_self])
|
||||
/* But often we just need to access the vtable's data; we can do that without
|
||||
the data->self->data indirection. */
|
||||
#define SCM_STRUCT_LAYOUT(X) (SCM_STRUCT_VTABLE_SLOTS (X)[scm_vtable_index_layout])
|
||||
#define SCM_STRUCT_PRINTER(X) (SCM_STRUCT_VTABLE_SLOTS (X)[scm_vtable_index_instance_printer])
|
||||
#define SCM_STRUCT_FINALIZER(X) ((scm_t_struct_finalize)SCM_STRUCT_VTABLE_DATA (X)[scm_vtable_index_instance_finalize])
|
||||
#define SCM_STRUCT_VTABLE_FLAGS(X) (SCM_STRUCT_VTABLE_DATA (X)[scm_vtable_index_flags])
|
||||
#define SCM_STRUCT_VTABLE_FLAG_IS_SET(X,F) (SCM_STRUCT_VTABLE_DATA (X)[scm_vtable_index_flags]&(F))
|
||||
|
||||
#define SCM_STRUCT_APPLICABLE_P(X) (SCM_STRUCT_VTABLE_FLAG_IS_SET ((X), SCM_VTABLE_FLAG_APPLICABLE))
|
||||
#define SCM_STRUCT_SETTER_P(X) (SCM_STRUCT_VTABLE_FLAG_IS_SET ((X), SCM_VTABLE_FLAG_SETTER))
|
||||
#define SCM_STRUCT_PROCEDURE(X) (SCM_STRUCT_SLOT_REF (X, scm_applicable_struct_index_procedure))
|
||||
#define SCM_SET_STRUCT_PROCEDURE(X,P) (SCM_STRUCT_SLOT_SET (X, scm_applicable_struct_index_procedure, P))
|
||||
#define SCM_STRUCT_SETTER(X) (SCM_STRUCT_SLOT_REF (X, scm_applicable_struct_index_setter))
|
||||
#define SCM_SET_STRUCT_SETTER(X,P) (SCM_STRUCT_SLOT_SET (X, scm_applicable_struct_index_setter, P))
|
||||
|
||||
#define SCM_STRUCT_TABLE_NAME(X) SCM_CAR (X)
|
||||
#define SCM_SET_STRUCT_TABLE_NAME(X, NAME) SCM_SETCAR (X, NAME)
|
||||
|
|
@ -79,8 +143,7 @@ SCM_API SCM scm_struct_table;
|
|||
|
||||
|
||||
|
||||
SCM_API scm_t_bits * scm_alloc_struct (int n_words, int n_extra,
|
||||
const char *what);
|
||||
SCM_API SCM scm_alloc_struct (scm_t_bits *vtable_data, int n_words, const char *what);
|
||||
SCM_API SCM scm_make_struct_layout (SCM fields);
|
||||
SCM_API SCM scm_struct_p (SCM x);
|
||||
SCM_API SCM scm_struct_vtable_p (SCM x);
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue