;;;
;;; src/wait.lisp
;;;
;;; Constants and bindings for wait(2) and friends.
;;;

(cl:in-package :lh-linuxapi)

;; FIXME: Belongs elsewhere (types.lisp?).
(define-alien-type pid-t (signed 32))

;; We need waitpid, also not defined by sb-posix.  You'd think they
;; didn't do any of the process control stuff at all.  There's a pile
;; of stuff to go with, as well.

;; All constants and functions below verified for x86 and amd64.

;; Id types for waitid.
(defconstant p-all 0)
(defconstant p-pid 1)
(defconstant p-pgid 2)

;; Options for waitpid (some for waitid as well).
;; For waitpid.
(defconstant wnohang 1)
(defconstant wuntraced 2)

;; For waitid.
(defconstant wstopped 2)
(defconstant wexited 4)
(defconstant wcontinued 8)
(defconstant wnowait #x01000000)

;; Linux extensions.
(defconstant __wclone #x80000000)
(defconstant __wall #x40000000)
(defconstant __wnothread #x20000000)

;; Status field macros.

(declaim (inline wexitstatus))
(defun wexitstatus (status)
  (ldb (byte 8 8) status))

(declaim (inline wtermsig))
(defun wtermsig (status)
  (ldb (byte 7 0) status))

(declaim (inline wstopsig))
(defun wstopsig (status)
  (wexitstatus status))

(declaim (inline wifexited))
(defun wifexited (status)
  (zerop (wtermsig status)))

(declaim (inline wifsignaled))
(defun wifsignaled (status)
  (< 0 (ldb (byte 7 0) status) #x7f))

(declaim (inline wifstopped))
(defun wifstopped (status)
  (= (ldb (byte 8 0) status) #x7f))

(declaim (inline wifcontinued))
(defun wifcontinued (status)
  (= status #xffff))

(declaim (inline wcoredump))
(defun wcoredump (status)
  (logbitp 7 status))

;; Honestly, now might be a good time to abandon the "lightweight
;; wrapper" approach in favor of a more full-service interface.

(defun parse-wait-status (status)
  (cond
    ((wifexited status)
     `(:exited ,(wexitstatus status)))
    ((wifsignaled status)
     `(:killed ,(wtermsig status) ,(wcoredump status)))
    ((wifstopped status)
     `(:stopped ,(wstopsig status)))
    ((wifcontinued status)
     '(:continued))
    (t
     ;; By examination of the state coverage of the low 8 bits of
     ;; STATUS, we know that this is possible for status values with a
     ;; low octet of #xff that is not #xffff.
     (error "Unknown wait status #x~X" status))))

;; Per Stevens (APUE), even after receiving SIGCHLD through whatever
;; means, we still need to wait(2).  Or, in our case, waitpid(2).

;; The prototype for wait is (from the manpage):
;;
;;    pid_t wait(int *status);

(defun wait ()
  "wait(2) system call.  See linux man-page for details.  Returns
three values.  First, the return value from wait(2).  Second, the
status of the process, or zero if an error occured.  Third, the value
of errno, or 0 if no error occurred."
  (with-alien ((status int))
    (let ((pid (alien-funcall (extern-alien "wait" (function pid-t (* int)))
			      (addr status))))
      (if (= -1 pid)
	  (values -1 0 (get-errno))
	  (values pid status 0)))))

;; The prototype for waitpid is (from the manpage):
;;
;;    pid_t waitpid(pid_t pid, int *status, int options);

(defun waitpid (pid options)
  "waitpid(2) system call.  See linux man-page for details.  Returns
three values.  First, the return value from waitpid(2).  Second, the
status of the process, or zero if an error occurred or no child
process is stopped.  Third, the value of errno, or 0 if no error
occurred."
  (with-alien ((status int))
    (let ((new-pid (alien-funcall (extern-alien "waitpid"
						(function pid-t
							  pid-t (* int) int))
				  pid (addr status) options)))
      (cond
	((= -1 new-pid)
	 (values -1 0 (get-errno)))
	((zerop new-pid)
	 (values 0 0 0))
	(t
	 (values new-pid status 0))))))

;; FIXME: Add waitid(2).

;; FIXME: Once we have getrusage(2) and friends, add wait3(2) and wait4(2).

;;; EOF
