summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2015-01-11 16:36:45 +0100
committerAndy Wingo <wingo@pobox.com>2015-01-23 16:16:02 +0100
commit92928b8619d2711e9e05b94831a479525ba9aede (patch)
tree21978fd82a49db5db06ab970a62107a2901ea9f2
parent4702cbeb3780d0c81076bae0723a1fd544576471 (diff)
downloadguile-92928b8619d2711e9e05b94831a479525ba9aede.tar.gz
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.
-rw-r--r--libguile/goops.c2
-rw-r--r--libguile/goops.h6
-rw-r--r--module/oop/goops.scm13
3 files changed, 9 insertions, 12 deletions
diff --git a/libguile/goops.c b/libguile/goops.c
index 37e3fd2b5..05bc06e15 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 eec1973fa..8992c2b9f 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 9114e4640..3a930e66e 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