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
(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")
(: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")
(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))
(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)
(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))))
(let ((*default-pathname-defaults* *test-directory*))
(sb-posix:unlink (car (directory "*.txt")))))
0)
-
+\f
+(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)
;;; 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"
projects / sbcl.git / commitdiff