summaryrefslogtreecommitdiff
path: root/libguile/struct.h
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-11-03 23:59:51 +0100
committerAndy Wingo <wingo@pobox.com>2009-11-26 00:24:58 +0100
commitb6cf4d026506b8e5042671f7503d4d9e9a810d49 (patch)
tree23fc026ced45b0ae756c4d0de111e9521711c7a8 /libguile/struct.h
parent9bd48cb17b4ce685f94f974442d452485a1017d6 (diff)
downloadguile-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.h147
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);