Mercurial > demo / examples/db/xdb/io.lisp
changeset 44: |
99d4ab4f8d53 |
parent: |
81b7333f27f8
|
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Sun, 11 Aug 2024 01:50:18 -0400 |
permissions: |
-rw-r--r-- |
description: |
update |
1 ;;; io/blob.lisp --- Blob Database IO 9 (defvar *fsync-data* nil) 11 (defconstant +buffer-size+ 8192) 13 (deftype word () 'sb-ext:word) 15 (defstruct (input-stream 19 (buffer-start (sb-sys:sap-int 20 (sb-alien::%make-alien (* sb-vm:n-byte-bits 21 (+ +buffer-size+ 3)))) 23 (buffer-end 0 :type word) 24 (buffer-position 0 :type word)) 26 (defstruct (output-stream 29 (buffer-start (sb-sys:sap-int 30 (sb-alien::%make-alien (* sb-vm:n-byte-bits 31 (+ +buffer-size+ 3)))) 33 (buffer-end 0 :type word) 34 (buffer-position 0 :type word)) 36 (defun open-file (file-stream 38 (if (eql direction :output) 39 (let ((output (make-output-stream 40 :fd (sb-sys:fd-stream-fd file-stream)))) 41 (setf (output-stream-buffer-position output) 42 (output-stream-buffer-start output) 43 (output-stream-buffer-end output) 44 (+ (output-stream-buffer-start output) 48 :fd (sb-sys:fd-stream-fd file-stream) 49 :left (file-length file-stream)))) 51 (defun close-input-stream (stream) 52 (sb-alien:alien-funcall 53 (sb-alien:extern-alien "free" 54 (function (values) sb-alien:long)) 55 (input-stream-buffer-start stream))) 57 (defun close-output-stream (stream) 59 (sb-alien:alien-funcall 60 (sb-alien:extern-alien "free" 61 (function (values) sb-alien:long)) 62 (output-stream-buffer-start stream))) 64 (declaim (inline stream-end-of-file-p)) 65 (defun stream-end-of-file-p (stream) 66 (and (>= (input-stream-buffer-position stream) 67 (input-stream-buffer-end stream)) 68 (zerop (input-stream-left stream)))) 70 (declaim (inline sap-ref-24)) 71 (defun sap-ref-24 (sap offset) 72 (declare (optimize speed (safety 0)) 74 (mask-field (byte 24 0) (sb-sys:sap-ref-32 sap offset))) 76 (declaim (inline n-sap-ref)) 77 (defun n-sap-ref (n sap &optional (offset 0)) 79 (1 #'sb-sys:sap-ref-8) 80 (2 #'sb-sys:sap-ref-16) 82 (4 #'sb-sys:sap-ref-32)) 86 (declaim (inline unix-read)) 87 (defun unix-read (fd buf len) 88 (declare (optimize (sb-c::float-accuracy 0) 90 (declare (type sb-unix::unix-fd fd) 92 (sb-alien:alien-funcall 93 (sb-alien:extern-alien "read" 94 (function sb-alien:int 95 sb-alien:int sb-alien:long sb-alien:int)) 98 (declaim (inline unix-read)) 99 (defun unix-write (fd buf len) 100 (declare (optimize (sb-c::float-accuracy 0) 102 (declare (type sb-unix::unix-fd fd) 104 (sb-alien:alien-funcall 105 (sb-alien:extern-alien "write" 106 (function sb-alien:int 107 sb-alien:int sb-alien:long sb-alien:int)) 110 (defun fill-buffer (stream offset) 111 (let ((length (unix-read (input-stream-fd stream) 112 (+ (input-stream-buffer-start stream) offset) 113 (- +buffer-size+ offset)))) 114 (setf (input-stream-buffer-end stream) 115 (+ (input-stream-buffer-start stream) (+ length offset))) 116 (decf (input-stream-left stream) length)) 119 (defun refill-buffer (n stream) 120 (declare (type word n) 121 (input-stream stream)) 122 (let ((left-n-bytes (- (input-stream-buffer-end stream) 123 (input-stream-buffer-position stream)))) 124 (when (> (- n left-n-bytes) 125 (input-stream-left stream)) 126 (error "End of file ~a" stream)) 127 (unless (zerop left-n-bytes) 128 (setf (sb-sys:sap-ref-word (sb-sys:int-sap (input-stream-buffer-start stream)) 0) 129 (n-sap-ref left-n-bytes (sb-sys:int-sap (input-stream-buffer-position stream))))) 130 (fill-buffer stream left-n-bytes)) 131 (let ((start (input-stream-buffer-start stream))) 132 (setf (input-stream-buffer-position stream) 136 (declaim (inline advance-input-stream)) 137 (defun advance-input-stream (n stream) 138 (declare (optimize (space 0)) 140 (type input-stream stream)) 141 (let* ((sap (input-stream-buffer-position stream)) 142 (new-sap (sb-ext:truly-the word (+ sap n)))) 143 (declare (word sap new-sap)) 144 (cond ((> new-sap (input-stream-buffer-end stream)) 145 (refill-buffer n stream) 146 (sb-sys:int-sap (input-stream-buffer-start stream))) 148 (setf (input-stream-buffer-position stream) 150 (sb-sys:int-sap sap))))) 152 (declaim (inline read-n-bytes)) 153 (defun read-n-bytes (n stream) 154 (declare (optimize (space 0)) 156 (n-sap-ref n (advance-input-stream n stream))) 158 (declaim (inline read-n-signed-bytes)) 159 (defun read-n-signed-bytes (n stream) 160 (declare (optimize speed) 161 (sb-ext:muffle-conditions sb-ext:compiler-note) 162 (type (integer 1 4) n)) 164 (1 #'sb-sys:signed-sap-ref-8) 165 (2 #'sb-sys:signed-sap-ref-16) 167 (4 #'sb-sys:signed-sap-ref-32)) 168 (advance-input-stream n stream) 171 (declaim (inline write-n-signed-bytes)) 172 (defun write-n-signed-bytes (value n stream) 173 (declare (optimize speed) 174 (sb-ext:muffle-conditions sb-ext:compiler-note) 177 (1 (setf (sb-sys:signed-sap-ref-8 (advance-output-stream n stream) 0) 179 (2 (setf (sb-sys:signed-sap-ref-16 (advance-output-stream n stream) 0) 182 (4 (setf (sb-sys:signed-sap-ref-32 (advance-output-stream n stream) 0) 186 (defun flush-buffer (stream) 187 (unix-write (output-stream-fd stream) 188 (output-stream-buffer-start stream) 189 (- (output-stream-buffer-position stream) 190 (output-stream-buffer-start stream)))) 192 (declaim (inline advance-output-stream)) 193 (defun advance-output-stream (n stream) 194 (declare (optimize (space 0) (safety 0)) 196 (type output-stream stream) 198 (let* ((sap (output-stream-buffer-position stream)) 199 (new-sap (sb-ext:truly-the word (+ sap n)))) 200 (declare (word sap new-sap)) 201 (cond ((> new-sap (output-stream-buffer-end stream)) 202 (flush-buffer stream) 203 (setf (output-stream-buffer-position stream) 204 (+ (output-stream-buffer-start stream) 206 (sb-sys:int-sap (output-stream-buffer-start stream))) 208 (setf (output-stream-buffer-position stream) 210 (sb-sys:int-sap sap))))) 212 (declaim (inline write-n-bytes)) 213 (defun write-n-bytes (value n stream) 214 (declare (optimize (space 0)) 216 (setf (sb-sys:sap-ref-32 217 (advance-output-stream n stream) 222 (declaim (inline copy-mem)) 223 (defun copy-mem (from to length) 224 (let ((words-end (- length (rem length sb-vm:n-word-bytes)))) 225 (loop for i by sb-vm:n-word-bytes below words-end 226 do (setf (sb-sys:sap-ref-word to i) 227 (sb-sys:sap-ref-word from i))) 228 (loop for i from words-end below length 229 do (setf (sb-sys:sap-ref-8 to i) 230 (sb-sys:sap-ref-8 from i))))) 232 (declaim (inline read-ascii-string-optimized)) 233 (defun read-ascii-string-optimized (length string stream) 234 (declare (type fixnum length) 237 (sb-sys:with-pinned-objects (string) 238 (let ((sap (advance-input-stream length stream)) 239 (string-sap (sb-sys:vector-sap string))) 240 (copy-mem sap string-sap length))) 242 (defmacro with-io-file ((stream file 243 &key append (direction :input)) 245 (let ((fd-stream (gensym))) 246 `(with-open-file (,fd-stream ,file 247 :element-type '(unsigned-byte 8) 248 :direction ,direction 249 ,@(and (eql direction :output) 250 `(:if-exists ,(if append 254 `(:if-does-not-exist :create))) 255 (let ((,stream (open-file ,fd-stream :direction ,direction))) 260 `((close-output-stream ,stream) 263 (sb-sys:fd-stream-fd ,fd-stream))))) 265 `((close-input-stream ,stream)))))))))