From 545019d4b8419ffa962134c7d8b9b3a4ec30a71d Mon Sep 17 00:00:00 2001 From: theemacsshibe Date: Tue, 7 Apr 2020 19:30:40 +1000 Subject: [PATCH] Use our own output buffer macro to speed up rendering --- Code/Binary-format/fasterer-output.lisp | 28 ++++++++++++++++++ Code/Binary-format/renderer.lisp | 39 +++++++++++++------------ Code/netfarm.asd | 5 ++-- 3 files changed, 51 insertions(+), 21 deletions(-) create mode 100644 Code/Binary-format/fasterer-output.lisp diff --git a/Code/Binary-format/fasterer-output.lisp b/Code/Binary-format/fasterer-output.lisp new file mode 100644 index 0000000..9164911 --- /dev/null +++ b/Code/Binary-format/fasterer-output.lisp @@ -0,0 +1,28 @@ +(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))))) diff --git a/Code/Binary-format/renderer.lisp b/Code/Binary-format/renderer.lisp index 6547dab..06d6fda 100644 --- a/Code/Binary-format/renderer.lisp +++ b/Code/Binary-format/renderer.lisp @@ -1,21 +1,24 @@ (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 diff --git a/Code/netfarm.asd b/Code/netfarm.asd index 30b53db..e4d1a4d 100644 --- a/Code/netfarm.asd +++ b/Code/netfarm.asd @@ -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 -- GitLab