contrib/sb-simple-streams/unix.lisp

   1 ;;; -*- lisp -*-
   2
   3 ;;; This code is in the public domain.
   4
   5 ;;; The cmucl implementation of simple-streams was done by Paul Foley,
   6 ;;; who placed the code in the public domain.  Sbcl port by Rudi
   7 ;;; Schlatte.
   8
   9 ;;; TODO (Rudi 2003-05-12): The contents of this file, along with
  10 ;;; constants.lisp, should presumably end up somewhere else, either in
  11 ;;; sbcl itself or in sb-posix.
  12
  13 (in-package "SB-UNIX")
  14
  15
  16 (export '(prot-read prot-write prot-exec prot-none
  17           map-shared map-private map-fixed
  18           unix-mmap unix-munmap
  19           unix-mlock unix-munlock))
  20
  21
  22 (defun unix-mmap (addr length prot flags fd offset)
  23   (declare (type (or null system-area-pointer) addr)
  24            (type (unsigned-byte 32) length)
  25            (type (integer 1 7) prot)
  26            (type (unsigned-byte 32) flags)
  27            (type (or null unix-fd) fd)
  28            (type (signed-byte 32) offset))
  29   (let ((result (alien-funcall (extern-alien "mmap"
  30                                              (function system-area-pointer
  31                                                        system-area-pointer
  32                                                        size-t int int int
  33                                                        off-t))
  34                                (or addr (sb-sys:int-sap 0)) length prot flags
  35                                (or fd -1) offset)))
  36     ;; FIXME (Rudi 2003-05-12) : here, we assume that a sap is 32
  37     ;; bits.  Revisit during the 64-bit port.  #XFFFFFFFF is (void
  38     ;; *)-1, which is the charming return value of mmap on failure.
  39     (if (= (sb-sys:sap-int result) #XFFFFFFFF)
  40         (values nil (get-errno))
  41         result)))
  42
  43 (defun unix-munmap (start length)
  44   (declare (type system-area-pointer start)
  45            (type (unsigned-byte 32) length))
  46   (void-syscall ("munmap" system-area-pointer size-t) start length))
  47
  48 (defun unix-mlock (addr length)
  49   (declare (type system-area-pointer addr)
  50            (type (unsigned-byte 32) length))
  51   (void-syscall ("mlock" system-area-pointer size-t) addr length))
  52
  53 (defun unix-munlock (addr length)
  54   (declare (type system-area-pointer addr)
  55            (type (unsigned-byte 32) length))
  56   (void-syscall ("munlock" system-area-pointer size-t) addr length))
  57
  58
  59