Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Vladimir Sedach
storage
Commits
ace1e4b9
Commit
ace1e4b9
authored
Dec 27, 2011
by
Stas Boukarev
Browse files
Remove class cache, it's not used anywhere.
parent
4181e6ce
Changes
4
Hide whitespace changes
Inline
Side-by-side
disk.lisp
View file @
ace1e4b9
...
...
@@ -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
)))
...
...
io-generic.lisp
View file @
ace1e4b9
...
...
@@ -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
(
-
(
logan
d
byte
(
ash
1
(
1-
(
*
n
8
))))))))
(
logior
byte
(
-
(
mask-fiel
d
(
byte
1
(
1-
(
*
n
8
)))
byte
)))))
(
declaim
(
inline
read-2-bytes
read-3-bytes
read-4-bytes
))
(
defun
read-2-bytes
(
stream
)
...
...
mop.lisp
View file @
ace1e4b9
...
...
@@ -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
)))
;;;
...
...
storage.lisp
View file @
ace1e4b9
...
...
@@ -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
)))
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment