(library (nmosh pffi bsd kqueue)
         (export 
           kq_create
           kevent_alloc
           kevent_dispose
           kevent_set_readevent!
           kevent_set_writeevent!
           kevent_set_enableuserevent!
           kevent_set_triggeruserevent!
           kevent_ident
           kevent_type
           kevent_exec
           kevent_decode_fd

           )
         (import (rnrs)
                 (yuni core)
                 (srfi :8)
                 (nmosh ffi box)
                 (nmosh pffi interface)
                 (nmosh pffi posix fd)
                 (prefix (nmosh stubs kqueue-stubs) stub:))

;; kevent

(define* kevent* (ptr n))

(define (kq_create) ;; => fd
  (int->fd (stub:kq_create)))

(define (kevent_alloc n)
  (let ((p (kevent_alloc n)))
    (make kevent*
          (ptr p)
          (n n))))

(define* (kevent_dispose (kevent*))
  (let-with kevent* (ptr)
    (stub:kevent_dispose ptr)))

(define* (kevent->pointer (kevent*) idx)
  (let-with kevent* (n ptr)
    (unless (< idx n)
      (assertion-violation 'kevent->pointer "invalid argument" n))
    (stub:kevent_offset ptr n)))

(define* (kevent_set_readevent! (kevent*) n (fd))
  (stub:kevent_set_readevent (kevent->pointer kevent* n)
                             (fd->int fd)))

(define* (kevent_set_writeevent! (kevent*) n (fd))
  (stub:kevent_set_writeevent (kevent->pointer kevent* n)
                             (fd->int fd)))

(define* (kevent_set_enableuserevent! (kevent*) n id)
  (stub:kevent_set_enableuserevent (kevent->pointer kevent* n)
                                   id))

(define* (kevent_set_triggeruserevent! (kevent*) n id)
  (stub:kevent_set_triggeruserevent (kevent->pointer kevent* n)
                                   id))

(define* (kevent_type (kevent*) n)
  (let ((i (stub:kevent_type (kevent->pointer kevent* n))))
    (case i
      ((0) 'USER)
      ((1) 'FILE)
      ((2) 'ERROR))))

(define* (kevent_ident (kevent*) n)
  (let ((p (kevent->pointer kevent* n)))
    (let ((x (stub:kevent_ident p))
          (t (kevent_type kevent* n)))
      (if (eq? t 'USER)
        x
        (int->fd x)))))

(define* (kevent_decode_fd (kevent*) n) ;; => read/write eof? data
  (let ((box-type (make-int-box))
        (box-eof (make-int-box))
        (box-data (make-int-box)))
    (stub:kevent_decode_fd (kevent->pointer kevent* n)
                           box-type
                           box-eof
                           box-data)
    (let ((type (int-box-ref box-type))
          (eof (int-box-ref box-eof))
          (data (int-box-ref box-data)))
      (values (if (= type 0) 'read 'write)
              (= eof 1) 
              data))))

(define null-pointer (integer->pointer 0))
(define (null-pointer? x) (= (pointer->integer x) 0))

(define* (kevent_exec (q fd) changes changeoffset changecount out outcount outoffset timeout)
  ;; FIXME: check bounds..
  (let ((changeptr (if changes (kevent->pointer changes changeoffset) null-pointer))
        (outptr (if out (kevent->pointer out outoffset) null-pointer)))
    (let ((ret (stub:kevent_exec (fd->int q)
                                 changecount
                                 changeptr
                                 outcount
                                 outptr
                                 timeout)))
      ret)))

)