diff --git a/Code/Binary-format/fasterer-output.lisp b/Code/Binary-format/fasterer-output.lisp new file mode 100644 index 0000000000000000000000000000000000000000..91649114f86d30aaaa73e638370d3edb8a1e8484 --- /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 6547dabf0ccab5a019223e5034b4b8daef2ac821..06d6fdaaa1bf010d94fa6f7ccbb9d6f26f3ecde6 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 30b53db8495b55f6467597927d4337416b3832be..e4d1a4d515e30232332bae12539a4e5f3503e0a8 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