[cparse-cvs] CVS update: cparse/02debug.lisp cparse/01debug.lisp

[Christian Lynbech]

Update of /project/cparse/cvsroot/cparse
In directory common-lisp.net:/tmp/cvs-serv10660

Modified Files:
	01debug.lisp 
Added Files:
	02debug.lisp 
Log Message:
Renamed old 01debug.lisp to 02debug.lisp

added new 01debug.lisp with a handwritten dirtest version

Date: Mon Nov 29 21:24:07 2004
Author: clynbech



Index: cparse/01debug.lisp
diff -u cparse/01debug.lisp:1.1 cparse/01debug.lisp:1.2
--- cparse/01debug.lisp:1.1	Wed Nov 24 21:29:32 2004
+++ cparse/01debug.lisp	Mon Nov 29 21:24:06 2004
@@ -1,17 +1,73 @@
+
+#|
+(clc:require :uffi)
 (load "00debug.lisp")
+|#
+
+(defmacro my-convert-to-foreign-string (obj)
+  (let ((size (gensym))
+	(storage (gensym))
+	(i (gensym))
+	(char-type '(alien:signed 8)))
+    `(etypecase ,obj
+       (null 
+	(alien:sap-alien (system:int-sap 0) (* ,char-type)))
+       (string
+	(let* ((,size (length ,obj))
+	       (,storage (alien:make-alien ,char-type (1+ ,size))))
+	  (setq ,storage (alien:cast ,storage (* ,char-type)))
+	  (locally
+	      (declare (optimize (speed 3) (safety 0)))
+	    (dotimes (,i ,size)
+	      (declare (fixnum ,i))
+	      (setf (alien:deref ,storage ,i) (char-code (char ,obj ,i))))
+	    (setf (alien:deref ,storage ,size) 0))
+	  ,storage)))))
+
+(defmacro my-convert-from-foreign-string (obj &key
+					   length
+					   (locale :default)
+					   (null-terminated-p t))
+  `(if (uffi:null-pointer-p ,obj)
+    nil
+    (uffi::cmucl-naturalize-cstring (alien:alien-sap ,obj)
+     :length ,length
+     :null-terminated-p ,null-terminated-p)))
+
+
+(uffi:def-foreign-type nil
+    (:struct dirent
+	     (d-ino :unsigned-long)
+	     (d-off :long)
+	     (d-reclen :unsigned-short)
+	     (d-type :unsigned-char)
+	     (d-name (:array :char 256)))) 
+ 
+(uffi:def-function "opendir"
+    ((--name (* :char)))
+  :returning (* (:struct --dirstream)))
+
+(uffi:def-function "closedir"
+    ((--dirp (* (:struct --dirstream))))
+  :returning :int)
+
+(uffi:def-function "readdir"
+    ((--dirp (* (:struct --dirstream))))
+  :returning (* (:struct dirent)))
+
+(defun main ()
+  (format t "DIRTEST/ffi~%")
+  (let* ((tmp (my-convert-to-foreign-string "/tmp"))
+	 (handle (opendir tmp)))
+    (unwind-protect
+	 (do ((entry (readdir handle) (readdir handle))
+	      (x 0 (incf x)))
+	     ((or (uffi:null-pointer-p handle) (uffi:null-pointer-p entry)))
+	   (format t "~S: ~S~%" x
+		   (my-convert-from-foreign-string
+		    (uffi:get-slot-value entry dirent 'd-name))))
+      (unless (uffi:null-pointer-p handle)
+	(closedir handle))
+      (uffi:free-foreign-object tmp))))
 
-(defun dir-test-0 ()
-  (format t "~%~%============~%")
-  (uffi-alien:make-alien-defs '("/usr/include/sys/types.h"
-				"/usr/include/dirent.h")
-			      :file "dir-test-ffi.lisp"
-			      :compile t :load t))
-
-(defun dir-test-1 ()
-  (let* ((name (uffi:convert-to-foreign-string "/home/tedchly"))
-	 (handle (opendir name)))
-    (uffi:with-foreign-object (entry '(* (:struct dirent)))
-      (setq entry (readdir handle)))
-    (format t "Entry: ~S~%" entry)
-    
-    ))
\ No newline at end of file
+;(main)