mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-15 13:52:16 -08:00
Code Issues Projects Releases Packages Wiki Activity

All changes to classes cause update-instance-for-redefined-class to be called, not only when the structure changes.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2009-11-29 22:26:59 +01:00
parent 2f0d83727a
commit b2bb6fb94b
2 changed files with 28 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

3
src/CHANGELOG
View file

@ -82,6 +82,9 @@ ECL 9.12.1:
- The optimized slot accessors check that the instances are up to date.
- The use of MAKE-INSTANCES-OBSOLETE now forces UPDATE-INSTANCE-FOR-REDEFINED-CLASS
to be invoked even if the slots did not change.
* Sockets:
- The socket option TCP_NODELAY option has been fixed: it was improperly using

51
src/clos/change.lsp
View file

@ -131,32 +131,31 @@
(discarded-slots '())
(added-slots '())
(property-list '()))
(unless (equal old-slotds new-slotds)
(setf instance (si::allocate-raw-instance instance class (class-size class)))
(si::instance-sig-set instance)
(let* ((new-i 0)
(old-local-slotds (remove :instance old-slotds :test-not #'eq
:key #'slot-definition-allocation))
(new-local-slotds (remove :instance new-slotds :test-not #'eq
:key #'slot-definition-allocation)))
(declare (fixnum new-i))
(setq discarded-slots
(set-difference (mapcar #'slot-definition-name old-local-slotds)
(mapcar #'slot-definition-name new-local-slotds)))
(dolist (slot-name discarded-slots)
(let* ((ndx (position slot-name old-local-slotds :key #'slot-definition-name)))
(push (cons slot-name (si::instance-ref old-instance ndx))
property-list)))
(dolist (new-slot new-local-slotds)
(let* ((name (slot-definition-name new-slot))
(old-i (position name old-local-slotds :key #'slot-definition-name)))
(if old-i
(si::instance-set instance new-i
(si::instance-ref old-instance old-i))
(push name added-slots))
(incf new-i))))
(update-instance-for-redefined-class instance added-slots
discarded-slots property-list))))
(setf instance (si::allocate-raw-instance instance class (class-size class)))
(si::instance-sig-set instance)
(let* ((new-i 0)
(old-local-slotds (remove :instance old-slotds :test-not #'eq
:key #'slot-definition-allocation))
(new-local-slotds (remove :instance new-slotds :test-not #'eq
:key #'slot-definition-allocation)))
(declare (fixnum new-i))
(setq discarded-slots
(set-difference (mapcar #'slot-definition-name old-local-slotds)
(mapcar #'slot-definition-name new-local-slotds)))
(dolist (slot-name discarded-slots)
(let* ((ndx (position slot-name old-local-slotds :key #'slot-definition-name)))
(push (cons slot-name (si::instance-ref old-instance ndx))
property-list)))
(dolist (new-slot new-local-slotds)
(let* ((name (slot-definition-name new-slot))
(old-i (position name old-local-slotds :key #'slot-definition-name)))
(if old-i
(si::instance-set instance new-i
(si::instance-ref old-instance old-i))
(push name added-slots))
(incf new-i))))
(update-instance-for-redefined-class instance added-slots
discarded-slots property-list)))
;;; ----------------------------------------------------------------------
;;; CLASS REDEFINITION PROTOCOL