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 ;;; TODO (Rudi 2003-05-12): Check whether this bug exists in sbcl, fix
  17 ;;; it if yes, and take care not to break platforms where the offset
  18 ;;; is not a 32-bit signed integer.
  19
  20 ;; Fix bug that claims offset is unsigned, so seeking backwards works!
  21 (defun unix-lseek (fd offset whence)
  22   "Unix-lseek accepts a file descriptor and moves the file pointer ahead
  23    a certain offset for that file.  Whence can be any of the following:
  24
  25    l_set        Set the file pointer.
  26    l_incr       Increment the file pointer.
  27    l_xtnd       Extend the file size.
  28   "
  29   (declare (type unix-fd fd)
  30            (type (signed-byte 32) offset)
  31            (type (integer 0 2) whence))
  32   (int-syscall ("lseek" int off-t int) fd offset whence))
  33
  34 (export '(prot-read prot-write prot-exec prot-none
  35           map-shared map-private map-fixed
  36           unix-mmap unix-munmap
  37           unix-mlock unix-munlock))
  38
  39
  40 (defun unix-mmap (addr length prot flags fd offset)
  41   (declare (type (or null system-area-pointer) addr)
  42            (type (unsigned-byte 32) length)
  43            (type (integer 1 7) prot)
  44            (type (unsigned-byte 32) flags)
  45            (type (or null unix-fd) fd)
  46            (type (signed-byte 32) offset))
  47   (let ((result (alien-funcall (extern-alien "mmap"
  48                                              (function system-area-pointer
  49                                                        system-area-pointer
  50                                                        size-t int int int
  51                                                        off-t))
  52                                (or addr (sb-sys:int-sap 0)) length prot flags
  53                                (or fd -1) offset)))
  54     ;; FIXME (Rudi 2003-05-12) : here, we assume that a sap is 32
  55     ;; bits.  Revisit during the 64-bit port.  #XFFFFFFFF is (void
  56     ;; *)-1, which is the charming return value of mmap on failure.
  57     (if (= (sb-sys:sap-int result) #XFFFFFFFF)
  58         (values nil (get-errno))
  59         result)))
  60
  61 (defun unix-munmap (start length)
  62   (declare (type system-area-pointer start)
  63            (type (unsigned-byte 32) length))
  64   (void-syscall ("munmap" system-area-pointer size-t) start length))
  65
  66 (defun unix-mlock (addr length)
  67   (declare (type system-area-pointer addr)
  68            (type (unsigned-byte 32) length))
  69   (void-syscall ("mlock" system-area-pointer size-t) addr length))
  70
  71 (defun unix-munlock (addr length)
  72   (declare (type system-area-pointer addr)
  73            (type (unsigned-byte 32) length))
  74   (void-syscall ("munlock" system-area-pointer size-t) addr length))
  75
  76
  77