diff options
author | Andy Wingo <wingo@pobox.com> | 2009-11-03 23:59:51 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-11-26 00:24:58 +0100 |
commit | b6cf4d026506b8e5042671f7503d4d9e9a810d49 (patch) | |
tree | 23fc026ced45b0ae756c4d0de111e9521711c7a8 /libguile/struct.h | |
parent | 9bd48cb17b4ce685f94f974442d452485a1017d6 (diff) | |
download | guile-b6cf4d026506b8e5042671f7503d4d9e9a810d49.tar.gz |
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.
Diffstat (limited to 'libguile/struct.h')
-rw-r--r-- | libguile/struct.h | 147 |
1 files changed, 105 insertions, 42 deletions
diff --git a/libguile/struct.h b/libguile/struct.h index 8634659f8..eb4bfc2e4 100644 --- a/libguile/struct.h +++ b/libguile/struct.h @@ -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 - -/* 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 */ - -/* 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? */ - -typedef void (*scm_t_struct_free) (scm_t_bits * vtable, scm_t_bits * data); - -#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) */ +/* 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. + + I would like to write this all up here, but for now: + + http://wingolog.org/pub/goops-class-redefinition-3.png + */ + +/* 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_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_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)) - -#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 */ +#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) + +/* 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)) + +/* 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); |