123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657 |
- (define-module (mach mmap)
- #:use-module (mach ffi))
- ;; 'prot' protection flags for mmap.
- (define-bitfield mmap-prot-flags
- (PROT_NONE #x00)
- (PROT_READ #x04)
- (PROT_WRITE #x02)
- (PROT_EXEC #x01))
- ;; Specifies the type of the object in mmap 'flags'.
- (define-bitfield mmap-map-flags
- (MAP_FILE #x0001)
- (MAP_TYPE #x000f)
- (MAP_SHARED #x0010)
- (MAP_PRIVATE #x0000)
- (MAP_FIXED #x0100)
- (MAP_NOEXTEND #x0200)
- (MAP_HASSEMAPHORE #x0400)
- (MAP_INHERIT #x0800)
- (MAP_ANON #x0002))
- (define-ffi ("mmap" %mmap)
- (ffi:pointer identity)
- (address ffi:pointer identity)
- (length ffi:unsigned-int identity) ;; XXX size_t?
- (protection ffi:int (unwrap-bits mmap-prot-flags))
- (flags ffi:int (unwrap-bits mmap-map-flags))
- (filedes ffi:int identity)
- (offset ffi:off_t identity)) ;; XXX check
- ;; TODO: these two procedures should perhaps
- ;; raise conditions instead? Preferably something
- ;; more specific than 'system-error ...
- (define (mmap address length protection flags filedes offset)
- "Map files or devices into memory. If address is 0, it is ignored.
- On success, return the pointer. On failure, return #f."
- (let ((ptr (%mmap address length protection flags filedes offset)))
- ;; Mmap returns -1 in case of error
- ;; XXX 64-bit
- (if (= (pointer-address ptr) #xffffffff)
- #f
- ptr)))
- (define-ffi ("munmap" %munmap) (ffi:int identity)
- (address ffi:pointer identity)
- (length ffi:unsigned-int identity))
- (define (munmap pointer length)
- "Remove the mapping starting at @var{pointer} and @var{length} long.
- On success, return #t. On failure, return #f. "
- (cond ((and (exact-integer? length) (= length 0)) #t)
- ((null-pointer? pointer) #f)
- ;; In case of success, munmap returns 0.
- (#t (= (%munmap pointer length)))))
|