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.

1 files changed, 6 insertions, 5 deletions

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)