From 1cfc26ca0a3e3dd2da73e1b794ed126f9ccad9f2 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Sat, 7 Apr 2007 15:05:52 +0000 Subject: [PATCH] Use unix-mmap from unix.lisp because mmap can return "negative" values, which means we can't use syscall. Issue noted by Madhu, cmucl-imp, 2007-04. This appears to have been lost during the Great CVS Corruption. --- code/unix-glibc2.lisp | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/code/unix-glibc2.lisp b/code/unix-glibc2.lisp index 2a9ef10c9..e0af64cc4 100644 --- a/code/unix-glibc2.lisp +++ b/code/unix-glibc2.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix-glibc2.lisp,v 1.36 2005/10/10 20:31:13 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix-glibc2.lisp,v 1.37 2007/04/07 15:05:52 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -245,16 +245,26 @@ (defconstant ms_sync 4) (defconstant ms_invalidate 2) +;; The return value from mmap that means mmap failed. +(defconstant map_failed -1) + (defun unix-mmap (addr length prot flags fd offset) (declare (type (or null system-area-pointer) addr) (type (unsigned-byte 32) length) (type (integer 1 7) prot) (type (unsigned-byte 32) flags) (type (or null unix-fd) fd) - (type (signed-byte 32) offset)) - (syscall ("mmap" system-area-pointer size-t int int int off-t) - (sys:int-sap result) - (or addr +null+) length prot flags (or fd -1) offset)) + (type file-offset offset)) + ;; Can't use syscall, because the address that is returned could be + ;; "negative". Hence we explicitly check for mmap returning + ;; MAP_FAILED. + (let ((result + (alien-funcall (extern-alien "mmap" (function int system-area-pointer + size-t int int int off-t)) + (or addr +null+) length prot flags (or fd -1) offset))) + (if (= result map_failed) + (values nil (unix-errno)) + (sys:int-sap result)))) (defun unix-munmap (addr length) (declare (type system-area-pointer addr) -- GitLab