Use-LibC Patch for OPAL:DIRECTORY-P (CMUCL and SBCL)

Sean Champ <[email protected]> Tue, 2 Aug 2005 18:31:01 -0700
Newsgroups gmane.lisp.garnet.user
Message-ID <[email protected]>
--EVF5PPMfhYS0aIcm
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline

* Background

The function `directory-p', defined in Garnet's src/opal/utils.lisp,
had caught my attention.

For systems neither clisp nor #+apple (that indicating: MCL ?), Opal's
directory-p is using the shell 'test' command. 

While I know it works, as intended and as it is, yet I'd wanted
to produce something more "low-level" -- someting not involving a call
to an external command.

There is the 'stat' function (documented in the stat(2) manual page)
in LibC. As it happens, LibC's 'stat' is enough for determining if an
existing filesystem entity is a directory or not.


CMUCL has an interface on 'stat' -- unix:unix-stat -- made in 
involvement with CMUCL's FFI. SBCL has the like of it, made in SBCL. 


* Summary

I've patched  Garnet's src/opal/utils.lisp, in  the body of
directory-p. The patch is atttached, of course. 


The patched code will work, upon the following platforms (in addition
to those platforms upon which it already works, by other means) and
upon which, the patched code has been tested:
 1) CMUCL
 2) SBCL with Unicode support
 3) SBCL withtout Unicode support


The patch has been made in difference upon utils.lisp, from the 
http://garnetlisp.sourceforge.net/ codebase.


If the patch would be applied into to the said Garnet codebase:
hurrah. If it would not, I'm open for discussion about it.


Adieu or such,

---
Sean Champ
[email protected]

--EVF5PPMfhYS0aIcm
Content-Type: text/plain; charset=us-ascii
Content-Description: patch for `directory-p' from src/opal/utils.lisp
Content-Disposition: attachment; filename="opal.utils.lisp.directory-p.diff"

Index: utils.lisp
===================================================================
RCS file: /cvsroot/garnetlisp/garnet/src/opal/utils.lisp,v
retrieving revision 1.1
diff -p -u -u -r1.1 utils.lisp
--- utils.lisp	7 Feb 2004 22:39:02 -0000	1.1
+++ utils.lisp	3 Aug 2005 01:04:51 -0000
@@ -299,7 +299,21 @@ Please consult your lisp's user manual f
   #+apple
   (ccl:directory-pathname-p pathname)
 
-  #-(or clisp apple)
+  #+cmu
+  (let ((file-mode (nth-value 3 (unix:unix-stat pathname))))
+    (and file-mode
+	 (= (logand file-mode unix::s-ifmt) ;; ref: sys/stat.h
+	    unix::s-ifdir)))
+
+  #+sbcl 
+  (let ((file-mode (nth-value 3 (sb-unix:unix-stat
+				 #-sb-unicode pathname
+				 #+sb-unicode (coerce pathname 'base-string)))))
+    (and file-mode
+	 (= (logand file-mode sb-unix::s-ifmt)
+	    sb-unix::s-ifdir)))
+  
+  #-(or clisp apple cmu sbcl)
   ;; command-string is the string that's going to be executed.
   (let ((command-string
 	 (concatenate 'string "test -d " pathname " && echo 1")))

--EVF5PPMfhYS0aIcm--