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 #+BEGIN_SRC lisp :tangle ../src/components/input.lisp
(defun read-raw-byte (&key timeout) (defun read-raw-byte (&key timeout)
(let* ((buf (sb-alien:make-alien sb-alien:unsigned-char 1)) (let* ((buf (make-array 1 :element-type '(unsigned-byte 8)))
(fd 0)) (fd 0)
(unwind-protect (timeout-ms (when timeout (max 1 (round (* timeout 1000))))))
(if timeout (sb-sys:with-pinned-objects (buf)
(progn (sb-unix:unix-simple-poll fd :input timeout) (let ((sap (sb-sys:vector-sap buf)))
(let ((n (sb-unix:unix-read fd buf 1))) (if timeout-ms
(if (= n 1) (sb-alien:deref buf 0) (values nil :eof)))) (progn (sb-unix:unix-simple-poll fd :input timeout-ms)
(let ((n (sb-unix:unix-read fd buf 1))) (let ((n (sb-unix:unix-read fd sap 1)))
(if (= n 1) (sb-alien:deref buf 0) (values nil :eof)))) (if (= n 1) (aref buf 0) (values nil :eof))))
(sb-alien:free-alien buf)))) (let ((n (sb-unix:unix-read fd sap 1)))
(if (= n 1) (aref buf 0) (values nil :eof))))))))
#+END_SRC #+END_SRC
** Escape sequence reader ** Escape sequence reader

View File

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