source: trunk/source/level-1/ppc-callback-support.lisp @ 13636

Last change on this file since 13636 was 13067, checked in by rme, 10 years ago

Update copyright notices.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.6 KB
Line 
1;;;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 2009 Clozure Associates
4;;;   Copyright (C) 1994-2001 Digitool, Inc
5;;;   This file is part of Clozure CL. 
6;;;
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
9;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
10;;;   which is distributed with Clozure CL as the file "LGPL".  Where these
11;;;   conflict, the preamble takes precedence. 
12;;;
13;;;   Clozure CL is referenced in the preamble as the "LIBRARY."
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
22(in-package "CCL")
23
24
25
26;;; This is machine-dependent (it conses up a piece of "trampoline" code
27;;; which calls a subprim in the lisp kernel.)
28#-(and linuxppc-target poweropen-target)
29(defun make-callback-trampoline (index &optional info)
30  (declare (ignorable info))
31  (macrolet ((ppc-lap-word (instruction-form)
32               (uvref (uvref (compile nil `(lambda (&lap 0) (ppc-lap-function () ((?? 0)) ,instruction-form))) 0) #+ppc32-host 0 #+ppc64-host 1)))
33    (let* ((subprim
34            #+eabi-target
35             #.(subprim-name->offset '.SPeabi-callback)
36             #-eabi-target
37             #.(subprim-name->offset '.SPpoweropen-callback))
38           (p (%allocate-callback-pointer 12)))
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 ??))))
46      (ff-call (%kernel-import #.target::kernel-import-makedataexecutable) 
47               :address p 
48               :unsigned-fullword 12
49               :void)
50      p)))
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.
57#+(and linuxppc-target poweropen-target)
58(defun make-callback-trampoline (index &optional info)
59  (declare (ignorable info))
60  (let* ((p (%allocate-callback-pointer 16)))
61    (setf (%%get-unsigned-longlong p 0) #.(subprim-name->offset '.SPpoweropen-callback)
62          (%%get-unsigned-longlong p 8) index)
63    p))
64
Note: See TracBrowser for help on using the repository browser.