From 7e91ff651b3c9f7c27f2be146ea611bab65809a8 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 7 Sep 2017 16:55:30 +0200 Subject: [PATCH] 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 | 73 +++++++++++++----------------------- module/system/base/types.scm | 11 +++--- 6 files changed, 51 insertions(+), 95 deletions(-) diff --git a/libguile/gc.c b/libguile/gc.c index 4478128c6..b9064b3b1 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 12a3687a4..7e7a26553 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 d87ec7a64..b469a1a64 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 51c0f111d..67e2e62df 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 e7007b7e0..0dfcf4618 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. +/* 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); diff --git a/module/system/base/types.scm b/module/system/base/types.scm index 49aea27ba..06528853c 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)