cffi-posix/cffi-dirent/cffi-fcntl.lisp

• Show log

  Commit

• Hash : 41894d88
  Author : Thomas de Grivel
  Date : 2017-05-27T21:35:34
  

  ISC license.

Download

• cffi-fcntl.lisp

• ;;
  ;;  cffi-fcntl  -  Common Lisp wrapper for fcntl.h
  ;;
  ;;  Copyright 2017 Thomas de Grivel <thoxdg@gmail.com>
  ;;
  ;;  Permission to use, copy, modify, and distribute this software for any
  ;;  purpose with or without fee is hereby granted, provided that the above
  ;;  copyright notice and this permission notice appear in all copies.
  ;;
  ;;  THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
  ;;  WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
  ;;  MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
  ;;  ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  ;;  WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
  ;;  ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  ;;  OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  ;;
  
  (in-package :cffi-fcntl)
  
  (defcfun ("fcntl" c-fcntl) :int
    (fd :int)
    (cmd :int))
  
  (defcfun ("fcntl" c-fcntl/int) :int
    (fd :int)
    (cmd :int)
    (arg :int))
  
  (defcfun ("fcntl" c-fcntl/pointer) :int
    (fd :int)
    (cmd :int)
    (arg :pointer))
  
  (defun getfl (fd)
    (c-fcntl fd +f-getfl+))
  
  (defun setfl (fd flags)
    (c-fcntl/int fd +f-setfl+ flags))
  
  (defcfun ("open" c-open/2) :int
    (pathname :string)
    (flags :int))
  
  (defcfun ("open" c-open/3) :int
    (pathname :string)
    (flags :int)
    (mode mode-t))
  
  (defun open (pathname flags &optional mode)
    (let ((fd (if (= 0 (logand flags +o-creat+))
  		(c-open/2 pathname flags)
  		(c-open/3 pathname flags mode))))
      (when (< fd 0)
        (error-errno "open"))
      fd))
  
  (defcfun ("openat" c-openat/3) :int
    (dirfd :int)
    (pathname :string)
    (flags :int))
  
  (defcfun ("openat" c-openat/4) :int
    (dirfd :int)
    (pathname :string)
    (flags :int)
    (mode mode-t))
  
  (defun openat (dirfd pathname flags &optional mode)
    (let ((fd (if (= 0 (logand flags +o-creat+))
  		(c-openat/3 dirfd pathname flags)
  		(c-openat/4 dirfd pathname flags mode))))
      (when (< fd 0)
        (error-errno "openat"))
      fd))
  
  (defcfun ("creat" c-creat) :int
    (file :string)
    (mode mode-t))
  
  (defun creat (file mode)
    (let ((fd (c-creat file mode)))
      (when (< fd 0)
        (error-errno "creat"))
      fd))
  

Download