X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-posix%2Finterface.lisp;h=7c83661bb5b8047f50c6e274193ea35e453a02e8;hb=1d46d379bb7a6424524b978f213ef69be5f1ad69;hp=b942f3ef6aec683e61f12d21ba7996f18dc1597d;hpb=95110584db3224cf61b774f1402a71a79e61432f;p=sbcl.git diff --git a/contrib/sb-posix/interface.lisp b/contrib/sb-posix/interface.lisp index b942f3e..7c83661 100644 --- a/contrib/sb-posix/interface.lisp +++ b/contrib/sb-posix/interface.lisp @@ -33,16 +33,18 @@ (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)) @@ -51,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 @@ -65,26 +87,26 @@ ;;; 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)) @@ -152,6 +174,16 @@ (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) @@ -165,4 +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)