1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253 |
- (define-module (mach port-creation)
- #:use-module (mach ffi)
- #:use-module (mach types)
- #:use-module (mach port-right)
- #:use-module (mach task)
- #:export (port-allocate-name reply-port port-allocate))
- ;;
- ;; This file contains functions to deal with port creation.
- ;;
- (define-ffi ("mach_port_allocate" %mach-port-allocate)
- (err identity) ; ???
- (task ffi:ipc-space %unwrap-ipc-space)
- (right-type ffi:port-right-type %unwrap-port-right-type)
- ;; IIUC, this is were the actual reply port is written.
- (reply-port-box ffi:pointer identity))
- ;; XXX I don't understand what this does exactly.
- (define* (port-allocate right-type #:optional (task (task-self)))
- ;; XXX mention RIGHT-TYPE, and explain what TASK!=(task-self)
- ;; implies.
- "Creates a new right in the specified task."
- ;; The initial value of the foreign box does not matter.
- (let* ((port-box (make-c-struct '(*) %null-pointer))
- (return-code
- (%mach-port-allocate task right-type port-box)))
- ;; XXX what is select-error?
- (select-error return-code (dereference-pointer port-box))))
- (define-ffi ("mach_reply_port" %mach-reply-port)
- (port %wrap-mach-port))
- (define (reply-port)
- "Creates a reply port in the calling task."
- (%mach-reply-port))
- (define-ffi ("mach_port_allocate_name" %mach-port-allocate-name)
- (err identity)
- (task ffi:ipc-space %unwrap-ipc-space)
- (right-type ffi:port-right-type %unwrap-port-right-type)
- ;; XXX a port name is a port itself?
- (name ffi:mach-port %unwrap-mach-port))
- (define* (port-allocate-name right-type port-name #:optional (task (task-self)))
- ;; XXX and what on failure?
- ;; XXX what are port names?
- "Creates a new right in the specified task, with a specified name for the new right. name must not already be in use for some right, and it can't be the reserved values nil or :dead. On success the port-name is returned."
- (let ((return-code
- (%mach-port-allocate-name task right-type port-name)))
- (select-error return-code port-name)))
|