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)