<commit_before>;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
;;;
;;; --- *UNIX foreign function definitions.
;;;

(in-package :iolib.syscalls)

;;; Needed for clock_gettime() and friends.
(eval-when (:compile-toplevel :load-toplevel :execute)
  (define-foreign-library librt
    (:linux "librt.so"))
  (use-foreign-library librt))



;;;-------------------------------------------------------------------------
;;; ERRNO-related functions
;;;-------------------------------------------------------------------------

(defentrypoint (setf %sys-errno) (value)
  "Set errno value."
  (%%sys-set-errno value))

(defsyscall (%%sys-strerror-r (#+linux "__xpg_strerror_r" "strerror_r"))
    :int
  (errnum :int)
  (buf    :pointer)
  (buflen size-t))

(defentrypoint %sys-strerror (&optional (err (%sys-errno)))
  "Look up the error message string for ERRNO (reentrant)."
  (let ((errno
         (if (keywordp err)
             (foreign-enum-value 'errno-values err)
             err)))
    (with-foreign-pointer-as-string ((buf bufsiz) 1024)
      (%%sys-strerror-r errno buf bufsiz))))

(defmethod print-object ((e syscall-error) stream)
  (let ((code (code-of e))
        (identifier (identifier-of e))
        (message (message-of e)))
    (if message
        (format stream "~A" message)
        (print-unreadable-object (e stream :type nil :identity nil)
          (format stream "System-Error ~A(~S) ~S"
                  identifier (or code "[No code]")
                  (or (%sys-strerror code) "[Can't get error string.]"))))))



;;;-------------------------------------------------------------------------
;;; Memory manipulation
;;;-------------------------------------------------------------------------

(defcfun* (%sys-memset "memset") :pointer
  "Fill the first COUNT bytes of BUFFER with the constant VALUE."
  (buffer :pointer)
  (value  :int)
  (count  size-t))

(defentrypoint %sys-bzero (buffer count)
  "Fill the first COUNT bytes of BUFFER with zeros."
  (%sys-memset buffer 0 count))

(defcfun* (%sys-memcpy "memcpy") :pointer
  "Copy COUNT octets from SRC to DEST.
The two memory areas must not overlap."
  (dest :pointer)
  (src  :pointer)
  (count size-t))

(defcfun* (%sys-memmove "memmove") :pointer
  "Copy COUNT octets from SRC to DEST.
The two memory areas may overlap."
  (dest :pointer)
  (src  :pointer)
  (count size-t))



;;;-------------------------------------------------------------------------
;;; I/O
;;;-------------------------------------------------------------------------

(defsyscall (%sys-read "read")
    (ssize-t :restart t :handle fd)
  "Read at most COUNT bytes from FD into the foreign area BUF."
  (fd    :int)
  (buf   :pointer)
  (count size-t))

(defsyscall (%sys-write "write")
    (ssize-t :restart t :handle fd)
  "Write at most COUNT bytes to FD from the foreign area BUF."
  (fd    :int)
  (buf   :pointer)
  (count size-t))

(defsyscall (%sys-readv "readv")
    (ssize-t :restart t :handle fd)
  "Read from FD into the first IOVCNT buffers of the IOV array."
  (fd     :int)
  (iov    :pointer)
  (iovcnt :int))

(defsyscall (%sys-writev "writev")
    (ssize-t :restart t :handle fd)
  "Writes to FD the first IOVCNT buffers of the IOV array."
  (fd     :int)
  (iov    :pointer)
  (iovcnt :int))

(defsyscall (%sys-pread (#+linux "pread64" "pread"))
    (ssize-t :restart t :handle fd)
  "Read at most COUNT bytes from FD at offset OFFSET into the foreign area BUF."
  (fd     :int)
  (buf    :pointer)
  (count  size-t)
  (offset off-t))

(defsyscall (%sys-pwrite (#+linux "pwrite64" "pwrite"))
    (ssize-t :restart t :handle fd)
  "Write at most COUNT bytes to FD at offset OFFSET from the foreign area BUF."
  (fd     :int)
  (buf    :pointer)
  (count  size-t)
  (offset off-t))



;;;-------------------------------------------------------------------------
;;; Files
;;;-------------------------------------------------------------------------

(defsyscall (%%sys-open (#+linux "open64" "open"))
    (:int :restart t)
  (path  sstring)
  (flags :int)
  (mode  mode-t))

(defvar *default-open-mode* #o666)

(defentrypoint %sys-open (path flags &optional (mode *default-open-mode*))
  "Open a file descriptor for PATH using FLAGS and permissions MODE
\(default value is *DEFAULT-OPEN-MODE* - #o666)."
  (%%sys-open path flags mode))

(defsyscall (%sys-creat (#+linux "creat64" "creat"))
    (:int :restart t)
  "Create file PATH with permissions MODE and return the new FD."
  (path sstring)
  (mode mode-t))

(defsyscall (%%sys-pipe "pipe") :int
  (fds :pointer))

(defentrypoint %sys-pipe ()
  "Create pipe, returns two values with the new FDs."
  (with-foreign-object (fds :int 2)
    (%%sys-pipe fds)
    (values (mem-aref fds :int 0)
            (mem-aref fds :int 1))))

(defsyscall (%sys-mkfifo "mkfifo") :int
  "Create a FIFO (named pipe) with name PATH and permissions MODE."
  (path sstring)
  (mode mode-t))

(defsyscall (%sys-umask "umask") mode-t
  "Sets the umask to NEW-MODE and returns the old one."
  (new-mode mode-t))

(defsyscall (%sys-lseek (#+linux "lseek64" "lseek"))
    (off-t :handle fd)
  "Reposition the offset of the open file associated with the file descriptor FD
to the argument OFFSET according to the directive WHENCE."
  (fd     :int)
  (offset off-t)
  (whence :int))

(defsyscall (%sys-access "access") :int
  "Check whether the file PATH can be accessed using mode MODE."
  (path sstring)
  (mode :int))

(defsyscall (%sys-truncate (#+linux "truncate64" "truncate"))
    (:int :restart t)
  "Truncate the file PATH to a size of precisely LENGTH octets."
  (path   sstring)
  (length off-t))

(defsyscall (%sys-ftruncate (#+linux "ftruncate64" "ftruncate"))
    (:int :restart t :handle fd)
  "Truncate the file referenced by FD to a size of precisely LENGTH octets."
  (fd     :int)
  (length off-t))

(defsyscall (%sys-rename "rename") :int
  "Rename file named by OLDPATH to NEWPATH."
  (oldpath sstring)
  (newpath sstring))

(defsyscall (%sys-link "link") :int
  "Create a hard link from file OLDPATH to NEWPATH."
  (oldpath sstring)
  (newpath sstring))

(defsyscall (%sys-symlink "symlink") :int
  "Create a symbolic link from file OLDPATH to NEWPATH."
  (oldpath sstring)
  (newpath sstring))

(defsyscall (%%sys-readlink "readlink") ssize-t
  (path    sstring)
  (buf     :pointer)
  (bufsize size-t))

(defentrypoint %sys-readlink (path)
  "Read the file name pointed by the symbolic link PATH."
  (with-foreign-pointer (buf +cstring-path-max+ bufsize)
    (let ((count (%%sys-readlink path buf bufsize)))
      (cstring-to-sstring buf count))))

(defsyscall (%%sys-realpath "realpath") sstring
  (path          sstring)
  (resolved-path :pointer))

(defentrypoint %sys-realpath (path)
  "Read the file name pointed by the symbolic link PATH."
  (with-foreign-pointer (buf +cstring-path-max+)
    (%%sys-realpath path buf)))

(defsyscall (%sys-unlink "unlink") :int
  "Delete the file PATH from the file system."
  (path sstring))

(defsyscall (%sys-chown "chown")
    (:int :restart t)
  "Change ownership of file PATH to uid OWNER and gid GROUP(dereferences symlinks)."
  (path  sstring)
  (owner uid-t)
  (group uid-t))

(defsyscall (%sys-fchown "fchown")
    (:int :restart t :handle fd)
  "Change ownership of an open file referenced by FD to uid OWNER and gid GROUP."
  (fd    :int)
  (owner uid-t)
  (group uid-t))

(defsyscall (%sys-lchown "lchown")
    (:int :restart t)
  "Change ownership of a file PATH to uid OWNER and gid GROUP(does not dereference symlinks)."
  (path  sstring)
  (owner uid-t)
  (group uid-t))

(defsyscall (%sys-chmod "chmod")
    (:int :restart t)
  "Change permissions of file PATH to mode MODE."
  (path sstring)
  (mode mode-t))

(defsyscall (%sys-fchmod "fchmod")
    (:int :restart t :handle fd)
  "Change permissions of open file referenced by FD to mode MODE."
  (fd   :int)
  (mode mode-t))

;;; STAT()

(define-c-struct-wrapper stat ())

(defsyscall (%%sys-stat (#+linux "__xstat64" "stat"))
    :int
  #+linux
  (version   :int)
  (file-name sstring)
  (buf       :pointer))

(defsyscall (%%sys-fstat (#+linux "__fxstat64" "fstat"))
    (:int :handle fd)
  #+linux
  (version :int)
  (fd      :int)
  (buf     :pointer))

(defsyscall (%%sys-lstat (#+linux "__lxstat64" "lstat"))
    :int
  #+linux
  (version   :int)
  (file-name sstring)
  (buf       :pointer))

;;; If necessary for performance reasons, we can add an optional
;;; argument to this function and use that to reuse a wrapper object.
(defentrypoint funcall-stat (fn arg)
  (with-foreign-object (buf 'stat)
    (funcall fn #+linux +stat-version+ arg buf)
    (make-instance 'stat :pointer buf)))

(defentrypoint %sys-stat (path)
  "Get information about file PATH(dereferences symlinks)."
  (funcall-stat #'%%sys-stat path))

(defentrypoint %sys-fstat (fd)
  "Get information about file descriptor FD."
  (funcall-stat #'%%sys-fstat fd))

(defentrypoint %sys-lstat (path)
  "Get information about file PATH(does not dereference symlinks)."
  (funcall-stat #'%%sys-lstat path))

(defsyscall (%sys-sync "sync") :void
  "Schedule all file system buffers to be written to disk.")

(defsyscall (%sys-fsync "fsync")
    (:int :restart t)
  "Schedule a file's buffers to be written to disk."
  (fd :int))

(defsyscall (%%sys-mkstemp (#+linux "mkstemp64" "mkstemp")) :int
  (template :pointer))

(defentrypoint %sys-mkstemp (&optional (template ""))
  "Generate a unique temporary filename from TEMPLATE.
Return two values: the file descriptor and the path of the temporary file."
  (let ((template (concatenate 'string template "XXXXXX")))
    (with-sstring-to-cstring (ptr template)
      (values (%%sys-mkstemp ptr) (cstring-to-sstring ptr)))))



;;;-------------------------------------------------------------------------
;;; Directories
;;;-------------------------------------------------------------------------

(defsyscall (%sys-mkdir "mkdir") :int
  "Create directory PATH with permissions MODE."
  (path sstring)
  (mode mode-t))

(defsyscall (%sys-rmdir "rmdir") :int
  "Delete directory PATH."
  (path sstring))

(defsyscall (%sys-chdir "chdir") :int
  "Change the current working directory to PATH."
  (path sstring))

(defsyscall (%sys-fchdir "fchdir")
    (:int :restart t :handle fd)
  "Change the current working directory to the directory referenced by FD."
  (fd :int))

(defsyscall (%%sys-getcwd "getcwd") :pointer
  (buf :pointer)
  (size size-t))

(defentrypoint %sys-getcwd ()
  "Return the current working directory as a string."
  (with-cstring-to-sstring (buf +cstring-path-max+ bufsize)
    (%%sys-getcwd buf bufsize)))

(defsyscall (%%sys-mkdtemp "mkdtemp") sstring
  (template sstring))

(defentrypoint %sys-mkdtemp (&optional (template ""))
  "Generate a unique temporary filename from TEMPLATE."
  (let ((template (concatenate 'string template "XXXXXX")))
    (%%sys-mkdtemp template)))



;;;-------------------------------------------------------------------------
;;; File Descriptors
;;;-------------------------------------------------------------------------

(defsyscall (%sys-close "close")
    (:int :handle fd)
  "Close open file descriptor FD."
  (fd :int))

(defsyscall (%sys-dup "dup")
    (:int :handle fd)
  "Duplicate file descriptor FD."
  (fd :int))

(defsyscall (%sys-dup2 "dup2")
    (:int :restart t :handle oldfd :handle2 newfd)
  "Make NEWFD be the copy of OLDFD, closing NEWFD first if necessary."
  (oldfd :int)
  (newfd :int))

(defsyscall (%%sys-fcntl/noarg "fcntl")
    (:int :handle fd)
  (fd  :int)
  (cmd :int))

;;; FIXME: Linux/glibc says ARG's type is long, POSIX says it's int.
;;; Is this an issue?
(defsyscall (%%sys-fcntl/int "fcntl")
    (:int :handle fd)
  (fd  :int)
  (cmd :int)
  (arg :int))

(defsyscall (%%sys-fcntl/pointer "fcntl")
    (:int :handle fd)
  (fd  :int)
  (cmd :int)
  (arg :pointer))

(defentrypoint %sys-fcntl (fd cmd &optional (arg nil argp))
  (cond
    ((not argp)     (%%sys-fcntl/noarg   fd cmd))
    ((integerp arg) (%%sys-fcntl/int     fd cmd arg))
    ((pointerp arg) (%%sys-fcntl/pointer fd cmd arg))
    (t (error "Wrong argument to fcntl: ~S" arg))))

(defsyscall (%%sys-ioctl/noarg "ioctl")
    (:int :restart t :handle fd)
  "Send request REQUEST to file referenced by FD."
  (fd      :int)
  (request :int))

(defsyscall (%%sys-ioctl/pointer "ioctl")
    (:int :restart t :handle fd)
  "Send request REQUEST to file referenced by FD using argument ARG."
 (fd      :int)
 (request :int)
 (arg     :pointer))

(defentrypoint %sys-ioctl (fd request &optional (arg nil argp))
  "Control an I/O device."
  (cond
    ((not argp)     (%%sys-ioctl/noarg   fd request))
    ((pointerp arg) (%%sys-ioctl/pointer fd request arg))
    (t (error "Wrong argument to ioctl: ~S" arg))))

(defentrypoint %sys-fd-open-p (fd)
  (handler-case
      (progn (%sys-fstat fd) t)
    (ebadf () nil)))



;;;-------------------------------------------------------------------------
;;; TTYs
;;;-------------------------------------------------------------------------

(defsyscall (%sys-posix-openpt "posix_openpt") :int
  (flags :int))

(defsyscall (%sys-grantpt "grantpt")
    (:int :handle fd)
  (fd :int))

(defsyscall (%sys-unlockpt "unlockpt")
    (:int :handle fd)
  (fd :int))

(defsyscall (%sys-ptsname "ptsname")
    (:string :handle fd)
  (fd :int))



;;;-------------------------------------------------------------------------
;;; File descriptor polling
;;;-------------------------------------------------------------------------

(defsyscall (%sys-select "select") :int
  "Scan for I/O activity on multiple file descriptors."
  (nfds      :int)
  (readfds   :pointer)
  (writefds  :pointer)
  (exceptfds :pointer)
  (timeout   :pointer))

(defentrypoint %sys-fd-zero (fd-set)
  (%sys-bzero fd-set size-of-fd-set)
  (values fd-set))

(defentrypoint %sys-copy-fd-set (from to)
  (%sys-memcpy to from size-of-fd-set)
  (values to))

(deftype select-file-descriptor ()
  `(mod #.fd-setsize))

(defentrypoint %sys-fd-isset (fd fd-set)
  (multiple-value-bind (byte-off bit-off) (floor fd 8)
    (let ((oldval (mem-aref fd-set :uint8 byte-off)))
      (logbitp bit-off oldval))))

(defentrypoint %sys-fd-clr (fd fd-set)
  (multiple-value-bind (byte-off bit-off) (floor fd 8)
    (let ((oldval (mem-aref fd-set :uint8 byte-off)))
      (setf (mem-aref fd-set :uint8 byte-off)
            (logandc2 oldval (ash 1 bit-off)))))
  (values fd-set))

(defentrypoint %sys-fd-set (fd fd-set)
  (multiple-value-bind (byte-off bit-off) (floor fd 8)
    (let ((oldval (mem-aref fd-set :uint8 byte-off)))
      (setf (mem-aref fd-set :uint8 byte-off)
            (logior oldval (ash 1 bit-off)))))
  (values fd-set))

;;; FIXME: Until a way to autodetect platform features is implemented
(eval-when (:compile-toplevel :load-toplevel :execute)
  (unless (boundp 'pollrdhup)
    (defconstant pollrdhup 0)))

(defsyscall (%sys-poll "poll") :int
  "Scan for I/O activity on multiple file descriptors."
  (fds     :pointer)
  (nfds    nfds-t)
  (timeout :int))

#+linux
(progn
  (defsyscall (%sys-epoll-create "epoll_create") :int
    "Open an epoll file descriptor."
    (size :int))

  (defsyscall (%sys-epoll-ctl "epoll_ctl")
      (:int :handle epfd :handle2 fd)
    "Control interface for an epoll descriptor."
    (epfd  :int)
    (op    :int)
    (fd    :int)
    (event :pointer))

  (defsyscall (%sys-epoll-wait "epoll_wait")
      (:int :handle epfd)
    "Wait for an I/O event on an epoll file descriptor."
    (epfd      :int)
    (events    :pointer)
    (maxevents :int)
    (timeout   :int)))

#+bsd
(progn
  (defsyscall (%sys-kqueue "kqueue") :int
    "Open a kernel event queue.")

  (defsyscall (%sys-kevent "kevent")
      (:int :handle fd)
    "Control interface for a kernel event queue."
    (fd         :int)
    (changelist :pointer)               ; const struct kevent *
    (nchanges   :int)
    (eventlist  :pointer)               ; struct kevent *
    (nevents    :int)
    (timeout    :pointer))              ; const struct timespec *

  (defentrypoint %sys-ev-set (%kev %ident %filter %flags %fflags %data %udata)
    (with-foreign-slots ((ident filter flags fflags data udata) %kev kevent)
      (setf ident %ident filter %filter flags %flags
            fflags %fflags data %data udata %udata))))



;;;-------------------------------------------------------------------------
;;; Directory walking
;;;-------------------------------------------------------------------------

(defsyscall (%sys-opendir "opendir") :pointer
  "Open directory PATH for listing of its contents."
  (path sstring))

#-darwin
(defsyscall (%sys-fdopendir "fdopendir") :pointer
  "Open directory denoted by descriptor FD for listing of its contents."
  (fd :int))

#-darwin
(defsyscall (%sys-dirfd "dirfd") :int
  "Returns the file descriptor associated with the directory DIRP."
  (dirp :pointer))

(defsyscall (%sys-closedir "closedir") :int
  "Close directory DIR when done listing its contents."
  (dirp :pointer))

(defsyscall (%%sys-readdir-r (#+linux "readdir64_r" "readdir_r"))
    (:int
     :error-predicate plusp
     :error-location :return)
  (dirp   :pointer)
  (entry  :pointer)
  (result :pointer))

(defentrypoint %sys-readdir (dir)
  "Reads an item from the listing of directory DIR (reentrant)."
  (with-foreign-objects ((entry 'dirent) (result :pointer))
    (%%sys-readdir-r dir entry result)
    (if (null-pointer-p (mem-ref result :pointer))
        nil
        (with-foreign-slots ((name type fileno) entry dirent)
          (values (cstring-to-sstring name) type fileno)))))

(defsyscall (%sys-rewinddir "rewinddir") :void
  "Rewind directory DIR."
  (dirp :pointer))

(defsyscall (%sys-seekdir "seekdir") :void
  "Seek into directory DIR to position POS(as returned by TELLDIR)."
  (dirp :pointer)
  (pos  :long))

;;; FIXME: According to POSIX docs "no errors are defined" for
;;; telldir() but Linux manpages specify a possible EBADF.
(defsyscall (%sys-telldir "telldir") off-t
  "Return the current location in directory DIR."
  (dirp :pointer))



;;;-------------------------------------------------------------------------
;;; Memory mapping
;;;-------------------------------------------------------------------------

(defsyscall (%sys-mmap (#+linux "mmap64" "mmap"))
    (:pointer :handle fd)
  "Map file referenced by FD at offset OFFSET into address space of the
calling process at address ADDR and length LENGTH.
PROT describes the desired memory protection of the mapping.
FLAGS determines whether updates to the mapping are visible to other
processes mapping the same region."
  (addr   :pointer)
  (length size-t)
  (prot   :int)
  (flags  :int)
  (fd     :int)
  (offset off-t))

(defsyscall (%sys-munmap "munmap") :int
  "Unmap pages of memory starting at address ADDR with length LENGTH."
  (addr   :pointer)
  (length size-t))



;;;-------------------------------------------------------------------------
;;; Process creation and info
;;;-------------------------------------------------------------------------

(defsyscall (%sys-fork "fork") pid-t
  "Create a child process.")

(defsyscall (%sys-execv "execv") :int
  (path :string)
  (argv :pointer))

(defsyscall (%sys-execvp "execvp") :int
  (file :string)
  (argv :pointer))

(defsyscall (%sys-waitpid "waitpid") pid-t
  (pid     pid-t)
  (status  :pointer)
  (options :int))

(defsyscall (%sys-getpid "getpid") pid-t
  "Returns the process id of the current process")

(defsyscall (%sys-getppid "getppid") pid-t
  "Returns the process id of the current process's parent")

#+linux
(defentrypoint %sys-gettid ()
  (foreign-funcall "syscall" :int sys-gettid :int))

(defsyscall (%sys-getuid "getuid") uid-t
  "Get real user id of the current process.")

(defsyscall (%sys-setuid "setuid") :int
  "Set real user id of the current process to UID."
  (uid uid-t))

(defsyscall (%sys-geteuid "geteuid") uid-t
  "Get effective user id of the current process.")

(defsyscall (%sys-seteuid "seteuid") :int
  "Set effective user id of the current process to UID."
  (uid uid-t))

(defsyscall (%sys-getgid "getgid") gid-t
  "Get real group id of the current process.")

(defsyscall (%sys-setgid "setgid") :int
  "Set real group id of the current process to GID."
  (gid gid-t))

(defsyscall (%sys-getegid "getegid") gid-t
  "Get effective group id of the current process.")

(defsyscall (%sys-setegid "setegid") :int
  "Set effective group id of the current process to GID."
  (gid gid-t))

(defsyscall (%sys-setreuid "setreuid") :int
  "Set real and effective user id of the current process to RUID and EUID."
  (ruid uid-t)
  (euid uid-t))

(defsyscall (%sys-setregid "setregid") :int
  "Set real and effective group id of the current process to RGID and EGID."
  (rgid gid-t)
  (egid gid-t))

(defsyscall (%sys-getpgid "getpgid") pid-t
  "Get process group id of process PID."
  (pid pid-t))

(defsyscall (%sys-setpgid "setpgid") :int
  "Set process group id of process PID to value PGID."
  (pid  pid-t)
  (pgid pid-t))

(defsyscall (%sys-getpgrp "getpgrp") pid-t
  "Get process group id of the current process.")

(defsyscall (%sys-setpgrp "setpgrp") pid-t
  "Set process group id of the current process.")

(defsyscall (%sys-setsid "setsid") pid-t
  "Create session and set process group id of the current process.")

(defsyscall (%%sys-getrlimit (#+linux "getrlimit64" "getrlimit"))
    :int
  (resource :int)
  (rlimit   :pointer))

(defentrypoint %sys-getrlimit (resource)
  "Return soft and hard limit of system resource RESOURCE."
  (with-foreign-object (rl 'rlimit)
    (with-foreign-slots ((cur max) rl rlimit)
      (%%sys-getrlimit resource rl)
      (values cur max))))

(defsyscall (%%sys-setrlimit (#+linux "setrlimit64" "setrlimit"))
    :int
  (resource :int)
  (rlimit   :pointer))

(defentrypoint %sys-setrlimit (resource soft-limit hard-limit)
  "Set SOFT-LIMIT and HARD-LIMIT of system resource RESOURCE."
  (with-foreign-object (rl 'rlimit)
    (with-foreign-slots ((cur max) rl rlimit)
      (setf cur soft-limit
            max hard-limit)
      (%%sys-setrlimit resource rl))))

(defsyscall (%%sys-getrusage "getrusage") :int
  (who   :int)
  (usage :pointer))

;;; TODO: it might be more convenient to return a wrapper object here
;;; instead like we do in STAT.
(defentrypoint %sys-getrusage (who)
  "Return resource usage measures of WHO."
  (with-foreign-object (ru 'rusage)
    (%%sys-getrusage who ru)
    (with-foreign-slots ((maxrss ixrss idrss isrss minflt majflt nswap inblock
                          oublock msgsnd msgrcv nsignals nvcsw nivcsw)
                         ru rusage)
      (values (foreign-slot-value (foreign-slot-pointer ru 'rusage 'utime)
                                  'timeval 'sec)
              (foreign-slot-value (foreign-slot-pointer ru 'rusage 'utime)
                                  'timeval 'usec)
              (foreign-slot-value (foreign-slot-pointer ru 'rusage 'stime)
                                  'timeval 'sec)
              (foreign-slot-value (foreign-slot-pointer ru 'rusage 'stime)
                                  'timeval 'usec)
              maxrss ixrss idrss isrss minflt majflt
              nswap inblock oublock msgsnd
              msgrcv nsignals nvcsw nivcsw))))

(defsyscall (%sys-getpriority "getpriority") :int
  "Get the scheduling priority of a process, process group, or user,
as indicated by WHICH and WHO."
  (which :int)
  (who   :int))

(defsyscall (%sys-setpriority "setpriority") :int
  "Set the scheduling priority of a process, process group, or user,
as indicated by WHICH and WHO to VALUE."
  (which :int)
  (who   :int)
  (value :int))

(defentrypoint %sys-nice (&optional (increment 0))
  "Get or set process priority."
  ;; FIXME: race condition. might need WITHOUT-INTERRUPTS on some impl.s
  (setf (%sys-errno) 0)
  (let ((retval (foreign-funcall "nice" :int increment :int))
        (errno (%sys-errno)))
    (if (and (= retval -1) (/= errno 0))
        (signal-syscall-error errno)
        retval)))



;;;-------------------------------------------------------------------------
;;; Signals
;;;-------------------------------------------------------------------------

(defsyscall (%sys-kill "kill") :int
  "Send signal SIG to process PID."
  (pid    pid-t)
  (signum :int))

(defsyscall (%sys-sigaction "sigaction") :int
  (signum :int)
  (act    :pointer)
  (oldact :pointer))


<commit_msg>Add %SYS-EXIT that calls _exit(2) not exit(3).<commit_after>;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
;;;
;;; --- *UNIX foreign function definitions.
;;;

(in-package :iolib.syscalls)

;;; Needed for clock_gettime() and friends.
(eval-when (:compile-toplevel :load-toplevel :execute)
  (define-foreign-library librt
    (:linux "librt.so"))
  (use-foreign-library librt))



;;;-------------------------------------------------------------------------
;;; ERRNO-related functions
;;;-------------------------------------------------------------------------

(defentrypoint (setf %sys-errno) (value)
  "Set errno value."
  (%%sys-set-errno value))

(defsyscall (%%sys-strerror-r (#+linux "__xpg_strerror_r" "strerror_r"))
    :int
  (errnum :int)
  (buf    :pointer)
  (buflen size-t))

(defentrypoint %sys-strerror (&optional (err (%sys-errno)))
  "Look up the error message string for ERRNO (reentrant)."
  (let ((errno
         (if (keywordp err)
             (foreign-enum-value 'errno-values err)
             err)))
    (with-foreign-pointer-as-string ((buf bufsiz) 1024)
      (%%sys-strerror-r errno buf bufsiz))))

(defmethod print-object ((e syscall-error) stream)
  (let ((code (code-of e))
        (identifier (identifier-of e))
        (message (message-of e)))
    (if message
        (format stream "~A" message)
        (print-unreadable-object (e stream :type nil :identity nil)
          (format stream "System-Error ~A(~S) ~S"
                  identifier (or code "[No code]")
                  (or (%sys-strerror code) "[Can't get error string.]"))))))



;;;-------------------------------------------------------------------------
;;; Memory manipulation
;;;-------------------------------------------------------------------------

(defcfun* (%sys-memset "memset") :pointer
  "Fill the first COUNT bytes of BUFFER with the constant VALUE."
  (buffer :pointer)
  (value  :int)
  (count  size-t))

(defentrypoint %sys-bzero (buffer count)
  "Fill the first COUNT bytes of BUFFER with zeros."
  (%sys-memset buffer 0 count))

(defcfun* (%sys-memcpy "memcpy") :pointer
  "Copy COUNT octets from SRC to DEST.
The two memory areas must not overlap."
  (dest :pointer)
  (src  :pointer)
  (count size-t))

(defcfun* (%sys-memmove "memmove") :pointer
  "Copy COUNT octets from SRC to DEST.
The two memory areas may overlap."
  (dest :pointer)
  (src  :pointer)
  (count size-t))



;;;-------------------------------------------------------------------------
;;; I/O
;;;-------------------------------------------------------------------------

(defsyscall (%sys-read "read")
    (ssize-t :restart t :handle fd)
  "Read at most COUNT bytes from FD into the foreign area BUF."
  (fd    :int)
  (buf   :pointer)
  (count size-t))

(defsyscall (%sys-write "write")
    (ssize-t :restart t :handle fd)
  "Write at most COUNT bytes to FD from the foreign area BUF."
  (fd    :int)
  (buf   :pointer)
  (count size-t))

(defsyscall (%sys-readv "readv")
    (ssize-t :restart t :handle fd)
  "Read from FD into the first IOVCNT buffers of the IOV array."
  (fd     :int)
  (iov    :pointer)
  (iovcnt :int))

(defsyscall (%sys-writev "writev")
    (ssize-t :restart t :handle fd)
  "Writes to FD the first IOVCNT buffers of the IOV array."
  (fd     :int)
  (iov    :pointer)
  (iovcnt :int))

(defsyscall (%sys-pread (#+linux "pread64" "pread"))
    (ssize-t :restart t :handle fd)
  "Read at most COUNT bytes from FD at offset OFFSET into the foreign area BUF."
  (fd     :int)
  (buf    :pointer)
  (count  size-t)
  (offset off-t))

(defsyscall (%sys-pwrite (#+linux "pwrite64" "pwrite"))
    (ssize-t :restart t :handle fd)
  "Write at most COUNT bytes to FD at offset OFFSET from the foreign area BUF."
  (fd     :int)
  (buf    :pointer)
  (count  size-t)
  (offset off-t))



;;;-------------------------------------------------------------------------
;;; Files
;;;-------------------------------------------------------------------------

(defsyscall (%%sys-open (#+linux "open64" "open"))
    (:int :restart t)
  (path  sstring)
  (flags :int)
  (mode  mode-t))

(defvar *default-open-mode* #o666)

(defentrypoint %sys-open (path flags &optional (mode *default-open-mode*))
  "Open a file descriptor for PATH using FLAGS and permissions MODE
\(default value is *DEFAULT-OPEN-MODE* - #o666)."
  (%%sys-open path flags mode))

(defsyscall (%sys-creat (#+linux "creat64" "creat"))
    (:int :restart t)
  "Create file PATH with permissions MODE and return the new FD."
  (path sstring)
  (mode mode-t))

(defsyscall (%%sys-pipe "pipe") :int
  (fds :pointer))

(defentrypoint %sys-pipe ()
  "Create pipe, returns two values with the new FDs."
  (with-foreign-object (fds :int 2)
    (%%sys-pipe fds)
    (values (mem-aref fds :int 0)
            (mem-aref fds :int 1))))

(defsyscall (%sys-mkfifo "mkfifo") :int
  "Create a FIFO (named pipe) with name PATH and permissions MODE."
  (path sstring)
  (mode mode-t))

(defsyscall (%sys-umask "umask") mode-t
  "Sets the umask to NEW-MODE and returns the old one."
  (new-mode mode-t))

(defsyscall (%sys-lseek (#+linux "lseek64" "lseek"))
    (off-t :handle fd)
  "Reposition the offset of the open file associated with the file descriptor FD
to the argument OFFSET according to the directive WHENCE."
  (fd     :int)
  (offset off-t)
  (whence :int))

(defsyscall (%sys-access "access") :int
  "Check whether the file PATH can be accessed using mode MODE."
  (path sstring)
  (mode :int))

(defsyscall (%sys-truncate (#+linux "truncate64" "truncate"))
    (:int :restart t)
  "Truncate the file PATH to a size of precisely LENGTH octets."
  (path   sstring)
  (length off-t))

(defsyscall (%sys-ftruncate (#+linux "ftruncate64" "ftruncate"))
    (:int :restart t :handle fd)
  "Truncate the file referenced by FD to a size of precisely LENGTH octets."
  (fd     :int)
  (length off-t))

(defsyscall (%sys-rename "rename") :int
  "Rename file named by OLDPATH to NEWPATH."
  (oldpath sstring)
  (newpath sstring))

(defsyscall (%sys-link "link") :int
  "Create a hard link from file OLDPATH to NEWPATH."
  (oldpath sstring)
  (newpath sstring))

(defsyscall (%sys-symlink "symlink") :int
  "Create a symbolic link from file OLDPATH to NEWPATH."
  (oldpath sstring)
  (newpath sstring))

(defsyscall (%%sys-readlink "readlink") ssize-t
  (path    sstring)
  (buf     :pointer)
  (bufsize size-t))

(defentrypoint %sys-readlink (path)
  "Read the file name pointed by the symbolic link PATH."
  (with-foreign-pointer (buf +cstring-path-max+ bufsize)
    (let ((count (%%sys-readlink path buf bufsize)))
      (cstring-to-sstring buf count))))

(defsyscall (%%sys-realpath "realpath") sstring
  (path          sstring)
  (resolved-path :pointer))

(defentrypoint %sys-realpath (path)
  "Read the file name pointed by the symbolic link PATH."
  (with-foreign-pointer (buf +cstring-path-max+)
    (%%sys-realpath path buf)))

(defsyscall (%sys-unlink "unlink") :int
  "Delete the file PATH from the file system."
  (path sstring))

(defsyscall (%sys-chown "chown")
    (:int :restart t)
  "Change ownership of file PATH to uid OWNER and gid GROUP(dereferences symlinks)."
  (path  sstring)
  (owner uid-t)
  (group uid-t))

(defsyscall (%sys-fchown "fchown")
    (:int :restart t :handle fd)
  "Change ownership of an open file referenced by FD to uid OWNER and gid GROUP."
  (fd    :int)
  (owner uid-t)
  (group uid-t))

(defsyscall (%sys-lchown "lchown")
    (:int :restart t)
  "Change ownership of a file PATH to uid OWNER and gid GROUP(does not dereference symlinks)."
  (path  sstring)
  (owner uid-t)
  (group uid-t))

(defsyscall (%sys-chmod "chmod")
    (:int :restart t)
  "Change permissions of file PATH to mode MODE."
  (path sstring)
  (mode mode-t))

(defsyscall (%sys-fchmod "fchmod")
    (:int :restart t :handle fd)
  "Change permissions of open file referenced by FD to mode MODE."
  (fd   :int)
  (mode mode-t))

;;; STAT()

(define-c-struct-wrapper stat ())

(defsyscall (%%sys-stat (#+linux "__xstat64" "stat"))
    :int
  #+linux
  (version   :int)
  (file-name sstring)
  (buf       :pointer))

(defsyscall (%%sys-fstat (#+linux "__fxstat64" "fstat"))
    (:int :handle fd)
  #+linux
  (version :int)
  (fd      :int)
  (buf     :pointer))

(defsyscall (%%sys-lstat (#+linux "__lxstat64" "lstat"))
    :int
  #+linux
  (version   :int)
  (file-name sstring)
  (buf       :pointer))

;;; If necessary for performance reasons, we can add an optional
;;; argument to this function and use that to reuse a wrapper object.
(defentrypoint funcall-stat (fn arg)
  (with-foreign-object (buf 'stat)
    (funcall fn #+linux +stat-version+ arg buf)
    (make-instance 'stat :pointer buf)))

(defentrypoint %sys-stat (path)
  "Get information about file PATH(dereferences symlinks)."
  (funcall-stat #'%%sys-stat path))

(defentrypoint %sys-fstat (fd)
  "Get information about file descriptor FD."
  (funcall-stat #'%%sys-fstat fd))

(defentrypoint %sys-lstat (path)
  "Get information about file PATH(does not dereference symlinks)."
  (funcall-stat #'%%sys-lstat path))

(defsyscall (%sys-sync "sync") :void
  "Schedule all file system buffers to be written to disk.")

(defsyscall (%sys-fsync "fsync")
    (:int :restart t)
  "Schedule a file's buffers to be written to disk."
  (fd :int))

(defsyscall (%%sys-mkstemp (#+linux "mkstemp64" "mkstemp")) :int
  (template :pointer))

(defentrypoint %sys-mkstemp (&optional (template ""))
  "Generate a unique temporary filename from TEMPLATE.
Return two values: the file descriptor and the path of the temporary file."
  (let ((template (concatenate 'string template "XXXXXX")))
    (with-sstring-to-cstring (ptr template)
      (values (%%sys-mkstemp ptr) (cstring-to-sstring ptr)))))



;;;-------------------------------------------------------------------------
;;; Directories
;;;-------------------------------------------------------------------------

(defsyscall (%sys-mkdir "mkdir") :int
  "Create directory PATH with permissions MODE."
  (path sstring)
  (mode mode-t))

(defsyscall (%sys-rmdir "rmdir") :int
  "Delete directory PATH."
  (path sstring))

(defsyscall (%sys-chdir "chdir") :int
  "Change the current working directory to PATH."
  (path sstring))

(defsyscall (%sys-fchdir "fchdir")
    (:int :restart t :handle fd)
  "Change the current working directory to the directory referenced by FD."
  (fd :int))

(defsyscall (%%sys-getcwd "getcwd") :pointer
  (buf :pointer)
  (size size-t))

(defentrypoint %sys-getcwd ()
  "Return the current working directory as a string."
  (with-cstring-to-sstring (buf +cstring-path-max+ bufsize)
    (%%sys-getcwd buf bufsize)))

(defsyscall (%%sys-mkdtemp "mkdtemp") sstring
  (template sstring))

(defentrypoint %sys-mkdtemp (&optional (template ""))
  "Generate a unique temporary filename from TEMPLATE."
  (let ((template (concatenate 'string template "XXXXXX")))
    (%%sys-mkdtemp template)))



;;;-------------------------------------------------------------------------
;;; File Descriptors
;;;-------------------------------------------------------------------------

(defsyscall (%sys-close "close")
    (:int :handle fd)
  "Close open file descriptor FD."
  (fd :int))

(defsyscall (%sys-dup "dup")
    (:int :handle fd)
  "Duplicate file descriptor FD."
  (fd :int))

(defsyscall (%sys-dup2 "dup2")
    (:int :restart t :handle oldfd :handle2 newfd)
  "Make NEWFD be the copy of OLDFD, closing NEWFD first if necessary."
  (oldfd :int)
  (newfd :int))

(defsyscall (%%sys-fcntl/noarg "fcntl")
    (:int :handle fd)
  (fd  :int)
  (cmd :int))

;;; FIXME: Linux/glibc says ARG's type is long, POSIX says it's int.
;;; Is this an issue?
(defsyscall (%%sys-fcntl/int "fcntl")
    (:int :handle fd)
  (fd  :int)
  (cmd :int)
  (arg :int))

(defsyscall (%%sys-fcntl/pointer "fcntl")
    (:int :handle fd)
  (fd  :int)
  (cmd :int)
  (arg :pointer))

(defentrypoint %sys-fcntl (fd cmd &optional (arg nil argp))
  (cond
    ((not argp)     (%%sys-fcntl/noarg   fd cmd))
    ((integerp arg) (%%sys-fcntl/int     fd cmd arg))
    ((pointerp arg) (%%sys-fcntl/pointer fd cmd arg))
    (t (error "Wrong argument to fcntl: ~S" arg))))

(defsyscall (%%sys-ioctl/noarg "ioctl")
    (:int :restart t :handle fd)
  "Send request REQUEST to file referenced by FD."
  (fd      :int)
  (request :int))

(defsyscall (%%sys-ioctl/pointer "ioctl")
    (:int :restart t :handle fd)
  "Send request REQUEST to file referenced by FD using argument ARG."
 (fd      :int)
 (request :int)
 (arg     :pointer))

(defentrypoint %sys-ioctl (fd request &optional (arg nil argp))
  "Control an I/O device."
  (cond
    ((not argp)     (%%sys-ioctl/noarg   fd request))
    ((pointerp arg) (%%sys-ioctl/pointer fd request arg))
    (t (error "Wrong argument to ioctl: ~S" arg))))

(defentrypoint %sys-fd-open-p (fd)
  (handler-case
      (progn (%sys-fstat fd) t)
    (ebadf () nil)))



;;;-------------------------------------------------------------------------
;;; TTYs
;;;-------------------------------------------------------------------------

(defsyscall (%sys-posix-openpt "posix_openpt") :int
  (flags :int))

(defsyscall (%sys-grantpt "grantpt")
    (:int :handle fd)
  (fd :int))

(defsyscall (%sys-unlockpt "unlockpt")
    (:int :handle fd)
  (fd :int))

(defsyscall (%sys-ptsname "ptsname")
    (:string :handle fd)
  (fd :int))



;;;-------------------------------------------------------------------------
;;; File descriptor polling
;;;-------------------------------------------------------------------------

(defsyscall (%sys-select "select") :int
  "Scan for I/O activity on multiple file descriptors."
  (nfds      :int)
  (readfds   :pointer)
  (writefds  :pointer)
  (exceptfds :pointer)
  (timeout   :pointer))

(defentrypoint %sys-fd-zero (fd-set)
  (%sys-bzero fd-set size-of-fd-set)
  (values fd-set))

(defentrypoint %sys-copy-fd-set (from to)
  (%sys-memcpy to from size-of-fd-set)
  (values to))

(deftype select-file-descriptor ()
  `(mod #.fd-setsize))

(defentrypoint %sys-fd-isset (fd fd-set)
  (multiple-value-bind (byte-off bit-off) (floor fd 8)
    (let ((oldval (mem-aref fd-set :uint8 byte-off)))
      (logbitp bit-off oldval))))

(defentrypoint %sys-fd-clr (fd fd-set)
  (multiple-value-bind (byte-off bit-off) (floor fd 8)
    (let ((oldval (mem-aref fd-set :uint8 byte-off)))
      (setf (mem-aref fd-set :uint8 byte-off)
            (logandc2 oldval (ash 1 bit-off)))))
  (values fd-set))

(defentrypoint %sys-fd-set (fd fd-set)
  (multiple-value-bind (byte-off bit-off) (floor fd 8)
    (let ((oldval (mem-aref fd-set :uint8 byte-off)))
      (setf (mem-aref fd-set :uint8 byte-off)
            (logior oldval (ash 1 bit-off)))))
  (values fd-set))

;;; FIXME: Until a way to autodetect platform features is implemented
(eval-when (:compile-toplevel :load-toplevel :execute)
  (unless (boundp 'pollrdhup)
    (defconstant pollrdhup 0)))

(defsyscall (%sys-poll "poll") :int
  "Scan for I/O activity on multiple file descriptors."
  (fds     :pointer)
  (nfds    nfds-t)
  (timeout :int))

#+linux
(progn
  (defsyscall (%sys-epoll-create "epoll_create") :int
    "Open an epoll file descriptor."
    (size :int))

  (defsyscall (%sys-epoll-ctl "epoll_ctl")
      (:int :handle epfd :handle2 fd)
    "Control interface for an epoll descriptor."
    (epfd  :int)
    (op    :int)
    (fd    :int)
    (event :pointer))

  (defsyscall (%sys-epoll-wait "epoll_wait")
      (:int :handle epfd)
    "Wait for an I/O event on an epoll file descriptor."
    (epfd      :int)
    (events    :pointer)
    (maxevents :int)
    (timeout   :int)))

#+bsd
(progn
  (defsyscall (%sys-kqueue "kqueue") :int
    "Open a kernel event queue.")

  (defsyscall (%sys-kevent "kevent")
      (:int :handle fd)
    "Control interface for a kernel event queue."
    (fd         :int)
    (changelist :pointer)               ; const struct kevent *
    (nchanges   :int)
    (eventlist  :pointer)               ; struct kevent *
    (nevents    :int)
    (timeout    :pointer))              ; const struct timespec *

  (defentrypoint %sys-ev-set (%kev %ident %filter %flags %fflags %data %udata)
    (with-foreign-slots ((ident filter flags fflags data udata) %kev kevent)
      (setf ident %ident filter %filter flags %flags
            fflags %fflags data %data udata %udata))))



;;;-------------------------------------------------------------------------
;;; Directory walking
;;;-------------------------------------------------------------------------

(defsyscall (%sys-opendir "opendir") :pointer
  "Open directory PATH for listing of its contents."
  (path sstring))

#-darwin
(defsyscall (%sys-fdopendir "fdopendir") :pointer
  "Open directory denoted by descriptor FD for listing of its contents."
  (fd :int))

#-darwin
(defsyscall (%sys-dirfd "dirfd") :int
  "Returns the file descriptor associated with the directory DIRP."
  (dirp :pointer))

(defsyscall (%sys-closedir "closedir") :int
  "Close directory DIR when done listing its contents."
  (dirp :pointer))

(defsyscall (%%sys-readdir-r (#+linux "readdir64_r" "readdir_r"))
    (:int
     :error-predicate plusp
     :error-location :return)
  (dirp   :pointer)
  (entry  :pointer)
  (result :pointer))

(defentrypoint %sys-readdir (dir)
  "Reads an item from the listing of directory DIR (reentrant)."
  (with-foreign-objects ((entry 'dirent) (result :pointer))
    (%%sys-readdir-r dir entry result)
    (if (null-pointer-p (mem-ref result :pointer))
        nil
        (with-foreign-slots ((name type fileno) entry dirent)
          (values (cstring-to-sstring name) type fileno)))))

(defsyscall (%sys-rewinddir "rewinddir") :void
  "Rewind directory DIR."
  (dirp :pointer))

(defsyscall (%sys-seekdir "seekdir") :void
  "Seek into directory DIR to position POS(as returned by TELLDIR)."
  (dirp :pointer)
  (pos  :long))

;;; FIXME: According to POSIX docs "no errors are defined" for
;;; telldir() but Linux manpages specify a possible EBADF.
(defsyscall (%sys-telldir "telldir") off-t
  "Return the current location in directory DIR."
  (dirp :pointer))



;;;-------------------------------------------------------------------------
;;; Memory mapping
;;;-------------------------------------------------------------------------

(defsyscall (%sys-mmap (#+linux "mmap64" "mmap"))
    (:pointer :handle fd)
  "Map file referenced by FD at offset OFFSET into address space of the
calling process at address ADDR and length LENGTH.
PROT describes the desired memory protection of the mapping.
FLAGS determines whether updates to the mapping are visible to other
processes mapping the same region."
  (addr   :pointer)
  (length size-t)
  (prot   :int)
  (flags  :int)
  (fd     :int)
  (offset off-t))

(defsyscall (%sys-munmap "munmap") :int
  "Unmap pages of memory starting at address ADDR with length LENGTH."
  (addr   :pointer)
  (length size-t))



;;;-------------------------------------------------------------------------
;;; Process creation and info
;;;-------------------------------------------------------------------------

(defsyscall (%sys-fork "fork") pid-t
  "Create a child process.")

(defsyscall (%sys-execv "execv") :int
  (path :string)
  (argv :pointer))

(defsyscall (%sys-execvp "execvp") :int
  (file :string)
  (argv :pointer))

(defsyscall (%sys-waitpid "waitpid") pid-t
  (pid     pid-t)
  (status  :pointer)
  (options :int))

(defsyscall (%sys-getpid "getpid") pid-t
  "Returns the process id of the current process")

(defsyscall (%sys-getppid "getppid") pid-t
  "Returns the process id of the current process's parent")

#+linux
(defentrypoint %sys-gettid ()
  (foreign-funcall "syscall" :int sys-gettid :int))

(defsyscall (%sys-getuid "getuid") uid-t
  "Get real user id of the current process.")

(defsyscall (%sys-setuid "setuid") :int
  "Set real user id of the current process to UID."
  (uid uid-t))

(defsyscall (%sys-geteuid "geteuid") uid-t
  "Get effective user id of the current process.")

(defsyscall (%sys-seteuid "seteuid") :int
  "Set effective user id of the current process to UID."
  (uid uid-t))

(defsyscall (%sys-getgid "getgid") gid-t
  "Get real group id of the current process.")

(defsyscall (%sys-setgid "setgid") :int
  "Set real group id of the current process to GID."
  (gid gid-t))

(defsyscall (%sys-getegid "getegid") gid-t
  "Get effective group id of the current process.")

(defsyscall (%sys-setegid "setegid") :int
  "Set effective group id of the current process to GID."
  (gid gid-t))

(defsyscall (%sys-setreuid "setreuid") :int
  "Set real and effective user id of the current process to RUID and EUID."
  (ruid uid-t)
  (euid uid-t))

(defsyscall (%sys-setregid "setregid") :int
  "Set real and effective group id of the current process to RGID and EGID."
  (rgid gid-t)
  (egid gid-t))

(defsyscall (%sys-getpgid "getpgid") pid-t
  "Get process group id of process PID."
  (pid pid-t))

(defsyscall (%sys-setpgid "setpgid") :int
  "Set process group id of process PID to value PGID."
  (pid  pid-t)
  (pgid pid-t))

(defsyscall (%sys-getpgrp "getpgrp") pid-t
  "Get process group id of the current process.")

(defsyscall (%sys-setpgrp "setpgrp") pid-t
  "Set process group id of the current process.")

(defsyscall (%sys-setsid "setsid") pid-t
  "Create session and set process group id of the current process.")

(defsyscall (%%sys-getrlimit (#+linux "getrlimit64" "getrlimit"))
    :int
  (resource :int)
  (rlimit   :pointer))

(defentrypoint %sys-getrlimit (resource)
  "Return soft and hard limit of system resource RESOURCE."
  (with-foreign-object (rl 'rlimit)
    (with-foreign-slots ((cur max) rl rlimit)
      (%%sys-getrlimit resource rl)
      (values cur max))))

(defsyscall (%%sys-setrlimit (#+linux "setrlimit64" "setrlimit"))
    :int
  (resource :int)
  (rlimit   :pointer))

(defentrypoint %sys-setrlimit (resource soft-limit hard-limit)
  "Set SOFT-LIMIT and HARD-LIMIT of system resource RESOURCE."
  (with-foreign-object (rl 'rlimit)
    (with-foreign-slots ((cur max) rl rlimit)
      (setf cur soft-limit
            max hard-limit)
      (%%sys-setrlimit resource rl))))

(defsyscall (%%sys-getrusage "getrusage") :int
  (who   :int)
  (usage :pointer))

;;; TODO: it might be more convenient to return a wrapper object here
;;; instead like we do in STAT.
(defentrypoint %sys-getrusage (who)
  "Return resource usage measures of WHO."
  (with-foreign-object (ru 'rusage)
    (%%sys-getrusage who ru)
    (with-foreign-slots ((maxrss ixrss idrss isrss minflt majflt nswap inblock
                          oublock msgsnd msgrcv nsignals nvcsw nivcsw)
                         ru rusage)
      (values (foreign-slot-value (foreign-slot-pointer ru 'rusage 'utime)
                                  'timeval 'sec)
              (foreign-slot-value (foreign-slot-pointer ru 'rusage 'utime)
                                  'timeval 'usec)
              (foreign-slot-value (foreign-slot-pointer ru 'rusage 'stime)
                                  'timeval 'sec)
              (foreign-slot-value (foreign-slot-pointer ru 'rusage 'stime)
                                  'timeval 'usec)
              maxrss ixrss idrss isrss minflt majflt
              nswap inblock oublock msgsnd
              msgrcv nsignals nvcsw nivcsw))))

(defsyscall (%sys-getpriority "getpriority") :int
  "Get the scheduling priority of a process, process group, or user,
as indicated by WHICH and WHO."
  (which :int)
  (who   :int))

(defsyscall (%sys-setpriority "setpriority") :int
  "Set the scheduling priority of a process, process group, or user,
as indicated by WHICH and WHO to VALUE."
  (which :int)
  (who   :int)
  (value :int))

(defentrypoint %sys-nice (&optional (increment 0))
  "Get or set process priority."
  ;; FIXME: race condition. might need WITHOUT-INTERRUPTS on some impl.s
  (setf (%sys-errno) 0)
  (let ((retval (foreign-funcall "nice" :int increment :int))
        (errno (%sys-errno)))
    (if (and (= retval -1) (/= errno 0))
        (signal-syscall-error errno)
        retval)))

(defsyscall (%sys-exit "_exit") :void
  "terminate the calling process"
  (status :int))




;;;-------------------------------------------------------------------------
;;; Signals
;;;-------------------------------------------------------------------------

(defsyscall (%sys-kill "kill") :int
  "Send signal SIG to process PID."
  (pid    pid-t)
  (signum :int))

(defsyscall (%sys-sigaction "sigaction") :int
  (signum :int)
  (act    :pointer)
  (oldact :pointer))



{'fraction_non_alphanumeric': 0.2060619722928109, 'fraction_numerical': 0.002664152799409788, 'mean_word_length': 2.490486409155937, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 3, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 8, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3936245', 'n_tokens_mistral': 16878, 'n_tokens_neox': 15956, 'n_words': 5178}