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)

diff --git a/contrib/sb-posix/TODO b/contrib/sb-posix/TODO
index 43f7283..a00894e 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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"