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:
@@ -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
|
||||
|
||||
@@ -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))
|
||||
|
||||
Reference in New Issue
Block a user