;;; -*- Gerbil -*-
;;; (C) vyzo at hackzen.org
;;; OS pipes
package: std/os

(import :std/foreign
        :std/os/error
        :std/os/fd
        :std/os/fcntl)
(export pipe)

(def (pipe (direction 'inout) (closeonexec #t))
  (unless (memq direction '(in out inout none))
    (error "Invalid argument; direction must be one of in, out, inout, none"))
  (let* ((ptr (check-ptr (make_pipe_ptr)))
         (_ (check-os-error (_pipe ptr) (pipe)))
         (ifd (pipe_ptr_ref ptr 0))
         (ofd (pipe_ptr_ref ptr 1))
         (set-nonblock
          (if closeonexec
            fd-set-nonblock/closeonexec
            fd-set-nonblock)))
    (case direction
      ((in)
       (let (iraw (fdopen ifd 'in 'pipe))
         (set-nonblock iraw)
         (values iraw ofd)))
      ((out)
       (let (oraw (fdopen ofd 'out 'pipe))
         (set-nonblock oraw)
         (values ifd oraw)))
      ((inout)
       (let ((iraw (fdopen ifd 'in 'pipe))
             (oraw (fdopen ofd 'out 'pipe)))
         (set-nonblock iraw)
         (set-nonblock oraw)
         (values iraw oraw)))
      ((none)
       (values ifd ofd)))))

(begin-ffi (_pipe make_pipe_ptr pipe_ptr_ref)
  (c-declare "#include <errno.h>")
  (c-declare "#include <unistd.h>")

  (define-macro (define-with-errno symbol ffi-symbol args)
    `(define (,symbol ,@args)
       (declare (not interrupts-enabled))
       (let ((r (,ffi-symbol ,@args)))
         (if (##fx< r 0)
           (##fx- (__errno))
           r))))

  (namespace ("std/os/pipe#" __pipe __errno))

  (c-define-type pipe*
    (pointer int (pipe*) "ffi_free"))

  (define-c-lambda __errno () int
    "___return (errno);")

  (define-c-lambda __pipe (pipe*) int
    "pipe")
  (define-with-errno _pipe __pipe (pipe-ptr))

  (define-c-lambda make_pipe_ptr () pipe*
    "___return ((int*)malloc (2 * sizeof (int)));")
  (define-c-lambda pipe_ptr_ref (pipe* int) int
    "___return (___arg1[___arg2]);"))
