From bb17b380fd97b90b3bd23ffd1722e671c0e1a26d Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Sat, 18 Feb 2012 11:44:36 +0400 Subject: [PATCH] More safety when writing bytes to memory. --- io-sbcl.lisp | 24 ++++++++++++++++++------ 1 file changed, 18 insertions(+), 6 deletions(-) diff --git a/io-sbcl.lisp b/io-sbcl.lisp index 41ea12d..a8ec99b 100644 --- a/io-sbcl.lisp +++ b/io-sbcl.lisp @@ -15,9 +15,8 @@ (end 0 :type word :read-only t)) (defun scale-file (stream size) - (file-position stream (1- size)) - (write-byte 0 stream) - (finish-output stream)) + (sb-posix:ftruncate (sb-sys:fd-stream-fd stream) + size)) (defun mmap (file-stream &key direction size) @@ -50,11 +49,19 @@ ;;; -(declaim (inline sap-ref-24)) +(declaim (inline sap-ref-24 (setf sap-ref-24))) (defun sap-ref-24 (sap offset) (declare (optimize speed (safety 0)) (fixnum offset)) - (mask-field (byte 24 0) (sb-sys:sap-ref-32 sap offset))) + (logior (ash (sb-sys:sap-ref-16 sap (1+ offset)) 8) + (sb-sys:sap-ref-8 sap offset))) + +(defun (setf sap-ref-24) (value sap offset) + (declare (optimize speed (safety 0)) + (fixnum offset) + ((unsigned-byte 24) value)) + (setf (sb-sys:sap-ref-16 sap offset) (mask-field (byte 16 0) value)) + (setf (sb-sys:sap-ref-8 sap (+ offset 2)) (ash value -16))) (defun signal-end-of-file (stream) (error "End of file ~a" stream)) @@ -100,8 +107,13 @@ (declaim (inline write-n-bytes)) (defun write-n-bytes (value n stream) (declare (optimize speed) + (sb-ext:muffle-conditions sb-ext:compiler-note) (fixnum n)) - (setf (sb-sys:sap-ref-32 (advance-stream n stream) 0) value) + (ecase n + (1 (setf (sb-sys:sap-ref-8 (advance-stream n stream) 0) value)) + (2 (setf (sb-sys:sap-ref-16 (advance-stream n stream) 0) value)) + (3 (setf (sap-ref-24 (advance-stream n stream) 0) value)) + (4 (setf (sb-sys:sap-ref-32 (advance-stream n stream) 0) value))) t) (declaim (inline write-n-signed-bytes))