Commit 80850296 authored by Christophe Rhodes's avatar Christophe Rhodes
Browse files

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
parent 20b23785

contrib/sb-posix/TODO

+1 −1
Original line number Diff line number Diff line
@@ -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

contrib/sb-posix/constants.lisp

+5 −0
Original line number Diff line number Diff line
@@ -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")

contrib/sb-posix/interface.lisp

+15 −2
Original line number Diff line number Diff line
@@ -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)

contrib/sb-posix/macros.lisp

+38 −24
Original line number Diff line number Diff line
@@ -39,20 +39,22 @@ 
  (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 (name return-type error-predicate &rest arguments)

  (let ((lisp-name (lisp-for-c-symbol name)))

(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 name))

       (sb-vm:extern-alien-name c-name))

      `(progn

	  (export ',lisp-name :sb-posix)

	(declaim (inline ,lisp-name))

	(defun ,lisp-name ,(mapcar #'car arguments)

	  (let ((r (alien-funcall

		    (extern-alien

		       ,name

		     ,c-name

		     (function ,return-type

			       ,@(mapcar

				  (lambda (x)
@@ -65,6 +67,18 @@ 
				    (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)))

    `(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)

	  (sb-int:style-warn "Didn't find definition for ~S" ,name)))))
 
      (declaim (inline ,lisp-name))

      (defun ,lisp-name ,arglist

	,@body))))

contrib/sb-posix/posix-tests.lisp

+12 −1
Original line number Diff line number Diff line
@@ -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)