Ignore:
Timestamp:
12/20/03 03:08:23 (18 years ago)
Author:
piso
Message:

INSTANCE-SLOT-LOCATION

File:
1 edited

Legend:

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

    r5212 r5215  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: clos.lisp,v 1.49 2003-12-20 02:18:13 piso Exp $
     4;;; $Id: clos.lisp,v 1.50 2003-12-20 03:08:23 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    254254                     #'compute-slots)
    255255                 class))
    256   (let ((length 0))
     256  (let ((length 0)
     257        (instance-slots ()))
    257258    (dolist (slot (class-slots class))
    258259      (case (slot-definition-allocation slot)
    259260        (:instance
    260261         (setf (slot-definition-location slot) length)
    261          (incf length))
     262         (incf length)
     263         (push (slot-definition-name slot) instance-slots))
    262264        (:class
    263265         (unless (slot-definition-location slot)
     
    268270                       (slot-location allocation-class (slot-definition-name slot)))))))))
    269271    (setf (class-layout class)
    270           (make-layout class length)))
     272          (make-layout class length (nreverse instance-slots))))
    271273  (setf (class-default-initargs class)
    272274        (compute-class-default-initargs class)))
     
    419421        nil)))
    420422
     423(defun instance-slot-location (instance slot-name)
     424  (let* ((layout (std-instance-layout instance))
     425         (location (and layout (instance-slot-index layout slot-name))))
     426    (if location
     427        location
     428        (slot-location (class-of instance) slot-name))))
     429
    421430(defun std-slot-value (instance slot-name)
    422   (let* ((location (slot-location (class-of instance) slot-name))
     431  (let* ((location (instance-slot-location instance slot-name))
    423432         (value (cond ((fixnump location)
    424433                       (instance-ref instance location))
     
    437446
    438447(defun %set-std-slot-value (instance slot-name new-value)
    439   (let ((location (slot-location (class-of instance) slot-name)))
     448  (let ((location (instance-slot-location instance slot-name)))
    440449    (cond ((fixnump location)
    441450           (setf (instance-ref instance location) new-value))
     
    455464
    456465(defun std-slot-boundp (instance slot-name)
    457   (let ((location (slot-location (class-of instance) slot-name)))
     466  (let ((location (instance-slot-location instance slot-name)))
    458467    (cond ((fixnump location)
    459468           (neq +slot-unbound+ (instance-ref instance location)))
     
    469478
    470479(defun std-slot-makunbound (instance slot-name)
    471   (let ((location (slot-location (class-of instance) slot-name)))
     480  (let ((location (instance-slot-location instance slot-name)))
    472481    (cond ((fixnump location)
    473482           (setf (instance-ref instance location) +slot-unbound+))
Note: See TracChangeset for help on using the changeset viewer.