source: branches/objc-gf/ccl/level-1/x86-callback-support.lisp @ 6088

Last change on this file since 6088 was 6088, checked in by gb, 13 years ago

Use DEFSTATIC vice DEFGLOBAL.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.3 KB
Line 
1;;;
2;;;   Copyright (C) 2005-2006 Clozure Associates and contributors
3;;;   This file is part of OpenMCL. 
4;;;
5;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
6;;;   License , known as the LLGPL and distributed with OpenMCL as the
7;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
8;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
9;;;   conflict, the preamble takes precedence. 
10;;;
11;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
12;;;
13;;;   The LLGPL is also available online at
14;;;   http://opensource.franz.com/preamble.html
15
16
17(in-package "CCL")
18
19(defstatic *callback-alloc-lock* (make-lock))
20
21;;;
22(defun %make-executable-page ()
23  (#_mmap (%null-ptr)
24          (#_getpagesize)
25          (logior #$PROT_READ #$PROT_WRITE #$PROT_EXEC)
26          (logior #$MAP_PRIVATE #$MAP_ANON)
27          -1
28          0))
29
30(defstatic *available-bytes-for-callbacks* 0)
31(defstatic *current-callback-page* nil)
32
33(defun reset-callback-storage ()
34  (setq *available-bytes-for-callbacks* (#_getpagesize)
35        *current-callback-page* (%make-executable-page)))
36
37(defun %allocate-callback-pointer (n)
38  (with-lock-grabbed (*callback-alloc-lock*)
39    (when (< *available-bytes-for-callbacks* n)
40      (reset-callback-storage))
41    (decf *available-bytes-for-callbacks* n)
42    (values (%inc-ptr *current-callback-page* *available-bytes-for-callbacks*))))
43
44
45 
46(defun make-callback-trampoline (index &optional monitor-exception-ports)
47  (declare (ignorable monitor-exception-ports))
48  (let* ((p (%allocate-callback-pointer 16))
49         (addr #.(subprim-name->offset '.SPcallback)))
50    (setf (%get-unsigned-byte p 0) #x41 ; movl $n,%r11d
51          (%get-unsigned-byte p 1) #xc7
52          (%get-unsigned-byte p 2) #xc3
53          (%get-unsigned-byte p 3) (ldb (byte 8 0) index)
54          (%get-unsigned-byte p 4) (ldb (byte 8 8) index)
55          (%get-unsigned-byte p 5) (ldb (byte 8 16) index)
56          (%get-unsigned-byte p 6) (ldb (byte 8 24) index)
57          (%get-unsigned-byte p 7) #xff  ; jmp *
58          (%get-unsigned-byte p 8) #x24
59          (%get-unsigned-byte p 9) #x25
60          (%get-unsigned-byte p 10) (ldb (byte 8 0) addr)
61          (%get-unsigned-byte p 11) (ldb (byte 8 8) addr)
62          (%get-unsigned-byte p 12) (ldb (byte 8 16) addr)
63          (%get-unsigned-byte p 13) (ldb (byte 8 24) addr))
64    p))
65         
66 
Note: See TracBrowser for help on using the repository browser.