Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
netfarm
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Hayley Patton
netfarm
Commits
545019d4
Commit
545019d4
authored
Apr 07, 2020
by
Hayley Patton
🐢
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Use our own output buffer macro to speed up rendering
parent
d218449f
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
51 additions
and
21 deletions
+51
-21
Code/Binary-format/fasterer-output.lisp
Code/Binary-format/fasterer-output.lisp
+28
-0
Code/Binary-format/renderer.lisp
Code/Binary-format/renderer.lisp
+20
-19
Code/netfarm.asd
Code/netfarm.asd
+3
-2
No files found.
Code/Binary-format/fasterer-output.lisp
0 → 100644
View file @
545019d4
(
in-package
:netfarm
)
(
defun
make-output-vector
(
parts
position
)
(
let
((
output-vector
(
make-array
position
:element-type
'
(
unsigned-byte
8
)))
(
start
0
))
(
declare
(
optimize
(
speed
3
)
(
safety
0
))
(
fixnum
start
))
(
loop
for
part
of-type
(
simple-array
(
unsigned-byte
8
)
(
*
))
in
(
reverse
parts
)
do
(
loop
for
output-position
of-type
fixnum
from
start
for
input-position
of-type
fixnum
below
(
length
part
)
for
byte
=
(
aref
part
input-position
)
do
(
setf
(
aref
output-vector
output-position
)
byte
))
(
incf
start
(
length
part
)))
output-vector
))
(
defmacro
with-output-to-vector
((
function-name
)
&body
body
)
(
alexandria:with-gensyms
(
parts
position
)
`
(
let
((
,
parts
'
())
(
,
position
0
))
(
declare
(
fixnum
,
position
))
(
flet
((
,
function-name
(
vector
)
(
declare
((
simple-array
(
unsigned-byte
8
)
(
*
))
vector
))
(
push
vector
,
parts
)
(
incf
,
position
(
length
vector
))))
,@
body
(
make-output-vector
,
parts
,
position
)))))
Code/Binary-format/renderer.lisp
View file @
545019d4
(
in-package
:netfarm
)
(
in-package
:netfarm
)
(
declaim
(
inline
write-type-tag
write-integer
)
(
optimize
(
speed
3
)))
(
defun
write-type-tag
(
tag
function
)
(
let
((
v
(
make-array
1
:element-type
'
(
unsigned-byte
8
))))
(
setf
(
aref
v
0
)
tag
)
(
funcall
function
v
)
t
))
(
defun
write-integer
(
integer
function
)
(
defun
write-integer
(
integer
function
)
(
let
((
byte-count
(
ceiling
(
integer-length
integer
)
8
)))
(
let
((
byte-count
(
ceiling
(
integer-length
integer
)
8
)))
(
assert
(
<
byte-count
256
))
(
assert
(
<
byte-count
256
))
(
flet
((
get-byte
(
n
)
(
write-type-tag
byte-count
function
)
(
ldb
(
byte
8
(
*
n
8
))
integer
)))
(
loop
with
buffer
=
(
make-array
byte-count
(
funcall
function
(
vector
byte-count
))
:element-type
'
(
unsigned-byte
8
))
(
loop
with
buffer
=
(
make-array
byte-count
for
byte-position
from
(
1-
byte-count
)
downto
0
:element-type
'
(
unsigned-byte
8
))
for
step
=
integer
then
(
ash
step
-8
)
for
byte-position
from
(
1-
byte-count
)
downto
0
do
(
setf
(
aref
buffer
byte-position
)
for
buffer-position
from
0
(
logand
step
#xFF
))
do
(
setf
(
aref
buffer
buffer-position
)
finally
(
funcall
function
buffer
))))
(
get-byte
byte-position
))
finally
(
funcall
function
buffer
)))))
(
defun
write-type-tag
(
tag
function
)
(
funcall
function
(
vector
tag
)))
(
defgeneric
binary-render-to-function
(
object
function
)
(
defgeneric
binary-render-to-function
(
object
function
)
(
:method
((
s
string
)
function
)
(
:method
((
s
string
)
function
)
...
@@ -128,18 +131,16 @@
...
@@ -128,18 +131,16 @@
(
defun
binary-render
(
object
&optional
function
)
(
defun
binary-render
(
object
&optional
function
)
(
if
(
null
function
)
(
if
(
null
function
)
(
flexi-streams:with-output-to-sequence
(
s
)
(
with-output-to-vector
(
f
)
(
binary-render-to-function
object
(
lambda
(
bytes
)
(
binary-render-to-function
object
#'
f
))
(
write-sequence
bytes
s
))))
(
binary-render-to-function
object
function
)))
(
binary-render-to-function
object
function
)))
(
defun
binary-render-object
(
object
&key
function
(
defun
binary-render-object
(
object
&key
function
(
emit-computed-values
t
)
(
emit-computed-values
t
)
(
emit-signatures
t
))
(
emit-signatures
t
))
(
if
(
null
function
)
(
if
(
null
function
)
(
flexi-streams:with-output-to-sequence
(
s
)
(
with-output-to-vector
(
f
)
(
binary-render-object-to-function
object
(
lambda
(
bytes
)
(
binary-render-object-to-function
object
#'
f
(
write-sequence
bytes
s
))
emit-computed-values
emit-computed-values
emit-signatures
))
emit-signatures
))
(
binary-render-object-to-function
object
function
(
binary-render-object-to-function
object
function
...
...
Code/netfarm.asd
View file @
545019d4
...
@@ -49,8 +49,9 @@
...
@@ -49,8 +49,9 @@
(
:file
"new-renderer"
)))
(
:file
"new-renderer"
)))
(
:module
"Binary-format"
(
:module
"Binary-format"
:depends-on
(
"Objects"
)
:depends-on
(
"Objects"
)
:components
((
:file
"parser"
)
:components
((
:file
"fasterer-output"
)
(
:file
"renderer"
)))
(
:file
"parser"
)
(
:file
"renderer"
:depends-on
(
"fasterer-output"
))))
(
:module
"Crypto"
(
:module
"Crypto"
:depends-on
(
"Binary-format"
)
:depends-on
(
"Binary-format"
)
:serial
t
:serial
t
...
...
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