4.1 The Foreign Function Interface

4.1.5 Examples

;;; OPENDIR-DIRECTORY uses OPENDIR(3) and READDIR(3) to walk
;;; through the directory named DIRECTORY-NAME. (The foreign
;;; function definitions for these two LIBC functions are in SYS-
;;; DIR-H.) Like the example in 
;;; Section 4.1.1.  The 
;;; function OPENDIR-DIRECTORY in this 
;;; example copies its Lisp string argument, DIRECTORY-NAME, into
;;; foreign storage and uses the foreign pointer as an argument
;;;for a foreign function. After OPENDIR-DIRECTORY is finished,
;;; it reclaims this foreign storage. OPENDIR-DIRECTORY has two
;;; values: the first is a list of strings that are names of files
;;; in DIRECTORY-NAME; the second is T if OPENDIR(3) succeeds.  ;;; OPENDIR(3) fails if DIRECTORY-NAME is not the name of a 
;;; directory.

;;; The example uses the following Lisp structure template for the  
;;; LIBC functions.

> (def-foreign-struct DIR
    (dd_fd        :type   :signed-32bit)
    (dd_loc       :type   :signed-32bit)
    (dd_size      :type   :signed-32bit)
    (dd_buf       :type   (:pointer :character)))
DIR

> (def-foreign-struct dirent
    (d_ino     :type   :signed-32bit)
    (d_off     :type   :signed-32bit)
    (d_reclen  :type   :unsigned-16bit)
    (d_name    :type   (:array :character (256))))
DIRENT

> (def-foreign-function (opendir (:language :c)
                                 (:return-type (:pointer DIR)))
                        (fn (:pointer :character)))
OPENDIR

> (def-foreign-function (readdir (:language :c)
                                 (:return-type (:pointer dirent)))
                        (dirp (:pointer DIR)))
READDIR

> (def-foreign-function (closedir (:language :c)
                                  (:return-type :null))
                        (dirp (:pointer DIR)))
CLOSEDIR

> (load-foreign-libraries nil)
T

;;; Once the template is defined, the following session could
;;; occur.
> (defun opendir-directory (directory-name)
    (check-type directory-name string)
    (let* ((f-directory-name (malloc-foreign-string 
                                directory-name))
           (dirp (opendir f-directory-name)))
      (multiple-value-prog1
       (if (zerop (foreign-pointer-address dirp)) (values '() '())
              (do ((filenames '())
                   (dirent (readdir dirp) (readdir dirp)))
                  ((zerop (foreign-pointer-address dirent))
                   (closedir dirp)
                   (values (nreverse filenames) 't))
            ; DIRENT-D_NAME points to a character array that
            ; can hold the largest file name, but the actual
            ; string in that location, which is null terminated,
            ; is not that long.  Thus, the foreign pointer
            ; must be converted into the type (:pointer :character)
            ; so that FOREIGN-STRING-VALUE works properly.
                (push (foreign-string-value
                        (make-foreign-pointer
                          :type '(:pointer :character)
                          :address (foreign-pointer-address
                                     (dirent-d_name dirent))))
                      filenames)))
        (free-foreign-pointer f-directory-name))))
OPENDIR-DIRECTORY

;;; The value of MALLOC-FOREIGN-STRING is of type (:pointer 
;;; :character), and it points to a newly created foreign array of 
;;; characters.  This array's contents are a null-terminated copy 
;;; of MALLOC-FOREIGN-STRING's argument, a Lisp string.  The 
;;; expression (foreign-string-value (malloc-foreign-string 
;;; <string>)) returns a copy of <string>, if <string> does not 
;;; contain a null byte.
;;; The function MALLOC-FOREIGN-STRING was used in the example in  
;;; the Section 4.1.1

> (defun malloc-foreign-string (str)
    (check-type str string)
    (let ((f-str (malloc-foreign-pointer
                   :type
           '(:pointer (:array :character (,(1+ (length str))))))))
      (setf (foreign-string-value f-str) str)
      (setf (foreign-pointer-type f-str)
            '(:pointer :character))
      f-str))
MALLOC-FOREIGN-STRING

> (opendir-directory ".")
    ("."  ".." "listdir.c" "listdir.o" "sys-stat-h.lisp"
       "directory.lisp~" "perror.lisp" "test-io" "directory.lisp"
       "sys-types-h.lisp" "getenv.lisp" "test-io.c" "check-stat.c"
       "sys-dir-h.lisp" "sys-errno-h.lisp" "sys-sysmacros-h.lisp"
       "stat.lisp" "c-types" "obsolete")
T

Generated with Harlequin WebMaker