X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-posix%2Finterface.lisp;h=7c83661bb5b8047f50c6e274193ea35e453a02e8;hb=4af254de85367806d14ccafc4dfbe79a235b926d;hp=3631996749942477077228c4da845753e6daf643;hpb=8b77810a9c727bb6026e575f38a176a39e7675b4;p=sbcl.git

diff --git a/contrib/sb-posix/interface.lisp b/contrib/sb-posix/interface.lisp
index 3631996..7c83661 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))
@@ -49,6 +53,26 @@
 (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 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)
   ;; readdir() has the worst error convention in the world.  It's just
@@ -173,3 +197,41 @@
     (when (minusp r)
       (syscall-error)))
   (values (aref filedes2 0) (aref filedes2 1)))
+
+(export 'sb-posix::tcsetattr :sb-posix)
+(declaim (inline sb-posix::tcsetattr))
+(defun sb-posix::tcsetattr (fd actions termios)
+  (let ((fd (sb-posix::file-descriptor fd)))
+    (let* ((s (sb-sys:int-sap
+	       ;; FIXME: WILL NOT WORK ON 64-BIT LISP.  VECTOR-SAP would
+	       ;; be better if the STAT object were guaranteed to be a
+	       ;; vector, but it's not (and may well turn into an alien
+	       ;; soon).
+	       (+ 8 (logandc2 (sb-kernel:get-lisp-obj-address termios) 7))))
+	   (r (alien-funcall
+	       ;; it's the old (* T) problem again :-(
+	       (extern-alien "tcsetattr" (function int int int (* t)))
+	       fd actions s)))
+      (when (minusp r)
+	(syscall-error)))
+    (values)))
+(export 'sb-posix::tcgetattr :sb-posix)
+(declaim (inline sb-posix::tcgetattr))
+(defun sb-posix::tcgetattr (fd &optional termios)
+  (unless termios
+    (setq termios (sb-posix::allocate-termios)))
+  	;; FIXME: Hmm.  WITH-PINNED-OBJECTS/WITHOUT-GCING or something
+	;; is probably needed round here.
+  (let* ((s (sb-sys:int-sap
+	     ;; FIXME: WILL NOT WORK ON 64-BIT LISP.  VECTOR-SAP would
+	     ;; be better if the STAT object were guaranteed to be a
+	     ;; vector, but it's not (and may well turn into an alien
+	     ;; soon).
+	     (+ 8 (logandc2 (sb-kernel:get-lisp-obj-address termios) 7))))
+	 (r (alien-funcall
+	     (extern-alien "tcgetattr" (function int int (* t)))
+	     (sb-posix::file-descriptor fd)
+	     s)))
+    (when (minusp r)
+      (syscall-error)))
+  termios)