[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 04/07: Remove indirection in structs
From: |
Andy Wingo |
Subject: |
[Guile-commits] 04/07: Remove indirection in structs |
Date: |
Thu, 14 Sep 2017 05:10:28 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit 7e91ff651b3c9f7c27f2be146ea611bab65809a8
Author: Andy Wingo <address@hidden>
Date: Thu Sep 7 16:55:30 2017 +0200
Remove indirection in structs
* libguile/gc.c (scm_storage_prehistory): Register struct displacement
here.
* libguile/goops.c (scm_sys_modify_instance): Fix the format of a
comment.
* libguile/modules.c (scm_post_boot_init_modules): Update for new format
of struct vtable references.
* libguile/struct.c (scm_i_alloc_struct): Update to include slots
directly, instead of being indirected by an embedded pointer.
(scm_c_make_structv, scm_allocate_struct, scm_i_make_vtable_vtable):
Adapt to pass vtable bits as argument to scm_i_alloc_struct, not
vtable data bits.
(scm_init_struct): Remove two-word displacement from libgc.
* libguile/struct.h: Update comment.
(SCM_STRUCT_SLOTS, SCM_STRUCT_DATA): Update definitions.
(SCM_STRUCT_VTABLE_DATA, SCM_STRUCT_VTABLE_SLOTS): Remove.
(SCM_STRUCT_VTABLE, SCM_STRUCT_LAYOUT, SCM_STRUCT_PRINTER)
(SCM_STRUCT_FINALIZER, SCM_STRUCT_VTABLE_FLAGS)
(SCM_STRUCT_VTABLE_FLAG_IS_SET): Simplify definitions.
* module/system/base/types.scm (cell->object, address->inferior-struct):
Adapt to struct representation change.
---
libguile/gc.c | 6 ++--
libguile/goops.c | 5 ++-
libguile/modules.c | 4 +--
libguile/struct.c | 47 +++++++--------------------
libguile/struct.h | 75 ++++++++++++++++----------------------------
module/system/base/types.scm | 11 ++++---
6 files changed, 52 insertions(+), 96 deletions(-)
diff --git a/libguile/gc.c b/libguile/gc.c
index 4478128..b9064b3 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006,
- * 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2016 Free Software Foundation,
Inc.
+ * 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2016, 2017 Free Software
Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -480,9 +480,9 @@ scm_storage_prehistory ()
/* We only need to register a displacement for those types for which the
higher bits of the type tag are used to store a pointer (that is, a
- pointer to an 8-octet aligned region). For `scm_tc3_struct', this is
- handled in `scm_alloc_struct ()'. */
+ pointer to an 8-octet aligned region). */
GC_REGISTER_DISPLACEMENT (scm_tc3_cons);
+ GC_REGISTER_DISPLACEMENT (scm_tc3_struct);
/* GC_REGISTER_DISPLACEMENT (scm_tc3_unused); */
/* Sanity check. */
diff --git a/libguile/goops.c b/libguile/goops.c
index 12a3687..7e7a265 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -521,9 +521,8 @@ SCM_DEFINE (scm_sys_modify_instance, "%modify-instance", 2,
0, 0,
SCM_ASSERT (old_nfields == new_nfields, new, SCM_ARG2, FUNC_NAME);
/* Exchange the data contained in old and new. We exchange rather than
- * scratch the old value with new to be correct with GC.
- * See "Class redefinition protocol above".
- */
+ scratch the old value with new to be correct with GC. See "Class
+ redefinition protocol" in goops.scm. */
scm_i_pthread_mutex_lock (&goops_lock);
/* Swap vtables. */
{
diff --git a/libguile/modules.c b/libguile/modules.c
index d87ec7a..b469a1a 100644
--- a/libguile/modules.c
+++ b/libguile/modules.c
@@ -1,4 +1,4 @@
-/* Copyright (C)
1998,2000,2001,2002,2003,2004,2006,2007,2008,2009,2010,2011,2012 Free Software
Foundation, Inc.
+/* Copyright (C)
1998,2000,2001,2002,2003,2004,2006,2007,2008,2009,2010,2011,2012,2017 Free
Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -875,7 +875,7 @@ static void
scm_post_boot_init_modules ()
{
SCM module_type = SCM_VARIABLE_REF (scm_c_lookup ("module-type"));
- scm_module_tag = (SCM_CELL_WORD_1 (module_type) + scm_tc3_struct);
+ scm_module_tag = SCM_UNPACK (module_type) + scm_tc3_struct;
resolve_module_var = scm_c_lookup ("resolve-module");
define_module_star_var = scm_c_lookup ("define-module*");
diff --git a/libguile/struct.c b/libguile/struct.c
index 51c0f11..67e2e62 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007,
- * 2008, 2009, 2010, 2011, 2012, 2013, 2015 Free Software Foundation, Inc.
+ * 2008, 2009, 2010, 2011, 2012, 2013, 2015, 2017 Free Software Foundation,
Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -420,30 +420,17 @@ struct_finalizer_trampoline (void *ptr, void *unused_data)
finalize (obj);
}
-/* All struct data must be allocated at an address whose bottom three
- bits are zero. This is because the tag for a struct lives in the
- bottom three bits of the struct's car, and the upper bits point to
- the data of its vtable, which is a struct itself. Thus, if the
- address of that data doesn't end in three zeros, tagging it will
- destroy the pointer.
-
- I suppose we should make it clear here that, the data must be 8-byte
aligned,
- *within* the struct, and the struct itself should be 8-byte aligned. In
- practice we ensure this because the data starts two words into a struct.
-
- This function allocates an 8-byte aligned block of memory, whose first word
- points to the given vtable data, then a data pointer, then n_words of data.
- */
-SCM
-scm_i_alloc_struct (scm_t_bits *vtable_data, int n_words)
+/* A struct is a sequence of words preceded by a pointer to the struct's
+ vtable. The vtable reference is tagged with the struct tc3. */
+static SCM
+scm_i_alloc_struct (scm_t_bits vtable_bits, int n_words)
{
SCM ret;
- ret = scm_words ((scm_t_bits)vtable_data | scm_tc3_struct, n_words + 2);
- SCM_SET_CELL_WORD_1 (ret, (scm_t_bits)SCM_CELL_OBJECT_LOC (ret, 2));
+ ret = scm_words (vtable_bits | scm_tc3_struct, n_words + 1);
- /* vtable_data can be null when making a vtable vtable */
- if (vtable_data && vtable_data[scm_vtable_index_instance_finalize])
+ /* vtable_bits can be 0 when making a vtable vtable */
+ if (vtable_bits && SCM_VTABLE_INSTANCE_FINALIZER (SCM_PACK (vtable_bits)))
/* Register a finalizer for the newly created instance. */
scm_i_set_finalizer (SCM2PTR (ret), struct_finalizer_trampoline, NULL);
@@ -481,7 +468,7 @@ scm_c_make_structv (SCM vtable, size_t n_tail, size_t
n_init, scm_t_bits *init)
goto bad_tail;
}
- obj = scm_i_alloc_struct (SCM_STRUCT_DATA (vtable), basic_size + n_tail);
+ obj = scm_i_alloc_struct (SCM_UNPACK (vtable), basic_size + n_tail);
scm_struct_init (obj, layout, n_tail, n_init, init);
@@ -538,7 +525,7 @@ SCM_DEFINE (scm_allocate_struct, "allocate-struct", 2, 0, 0,
SCM_ASSERT (SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size) == c_nfields,
nfields, 2, FUNC_NAME);
- ret = scm_i_alloc_struct (SCM_STRUCT_DATA (vtable), c_nfields);
+ ret = scm_i_alloc_struct (SCM_UNPACK (vtable), c_nfields);
if (SCM_LIKELY (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE)))
{
@@ -612,9 +599,9 @@ scm_i_make_vtable_vtable (SCM fields)
basic_size = scm_i_symbol_length (layout) / 2;
- obj = scm_i_alloc_struct (NULL, basic_size);
+ obj = scm_i_alloc_struct (0, basic_size);
/* Make it so that the vtable of OBJ is itself. */
- SCM_SET_CELL_WORD_0 (obj, (scm_t_bits) SCM_STRUCT_DATA (obj) |
scm_tc3_struct);
+ SCM_SET_CELL_WORD_0 (obj, SCM_UNPACK (obj) | scm_tc3_struct);
v = SCM_UNPACK (layout);
scm_struct_init (obj, layout, 0, 1, &v);
@@ -980,16 +967,6 @@ scm_init_struct ()
{
SCM name;
- /* The first word of a struct is equal to `SCM_STRUCT_DATA (vtable) +
- scm_tc3_struct', and `SCM_STRUCT_DATA (vtable)' is 2 words after VTABLE by
- default. */
- GC_REGISTER_DISPLACEMENT (2 * sizeof (scm_t_bits) + scm_tc3_struct);
-
- /* In the general case, `SCM_STRUCT_DATA (obj)' points 2 words after the
- beginning of a GC-allocated region; that region is different from that of
- OBJ once OBJ has undergone class redefinition. */
- GC_REGISTER_DISPLACEMENT (2 * sizeof (scm_t_bits));
-
required_vtable_fields = scm_from_latin1_string (SCM_VTABLE_BASE_LAYOUT);
scm_c_define ("standard-vtable-fields", required_vtable_fields);
required_applicable_fields = scm_from_latin1_string
(SCM_APPLICABLE_BASE_LAYOUT);
diff --git a/libguile/struct.h b/libguile/struct.h
index e7007b7..0dfcf46 100644
--- a/libguile/struct.h
+++ b/libguile/struct.h
@@ -3,7 +3,7 @@
#ifndef SCM_STRUCT_H
#define SCM_STRUCT_H
-/* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007, 2008, 2009, 2010, 2011,
2012, 2013, 2015 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007, 2008, 2009, 2010, 2011,
2012, 2013, 2015, 2017 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -28,42 +28,28 @@
-/* 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.
-
- To summarize, structs are laid out this way:
-
- .-------.
- | |
- .----------------+---v------------- -
- | vtable | data | slot0 | slot1 |
- `----------------+----------------- -
- | .-------.
- | | |
- .---v------------+---v------------- -
- | vtable | data | slot0 | slot1 |
- `----------------+----------------- -
- |
- v
+/* Structs are sequences of words where the first word points to the
+ struct's vtable, and the rest are its slots. The vtable indicates
+ how many words are in the struct among other meta-information. A
+ vtable is itself a struct and as such has a vtable, and so on until
+ you get to a root struct that is its own vtable.
+ .--------+----------------- -
+ | vtable | slot0 | slot1 |
+ `--------+----------------- -
+ |
+ |
+ .---v----+----------------- -
+ | vtable | slot0 | slot1 |
+ `--------+----------------- -
+ |
...
- .-------.
- | | |
- .---v------------+---v------------- -
- .-| vtable | data | slot0 | slot1 |
- | `----------------+----------------- -
+ |
+ .---v----+----------------- -
+ .-| vtable | slot0 | slot1 |
+ | `--------+----------------- -
| ^
`-----'
-
- The DATA indirection (which corresponds to `SCM_STRUCT_DATA ()') is
necessary
- to implement class redefinition.
-
- For more details, see:
-
- http://wingolog.org/archives/2009/11/09/class-redefinition-in-guile
-
*/
/* All vtables have the following fields. */
@@ -123,10 +109,10 @@
typedef void (*scm_t_struct_finalize) (SCM obj);
#define SCM_STRUCTP(X) (!SCM_IMP(X) && (SCM_TYP3(X) ==
scm_tc3_struct))
-#define SCM_STRUCT_SLOTS(X) ((SCM*)SCM_CELL_WORD_1 ((X)))
+#define SCM_STRUCT_SLOTS(X) (SCM_CELL_OBJECT_LOC(X, 1))
#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(X) ((scm_t_bits*)SCM_STRUCT_SLOTS (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)
@@ -145,18 +131,12 @@ typedef void (*scm_t_struct_finalize) (SCM obj);
#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_VTABLE(X) (SCM_PACK (SCM_CELL_WORD_0 (X) -
scm_tc3_struct))
+#define SCM_STRUCT_LAYOUT(X) (SCM_VTABLE_LAYOUT (SCM_STRUCT_VTABLE
(X)))
+#define SCM_STRUCT_PRINTER(X) (SCM_VTABLE_INSTANCE_PRINTER
(SCM_STRUCT_VTABLE (X)))
+#define SCM_STRUCT_FINALIZER(X) (SCM_VTABLE_INSTANCE_FINALIZER
(SCM_STRUCT_VTABLE (X)))
+#define SCM_STRUCT_VTABLE_FLAGS(X) (SCM_VTABLE_FLAGS (SCM_STRUCT_VTABLE
(X)))
+#define SCM_STRUCT_VTABLE_FLAG_IS_SET(X,F) (SCM_VTABLE_FLAG_IS_SET
(SCM_STRUCT_VTABLE (X), (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))
@@ -191,7 +171,6 @@ SCM_API void scm_print_struct (SCM exp, SCM port,
scm_print_state *);
SCM_INTERNAL SCM scm_i_struct_equalp (SCM s1, SCM s2);
SCM_INTERNAL unsigned long scm_struct_ihashq (SCM, unsigned long, void *);
-SCM_INTERNAL SCM scm_i_alloc_struct (scm_t_bits *vtable_data, int n_words);
SCM_INTERNAL void scm_i_struct_inherit_vtable_magic (SCM vtable, SCM obj);
SCM_INTERNAL void scm_init_struct (void);
diff --git a/module/system/base/types.scm b/module/system/base/types.scm
index 49aea27..0652885 100644
--- a/module/system/base/types.scm
+++ b/module/system/base/types.scm
@@ -366,13 +366,14 @@ TYPE-NUMBER."
(%visited-cells))))
body ...))))
-(define (address->inferior-struct address vtable-data-address backend)
+(define (address->inferior-struct address vtable-address backend)
"Read the struct at ADDRESS using BACKEND. Return an 'inferior-struct'
object representing it."
(define %vtable-layout-index 0)
(define %vtable-name-index 5)
- (let* ((layout-address (+ vtable-data-address
+ (let* ((vtable-data-address (+ vtable-address %word-size))
+ (layout-address (+ vtable-data-address
(* %vtable-layout-index %word-size)))
(layout-bits (dereference-word backend layout-address))
(layout (scm->object layout-bits backend))
@@ -383,7 +384,7 @@ object representing it."
(if (symbol? layout)
(let* ((layout (symbol->string layout))
(len (/ (string-length layout) 2))
- (slots (dereference-word backend (+ address %word-size)))
+ (slots (+ address %word-size))
(port (memory-port backend slots (* len %word-size)))
(fields (get-bytevector-n port (* len %word-size)))
(result (inferior-struct name #f)))
@@ -405,9 +406,9 @@ using BACKEND."
(or (and=> (vhash-assv address (%visited-cells)) cdr) ; circular object
(let ((port (memory-port backend address)))
(match-cell port
- (((vtable-data-address & 7 = %tc3-struct))
+ (((vtable-address & 7 = %tc3-struct))
(address->inferior-struct address
- (- vtable-data-address %tc3-struct)
+ (- vtable-address %tc3-struct)
backend))
(((_ & #x7f = %tc7-symbol) buf hash props)
(match (cell->object buf backend)
- [Guile-commits] branch master updated (cfe2279 -> ed549da), Andy Wingo, 2017/09/14
- [Guile-commits] 01/07: GOOPS instance migration implemented in Scheme, Andy Wingo, 2017/09/14
- [Guile-commits] 02/07: Change name of "static" flag indicating static slot allocation, Andy Wingo, 2017/09/14
- [Guile-commits] 06/07: Remove "redefined" class slot, Andy Wingo, 2017/09/14
- [Guile-commits] 05/07: remove self field of vtables, Andy Wingo, 2017/09/14
- [Guile-commits] 04/07: Remove indirection in structs,
Andy Wingo <=
- [Guile-commits] 07/07: Document class redefinition change, Andy Wingo, 2017/09/14
- [Guile-commits] 03/07: Implement class redefinition on top of fixed structs, Andy Wingo, 2017/09/14