[Guile-commits] 48/87: Re-use the vtable "size" field for GOOPS nfields

[Andy Wingo]

wingo pushed a commit to branch wip-goops-refactor
in repository guile.

commit 9911b1654c104f377abd129758e4b59b99e77da0
Author: Andy Wingo <address@hidden>
Date:   Sun Jan 11 16:36:45 2015 +0100

    Re-use the vtable "size" field for GOOPS nfields
    
    * module/oop/goops.scm (fold-<class>-slots): The first "reserved" slot
      is actually for instance sizes, used by the "simple struct"
      mechanism.  Reuse this field for GOOPS's "nfields".
      (make-standard-class, <class>, initialize): Adapt order of field
      initializations.
    
    * libguile/goops.h (SCM_CLASS_CLASS_LAYOUT, SCM_N_CLASS_SLOTS)
    * libguile/goops.c (scm_sys_allocate_instance): Adapt.
---
 libguile/goops.c     |    2 +-
 libguile/goops.h     |    6 ++----
 module/oop/goops.scm |   13 ++++++-------
 3 files changed, 9 insertions(+), 12 deletions(-)

diff --git a/libguile/goops.c b/libguile/goops.c
index 2406bcf..bd4effa 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -544,7 +544,7 @@ SCM_DEFINE (scm_sys_allocate_instance, 
"%allocate-instance", 2, 0, 0,
 
   /* FIXME: duplicates some of scm_make_struct. */
 
-  n = SCM_I_INUM (SCM_SLOT (class, scm_si_nfields));
+  n = SCM_STRUCT_DATA_REF (class, scm_vtable_index_size);
   obj = scm_i_alloc_struct (SCM_STRUCT_DATA (class), n);
 
   layout = SCM_VTABLE_LAYOUT (class);
diff --git a/libguile/goops.h b/libguile/goops.h
index eec1973..8992c2b 100644
--- a/libguile/goops.h
+++ b/libguile/goops.h
@@ -67,8 +67,7 @@
   "pw" /* direct methods */                     \
   "pw" /* cpl */                                \
   "pw" /* slots */                              \
-  "pw" /* getters-n-setters */                  \
-  "pw" /* nfields */
+  "pw" /* getters-n-setters */
 
 #define scm_si_redefined         (scm_vtable_offset_user + 0)
 #define scm_si_direct_supers    (scm_vtable_offset_user + 1) /* (class ...) */
@@ -78,8 +77,7 @@
 #define scm_si_cpl              (scm_vtable_offset_user + 5) /* (class ...) */
 #define scm_si_slots            (scm_vtable_offset_user + 6) /* ((name . 
options) ...) */
 #define scm_si_getters_n_setters (scm_vtable_offset_user + 7)
-#define scm_si_nfields          (scm_vtable_offset_user + 8) /* an integer */
-#define SCM_N_CLASS_SLOTS       (scm_vtable_offset_user + 9)
+#define SCM_N_CLASS_SLOTS       (scm_vtable_offset_user + 8)
 
 #define SCM_OBJ_CLASS_REDEF(x)  (SCM_PACK (SCM_STRUCT_VTABLE_DATA (x) 
[scm_si_redefined]))
 #define SCM_INST(x)           SCM_STRUCT_DATA (x)
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 050603c..9537233 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -171,8 +171,8 @@
         (instance-finalizer <hidden-slot>)
         (print)
         (name <protected-hidden-slot>)
-        (reserved-0 <hidden-slot>)
-        (reserved-1 <hidden-slot>)
+        (nfields <hidden-slot>)
+        (%reserved <hidden-slot>)
         (redefined)
         (direct-supers)
         (direct-slots)
@@ -180,8 +180,7 @@
         (direct-methods)
         (cpl)
         (slots)
-        (getters-n-setters)
-        (nfields)))
+        (getters-n-setters)))
     (syntax-case x ()
       ((_ fold visit seed)
        ;; The datum->syntax makes it as if the identifiers in `slots'
@@ -433,12 +432,12 @@
            (nfields (length slots))
            (g-n-s (%compute-getters-n-setters slots)))
       (struct-set! z class-index-name name)
+      (struct-set! z class-index-nfields nfields)
       (struct-set! z class-index-direct-slots dslots)
       (struct-set! z class-index-direct-subclasses '())
       (struct-set! z class-index-direct-methods '())
       (struct-set! z class-index-cpl cpl)
       (struct-set! z class-index-slots slots)
-      (struct-set! z class-index-nfields nfields)
       (struct-set! z class-index-getters-n-setters g-n-s)
       (struct-set! z class-index-redefined #f)
       (for-each (lambda (super)
@@ -479,13 +478,13 @@
       ;; The `direct-supers', `direct-slots', `cpl', `slots', and
       ;; `getters-n-setters' fields will be updated later.
       (struct-set! <class> class-index-name '<class>)
+      (struct-set! <class> class-index-nfields (length dslots))
       (struct-set! <class> class-index-direct-supers '())
       (struct-set! <class> class-index-direct-slots dslots)
       (struct-set! <class> class-index-direct-subclasses '())
       (struct-set! <class> class-index-direct-methods '())
       (struct-set! <class> class-index-cpl '())
       (struct-set! <class> class-index-slots dslots)
-      (struct-set! <class> class-index-nfields (length dslots))
       (struct-set! <class> class-index-getters-n-setters
                    (%compute-getters-n-setters dslots))
       (struct-set! <class> class-index-redefined #f)
@@ -2420,6 +2419,7 @@ var{initargs}."
         (supers (get-keyword #:dsupers    initargs '())))
     (let ((name (get-keyword #:name initargs '???)))
       (struct-set! class class-index-name            name))
+    (struct-set! class class-index-nfields           0)
     (struct-set! class class-index-direct-supers     supers)
     (struct-set! class class-index-direct-slots      dslots)
     (struct-set! class class-index-direct-subclasses '())
@@ -2428,7 +2428,6 @@ var{initargs}."
     (struct-set! class class-index-redefined         #f)
     (let ((slots (compute-slots class)))
       (struct-set! class class-index-slots           slots)
-      (struct-set! class class-index-nfields         0)
       (let ((getters-n-setters (compute-getters-n-setters class slots)))
         (struct-set! class class-index-getters-n-setters getters-n-setters))
       ;; Build getters - setters - accessors