diff --git a/code/alieneval.lisp b/code/alieneval.lisp index 485d36d0998a1313bb519c5354dca04f53c89437..66b274616baa60aa9f5a938189039910ac390dd6 100644 --- a/code/alieneval.lisp +++ b/code/alieneval.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/alieneval.lisp,v 1.64 2005/11/11 22:30:38 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alieneval.lisp,v 1.65 2007/11/09 19:24:35 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2218,6 +2218,17 @@ type and arg types, so we can detect incompatible redefinitions." (extern-alien "malloc" (function system-area-pointer unsigned)) length)) (fill-pointer code)) + ;; Make sure the malloc'ed area is executable. + (let* ((page-size (get-page-size)) + ;; mprotect wants address on a page boundary, so round down + ;; the address and round up the length + (code-base (sys:int-sap (* page-size + (floor (sys:sap-int code) page-size)))) + (len (* page-size (ceiling length page-size)))) + (unless (unix::unix-mprotect code-base len + (logior unix:prot_exec unix:prot_read unix:prot_write)) + (warn "Unable to mprotect ~S bytes (~S) at ~S (~S). Callbacks may not work." + len length code-base code))) (new-assem:segment-map-output segment (lambda (sap length) (kernel:system-area-copy sap 0 fill-pointer 0 diff --git a/code/exports.lisp b/code/exports.lisp index 6c6e73dca503bb07c2d5eac98bfda58f381c38ce..6bec4299fdc924057e9e7b5f3395c081dd2acc54 100644 --- a/code/exports.lisp +++ b/code/exports.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/exports.lisp,v 1.262 2007/11/05 15:25:03 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.263 2007/11/09 19:24:36 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -211,7 +211,7 @@ "PROT_READ" "PROT_WRITE" "PROT_EXEC" "PROT_NONE" "MAP_SHARED" "MAP_PRIVATE" "MAP_FIXED" "MAP_ANONYMOUS" "MS_ASYNC" "MS_SYNC" "MS_INVALIDATE" - "UNIX-MMAP" "UNIX-MUNMAP" "UNIX-MSYNC" + "UNIX-MMAP" "UNIX-MUNMAP" "UNIX-MSYNC" "UNIX-MPROTECT" "KBDCGET" "KBDCRESET" "KBDCRST" "KBDCSET" "KBDCSSTD" "KBDGCLICK" "KBDSCLICK" "KBDSGET" "L_INCR" "L_SET" "L_XTND" "OFF-T" "O_APPEND" "O_CREAT" "O_EXCL" "O_RDONLY" "O_RDWR" diff --git a/code/unix-glibc2.lisp b/code/unix-glibc2.lisp index 039e21e8699eb79809542f591dd47b40a0df5501..539ca9b85ddc78f2329c9e4067a2a8a86e16e5d6 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.40 2007/11/06 07:16:05 cshapiro Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix-glibc2.lisp,v 1.41 2007/11/09 19:24:36 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -81,7 +81,7 @@ prot_read prot_write prot_exec prot_none map_shared map_private map_fixed map_anonymous ms_async ms_sync ms_invalidate - unix-mmap unix-munmap unix-msync + unix-mmap unix-munmap unix-msync unix-mprotect unix-pathname unix-file-mode unix-fd unix-pid unix-uid unix-gid unix-setitimer unix-getitimer unix-access r_ok w_ok x_ok f_ok unix-chdir unix-chmod setuidexec @@ -278,6 +278,13 @@ (type (signed-byte 32) flags)) (syscall ("msync" system-area-pointer size-t int) t addr length flags)) +(defun unix-mprotect (addr length prot) + (declare (type system-area-pointer addr) + (type (unsigned-byte 32) length) + (type (integer 1 7) prot)) + (syscall ("mprotect" system-area-pointer size-t int) + t addr length prot)) + ;;;; Lisp types used by syscalls. (deftype unix-pathname () 'simple-string) diff --git a/code/unix.lisp b/code/unix.lisp index c53b11bafc248423d5acf9c1c9c0869cc0fccd03..42a8225a5288abacf950bcfe022452f63a0bb3c3 100644 --- a/code/unix.lisp +++ b/code/unix.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.lisp,v 1.115 2007/11/06 07:16:05 cshapiro Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix.lisp,v 1.116 2007/11/09 19:24:36 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -39,6 +39,7 @@ map_shared map_private map_fixed map_anonymous ms_async ms_sync ms_invalidate unix-mmap unix-munmap unix-msync + unix-mprotect unix-pathname unix-file-mode unix-fd unix-pid unix-uid unix-gid unix-setitimer unix-getitimer @@ -1082,6 +1083,13 @@ (type (unsigned-byte 32) length)) (syscall ("munmap" system-area-pointer size-t) t addr length)) +(defun unix-mprotect (addr length prot) + (declare (type system-area-pointer addr) + (type (unsigned-byte 32) length) + (type (integer 1 7) prot)) + (syscall ("mprotect" system-area-pointer size-t int) + t addr length prot)) + (defun unix-setuid (uid) "Set the user ID of the calling process to UID. If the calling process is the super-user, set the real diff --git a/general-info/release-19e.txt b/general-info/release-19e.txt index 3d5c02c90758c19448ba9ba2a7333edcfdf016d5..7c6179d99661c346982efee47184c5a9e89e6774 100644 --- a/general-info/release-19e.txt +++ b/general-info/release-19e.txt @@ -43,6 +43,7 @@ New in this release: - Preliminary support for external formats. Currently only iso8859-1 and utf-8 are supported. Utf-8 support is limited since CMUCL only has 8-bit characters. + - UNIX-MPROTECT added to access mprotect. * ANSI compliance fixes: - BOA constructors with &AUX variables are handled better now. @@ -131,6 +132,8 @@ New in this release: labels/flet functions. Untracing should work. Redefining a function should automatically retrace the local functions if they were traced previously. + - Callbacks should now work on systems where malloc'ed space does + not normally allow execution of code. * Trac Tickets: - #8 fixed so logs of bignums and ratios that won't fit into a