mmap.scm 1.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657
  1. (define-module (mach mmap)
  2. #:use-module (mach ffi))
  3. ;; 'prot' protection flags for mmap.
  4. (define-bitfield mmap-prot-flags
  5. (PROT_NONE #x00)
  6. (PROT_READ #x04)
  7. (PROT_WRITE #x02)
  8. (PROT_EXEC #x01))
  9. ;; Specifies the type of the object in mmap 'flags'.
  10. (define-bitfield mmap-map-flags
  11. (MAP_FILE #x0001)
  12. (MAP_TYPE #x000f)
  13. (MAP_SHARED #x0010)
  14. (MAP_PRIVATE #x0000)
  15. (MAP_FIXED #x0100)
  16. (MAP_NOEXTEND #x0200)
  17. (MAP_HASSEMAPHORE #x0400)
  18. (MAP_INHERIT #x0800)
  19. (MAP_ANON #x0002))
  20. (define-ffi ("mmap" %mmap)
  21. (ffi:pointer identity)
  22. (address ffi:pointer identity)
  23. (length ffi:unsigned-int identity) ;; XXX size_t?
  24. (protection ffi:int (unwrap-bits mmap-prot-flags))
  25. (flags ffi:int (unwrap-bits mmap-map-flags))
  26. (filedes ffi:int identity)
  27. (offset ffi:off_t identity)) ;; XXX check
  28. ;; TODO: these two procedures should perhaps
  29. ;; raise conditions instead? Preferably something
  30. ;; more specific than 'system-error ...
  31. (define (mmap address length protection flags filedes offset)
  32. "Map files or devices into memory. If address is 0, it is ignored.
  33. On success, return the pointer. On failure, return #f."
  34. (let ((ptr (%mmap address length protection flags filedes offset)))
  35. ;; Mmap returns -1 in case of error
  36. ;; XXX 64-bit
  37. (if (= (pointer-address ptr) #xffffffff)
  38. #f
  39. ptr)))
  40. (define-ffi ("munmap" %munmap) (ffi:int identity)
  41. (address ffi:pointer identity)
  42. (length ffi:unsigned-int identity))
  43. (define (munmap pointer length)
  44. "Remove the mapping starting at @var{pointer} and @var{length} long.
  45. On success, return #t. On failure, return #f. "
  46. (cond ((and (exact-integer? length) (= length 0)) #t)
  47. ((null-pointer? pointer) #f)
  48. ;; In case of success, munmap returns 0.
  49. (#t (= (%munmap pointer length)))))