1.0.48.7: add FD-STREAM-FD-TYPE, use it to decide when to poll the fd

[sbcl.git] / src / code / unix.lisp

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index d5ac483..115277a 100644 (file)
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -880,6 +880,30 @@ corresponds to NAME, or NIL if there is none."
     (syscall ("fstat_wrapper" int (* (struct wrapped_stat)))
              (%extract-stat-results (addr buf))
              fd (addr buf))))
+
+(defun fd-type (fd)
+  (declare (type unix-fd fd))
+  (let ((fmt (logand
+              sb!unix:s-ifmt
+              (or (with-alien ((buf (struct wrapped_stat)))
+                    (syscall ("fstat_wrapper" int (* (struct wrapped_stat)))
+                             (slot buf 'st-mode)
+                             fd (addr buf)))
+                  0))))
+    (cond ((logtest sb!unix:s-ififo fmt)
+           :fifo)
+          ((logtest sb!unix:s-ifchr fmt)
+           :character)
+          ((logtest sb!unix:s-ifdir fmt)
+           :directory)
+          ((logtest sb!unix:s-ifblk fmt)
+           :block)
+          ((logtest sb!unix:s-ifreg fmt)
+           :regular)
+          ((logtest sb!unix:s-ifsock fmt)
+           :socket)
+          (t
+           :unknown))))
 \f
 ;;;; time.h