Commit 545019d4 authored by  Hayley Patton's avatar Hayley Patton 🐢

Use our own output buffer macro to speed up rendering

parent d218449f
(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)))))
(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)
(let ((byte-count (ceiling (integer-length integer) 8)))
(assert (< byte-count 256))
(flet ((get-byte (n)
(ldb (byte 8 (* n 8)) integer)))
(funcall function (vector byte-count))
(loop with buffer = (make-array byte-count
:element-type '(unsigned-byte 8))
for byte-position from (1- byte-count) downto 0
for buffer-position from 0
do (setf (aref buffer buffer-position)
(get-byte byte-position))
finally (funcall function buffer)))))
(defun write-type-tag (tag function)
(funcall function (vector tag)))
(write-type-tag byte-count function)
(loop with buffer = (make-array byte-count
:element-type '(unsigned-byte 8))
for byte-position from (1- byte-count) downto 0
for step = integer then (ash step -8)
do (setf (aref buffer byte-position)
(logand step #xFF))
finally (funcall function buffer))))
(defgeneric binary-render-to-function (object function)
(:method ((s string) function)
......@@ -128,18 +131,16 @@
(defun binary-render (object &optional function)
(if (null function)
(flexi-streams:with-output-to-sequence (s)
(binary-render-to-function object (lambda (bytes)
(write-sequence bytes s))))
(with-output-to-vector (f)
(binary-render-to-function object #'f))
(binary-render-to-function object function)))
(defun binary-render-object (object &key function
(emit-computed-values t)
(emit-signatures t))
(if (null function)
(flexi-streams:with-output-to-sequence (s)
(binary-render-object-to-function object (lambda (bytes)
(write-sequence bytes s))
(with-output-to-vector (f)
(binary-render-object-to-function object #'f
emit-computed-values
emit-signatures))
(binary-render-object-to-function object function
......
......@@ -49,8 +49,9 @@
(:file "new-renderer")))
(:module "Binary-format"
:depends-on ("Objects")
:components ((:file "parser")
(:file "renderer")))
:components ((:file "fasterer-output")
(:file "parser")
(:file "renderer" :depends-on ("fasterer-output"))))
(:module "Crypto"
:depends-on ("Binary-format")
:serial t
......
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