From: Christophe Rhodes Date: Sun, 1 Feb 2004 16:06:08 +0000 (+0000) Subject: 0.8.7.35: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=808502965803b3772ea40dab28ec85dc131e676a;p=sbcl.git 0.8.7.35: SB-POSIX enhancements, from Vincent Arkesteijn (lightly edited) ... new DEFINE-CALL-INTERNALLY and DEFINE-ENTRY-POINT macros ... necessary constants for OPEN ... define OPEN and IOCTL entry points ... start of tests for OPEN --- diff --git a/contrib/sb-posix/TODO b/contrib/sb-posix/TODO index d408e91..43f7283 100644 --- a/contrib/sb-posix/TODO +++ b/contrib/sb-posix/TODO @@ -13,7 +13,7 @@ create_module delete_module execve exit fcntl flock fork fstatfs ftime getcontext getdents getdomainname getdtablesize getgroups gethostid gethostname getitimer getpeername getpriority getrlimit getrusage getsockname getsockopt -gettimeofday gtty idle init_module ioctl ioctl_list ioperm iopl listen +gettimeofday gtty idle init_module ioctl_list ioperm iopl listen llseek lock madvise mincore mknod mlock mlockall modify_ldt mount mprotect mpx mremap msgctl msgget msgop msgrcv msgsnd munlock munlockall nanosleep nice pause poll diff --git a/contrib/sb-posix/constants.lisp b/contrib/sb-posix/constants.lisp index dae01b6..a330668 100644 --- a/contrib/sb-posix/constants.lisp +++ b/contrib/sb-posix/constants.lisp @@ -253,6 +253,9 @@ (time-t ctime "time_t" "st_ctime"))) ;; open() + (:integer o-rdonly "O_RDONLY") + (:integer o-wronly "O_WRONLY") + (:integer o-rdwr "O_RDWR") (:integer o-creat "O_CREAT") (:integer o-excl "O_EXCL") (:integer o-noctty "O_NOCTTY") @@ -266,6 +269,8 @@ (:integer o-direct "O_DIRECT") (:integer o-async "O_ASYNC") (:integer o-largefile "O_LARGEFILE") ; hmm... + (:integer o-dsync "O_DSYNC") + (:integer o-rsync "O_RSYNC") ;; lseek() (:integer seek-set "SEEK_SET") diff --git a/contrib/sb-posix/interface.lisp b/contrib/sb-posix/interface.lisp index 3631996..1d71e74 100644 --- a/contrib/sb-posix/interface.lisp +++ b/contrib/sb-posix/interface.lisp @@ -39,8 +39,12 @@ (define-call "lseek" sb-posix::off-t minusp (fd file-descriptor) (offset sb-posix::off-t) (whence int)) (define-call "mkdir" int minusp (pathname filename) (mode sb-posix::mode-t)) (define-call "mkfifo" int minusp (pathname filename) (mode sb-posix::mode-t)) -;;; FIXME: MODE arg should be optional? -(define-call "open" int minusp (pathname filename) (flags int) (mode sb-posix::mode-t)) +(define-call-internally open-with-mode "open" int minusp (pathname filename) (flags int) (mode sb-posix::mode-t)) +(define-call-internally open-without-mode "open" int minusp (pathname filename) (flags int)) +(define-entry-point "open" (pathname flags &optional (mode nil mode-supplied)) + (if mode-supplied + (open-with-mode pathname flags mode) + (open-without-mode pathname flags))) ;;(define-call "readlink" int minusp (path filename) (buf (* t)) (len int)) (define-call "rename" int minusp (oldpath filename) (newpath filename)) (define-call "rmdir" int minusp (pathname filename)) @@ -48,6 +52,15 @@ (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-call "opendir" (* t) null-alien (pathname filename)) (define-call "readdir" (* t) diff --git a/contrib/sb-posix/macros.lisp b/contrib/sb-posix/macros.lisp index 0aad987..248db20 100644 --- a/contrib/sb-posix/macros.lisp +++ b/contrib/sb-posix/macros.lisp @@ -39,32 +39,46 @@ (null (sb-sys:int-sap 0)) (sb-sys:system-area-pointer sap-or-nil)) +(define-designator alien-pointer-to-anything-or-nil (* t) + (null (sb-alien:sap-alien (sb-sys:int-sap 0) (* t))) + ((alien (* t)) alien-pointer-to-anything-or-nil)) + (defun lisp-for-c-symbol (s) (intern (substitute #\- #\_ (string-upcase s)) :sb-posix)) +(defmacro define-call-internally (lisp-name c-name return-type error-predicate &rest arguments) + (if (sb-fasl::foreign-symbol-address-as-integer-or-nil + (sb-vm:extern-alien-name c-name)) + `(progn + (declaim (inline ,lisp-name)) + (defun ,lisp-name ,(mapcar #'car arguments) + (let ((r (alien-funcall + (extern-alien + ,c-name + (function ,return-type + ,@(mapcar + (lambda (x) + (gethash (cadr x) *designator-types* (cadr x))) + arguments))) + ,@(mapcar (lambda (x) + (if (nth-value 1 (gethash (cadr x) *designator-types*)) + `(,(intern (symbol-name (cadr x)) :sb-posix) + ,(car x)) + (car x))) + arguments)))) + (if (,error-predicate r) (syscall-error) r)))) + `(sb-int:style-warn "Didn't find definition for ~S" ,c-name))) + (defmacro define-call (name return-type error-predicate &rest arguments) (let ((lisp-name (lisp-for-c-symbol name))) - (if (sb-fasl::foreign-symbol-address-as-integer-or-nil - (sb-vm:extern-alien-name name)) - `(progn - (export ',lisp-name :sb-posix) - (declaim (inline ,lisp-name)) - (defun ,lisp-name ,(mapcar #'car arguments) - (let ((r (alien-funcall - (extern-alien - ,name - (function ,return-type - ,@(mapcar - (lambda (x) - (gethash (cadr x) *designator-types* (cadr x))) - arguments))) - ,@(mapcar (lambda (x) - (if (nth-value 1 (gethash (cadr x) *designator-types*)) - `(,(intern (symbol-name (cadr x)) :sb-posix) - ,(car x)) - (car x))) - arguments)))) - (if (,error-predicate r) (syscall-error) r)))) - `(progn - (export ',lisp-name :sb-posix) - (sb-int:style-warn "Didn't find definition for ~S" ,name))))) + `(progn + (export ',lisp-name :sb-posix) + (define-call-internally ,lisp-name ,name ,return-type ,error-predicate ,@arguments)))) + +(defmacro define-entry-point (name arglist &body body) + (let ((lisp-name (lisp-for-c-symbol name))) + `(progn + (export ',lisp-name :sb-posix) + (declaim (inline ,lisp-name)) + (defun ,lisp-name ,arglist + ,@body)))) diff --git a/contrib/sb-posix/posix-tests.lisp b/contrib/sb-posix/posix-tests.lisp index 647af23..41d9b2f 100644 --- a/contrib/sb-posix/posix-tests.lisp +++ b/contrib/sb-posix/posix-tests.lisp @@ -314,4 +314,15 @@ (let ((*default-pathname-defaults* *test-directory*)) (sb-posix:unlink (car (directory "*.txt"))))) 0) - + +(deftest open.1 + (let ((fd (sb-posix:open *test-directory* sb-posix::o-rdonly))) + (ignore-errors (sb-posix:close fd)) + (< fd 0)) + nil) + +(deftest open.error.1 + (handler-case (sb-posix:open *test-directory* sb-posix::o-wronly) + (sb-posix:syscall-error (c) + (sb-posix:syscall-errno c))) + #.sb-posix::eisdir) diff --git a/version.lisp-expr b/version.lisp-expr index b2f2a79..65e181a 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.34" +"0.8.7.35"