├── .gitignore ├── t ├── package.lisp ├── gray.lisp ├── benchmark-defs.lisp ├── benchmarks.lisp ├── basic.lisp └── test-values ├── src ├── types.lisp ├── package.lisp ├── gray.lisp └── io.lisp ├── fast-io-test.asd ├── fast-io.asd ├── LICENSE └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | \#* 2 | .\#* 3 | *~ 4 | *.fasl 5 | *.lx??fsl -------------------------------------------------------------------------------- /t/package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:fast-io.test 2 | (:use #:cl #:alexandria #:checkl #:fast-io)) 3 | -------------------------------------------------------------------------------- /src/types.lisp: -------------------------------------------------------------------------------- 1 | (in-package :fast-io) 2 | 3 | (deftype octet () '(unsigned-byte 8)) 4 | (deftype octet-vector () '(simple-array octet (*))) 5 | 6 | (deftype index () `(integer 0 ,array-total-size-limit)) 7 | -------------------------------------------------------------------------------- /fast-io-test.asd: -------------------------------------------------------------------------------- 1 | (cl:eval-when (:load-toplevel :execute) 2 | (asdf:load-system :fiveam) 3 | (asdf:load-system :checkl)) 4 | 5 | (defsystem :fast-io-test 6 | :description "Tests for fast-io" 7 | 8 | :depends-on (:fast-io :checkl) 9 | 10 | :pathname "t" 11 | :serial t 12 | 13 | :components 14 | ((:file "package") 15 | (:file "benchmark-defs") 16 | 17 | (checkl:tests "basic") 18 | (checkl:tests "gray") 19 | (checkl:test-values "test-values" 20 | :package :fast-io.test))) 21 | 22 | (checkl:define-test-op :fast-io :fast-io-test) 23 | (checkl:define-test-op :fast-io-test) 24 | -------------------------------------------------------------------------------- /fast-io.asd: -------------------------------------------------------------------------------- 1 | (eval-when (:compile-toplevel :load-toplevel :execute) 2 | (pushnew :fast-io *features*)) 3 | 4 | #+(or sbcl ccl cmucl ecl lispworks allegro) 5 | (eval-when (:compile-toplevel :load-toplevel :execute) 6 | (pushnew :fast-io-sv *features*)) 7 | 8 | (defsystem :fast-io 9 | :description "Alternative I/O mechanism to a stream or vector" 10 | :author "Ryan Pavlik" 11 | :license "MIT" 12 | :version "1.0" 13 | 14 | :depends-on (:alexandria :trivial-gray-streams 15 | #+fast-io-sv 16 | :static-vectors) 17 | 18 | :pathname "src" 19 | :serial t 20 | 21 | :components 22 | ((:file "package") 23 | (:file "types") 24 | (:file "io") 25 | (:file "gray"))) 26 | -------------------------------------------------------------------------------- /t/gray.lisp: -------------------------------------------------------------------------------- 1 | (in-package :fast-io.test) 2 | 3 | (defmacro wos (seq &body body) 4 | `(let ((s (make-instance 'fast-output-stream)) 5 | (vec (octets-from ,seq))) 6 | ,@body 7 | (finish-output-stream s))) 8 | 9 | (defmacro wis (seq vec-len &body body) 10 | `(let ((s (make-instance 'fast-input-stream 11 | :vector (octets-from ,seq))) 12 | (vec (make-octet-vector ,vec-len))) 13 | ,@body)) 14 | 15 | (check (:name :write-stream) 16 | (results 17 | (wos #(1 2 3) (write-sequence vec s)) 18 | (wos #(1 2 3 4 5) 19 | (write-sequence vec s :start 1 :end 4)))) 20 | 21 | (check (:name :read-stream) 22 | (results 23 | (wis #(1 2 3) 2 24 | (results (read-sequence vec s) vec)) 25 | (wis #(1 2 3 4 5) 5 26 | (results (read-sequence vec s :start 1 :end 4) vec)))) 27 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2012-2020 Ryan Pavlik 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights 6 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | copies of the Software, and to permit persons to whom the Software is 8 | furnished to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in all 11 | copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 19 | SOFTWARE. 20 | -------------------------------------------------------------------------------- /t/benchmark-defs.lisp: -------------------------------------------------------------------------------- 1 | (in-package :fast-io.test) 2 | 3 | (declaim (inline now)) 4 | (defun now () 5 | (coerce (/ (get-internal-real-time) 6 | internal-time-units-per-second) 7 | 'double-float)) 8 | 9 | (defmacro bench ((&optional (times 1)) &body body) 10 | (with-gensyms (results t1 t2 i) 11 | (declare (ignorable results t2)) 12 | (once-only (times) 13 | `(let (,t1 14 | #+-(,results (make-array ,times :element-type 'double-float))) 15 | (declare (ignorable ,t1)) 16 | (time 17 | (dotimes (,i ,times) 18 | #+- 19 | (setf ,t1 (now)) 20 | ,@body 21 | #+- 22 | (let ((,t2 (now))) 23 | (setf (aref ,results ,i) (- ,t2 ,t1))))) 24 | #+- 25 | (format t "Tot: ~F | Min: ~F Max: ~F~%Avg: ~F Med: ~F Var: ~F Std: ~F" 26 | (reduce #'+ ,results) 27 | (reduce #'min ,results) 28 | (reduce #'max ,results) 29 | (mean ,results) 30 | (median ,results) 31 | (variance ,results) 32 | (standard-deviation ,results)))))) 33 | 34 | -------------------------------------------------------------------------------- /t/benchmarks.lisp: -------------------------------------------------------------------------------- 1 | (in-package :fast-io.test) 2 | 3 | ;; Naive 4 | 5 | (bench (50000) 6 | (let ((vec (make-array 16 :element-type 'octet 7 | :adjustable t 8 | :fill-pointer 0))) 9 | (dotimes (i 50) 10 | (vector-push-extend 0 vec)))) 11 | 12 | ;; Flexi-streams 13 | 14 | #+flexi-streams 15 | (bench (50000) 16 | (flexi-streams:with-output-to-sequence (stream) 17 | (dotimes (i 50) 18 | (write-byte 0 stream)))) 19 | 20 | #+flexi-streams 21 | (bench (50000) 22 | (flexi-streams:with-output-to-sequence (stream) 23 | (let ((vec (make-octet-vector 50))) 24 | (write-sequence vec stream)))) 25 | 26 | ;; Fast-io 27 | 28 | (bench (50000) 29 | (with-fast-output (buffer) 30 | (dotimes (i 50) 31 | (fast-write-byte 0 buffer)))) 32 | 33 | (defun test () 34 | (with-fast-output (buffer) 35 | (dotimes (i 50) 36 | (fast-write-byte 0 buffer)))) 37 | 38 | (bench (50000) (test)) 39 | 40 | (bench (1000000) 41 | (let ((vec (make-octet-vector 50))) 42 | (with-fast-output (buffer) 43 | (fast-write-sequence vec buffer)))) 44 | 45 | (bench (50000) 46 | (static-vectors:free-static-vector 47 | (with-fast-output (buffer :static) 48 | (dotimes (i 50) 49 | (fast-write-byte 0 buffer))))) 50 | 51 | ;; Fast-io streams 52 | 53 | (bench (1000000) 54 | (let ((stream (make-instance 'fast-output-stream)) 55 | (vec (make-octet-vector 50))) 56 | (write-sequence vec stream))) 57 | -------------------------------------------------------------------------------- /src/package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :fast-io 2 | (:use #:cl #:alexandria #:trivial-gray-streams) 3 | (:export #:*default-output-buffer-size* 4 | 5 | #:octet #:octet-vector #:index 6 | #:input-buffer #:output-buffer 7 | 8 | #:make-octet-vector #:octets-from 9 | 10 | #:make-output-buffer #:finish-output-buffer 11 | #:buffer-position 12 | 13 | #:make-input-buffer #:input-buffer-vector #:input-buffer-stream 14 | 15 | #:fast-read-byte #:fast-write-byte 16 | #:fast-read-sequence #:fast-write-sequence 17 | #:with-fast-input #:with-fast-output 18 | 19 | ;#:fast-seek 20 | 21 | #:write8 #:writeu8 22 | #:write8-le #:writeu8-le #:write8-be #:writeu8-be 23 | #:write16-le #:writeu16-le #:write16-be #:writeu16-be 24 | #:write24-le #:writeu24-le #:write24-be #:writeu24-be 25 | #:write32-le #:writeu32-le #:write32-be #:writeu32-be 26 | #:write64-le #:writeu64-le #:write64-be #:writeu64-be 27 | #:write128-le #:writeu128-le #:write128-be #:writeu128-be 28 | 29 | #:read8 #:readu8 30 | #:read8-le #:readu8-le #:read8-be #:readu8-be 31 | #:read16-le #:readu16-le #:read16-be #:readu16-be 32 | #:read32-le #:readu32-le #:read32-be #:readu32-be 33 | #:read64-le #:readu64-le #:read64-be #:readu64-be 34 | #:read128-le #:readu128-le #:read128-be #:readu128-be 35 | 36 | #:fast-output-stream #:fast-input-stream 37 | #:finish-output-stream)) 38 | -------------------------------------------------------------------------------- /t/basic.lisp: -------------------------------------------------------------------------------- 1 | (in-package :fast-io.test) 2 | 3 | (defmacro wo (&body body) 4 | `(with-fast-output (b) 5 | ,@body)) 6 | 7 | (defmacro wi (seq &body body) 8 | `(with-fast-input (b (octets-from ,seq)) 9 | ,@body)) 10 | 11 | (defmacro write-all (bits) 12 | (let ((fun (mapcar (lambda (m) (symbolicate (format nil m bits))) 13 | '("WRITE~A-BE" "WRITEU~A-BE" 14 | "WRITE~A-LE" "WRITEU~A-LE"))) 15 | (unsigned (- (expt 2 bits) 2)) 16 | (signed (- (truncate (expt 2 bits) 2)))) 17 | `(values 18 | (wo (,(first fun) ,signed b)) 19 | (wo (,(second fun) ,unsigned b)) 20 | (wo (,(third fun) ,signed b)) 21 | (wo (,(fourth fun) ,unsigned b))))) 22 | 23 | (defmacro read-all (bits) 24 | (let ((fun (mapcar (lambda (m) (symbolicate (format nil m bits))) 25 | '("READ~A-BE" "READU~A-BE" 26 | "READ~A-LE" "READU~A-LE")))) 27 | `(let ((bytes (multiple-value-list (write-all ,bits)))) 28 | (values 29 | (wi (first bytes) (,(first fun) b)) 30 | (wi (second bytes) (,(second fun) b)) 31 | (wi (third bytes) (,(third fun) b)) 32 | (wi (fourth bytes) (,(fourth fun) b)))))) 33 | 34 | (check (:name :octets) 35 | (results 36 | (make-octet-vector 4) 37 | (octets-from '(1 2 3 4)) 38 | (octets-from #(4 3 2 1)))) 39 | 40 | (check (:name :write-bytes :output-p t) 41 | (results 42 | (wo (fast-write-byte 1 b)) 43 | (wo (fast-write-sequence (octets-from '(1 2 3 4)) b)))) 44 | 45 | (check (:name :write-endian :output-p t) 46 | (results 47 | (write-all 8) 48 | (write-all 16) 49 | (write-all 32) 50 | (write-all 64) 51 | (write-all 128))) 52 | 53 | (check (:name :read-bytes :output-p t) 54 | (results 55 | (wi '(1) (fast-read-byte b)) 56 | (wi '(1 2 3 4) 57 | (let ((vec (make-octet-vector 4))) 58 | (fast-read-sequence vec b) 59 | vec)))) 60 | 61 | (check (:name :read-endian :output-p t) 62 | (results 63 | (read-all 8) 64 | (read-all 16) 65 | (read-all 32) 66 | (read-all 64) 67 | (read-all 128))) 68 | -------------------------------------------------------------------------------- /t/test-values: -------------------------------------------------------------------------------- 1 | (:PCODE 1 2 | (:HASH-TABLE 1 16 1.5 1.0 EQUALP NIL 3 | (:WRITE-BYTES 4 | (:LIST 2 (:ARRAY 3 (1) #1=(UNSIGNED-BYTE 8) (1)) 5 | (:ARRAY 4 (4) #1# (1 2 3 4))) 6 | :READ-BYTES (:LIST 5 1 (:ARRAY 6 (4) #1# (1 2 3 4))) :WRITE-ENDIAN 7 | (:LIST 7 8 | (:LIST 8 (:ARRAY 9 (1) #1# (128)) (:ARRAY 10 (1) #1# (254)) 9 | (:ARRAY 11 (1) #1# (128)) (:ARRAY 12 (1) #1# (254))) 10 | (:LIST 13 (:ARRAY 14 (2) #1# (128 0)) (:ARRAY 15 (2) #1# (255 254)) 11 | (:ARRAY 16 (2) #1# (0 128)) (:ARRAY 17 (2) #1# (254 255))) 12 | (:LIST 18 (:ARRAY 19 (4) #1# (128 0 0 0)) 13 | (:ARRAY 20 (4) #1# (255 255 255 254)) (:ARRAY 21 (4) #1# (0 0 0 128)) 14 | (:ARRAY 22 (4) #1# (254 255 255 255))) 15 | (:LIST 23 (:ARRAY 24 (8) #1# (128 0 0 0 0 0 0 0)) 16 | (:ARRAY 25 (8) #1# (255 255 255 255 255 255 255 254)) 17 | (:ARRAY 26 (8) #1# (0 0 0 0 0 0 0 128)) 18 | (:ARRAY 27 (8) #1# (254 255 255 255 255 255 255 255))) 19 | (:LIST 28 (:ARRAY 29 (16) #1# (128 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)) 20 | (:ARRAY 30 (16) #1# 21 | (255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 254)) 22 | (:ARRAY 31 (16) #1# (0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 128)) 23 | (:ARRAY 32 (16) #1# 24 | (254 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255)))) 25 | :READ-ENDIAN 26 | (:LIST 33 (:LIST 34 -128 254 -128 254) (:LIST 35 -32768 65534 -32768 65534) 27 | (:LIST 36 -2147483648 4294967294 -2147483648 4294967294) 28 | (:LIST 37 -9223372036854775808 18446744073709551614 -9223372036854775808 29 | 18446744073709551614) 30 | (:LIST 38 -170141183460469231731687303715884105728 31 | 340282366920938463463374607431768211454 32 | -170141183460469231731687303715884105728 33 | 340282366920938463463374607431768211454)) 34 | :OCTETS 35 | (:LIST 39 (:ARRAY 40 (4) #1# (0 0 0 0)) (:ARRAY 41 (4) #1# (1 2 3 4)) 36 | (:ARRAY 42 (4) #1# (4 3 2 1))) 37 | :READ-STREAM 38 | (:LIST 43 (:LIST 44 2 (:ARRAY 45 (2) #1# (1 2))) 39 | (:LIST 46 4 (:ARRAY 47 (5) #1# (0 1 2 3 0)))) 40 | :WRITE-STREAM 41 | (:LIST 48 (:ARRAY 49 (3) #1# (1 2 3)) (:ARRAY 50 (3) #1# (2 3 4)))))) -------------------------------------------------------------------------------- /src/gray.lisp: -------------------------------------------------------------------------------- 1 | (in-package :fast-io) 2 | 3 | ;; fast-stream 4 | 5 | (defclass fast-io-stream (fundamental-stream) 6 | ((openp :type boolean :initform t))) 7 | 8 | (defmethod stream-file-position ((stream fast-io-stream)) 9 | (with-slots (buffer) stream 10 | (buffer-position buffer))) 11 | 12 | (defmethod open-stream-p ((stream fast-io-stream)) 13 | (slot-value stream 'openep)) 14 | 15 | ;; fast-output-stream 16 | 17 | (defclass fast-output-stream (fast-io-stream fundamental-output-stream) 18 | ((buffer :type output-buffer))) 19 | 20 | (defmethod initialize-instance ((self fast-output-stream) &key stream 21 | buffer-size &allow-other-keys) 22 | (call-next-method) 23 | (let ((*default-output-buffer-size* (or buffer-size *default-output-buffer-size*))) 24 | (with-slots (buffer) self 25 | (setf buffer (make-output-buffer :output stream))))) 26 | 27 | (defmethod output-stream-p ((stream fast-output-stream)) 28 | (with-slots (buffer) stream 29 | (and (typep buffer 'output-buffer)))) 30 | 31 | (defmethod stream-element-type ((stream fast-output-stream)) 32 | "Return the underlying array element-type. 33 | Should always return '(unsigned-byte 8)." 34 | (with-slots (buffer) stream 35 | (array-element-type (output-buffer-vector buffer)))) 36 | 37 | (defmethod stream-write-byte ((stream fast-output-stream) byte) 38 | (with-slots (buffer) stream 39 | (fast-write-byte byte buffer))) 40 | 41 | (defmethod stream-write-sequence ((stream fast-output-stream) sequence start end 42 | &key &allow-other-keys) 43 | (with-slots (buffer) stream 44 | (fast-write-sequence sequence buffer start end)) 45 | sequence) 46 | 47 | (defun finish-output-stream (stream) 48 | (with-slots (buffer) stream 49 | (if (streamp (output-buffer-output buffer)) 50 | (flush buffer) 51 | (finish-output-buffer buffer)))) 52 | 53 | (defmethod close ((stream fast-output-stream) &key abort) 54 | (declare (ignore abort)) 55 | (finish-output-stream stream) 56 | (setf (slot-value stream 'openp) nil)) 57 | 58 | ;; fast-input-stream 59 | 60 | (defclass fast-input-stream (fast-io-stream fundamental-input-stream) 61 | ((buffer :type input-buffer))) 62 | 63 | (defmethod initialize-instance ((self fast-input-stream) &key stream 64 | vector &allow-other-keys) 65 | (call-next-method) 66 | (with-slots (buffer) self 67 | (setf buffer (make-input-buffer :vector vector :stream stream)))) 68 | 69 | (defmethod input-stream-p ((stream fast-input-stream)) 70 | (with-slots (buffer) stream 71 | (and (typep buffer 'input-buffer)))) 72 | 73 | (defmethod stream-element-type ((stream fast-input-stream)) 74 | "Return element-type of the underlying vector or stream. 75 | Return NIL if none are present." 76 | (with-slots (buffer) stream 77 | (if-let ((vec (input-buffer-vector buffer))) 78 | (array-element-type vec) 79 | (if-let ((stream (input-buffer-stream buffer))) 80 | (stream-element-type stream))))) 81 | 82 | (defmethod (setf stream-file-position) (new-pos (stream fast-input-stream)) 83 | (with-slots (buffer) stream 84 | (setf (buffer-position buffer) new-pos))) 85 | 86 | (defmethod peek-byte ((stream fast-input-stream) &optional peek-type (eof-error-p t) eof-value) 87 | (with-slots (buffer) stream 88 | (fast-peek-byte buffer peek-type eof-error-p eof-value))) 89 | 90 | (defmethod stream-read-byte ((stream fast-input-stream)) 91 | (with-slots (buffer) stream 92 | (fast-read-byte buffer))) 93 | 94 | (defmethod stream-read-sequence ((stream fast-input-stream) sequence start end 95 | &key &allow-other-keys) 96 | (with-slots (buffer) stream 97 | (fast-read-sequence sequence buffer start end))) 98 | 99 | (defmethod close ((stream fast-input-stream) &key abort) 100 | (declare (ignore abort)) 101 | (setf (slot-value stream 'openp) nil)) 102 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # fast-io 2 | 3 | **Now with 4 | [static-vectors](https://github.com/sionescu/static-vectors) 5 | support!** 6 | 7 | ```lisp 8 | (deftype octet '(unsigned-byte 8)) 9 | (deftype octet-vector '(simple-array octet (*))) 10 | ``` 11 | 12 | Fast-io is about improving performance to octet-vectors and octet 13 | streams (though primarily the former, while wrapping the latter). 14 | Imagine we're creating messages for the network. If we try and fill an 15 | octet-vector with 50 bytes, 50000 times, here are the results (SBCL 16 | 1.0.57): 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 |
vector-push-extend:flexi-streams:fast-io:
Time:0.767s2.545s0.090s
Bytes consed:104,778,352274,452,76818,373,904
38 | 39 | (See `t/benchmarks.lisp` for the exact code used.) 40 | 41 | It *should* be surprising that it takes a nontrivial effort to achieve 42 | relatively decent performance to octet-vectors, but probably isn't. 43 | However, fast-io provides a relatively straightforward interface for 44 | reading and writing either a stream or a vector: 45 | 46 | ```lisp 47 | ;;; Write a byte or sequence, optionally to a stream: 48 | 49 | (with-fast-output (buffer [STREAM | :vector | :static]) 50 | (fast-write-byte BYTE buffer)) 51 | 52 | (with-fast-output (buffer [STREAM | :vector | :static]) 53 | (fast-write-sequence OCTET-VECTOR buffer [START [END]])) 54 | 55 | ;;; Read from a vector or stream: 56 | 57 | (with-fast-input (buffer VECTOR [STREAM]) 58 | (fast-read-byte buffer)) 59 | 60 | (with-fast-input (buffer VECTOR [STREAM]) 61 | (let ((vec (make-octet-vector N))) 62 | (fast-read-sequence vec buffer [START [END]]))) 63 | ``` 64 | 65 | ## Multi-byte and Endianness 66 | 67 | Fast-io provides a host of read and write functions for big- and little-endian reads. See the [Dictionary](#reading-and-writing) below. 68 | 69 | ## Static Vectors 70 | 71 | You may now specify `:static` instead of a stream to 72 | `WITH-OUTPUT-BUFFER`. This returns an octet-vector created with 73 | [static-vectors](https://github.com/sionescu/static-vectors), 74 | which means that passing the buffered data directly to a foreign 75 | function is now that much more efficient: 76 | 77 | ```lisp 78 | (let ((data (with-fast-output (buffer :static) 79 | (buffer-some-data buffer)))) 80 | (foreign-send (static-vectors:static-vector-pointer data)) 81 | (static-vectors:free-static-vector data)) 82 | ``` 83 | 84 | Note that the restriction for manually freeing the result remains. 85 | This avoids multiple inefficient (i.e., byte-by-byte) copies to 86 | foreign memory. 87 | 88 | ## Streams 89 | 90 | Obviously, the above API isn't built around Lisp streams, or even 91 | gray-streams. However, fast-io provides a small wrapper using 92 | `trivial-gray-streams`, and supports `{WRITE,READ}-SEQUENCE`: 93 | 94 | ```lisp 95 | (let ((stream (make-instance 'fast-io:fast-output-stream))) 96 | (write-sequence (fast-io:octets-from '(1 2 3 4)) stream)) 97 | ``` 98 | 99 | Both `fast-input-stream` and `fast-output-stream` support backing a 100 | stream, much like using the plain fast-io buffers. However, using the 101 | gray-streams interface is a 3-4x as slow as using the buffers alone. 102 | Simple benchmarks show the gray-streams interface writing 1M 50-byte 103 | vectors in about 1.7s, whereas simply using buffers is about 0.8s. 104 | Consing remains similar between the two. 105 | 106 | ## Dictionary 107 | 108 | ### Octets 109 | 110 | Most functions operate on or require octet-vectors, i.e., 111 | 112 | ```lisp 113 | (deftype octet () '(unsigned-byte 8)) 114 | (deftype octet-vector '(simple-array octet (*))) 115 | ``` 116 | 117 | Which is exactly what is defined and exported from `fast-io`. Also: 118 | 119 | * `make-octet-vector LEN`
Make an octet-vector of length `LEN`. 120 | * `octets-from SEQUENCE`
Make an octet-vector from the contents of `SEQUENCE`. 121 | 122 | ### Buffers 123 | 124 | * `make-input-buffer &key VECTOR STREAM POS`
Create an input buffer for use with input functions. `:vector` specifies the vector to be read from. `:stream` specifies the stream to read from. `:pos` specifies the offset to start reading into `VECTOR` If both `:vector` and `:stream` is provided, the input buffer reads from the vector first, followed by the stream. 125 | * `make-output-buffer &key OUTPUT`
Create an output buffer for use with output functions. `:output` specifies an output stream. If `:output :static` is specified, and static-vectors is supported, output will be to a static-vector. 126 | * `finish-output-buffer BUFFER`
Finish the output and return the complete octet-vector. 127 | * `buffer-position BUFFER`
Return the current read/write position for `BUFFER`. 128 | 129 | * `with-fast-input (BUFFER VECTOR &optional STREAM (OFFSET 0)) &body body`
Create an input buffer called `BUFFER`, optionally reading from `VECTOR`, followed by reading from `STREAM`. If `OFFSET` is specified, start reading from this position in `VECTOR`. 130 | * `with-fast-output (BUFFER &optional OUTPUT) &body BODY`
Create an output buffer named `BUFFER`, optionally writing to the stream `OUTPUT`. This will automatically `FINISH-OUTPUT-BUFFER` on `BUFFER`. Thus the `with-fast-output` form evaluates to the completed octet-vector. 131 | 132 | ### Reading and Writing 133 | 134 | * `fast-read-byte INPUT-BUFFER &optional (EOF-ERROR-P t) EOF-VALUE`
Read a byte from `INPUT-BUFFER`. If `EOF-ERROR-P` is `t`, reading past the end-of-file will signal `CL:END-OF-FILE`. Otherwise, it will return `EOF-VALUE` instead. 135 | * `fast-write-byte BYTE OUTPUT-BUFFER`
Write a byte to `OUTPUT-BUFFER`. 136 | * `fast-read-sequence SEQUENCE INPUT-BUFFER &optional (START 0) END`
Read from `INPUT-BUFFER` into `SEQUENCE`. Values will be written starting at position `START` and, if `END` is specified, ending at `END`. Otherwise values will be written until the length of the sequence, or until the input is exhausted. 137 | * `fast-write-sequence SEQUENCE OUTPUT-BUFFER &optional (START 0) END`
Write `SEQUENCE` to `OUTPUT-BUFFER`, starting at position `START` in `SEQUENCE`. If `END` is specified, values will be written until `END`; otherwise, values will be written for the length of the sequence. 138 | 139 | For multi-byte reads and writes requiring endianness, fast-io provides functions in the following forms: 140 | 141 | * `write[u]{8,16,32,64,128}{-be,-le}`: E.g., `(write32-be VALUE BUFFER)` will write the specified 32-bit value to the specified buffer with a *big-endian* layout. Likewise, `(writeu16-le VALUE BUFFER)` will write an *unsigned* 16-bit value in *little-endian* layout. 142 | * `read[u]{8,16,32,64,128}{-be,-le}`: Similarly, `(read64-le BUFFER)` will read a 64-bit value from the buffer with little-endian layout. 143 | -------------------------------------------------------------------------------- /src/io.lisp: -------------------------------------------------------------------------------- 1 | (in-package :fast-io) 2 | 3 | ;; Vector buffer 4 | 5 | (defvar *default-output-buffer-size* 16) 6 | 7 | (declaim (ftype (function (index) octet-vector) make-octet-vector) 8 | (inline make-octet-vector)) 9 | (defun make-octet-vector (len) 10 | (make-array (the index len) :element-type 'octet)) 11 | 12 | (declaim (inline output-buffer-vector output-buffer-fill output-buffer-len)) 13 | (defstruct output-buffer 14 | (vector (make-octet-vector *default-output-buffer-size*) 15 | :type octet-vector) 16 | (fill 0 :type index) 17 | (len 0 :type index) 18 | (queue nil :type list) 19 | (last nil :type list) 20 | (output nil)) 21 | 22 | (defstruct input-buffer 23 | (vector nil :type (or null octet-vector)) 24 | (pos 0 :type index) 25 | (stream nil)) 26 | 27 | (defun buffer-position (buffer) 28 | "Return the number of bytes read (for an INPUT-BUFFER) or written 29 | (for an OUTPUT-BUFFER)" 30 | (etypecase buffer 31 | (input-buffer (input-buffer-pos buffer)) 32 | (output-buffer (output-buffer-len buffer)))) 33 | 34 | ;; Sometimes it is usefull just to skip the buffer instead of reading from it. 35 | (defun (setf buffer-position) (new-pos buffer) 36 | "Set the buffer position for input-buffer" 37 | (check-type buffer input-buffer) 38 | (let* ((pos (input-buffer-pos buffer)) 39 | (vec (input-buffer-vector buffer)) 40 | (vec-len (length vec))) 41 | (declare (optimize (speed 3) (safety 1)) 42 | (type octet-vector vec) 43 | (type non-negative-fixnum pos vec-len new-pos)) 44 | ;; Only need to update if pos or new-pos is in stream range. 45 | (when-let ((stream-update-needed? (or (> pos vec-len) 46 | (> new-pos vec-len))) 47 | (stream (input-buffer-stream buffer))) 48 | (let* ((stream-file-pos (file-position stream)) 49 | (pos-diff (- new-pos pos)) 50 | (stream-diff (cond ((and (> pos vec-len) 51 | (< new-pos vec-len)) 52 | ;; branch for pos in stream and new-pos 53 | ;; is in vector. 54 | (- vec-len pos)) 55 | ((and (< pos vec-len) 56 | (> new-pos vec-len)) 57 | ;; branch for pos in vector. and new-pos 58 | ;; is in stream. 59 | (- pos-diff (- vec-len pos))) 60 | ;; otherwise stream-diff = pos-diff. 61 | (t pos-diff))) 62 | (new-stream-pos (+ stream-file-pos stream-diff))) 63 | (declare (type non-negative-fixnum stream-file-pos new-stream-pos) 64 | (type fixnum pos-diff stream-diff)) 65 | (file-position stream new-stream-pos)))) 66 | (setf (slot-value buffer 'pos) new-pos)) 67 | 68 | (defun octets-from (sequence) 69 | (let ((vec (make-octet-vector (length sequence)))) 70 | (replace vec sequence) 71 | vec)) 72 | 73 | (defun concat-buffer (buffer) 74 | (let* ((len (output-buffer-len buffer)) 75 | (array 76 | #+fast-io-sv 77 | (if (eq :static (output-buffer-output buffer)) 78 | (static-vectors:make-static-vector (the index len)) 79 | (make-octet-vector len)) 80 | #-fast-io-sv 81 | (make-octet-vector len))) 82 | (loop as i = 0 then (+ i (length a)) 83 | for a in (output-buffer-queue buffer) do 84 | (replace (the octet-vector array) 85 | (the octet-vector a) :start1 i) 86 | finally 87 | (replace (the octet-vector array) 88 | (output-buffer-vector buffer) 89 | :start1 i 90 | :end2 (output-buffer-fill buffer))) 91 | array)) 92 | 93 | (defun flush (output-buffer) 94 | (when (> (output-buffer-fill output-buffer) 0) 95 | (write-sequence (output-buffer-vector output-buffer) 96 | (output-buffer-output output-buffer) 97 | :start 0 :end (output-buffer-fill output-buffer)) 98 | (prog1 (output-buffer-fill output-buffer) 99 | (setf (output-buffer-fill output-buffer) 0)))) 100 | 101 | (defun extend (buffer &optional (min 1)) 102 | (let ((vector (output-buffer-vector buffer))) 103 | (setf (output-buffer-last buffer) 104 | (nconc (output-buffer-last buffer) 105 | (cons vector nil)) 106 | (output-buffer-vector buffer) 107 | (make-octet-vector (max min (1+ (* 2 (length vector))))) 108 | (output-buffer-fill buffer) 0) 109 | (unless (output-buffer-queue buffer) 110 | (setf (output-buffer-queue buffer) 111 | (output-buffer-last buffer))))) 112 | 113 | (defun fast-write-byte (byte output-buffer) 114 | (declare (type octet byte) 115 | (type output-buffer output-buffer) 116 | (optimize (speed 3) (safety 1))) 117 | (when (= (output-buffer-fill output-buffer) 118 | (array-dimension (output-buffer-vector output-buffer) 0)) 119 | (if (streamp (output-buffer-output output-buffer)) 120 | (flush output-buffer) 121 | (extend output-buffer))) 122 | (prog1 123 | (setf (aref (output-buffer-vector output-buffer) 124 | (output-buffer-fill output-buffer)) 125 | byte) 126 | (incf (output-buffer-fill output-buffer)) 127 | (incf (output-buffer-len output-buffer)))) 128 | 129 | (defun fast-read-byte (input-buffer &optional (eof-error-p t) eof-value) 130 | (declare (type input-buffer input-buffer)) 131 | (when-let ((vec (input-buffer-vector input-buffer)) 132 | (pos (input-buffer-pos input-buffer))) 133 | (when (< pos (length vec)) 134 | (incf (input-buffer-pos input-buffer)) 135 | (return-from fast-read-byte (aref vec pos)))) 136 | (when-let (stream (input-buffer-stream input-buffer)) 137 | (let ((byte (read-byte stream eof-error-p eof-value))) 138 | (unless (equal byte eof-value) 139 | (incf (input-buffer-pos input-buffer))) 140 | (return-from fast-read-byte byte))) 141 | (if eof-error-p 142 | (error 'end-of-file :stream input-buffer) 143 | eof-value)) 144 | 145 | (defun fast-peek-byte (input-buffer &optional peek-type (eof-error-p t) eof-value) 146 | "This is like `peek-byte' only for fast-io input-buffers." 147 | (declare (type input-buffer input-buffer)) 148 | (loop :for octet = (fast-read-byte input-buffer eof-error-p :eof) 149 | :for new-pos :from (input-buffer-pos input-buffer) 150 | :until (cond ((eq octet :eof) 151 | (return eof-value)) 152 | ((null peek-type)) 153 | ((eq peek-type 't) 154 | (plusp octet)) 155 | ((= octet peek-type))) 156 | :finally (setf (buffer-position input-buffer) new-pos) 157 | (return octet))) 158 | 159 | (defun fast-write-sequence (sequence output-buffer &optional (start 0) end) 160 | (if (streamp (output-buffer-output output-buffer)) 161 | (progn 162 | (flush output-buffer) 163 | (write-sequence sequence (output-buffer-output output-buffer) :start start :end end)) 164 | (progn 165 | (let* ((start2 start) 166 | (len (if end 167 | (- end start) 168 | (- (length sequence) start))) 169 | (buffer-remaining 170 | (- (length (output-buffer-vector output-buffer)) 171 | (output-buffer-fill output-buffer)))) 172 | (when (> buffer-remaining 0) 173 | (replace (output-buffer-vector output-buffer) 174 | (the octet-vector sequence) 175 | :start1 (output-buffer-fill output-buffer) 176 | :start2 start2 177 | :end2 end) 178 | (incf start2 buffer-remaining) 179 | (incf (output-buffer-fill output-buffer) 180 | (min buffer-remaining len))) 181 | (let ((sequence-remaining (- (or end (length sequence)) start2))) 182 | (when (> sequence-remaining 0) 183 | (extend output-buffer sequence-remaining) 184 | (replace (output-buffer-vector output-buffer) 185 | (the octet-vector sequence) 186 | :start2 start2 187 | :end2 end) 188 | (incf (output-buffer-fill output-buffer) sequence-remaining))) 189 | (incf (output-buffer-len output-buffer) len) 190 | len)))) 191 | 192 | (defun fast-read-sequence (sequence input-buffer &optional (start 0) end) 193 | (declare (type octet-vector sequence) 194 | (type input-buffer input-buffer)) 195 | (let ((start1 start) 196 | (total-len (if end 197 | (- end start) 198 | (- (length sequence) start)))) 199 | (when-let ((vec (input-buffer-vector input-buffer)) 200 | (pos (input-buffer-pos input-buffer))) 201 | (when (< pos (length vec)) 202 | (let ((len (min total-len (- (length vec) pos)))) 203 | (replace sequence vec 204 | :start1 start1 205 | :start2 pos 206 | :end2 (+ pos len)) 207 | (incf (input-buffer-pos input-buffer) len) 208 | (incf start1 len)))) 209 | (when (< start1 total-len) 210 | (when-let (stream (input-buffer-stream input-buffer)) 211 | (let ((bytes-read (read-sequence sequence stream 212 | :start start1 213 | :end (+ total-len start1)))) 214 | (incf (input-buffer-pos input-buffer) bytes-read) 215 | (return-from fast-read-sequence bytes-read)))) 216 | start1)) 217 | 218 | (defun finish-output-buffer (output-buffer) 219 | "Finish an output buffer. If it is backed by a vector (static or otherwise) 220 | it returns the final octet vector. If it is backed by a stream it ensures that 221 | all data has been flushed to the stream." 222 | (if (streamp (output-buffer-output output-buffer)) 223 | (flush output-buffer) 224 | (concat-buffer output-buffer))) 225 | 226 | (defmacro with-fast-output ((buffer &optional output) &body body) 227 | "Create `BUFFER`, optionally outputting to `OUTPUT`." 228 | `(let ((,buffer (make-output-buffer :output ,output))) 229 | ,@body 230 | (if (streamp (output-buffer-output ,buffer)) 231 | (flush ,buffer) 232 | (finish-output-buffer ,buffer)))) 233 | 234 | (defmacro with-fast-input ((buffer vector &optional stream (offset 0)) &body body) 235 | `(let ((,buffer (make-input-buffer :vector ,vector :stream ,stream :pos ,offset))) 236 | ,@body)) 237 | 238 | ;; READx and WRITEx 239 | ;;; WRITE-UNSIGNED-BE, READ-UNSIGNED-BE, etc taken from PACK, which is 240 | ;;; in the public domain. 241 | 242 | (defmacro write-unsigned-be (value size buffer) 243 | (once-only (value buffer) 244 | `(progn 245 | ,@(loop for i from (* (1- size) 8) downto 0 by 8 246 | collect `(fast-write-byte (ldb (byte 8 ,i) ,value) ,buffer))))) 247 | 248 | (defmacro read-unsigned-be (size buffer) 249 | (with-gensyms (value) 250 | (once-only (buffer) 251 | `(let ((,value 0)) 252 | ,@(loop for i from (* (1- size) 8) downto 0 by 8 253 | collect `(setf (ldb (byte 8 ,i) ,value) (fast-read-byte ,buffer))) 254 | ,value)))) 255 | 256 | (defmacro write-unsigned-le (value size buffer) 257 | (once-only (value buffer) 258 | `(progn 259 | ,@(loop for i from 0 below (* 8 size) by 8 260 | collect `(fast-write-byte (ldb (byte 8 ,i) ,value) ,buffer))))) 261 | 262 | (defmacro read-unsigned-le (size buffer) 263 | (with-gensyms (value) 264 | (once-only (buffer) 265 | `(let ((,value 0)) 266 | ,@(loop for i from 0 below (* 8 size) by 8 267 | collect `(setf (ldb (byte 8 ,i) ,value) (fast-read-byte ,buffer))) 268 | ,value)))) 269 | 270 | (declaim (inline unsigned-to-signed)) 271 | (defun unsigned-to-signed (value size) 272 | (let ((max-signed (expt 2 (1- (* 8 size)))) 273 | (to-subtract (expt 2 (* 8 size)))) 274 | (if (>= value max-signed) 275 | (- value to-subtract) 276 | value))) 277 | 278 | (declaim (inline signed-to-unsigned)) 279 | (defun signed-to-unsigned (value size) 280 | (if (minusp value) 281 | (+ value (expt 2 (* 8 size))) 282 | value)) 283 | 284 | (defmacro make-readers (&rest bitlens) 285 | (let ((names (mapcar (lambda (n) 286 | (mapcar (lambda (m) (symbolicate (format nil m n))) 287 | '("READ~A-BE" "READU~A-BE" 288 | "READ~A-LE" "READU~A-LE"))) 289 | bitlens))) 290 | `(eval-when (:compile-toplevel :load-toplevel :execute) 291 | (declaim (inline ,@(flatten names))) 292 | ,@(loop for fun in names 293 | for bits in bitlens 294 | as bytes = (truncate bits 8) 295 | collect 296 | `(progn 297 | (defun ,(first fun) (buffer) 298 | (unsigned-to-signed (read-unsigned-be ,bytes buffer) ,bytes)) 299 | (defun ,(second fun) (buffer) 300 | (read-unsigned-be ,bytes buffer)) 301 | (defun ,(third fun) (buffer) 302 | (unsigned-to-signed (read-unsigned-le ,bytes buffer) ,bytes)) 303 | (defun ,(fourth fun) (buffer) 304 | (read-unsigned-le ,bytes buffer))))))) 305 | 306 | (defmacro make-writers (&rest bitlens) 307 | (let ((names (mapcar (lambda (n) 308 | (mapcar (lambda (m) (symbolicate (format nil m n))) 309 | '("WRITE~A-BE" "WRITEU~A-BE" 310 | "WRITE~A-LE" "WRITEU~A-LE"))) 311 | bitlens))) 312 | `(eval-when (:compile-toplevel :load-toplevel :execute) 313 | (declaim (notinline ,@(flatten names))) 314 | ,@(loop for fun in names 315 | for bits in bitlens 316 | as bytes = (truncate bits 8) 317 | collect 318 | `(progn 319 | (defun ,(first fun) (value buffer) 320 | (declare (type (signed-byte ,bits) value)) 321 | (write-unsigned-be (the (unsigned-byte ,bits) 322 | (signed-to-unsigned value ,bytes)) ,bytes buffer)) 323 | (defun ,(second fun) (value buffer) 324 | (declare (type (unsigned-byte ,bits) value)) 325 | (write-unsigned-be (the (unsigned-byte ,bits) value) 326 | ,bytes buffer)) 327 | (defun ,(third fun) (value buffer) 328 | (declare (type (signed-byte ,bits) value)) 329 | (write-unsigned-le (the (unsigned-byte ,bits) 330 | (signed-to-unsigned value ,bytes)) ,bytes buffer)) 331 | (defun ,(fourth fun) (value buffer) 332 | (declare (type (unsigned-byte ,bits) value)) 333 | (write-unsigned-le (the (unsigned-byte ,bits) value) 334 | ,bytes buffer))))))) 335 | 336 | (make-writers 16 24 32 64 128) 337 | (make-readers 16 24 32 64 128) 338 | 339 | (declaim (inline write8 writeu8 read8 readu8)) 340 | (defun write8 (value buffer) 341 | (declare (type (signed-byte 8) value)) 342 | (fast-write-byte (signed-to-unsigned value 1) buffer)) 343 | 344 | (defun writeu8 (value buffer) 345 | (declare (type (unsigned-byte 8) value)) 346 | (fast-write-byte value buffer)) 347 | 348 | 349 | (defun read8 (buffer) 350 | (unsigned-to-signed (fast-read-byte buffer) 1)) 351 | 352 | (defun readu8 (buffer) 353 | (fast-read-byte buffer)) 354 | 355 | (setf (symbol-function 'write8-le) #'write8) 356 | (setf (symbol-function 'write8-be) #'write8) 357 | (setf (symbol-function 'writeu8-le) #'writeu8) 358 | (setf (symbol-function 'writeu8-be) #'writeu8) 359 | 360 | (setf (symbol-function 'read8-le) #'read8) 361 | (setf (symbol-function 'read8-be) #'read8) 362 | (setf (symbol-function 'readu8-le) #'readu8) 363 | (setf (symbol-function 'readu8-be) #'readu8) 364 | --------------------------------------------------------------------------------