fix: read-raw-byte alien type mismatch and timeout ms conversion

- Replace make-alien unsigned-char buffer with make-array + vector-sap
  to avoid SBCL alien type mismatch between signed-char and unsigned-char
- Convert timeout seconds to fixnum milliseconds for unix-simple-poll
  (was passing float 0.1, broke on fixnum-typed sb-unix:to-msec)
- Both fixes make read-raw-byte work on SBCL 2.5.2.debian
This commit is contained in:
2026-05-13 16:15:09 -04:00
parent 22886c1794
commit 3bc6df6fd0
2 changed files with 22 additions and 20 deletions

View File

@@ -440,16 +440,17 @@ is interrupted by a signal.
#+BEGIN_SRC lisp :tangle ../src/components/input.lisp
(defun read-raw-byte (&key timeout)
(let* ((buf (sb-alien:make-alien sb-alien:unsigned-char 1))
(fd 0))
(unwind-protect
(if timeout
(progn (sb-unix:unix-simple-poll fd :input timeout)
(let ((n (sb-unix:unix-read fd buf 1)))
(if (= n 1) (sb-alien:deref buf 0) (values nil :eof))))
(let ((n (sb-unix:unix-read fd buf 1)))
(if (= n 1) (sb-alien:deref buf 0) (values nil :eof))))
(sb-alien:free-alien buf))))
(let* ((buf (make-array 1 :element-type '(unsigned-byte 8)))
(fd 0)
(timeout-ms (when timeout (max 1 (round (* timeout 1000))))))
(sb-sys:with-pinned-objects (buf)
(let ((sap (sb-sys:vector-sap buf)))
(if timeout-ms
(progn (sb-unix:unix-simple-poll fd :input timeout-ms)
(let ((n (sb-unix:unix-read fd sap 1)))
(if (= n 1) (aref buf 0) (values nil :eof))))
(let ((n (sb-unix:unix-read fd sap 1)))
(if (= n 1) (aref buf 0) (values nil :eof))))))))
#+END_SRC
** Escape sequence reader

View File

@@ -68,16 +68,17 @@
:raw (format nil "~C[~{~d~};~d~C" #\Esc params terminator)))))
(defun read-raw-byte (&key timeout)
(let* ((buf (sb-alien:make-alien sb-alien:unsigned-char 1))
(fd 0))
(unwind-protect
(if timeout
(progn (sb-unix:unix-simple-poll fd :input timeout)
(let ((n (sb-unix:unix-read fd buf 1)))
(if (= n 1) (sb-alien:deref buf 0) (values nil :eof))))
(let ((n (sb-unix:unix-read fd buf 1)))
(if (= n 1) (sb-alien:deref buf 0) (values nil :eof))))
(sb-alien:free-alien buf))))
(let* ((buf (make-array 1 :element-type '(unsigned-byte 8)))
(fd 0)
(timeout-ms (when timeout (max 1 (round (* timeout 1000))))))
(sb-sys:with-pinned-objects (buf)
(let ((sap (sb-sys:vector-sap buf)))
(if timeout-ms
(progn (sb-unix:unix-simple-poll fd :input timeout-ms)
(let ((n (sb-unix:unix-read fd sap 1)))
(if (= n 1) (aref buf 0) (values nil :eof))))
(let ((n (sb-unix:unix-read fd sap 1)))
(if (= n 1) (aref buf 0) (values nil :eof))))))))
(defun %read-escape-sequence ()
(flet ((read-next (&optional (timeout nil))