4.1.2 Creating foreign structure types

4.1.2.8 Examples

;;; STAT(2) fills in a structure that is defined as follows.  The
;;; C definition for this structure is found in the file <sys/
;;; stat.h>; it uses types defined in <sys/types.h> and <sys/
;;; time.h>. The (2) in the name of this function is a reference
;;; to the section of the UNIX manual pages in which the function
;;; is described. The descriptions are generally available on
;;; line.

> (def-foreign-struct timestruc
    (tv_sec :type :signed-32bit)
    (tv_nsec :type :signed-32bit))
TIMESTRUC

> (def-foreign-struct stat
    (st_dev     :type :unsigned-32bit)	; device inode resides on
    (st_pad1    :type (:array :signed-32bit (3))) ; padding
    (st_ino     :type :unsigned-32bit)   ; this inode's number
    (st_mode    :type :unsigned-32bit)   ; protection
    ;; file's number of hard links
    (st_nlink   :type :unsigned-32bit)
    (st_uid     :type :signed-32bit)     ; user id of owner
    (st_gid     :type :signed-32bit)     ; group id of owner
    (st_rdev    :type :unsigned-32bit)   ; type for device inode
    (st_pad2    :type (:array :signed-32bit (2))) ; padding
    (st_size    :type :signed-32bit)     ; total size of file
    (st_pad3    :type :signed-32bit)     ; padding
    (st_atime   :type timestruc)         ; file's last access time
    ;; file's last modification time
    (st_mtime   :type timestruc)
    ;; file's last status change time
    (st_ctime   :type timestruc)
    ;; optimal block size for file system i/o operators
    (st_blksize :type :signed-32bit) 
    ;; actual number of blocks allocated
    (st_blocks  :type :signed-32bit)
    ;; file-system type name
    (st_fstype  :type (:array :character (16))) 
    (st_pad4    :type (:array :signed-32bit (8))))
STAT 

;;; LIBC-STAT is a direct translation of the libc declaration for
;;; STAT(2):
;;;       int stat(path, buf)
;;;       char *path;
;;;       struct stat *buf;

> (def-foreign-function (libc-stat (:return-type :signed-32bit)
                                   (:name "stat")
                                   (:language :c))
      (path (:pointer :character))
      (buf (:pointer stat)))
LIBC-STAT

;; The Lisp function STAT returns a list containing the 
;; information that STAT(2) returns about the file named path, a
;; Lisp string. If STAT(2) fails, STAT returns NIL.  (If STAT(2)
;; succeeds, it returns 0; otherwise, it returns -1 and sets
;; errno.)  Like the GETENV example in 
;; Section 4.1.1, 
;; STAT calls LIBC-STAT with a
;; foreign storage copy of path and reclaims the foreign storage
;; that it uses.

> (defun stat (path)
    (check-type path string)
     ;; MALLOC-FOREIGN-STRING is defined in the GETENV example in  
     ;; Section 4.1.1.
    (let ((f-path (malloc-foreign-string path))
          (buf (malloc-foreign-pointer :type '(:pointer stat))))
     ;; After copying path into foreign storage and allocating
     ;; a buffer for the file information, call STAT(2) (via
     ;; LIBC-STAT).  If the call fails, return NIL; otherwise,
     ;; return a list with the file information.  In either case,
     ;; reclaim the foreign storage used.

      (prog1
          (if (not (zerop (libc-stat f-path buf))) '()
              (list (stat-st_dev buf)
                    (stat-st_ino buf)
                    (stat-st_mode buf)
                    (stat-st_nlink buf)
                    (stat-st_uid buf)
                    (stat-st_gid buf)
                    (stat-st_rdev buf)
                    (stat-st_size buf)
                    (timestruc-tv_sec (stat-st_atime buf))
                    (timestruc-tv_sec (stat-st_mtime buf))
                    (timestruc-tv_sec (stat-st_ctime buf))
                    (stat-st_blksize buf)
                    (stat-st_blocks buf)
                    (delete #\\Null (foreign-string-value
                                    (stat-st_fstype buf)))))
        (free-foreign-pointer f-path)
        (free-foreign-pointer buf))))
STAT

> (stat "/")
(8388632 2 16877 25 0 0 0 4096 724450613 724450659 724450659 8192 8 "ufs")

> (stat "/dev")
(8388632 6113 16893 15 0 3 0 4608 724445861 724386895 724386895 8192 10 "ufs")

> (stat "/dev/tty")
(8388632 2474 8630 1 0 3 5767168 0 721631236 721631236 721687093 8192 0 "ufs") 

Generated with Harlequin WebMaker