Commit ace1e4b9 authored by Stas Boukarev's avatar Stas Boukarev
Browse files

Remove class cache, it's not used anywhere.

parent 4181e6ce
......@@ -350,7 +350,6 @@
(finalize-inheritance class))
(+ 1 ;; type
(object-size (class-name class))
1 ;; class-id
+sequence-length+ ;; list length
(reduce #'+ (slots-to-store class)
:key (lambda (x)
......@@ -360,7 +359,6 @@
(defmethod write-object ((class storable-class) stream)
(write-n-bytes #.(type-code 'storable-class) 1 stream)
(write-object (class-name class) stream)
(write-n-bytes (class-id class) 1 stream)
(unless (class-finalized-p class)
(finalize-inheritance class))
(let ((slots (slots-to-store class)))
......@@ -370,12 +368,9 @@
stream))))
(defreader storable-class (stream)
(let ((class (find-class (read-next-object stream)))
(id (read-n-bytes 1 stream)))
(cache-class class id)
(let ((class (find-class (read-next-object stream))))
(unless (class-finalized-p class)
(finalize-inheritance class))
(pushnew class (storage-data (class-storage class)))
(setf (objects-of-class class) nil)
(let* ((length (read-n-bytes +sequence-length+ stream))
(vector (make-array length)))
......
......@@ -24,7 +24,7 @@
(declaim (inline read-n-signed-bytes))
(defun read-n-signed-bytes (n stream)
(let ((byte (read-n-bytes n stream)))
(logior byte (- (logand byte (ash 1 (1- (* n 8))))))))
(logior byte (- (mask-field (byte 1 (1- (* n 8))) byte)))))
(declaim (inline read-2-bytes read-3-bytes read-4-bytes))
(defun read-2-bytes (stream)
......
......@@ -5,8 +5,6 @@
(in-package #:storage)
(declaim (inline indexes))
(defclass storage ()
((data :initform nil
:accessor storage-data)
......@@ -27,8 +25,6 @@
:accessor class-relations)
(initforms :initform nil
:accessor class-initforms)
(class-id :initform 0
:accessor class-id)
(objects :initform nil
:accessor objects-of-class)
(storage :initform nil
......@@ -56,29 +52,6 @@
;;;
(defvar *class-cache* #())
(defun grow-cache ()
(let* ((next-position (length *class-cache*))
(new-cache (make-array (+ next-position 20) :initial-element nil)))
(replace new-cache *class-cache*)
(setf *class-cache* new-cache)
next-position))
(defun assign-id-to-class (class)
(loop for i from 0
for cached-class across *class-cache*
unless cached-class
return (cache-class-with-id class i)
when (eq cached-class class)
return (setf (class-id class) i)
finally (cache-class-with-id class (grow-cache)))
t)
(defun cache-class-with-id (class id)
(setf (class-id class) id)
(setf (aref *class-cache* id) class))
(defmethod validate-superclass
((class standard-class)
(superclass storable-class))
......@@ -192,8 +165,7 @@
(defmethod initialize-instance :after ((class storable-class) &key)
(when (class-storage class)
(pushnew class (storage-data (class-storage class)) :test #'eq))
(assign-id-to-class class))
(pushnew class (storage-data (class-storage class)) :test #'eq)))
;;;
......
......@@ -7,22 +7,6 @@
(defvar *storage* nil)
(defvar *read-class-cache* #())
(declaim (simple-vector *read-class-cache*))
(defun grow-read-cache (id)
(let ((new-cache (make-array (+ id 10) :initial-element nil)))
(replace new-cache *read-class-cache*)
(setf *read-class-cache* new-cache)))
(defun cache-class (class id)
(unless (array-in-bounds-p *read-class-cache* id)
(grow-read-cache id))
(setf (aref *read-class-cache* id) class))
(defun find-class-by-id (id)
(aref *read-class-cache* id))
(defun objects-of-type (type)
(objects-of-class (find-class type)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment