diff options
author | Andy Wingo <wingo@pobox.com> | 2017-09-22 15:04:36 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2017-09-22 15:43:10 +0200 |
commit | d354962b687d20252de7a647d8d501623d9f6bda (patch) | |
tree | 377b9dbac5fd1032ab71795767afabd3ede2694b /module/oop | |
parent | 2f9ad7d9bcd1f787e324158a1ee402d111e8608e (diff) | |
download | guile-d354962b687d20252de7a647d8d501623d9f6bda.tar.gz |
Remove support for tail arrays and self slots
* libguile/struct.c (scm_make_struct): Remove support for tail arrays
and self slots.
(set_vtable_layout_flags): Always initialize the nfields member.
(scm_is_valid_vtable_layout): Remove support for tail arrays and self
slots.
(scm_i_struct_inherit_vtable_magic): No need to issue deprecation
warning for self slots, as they are no longer supported.
(scm_struct_init): Remove support for tail arrays and self slots.
(scm_c_make_structv): Throw an exception if n_tail is not 0.
(scm_allocate_struct): Adapt to scm_struct_init change.
(scm_i_make_vtable_vtable): Initialize slots manually, to avoid
relying on an already-initialized nfields member.
(scm_struct_ref, scm_struct_set_x): Simplify.
* module/oop/goops.scm: As we now rely on nfields being valid, when
recalculating slots during boot we need to avoid resetting nfields of
<class>, even temporarily, as that would prevent any further access to
<class>!
Diffstat (limited to 'module/oop')
-rw-r--r-- | module/oop/goops.scm | 14 |
1 files changed, 14 insertions, 0 deletions
diff --git a/module/oop/goops.scm b/module/oop/goops.scm index 917367bd4..c883320f9 100644 --- a/module/oop/goops.scm +++ b/module/oop/goops.scm @@ -911,6 +911,20 @@ slots as we go." (compute-direct-slot-definition class initargs))) (struct-set! class class-index-direct-slots (map make-direct-slot-definition specs)))) + ;; Boot definition that avoids munging nfields. + (define (allocate-slots class slots) + (define (make-effective-slot-definition slot index) + (let* ((slot (compute-effective-slot-definition class slot))) + (struct-set! slot slot-index-slot-ref/raw (standard-get index)) + (struct-set! slot slot-index-slot-ref + (if (slot-definition-init-thunk slot) + (struct-ref slot slot-index-slot-ref/raw) + (bound-check-get index))) + (struct-set! slot slot-index-slot-set! (standard-set index)) + (struct-set! slot slot-index-index index) + (struct-set! slot slot-index-size 1) + slot)) + (map make-effective-slot-definition slots (iota (length slots)))) (define (initialize-slots! class) (let ((slots (build-slots-list (class-direct-slots class) (class-precedence-list class)))) |