From 84271f268f29364b57bfeb1b37642311eb8ab910 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sun, 1 Feb 2004 16:31:05 +0000 Subject: [PATCH] 0.8.7.36: SB-POSIX fcntl binding, inspired by Helmut Eller (with cribbing from Vincent Arkesteijn's ioctl()) ... add constants ... write three variants like ioctl (for two-arg, third-arg-integer and third-arg-pointer versions) --- contrib/sb-posix/TODO | 2 +- contrib/sb-posix/constants.lisp | 12 ++++++++++++ contrib/sb-posix/interface.lisp | 23 +++++++++++++++++------ version.lisp-expr | 2 +- 4 files changed, 31 insertions(+), 8 deletions(-) diff --git a/contrib/sb-posix/TODO b/contrib/sb-posix/TODO index 43f7283..a00894e 100644 --- a/contrib/sb-posix/TODO +++ b/contrib/sb-posix/TODO @@ -9,7 +9,7 @@ adding. FD_CLR FD_ISSET FD_SET FD_ZERO accept acct adjtime adjtimex bdflush bind break brk cacheflush capget capset chroot clone connect -create_module delete_module execve exit fcntl flock fork +create_module delete_module execve exit flock fork fstatfs ftime getcontext getdents getdomainname getdtablesize getgroups gethostid gethostname getitimer getpeername getpriority getrlimit getrusage getsockname getsockopt diff --git a/contrib/sb-posix/constants.lisp b/contrib/sb-posix/constants.lisp index a330668..ff3846c 100644 --- a/contrib/sb-posix/constants.lisp +++ b/contrib/sb-posix/constants.lisp @@ -276,4 +276,16 @@ (:integer seek-set "SEEK_SET") (:integer seek-cur "SEEK_CUR") (:integer seek-end "SEEK_END") + + ;; fcntl() + (:integer f-dupfd "F_DUPFD") + (:integer f-getfd "F_GETFD") + (:integer f-setfd "F_SETFD") + (:integer f-setfl "F_SETFL") + (:integer f-getlk "F_GETLK") + (:integer f-setlk "F_SETLK") + (:integer f-setlkw "F_SETLKW") + (:integer f-getown "F_GETOWN") + (:integer f-setown "F_SETOWN") + ) diff --git a/contrib/sb-posix/interface.lisp b/contrib/sb-posix/interface.lisp index 1d71e74..06f9c30 100644 --- a/contrib/sb-posix/interface.lisp +++ b/contrib/sb-posix/interface.lisp @@ -52,15 +52,26 @@ (define-call "sync" void never-fails) (define-call "truncate" int minusp (pathname filename) (length sb-posix::off-t)) (define-call "unlink" int minusp (pathname filename)) + (define-call-internally ioctl-without-arg "ioctl" int minusp (fd file-descriptor) (cmd int)) (define-call-internally ioctl-with-int-arg "ioctl" int minusp (fd file-descriptor) (cmd int) (arg int)) (define-call-internally ioctl-with-pointer-arg "ioctl" int minusp (fd file-descriptor) (cmd int) (arg alien-pointer-to-anything-or-nil)) -(define-entry-point "ioctl" (fd cmd &optional (arg nil arg-supplied)) - (if arg-supplied - (etypecase arg - ((alien int) (ioctl-with-int-arg fd cmd arg)) - ((or (alien (* t)) null) (ioctl-with-pointer-arg fd cmd arg))) - (ioctl-without-arg fd cmd))) +(define-entry-point "ioctl" (fd cmd &optional (arg nil argp)) + (if argp + (etypecase arg + ((alien int) (ioctl-with-int-arg fd cmd arg)) + ((or (alien (* t)) null) (ioctl-with-pointer-arg fd cmd arg))) + (ioctl-without-arg fd cmd))) + +(define-call-internally fcntl-without-arg "fcntl" int minusp (fd file-descriptor) (cmd int)) +(define-call-internally fcntl-with-int-arg "fcntl" int minusp (fd file-descriptor) (cmd int) (arg int)) +(define-call-internally fcntl-with-pointer-arg "fcntl" int minusp (fd file-descriptor) (cmd int) (arg alien-pointer-to-anything-or-nil)) +(define-entry-point "fcntl" (fd cmd &optional (arg nil argp)) + (if argp + (etypecase arg + ((alien int) (fcntl-with-int-arg fd cmd arg)) + ((or (alien (* t)) null) (fcntl-with-pointer-arg fd cmd arg))) + (fcntl-without-arg fd cmd))) (define-call "opendir" (* t) null-alien (pathname filename)) (define-call "readdir" (* t) diff --git a/version.lisp-expr b/version.lisp-expr index 65e181a..21a15fe 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.7.35" +"0.8.7.36" -- 1.7.10.4