Method: (LOAD-OBJECT T T STANDARD-CACHE)

Source

(defmethod load-object (object-id transaction (cache standard-cache))
  (multiple-value-bind (buffer id nr-slots schema-id most-recent-p)
      (find-committed-object-version object-id
                                     (transaction-id transaction)
                                     (heap cache))
    (declare (ignore id))
    (let* ((table (schema-table cache))
           (schema (find-schema-for-id table schema-id))
           (object (allocate-instance (find-class (schema-class-name schema)))))
      (unless (= nr-slots (nr-persistent-slots schema))
        (internal-rucksack-error
         "Schema inconsistency (expected ~D slots, got ~D slots)."
         (nr-persistent-slots schema)
         nr-slots))
      (let ((added-slots '())
            (discarded-slots '())
            ;; DISCARDED-SLOT-VALUES is a list of discarded slot names and
            ;; their (obsolete) values.
            (discarded-slot-values '()))
        (when (schema-obsolete-p schema)
          (setf added-slots (added-slot-names schema)
                discarded-slots (discarded-slot-names schema)))
        ;; Load and set slot values.
        ;; DO: We should probably initialize the transient slots to their
        ;; initforms here.
        ;; NOTE: The MOP doesn't intercept the (setf slot-value) here,
        ;; because the rucksack and object-id slots are still unbound.
        (loop for slot-name in (persistent-slot-names schema)
              do (let ((marker (read-next-marker buffer))
                       (old-slot-p (member slot-name discarded-slots)))
                   (if (eql marker +unbound-slot+)
                       (unless old-slot-p
                         (slot-makunbound object slot-name))
                     ;; Deserialize the value
                     (let ((value (deserialize-contents marker buffer)))
                       (if old-slot-p
                           (progn 
                             (push value discarded-slot-values)
                             (push slot-name discarded-slot-values))
                         (setf (slot-value object slot-name) value))))))
        ;; Set CACHE, OBJECT-ID and TRANSACTION-ID slots if it's a persistent
        ;; object.
        (when (typep object '(or persistent-object persistent-data))
          (setf (slot-value object 'rucksack) (current-rucksack)
                (slot-value object 'object-id) object-id
                (slot-value object 'transaction-id) (transaction-id transaction)))
        ;; Call UPDATE-PERSISTENT-INSTANCE-FOR-REDEFINED-CLASS if necessary.
        (when (schema-obsolete-p schema)
          (update-persistent-instance-for-redefined-class
           object
           added-slots
           discarded-slots
           discarded-slot-values)))
      ;;
      (values object most-recent-p))))
Source Context