Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Vladimir Sedach
storage
Commits
9065dad0
Commit
9065dad0
authored
Feb 10, 2012
by
Stas Boukarev
Browse files
Add float and complex types.
parent
92a4f445
Changes
1
Hide whitespace changes
Inline
Side-by-side
disk.lisp
View file @
9065dad0
...
...
@@ -14,6 +14,9 @@
fixnum
bignum
ratio
double-float
single-float
complex
list-of-objects
symbol
intern-package-and-symbol
...
...
@@ -323,6 +326,53 @@
(
/
(
read-next-object
stream
)
(
read-next-object
stream
)))
;;; Float
(
defmethod
object-size
((
float
float
))
(
+
1
(
etypecase
float
(
single-float
+single-float-length+
)
(
double-float
+double-float-length+
))))
(
defun
write-8-bytes
(
n
stream
)
(
write-n-bytes
(
ldb
(
byte
32
0
)
n
)
4
stream
)
(
write-n-bytes
(
ldb
(
byte
64
32
)
n
)
4
stream
))
(
defun
read-8-bytes
(
stream
)
(
logior
(
read-n-bytes
4
stream
)
(
ash
(
read-n-bytes
4
stream
)
32
)))
(
defmethod
write-object
((
float
float
)
stream
)
(
etypecase
float
(
single-float
(
write-n-bytes
#.
(
type-code
'single-float
)
1
stream
)
(
write-n-bytes
(
ieee-floats:encode-float32
float
)
4
stream
))
(
double-float
(
write-n-bytes
#.
(
type-code
'double-float
)
1
stream
)
(
write-8-bytes
(
ieee-floats:encode-float64
float
)
stream
))))
(
defreader
single-float
(
stream
)
(
ieee-floats:decode-float32
(
read-n-bytes
4
stream
)))
(
defreader
double-float
(
stream
)
(
ieee-floats:decode-float64
(
read-8-bytes
stream
)))
;;; Complex
(
defmethod
object-size
((
complex
complex
))
(
+
1
(
object-size
(
realpart
complex
))
(
object-size
(
imagpart
complex
))))
(
defmethod
write-object
((
complex
complex
)
stream
)
(
write-n-bytes
#.
(
type-code
'complex
)
1
stream
)
(
write-object
(
realpart
complex
)
stream
)
(
write-object
(
imagpart
complex
)
stream
))
(
defreader
complex
(
stream
)
(
complex
(
read-next-object
stream
)
(
read-next-object
stream
)))
;;; Characters
(
defmethod
object-size
((
character
character
))
...
...
@@ -393,7 +443,7 @@
(
code-char
(
read-n-bytes
+char-length+
stream
))))
string
))
;;;
c
ons
;;;
C
ons
(
defmethod
object-size
((
list
cons
))
(
let
((
count
(
+
1
1
)))
;; type + +end+
...
...
@@ -438,7 +488,7 @@
for
id
=
(
read-n-bytes
+id-length+
stream
)
collect
(
get-instance
id
)))
;;;
s
imple-vector
;;;
S
imple-vector
(
defmethod
object-size
((
vector
vector
))
(
typecase
vector
...
...
@@ -469,7 +519,7 @@
do
(
setf
(
svref
vector
i
)
(
read-next-object
stream
)))
vector
))
;;;
a
rray
;;;
A
rray
(
defun
array-size
(
array
)
(
loop
for
i
below
(
array-total-size
array
)
...
...
@@ -517,7 +567,7 @@
do
(
setf
(
row-major-aref
array
i
)
(
read-next-object
stream
)))
array
))
;;;
h
ash-table
;;;
H
ash-table
(
defvar
*hash-table-tests*
#(
eql
equal
equalp
eq
))
(
declaim
(
simple-vector
*hash-table-tests*
))
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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