(define-call "fdatasync" int minusp (fd file-descriptor))
(define-call "ftruncate" int minusp (fd file-descriptor) (length sb-posix::off-t))
(define-call "fsync" int minusp (fd file-descriptor))
-;;; no lchown on Darwin
-#-darwin
(define-call "lchown" int minusp (pathname filename)
(owner sb-posix::uid-t) (group sb-posix::gid-t))
(define-call "link" int minusp (oldpath filename) (newpath filename))
(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 "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
;;; uid, gid
(define-call "geteuid" sb-posix::uid-t never-fails) ; "always successful", it says
-#+linux (define-call "getresuid" sb-posix::uid-t never-fails)
+(define-call "getresuid" sb-posix::uid-t never-fails)
(define-call "getuid" sb-posix::uid-t never-fails)
(define-call "seteuid" int minusp (uid sb-posix::uid-t))
-#+linux (define-call "setfsuid" int minusp (uid sb-posix::uid-t))
+(define-call "setfsuid" int minusp (uid sb-posix::uid-t))
(define-call "setreuid" int minusp
(ruid sb-posix::uid-t) (euid sb-posix::uid-t))
-#+linux (define-call "setresuid" int minusp
+(define-call "setresuid" int minusp
(ruid sb-posix::uid-t) (euid sb-posix::uid-t)
(suid sb-posix::uid-t))
(define-call "setuid" int minusp (uid sb-posix::uid-t))
(define-call "getegid" sb-posix::gid-t never-fails)
(define-call "getgid" sb-posix::gid-t never-fails)
-#+linux (define-call "getresgid" sb-posix::gid-t never-fails)
+(define-call "getresgid" sb-posix::gid-t never-fails)
(define-call "setegid" int minusp (gid sb-posix::gid-t))
-#+linux (define-call "setfsgid" int minusp (gid sb-posix::gid-t))
+(define-call "setfsgid" int minusp (gid sb-posix::gid-t))
(define-call "setgid" int minusp (gid sb-posix::gid-t))
(define-call "setregid" int minusp
(rgid sb-posix::gid-t) (egid sb-posix::gid-t))
-#+linux (define-call "setresgid" int minusp
+(define-call "setresgid" int minusp
(rgid sb-posix::gid-t)
(egid sb-posix::gid-t) (sgid sb-posix::gid-t))
(define-stat-call "fstat" fd sb-posix::file-descriptor
(function int int (* t)))
+
+;;; mode flags
+(define-call "s_isreg" boolean never-fails (mode sb-posix::mode-t))
+(define-call "s_isdir" boolean never-fails (mode sb-posix::mode-t))
+(define-call "s_ischr" boolean never-fails (mode sb-posix::mode-t))
+(define-call "s_isblk" boolean never-fails (mode sb-posix::mode-t))
+(define-call "s_isfifo" boolean never-fails (mode sb-posix::mode-t))
+(define-call "s_islnk" boolean never-fails (mode sb-posix::mode-t))
+(define-call "s_issock" boolean never-fails (mode sb-posix::mode-t))
+
(export 'sb-posix::pipe :sb-posix)
(declaim (inline sb-posix::pipe))
(defun sb-posix::pipe (&optional filedes2)
(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)
projects / sbcl.git / blobdiff