source: trunk/source/level-1/x86-callback-support.lisp @ 11228

Last change on this file since 11228 was 11228, checked in by gb, 11 years ago

Set high byte of index to low byte of discard word count, not high byte ...

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.5 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
20#+x8664-target 
21(defun make-callback-trampoline (index &optional discard-stack-bytes)
22  (declare (ignore discard-stack-bytes))
23  (let* ((p (%allocate-callback-pointer 16))
24         (addr #.(subprim-name->offset '.SPcallback)))
25    (setf (%get-unsigned-byte p 0) #x41 ; movl $n,%r11d
26          (%get-unsigned-byte p 1) #xc7
27          (%get-unsigned-byte p 2) #xc3
28          (%get-unsigned-byte p 3) (ldb (byte 8 0) index)
29          (%get-unsigned-byte p 4) (ldb (byte 8 8) index)
30          (%get-unsigned-byte p 5) (ldb (byte 8 16) index)
31          (%get-unsigned-byte p 6) (ldb (byte 8 24) index)
32          (%get-unsigned-byte p 7) #xff  ; jmp *
33          (%get-unsigned-byte p 8) #x24
34          (%get-unsigned-byte p 9) #x25
35          (%get-unsigned-byte p 10) (ldb (byte 8 0) addr)
36          (%get-unsigned-byte p 11) (ldb (byte 8 8) addr)
37          (%get-unsigned-byte p 12) (ldb (byte 8 16) addr)
38          (%get-unsigned-byte p 13) (ldb (byte 8 24) addr))
39    p))
40         
41#+x8632-target         
42(defun make-callback-trampoline (index &optional (discard-stack-bytes 0))
43  (let* ((p (%allocate-callback-pointer 12))
44         (addr #.(subprim-name->offset '.SPcallback)))
45    (setf (%get-unsigned-byte p 0) #xb8 ; movl $n,%eax
46          (%get-unsigned-byte p 1) (ldb (byte 8 0) index)
47          (%get-unsigned-byte p 2) (ldb (byte 8 8) index)
48          (%get-unsigned-byte p 3) (ldb (byte 8 16) index)
49          (%get-unsigned-byte p 4) (ldb (byte 8 0) (ash (or discard-stack-bytes 0) (- x8632::word-shift)))
50          (%get-unsigned-byte p 5) #xff  ; jmp *
51          (%get-unsigned-byte p 6) #x24
52          (%get-unsigned-byte p 7) #x25
53          (%get-unsigned-byte p 8) (ldb (byte 8 0) addr)
54          (%get-unsigned-byte p 9) (ldb (byte 8 8) addr)
55          (%get-unsigned-byte p 10) (ldb (byte 8 16) addr)
56          (%get-unsigned-byte p 11) (ldb (byte 8 24) addr))
57    p))
58 
Note: See TracBrowser for help on using the repository browser.