1 | ;;;-*- Mode: Lisp; Package: CCL -*- |
---|
2 | ;;; |
---|
3 | ;;; Copyright (C) 1994-2001 Digitool, Inc |
---|
4 | ;;; This file is part of OpenMCL. |
---|
5 | ;;; |
---|
6 | ;;; OpenMCL is licensed under the terms of the Lisp Lesser GNU Public |
---|
7 | ;;; License , known as the LLGPL and distributed with OpenMCL as the |
---|
8 | ;;; file "LICENSE". The LLGPL consists of a preamble and the LGPL, |
---|
9 | ;;; which is distributed with OpenMCL as the file "LGPL". Where these |
---|
10 | ;;; conflict, the preamble takes precedence. |
---|
11 | ;;; |
---|
12 | ;;; OpenMCL is referenced in the preamble as the "LIBRARY." |
---|
13 | ;;; |
---|
14 | ;;; The LLGPL is also available online at |
---|
15 | ;;; http://opensource.franz.com/preamble.html |
---|
16 | |
---|
17 | ;;; ppc-callback-support.lisp |
---|
18 | ;;; |
---|
19 | ;;; Support for PPC callbacks |
---|
20 | |
---|
21 | (in-package "CCL") |
---|
22 | |
---|
23 | |
---|
24 | |
---|
25 | ;;; This is machine-dependent (it conses up a piece of "trampoline" code |
---|
26 | ;;; which calls a subprim in the lisp kernel.) |
---|
27 | #-(and linuxppc-target poweropen-target) |
---|
28 | (defun make-callback-trampoline (index &optional info) |
---|
29 | (declare (ignorable info)) |
---|
30 | (macrolet ((ppc-lap-word (instruction-form) |
---|
31 | (uvref (uvref (compile nil `(lambda (&lap 0) (ppc-lap-function () ((?? 0)) ,instruction-form))) 0) #+ppc32-host 0 #+ppc64-host 1))) |
---|
32 | (let* ((subprim |
---|
33 | #+eabi-target |
---|
34 | #.(subprim-name->offset '.SPeabi-callback) |
---|
35 | #-eabi-target |
---|
36 | #.(subprim-name->offset '.SPpoweropen-callback)) |
---|
37 | (p (%allocate-callback-pointer 12))) |
---|
38 | (setf (%get-long p 0) (logior (ldb (byte 8 16) index) |
---|
39 | (ppc-lap-word (lis 11 ??))) ; unboxed index |
---|
40 | (%get-long p 4) (logior (ldb (byte 16 0) index) |
---|
41 | (ppc-lap-word (ori 11 11 ??))) |
---|
42 | |
---|
43 | (%get-long p 8) (logior subprim |
---|
44 | (ppc-lap-word (ba ??)))) |
---|
45 | (ff-call (%kernel-import #.target::kernel-import-makedataexecutable) |
---|
46 | :address p |
---|
47 | :unsigned-fullword 12 |
---|
48 | :void) |
---|
49 | p))) |
---|
50 | |
---|
51 | ;;; In the 64-bit LinuxPPC ABI, functions are "transfer vectors": |
---|
52 | ;;; two-word vectors that contain the entry point in the first word |
---|
53 | ;;; and a pointer to the global variables ("table of contents", or |
---|
54 | ;;; TOC) the function references in the second word. We can use the |
---|
55 | ;;; TOC word in the transfer vector to store the callback index. |
---|
56 | #+(and linuxppc-target poweropen-target) |
---|
57 | (defun make-callback-trampoline (index &optional info) |
---|
58 | (declare (ignorable info)) |
---|
59 | (let* ((p (%allocate-callback-pointer 16))) |
---|
60 | (setf (%%get-unsigned-longlong p 0) #.(subprim-name->offset '.SPpoweropen-callback) |
---|
61 | (%%get-unsigned-longlong p 8) index) |
---|
62 | p)) |
---|
63 | |
---|