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