X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Funix.lisp;h=32f7716df4fae9b2203f1ba739a27500b9fab4e6;hb=30a7667ec095ac9b78a826c445b9af78c9c183ba;hp=d5ac4836b72c5d6c813d181c199d687ee7fc4913;hpb=bb3994fcc9a556d1a26d35f6ff9386d01030821d;p=sbcl.git

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index d5ac483..32f7716 100644
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -880,6 +880,31 @@ corresponds to NAME, or NIL if there is none."
     (syscall ("fstat_wrapper" int (* (struct wrapped_stat)))
              (%extract-stat-results (addr buf))
              fd (addr buf))))
+
+#!-win32
+(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))))
 
 ;;;; time.h