[cparse-cvs] CVS update: cparse/02debug.lisp cparse/01debug.lisp
Christian Lynbech
clynbech at common-lisp.net
Mon Nov 29 20:24:08 UTC 2004
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)
More information about the Cparse-cvs
mailing list