[Openmcl-cvs-notifications] r9212 - in /trunk/source: level-1/linux-files.lisp lib/foreign-types.lisp

[gb at clozure.com]

Author: gb
Date: Sun Apr 20 07:04:52 2008
New Revision: 9212

Log:
Use reentrant version of #_readdir.
Need a new canonical foreign-type ordinal for that.
This is a little tricky to bootstrap, so new images.


Modified:
    trunk/source/level-1/linux-files.lisp
    trunk/source/lib/foreign-types.lisp

Modified: trunk/source/level-1/linux-files.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/linux-files.lisp (original)
+++ trunk/source/level-1/linux-files.lisp Sun Apr 20 07:04:52 2008
@@ -539,9 +539,14 @@
   (#_closedir DIR))
 =

 (defun %read-dir (dir)
-  (let* ((res (#_readdir dir)))
-    (unless (%null-ptr-p res)
-      (get-foreign-namestring (pref res :dirent.d_name)))))
+  (rlet ((entry #>dirent)
+         (presult :address +null-ptr+))
+    (let* ((err (#_readdir_r dir entry presult))
+           (result (%get-ptr presult)))
+      (declare (fixnum err) (dynamic-extent result))
+      (when (zerop err)
+        (unless (%null-ptr-p result)
+          (get-foreign-namestring (pref result #>dirent.d_name)))))))
 =

 (defun tcgetpgrp (fd)
   (#_tcgetpgrp fd))

Modified: trunk/source/lib/foreign-types.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/foreign-types.lisp (original)
+++ trunk/source/lib/foreign-types.lisp Sun Apr 20 07:04:52 2008
@@ -1694,7 +1694,8 @@
       (canonicalize-foreign-type-ordinal '(:struct :dbm-constant))
       (canonicalize-foreign-type-ordinal '(:* (:struct :hostent)))
       (canonicalize-foreign-type-ordinal '(:array :int 2))
-      (canonicalize-foreign-type-ordinal '(:array (:struct :pollfd) 1)))))
+      (canonicalize-foreign-type-ordinal '(:array (:struct :pollfd) 1))
+      (canonicalize-foreign-type-ordinal '(:struct :dirent)))))
 =

 (defun install-standard-foreign-types (ftd)
   (let* ((*target-ftd* ftd)