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
ce85ba82
Commit
ce85ba82
authored
Mar 23, 2012
by
Stas Boukarev
Browse files
Optimize writing of non-base ascii strings.
parent
f2a504a1
Changes
2
Show whitespace changes
Inline
Side-by-side
disk.lisp
View file @
ce85ba82
...
...
@@ -331,13 +331,23 @@
(
defun
write-ascii-string
(
string
stream
)
(
declare
(
simple-string
string
))
(
write-n-bytes
#.
(
type-code
'ascii-string
)
1
stream
)
(
write-n-bytes
(
length
string
)
+sequence-length+
stream
)
#-
(
and
sb-unicode
(
or
x86
x86-64
))
(
loop
for
char
across
string
do
(
write-n-bytes
(
char-code
char
)
1
stream
)))
do
(
write-n-bytes
(
char-code
char
)
1
stream
))
#+
(
and
sb-unicode
(
or
x86
x86-64
))
(
write-ascii-non-base-string-optimized
string
stream
))
(
defun
write-multibyte-string
(
string
stream
)
(
declare
(
simple-string
string
))
(
write-n-bytes
#.
(
type-code
'string
)
1
stream
)
(
write-n-bytes
(
length
string
)
+sequence-length+
stream
)
#-
(
and
sb-unicode
(
or
x86
x86-64
))
(
loop
for
char
across
string
do
(
write-n-bytes
(
char-code
char
)
+char-length+
stream
)))
do
(
write-n-bytes
(
char-code
char
)
+char-length+
stream
))
#+
(
and
sb-unicode
(
or
x86
x86-64
))
(
write-multibyte-string-optimized
string
stream
))
(
defmethod
write-object
((
string
string
)
stream
)
(
etypecase
string
...
...
@@ -349,12 +359,8 @@
(
write-n-bytes
(
length
string
)
+sequence-length+
stream
)
(
write-ascii-string-optimized
string
stream
))
(
ascii-string
(
write-n-bytes
#.
(
type-code
'ascii-string
)
1
stream
)
(
write-n-bytes
(
length
string
)
+sequence-length+
stream
)
(
write-ascii-string
string
stream
))
(
string
(
write-n-bytes
#.
(
type-code
'string
)
1
stream
)
(
write-n-bytes
(
length
string
)
+sequence-length+
stream
)
(
write-multibyte-string
string
stream
))))
(
declaim
(
inline
read-ascii-string
))
...
...
io-sbcl.lisp
View file @
ce85ba82
...
...
@@ -286,6 +286,48 @@
+buffer-size+
)))))
string
)
(
declaim
(
inline
copy-mem-non-base-string
))
(
defun
copy-mem-non-base-string
(
from
to
length
)
(
declare
(
word
length
)
(
optimize
(
safety
0
)))
(
loop
for
string-index
fixnum
by
4
for
i
fixnum
below
length
do
(
setf
(
sb-sys:sap-ref-8
to
i
)
(
sb-sys:sap-ref-8
from
string-index
))))
(
declaim
(
inline
write-ascii-non-base-string-optimized
))
(
defun
write-ascii-non-base-string-optimized
(
string
stream
)
(
declare
(
optimize
speed
)
(
simple-string
string
)
(
sb-ext:muffle-conditions
sb-ext:compiler-note
))
(
sb-sys:with-pinned-objects
(
string
)
(
let*
((
length
(
length
string
))
(
position
(
output-stream-buffer-position
stream
))
(
string-sap
(
sb-sys:vector-sap
string
))
(
new-position
(
sb-ext:truly-the
word
(
+
position
length
))))
(
declare
(
type
word
position
new-position
))
(
cond
((
<=
new-position
(
output-stream-buffer-end
stream
))
(
copy-mem-non-base-string
string-sap
(
sb-sys:int-sap
position
)
length
)
(
setf
(
output-stream-buffer-position
stream
)
new-position
))
((
<=
length
+buffer-size+
)
(
let*
((
start
(
output-stream-buffer-start
stream
))
(
left
(
-
(
output-stream-buffer-end
stream
)
position
))
(
left-length
(
sb-ext:truly-the
word
(
-
length
left
))))
(
declare
(
word
left
left-length
))
(
copy-mem-non-base-string
string-sap
(
sb-sys:int-sap
position
)
left
)
(
setf
(
output-stream-buffer-position
stream
)
(
output-stream-buffer-end
stream
))
(
flush-buffer
stream
)
(
copy-mem-non-base-string
(
sb-sys:sap+
string-sap
left
)
(
sb-sys:int-sap
start
)
left-length
)
(
setf
(
output-stream-buffer-position
stream
)
(
sb-ext:truly-the
word
(
+
start
left-length
)))))
(
t
(
error
"Strings of more than ~a are not supported yet."
+buffer-size+
)))))
string
)
;;;
(
defmacro
with-io-file
((
stream
file
...
...
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