Changeset 12758


Ignore:
Timestamp:
06/18/10 23:15:52 (12 years ago)
Author:
astalla
Message:

Custom slot definition: slot-location managed like the other slot properties.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r12757 r12758  
    324324  (set-slot-definition-allocation-class slot-definition value))
    325325
     326(defun slot-definition-location (slot-definition)
     327  (%slot-definition-location slot-definition))
     328
     329(declaim (notinline (setf slot-definition-location-class)))
     330(defun (setf slot-definition-location) (value slot-definition)
     331  (set-slot-definition-location slot-definition value))
     332
    326333(defun init-slot-definition (slot &key name
    327334           (initargs ())
     
    392399      (case (slot-definition-allocation slot)
    393400        (:instance
    394          (set-slot-definition-location slot length)
     401         (setf (slot-definition-location slot) length)
    395402         (incf length)
    396403         (push (slot-definition-name slot) instance-slots))
    397404        (:class
    398          (unless (%slot-definition-location slot)
     405         (unless (slot-definition-location slot)
    399406           (let ((allocation-class (slot-definition-allocation-class slot)))
    400              (set-slot-definition-location slot
    401                                            (if (eq allocation-class class)
    402                                                (cons (slot-definition-name slot) +slot-unbound+)
    403                                                (slot-location allocation-class (slot-definition-name slot))))))
    404          (push (%slot-definition-location slot) shared-slots))))
     407             (setf (slot-definition-location slot)
     408       (if (eq allocation-class class)
     409           (cons (slot-definition-name slot) +slot-unbound+)
     410           (slot-location allocation-class (slot-definition-name slot))))))
     411         (push (slot-definition-location slot) shared-slots))))
    405412    (when old-layout
    406413      ;; Redefined class: initialize added shared slots.
     
    560567  (let ((slot (find-slot-definition class slot-name)))
    561568    (if slot
    562         (%slot-definition-location slot)
     569        (slot-definition-location slot)
    563570        nil)))
    564571
     
    25842591      (setf (slot-value slot-definition 'sys::allocation-class) value))))
    25852592
     2593(defgeneric slot-definition-location (slot-definition)
     2594  (:method ((slot-definition slot-definition))
     2595    (slot-definition-dispatch slot-definition
     2596      (%slot-definition-location slot-definition)
     2597      (slot-value slot-definition 'sys::location))))
     2598
     2599(defgeneric (setf slot-definition-location) (value slot-definition)
     2600  (:method (value (slot-definition slot-definition))
     2601    (slot-definition-dispatch slot-definition
     2602      (set-slot-definition-location slot-definition value)
     2603      (setf (slot-value slot-definition 'sys::location) value))))
     2604
    25862605;;; No %slot-definition-type.
    25872606
Note: See TracChangeset for help on using the changeset viewer.