mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
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.
This commit is contained in:
Andy Wingo
parent
4898959901
commit
7e91ff651b
6 changed files with 51 additions and 95 deletions
|
|
@ -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. */
|
||||
|
|
|
|||
|
|
@ -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. */
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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*");
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
/* 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.
|
||||
|
||||
To summarize, structs are laid out this way:
|
||||
|
||||
.-------.
|
||||
| |
|
||||
.----------------+---v------------- -
|
||||
| vtable | data | slot0 | slot1 |
|
||||
`----------------+----------------- -
|
||||
| .-------.
|
||||
| | |
|
||||
.---v------------+---v------------- -
|
||||
| vtable | data | slot0 | slot1 |
|
||||
`----------------+----------------- -
|
||||
.--------+----------------- -
|
||||
| vtable | slot0 | slot1 |
|
||||
`--------+----------------- -
|
||||
|
|
||||
|
|
||||
.---v----+----------------- -
|
||||
| vtable | slot0 | slot1 |
|
||||
`--------+----------------- -
|
||||
|
|
||||
v
|
||||
|
||||
...
|
||||
.-------.
|
||||
| | |
|
||||
.---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);
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue