source: branches/1.2/devel/source/level-1/ppc-callback-support.lisp @ 8123

Last change on this file since 8123 was 6948, checked in by gb, 12 years ago

Allocate callback trampolines via mmap on ppc, too.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.7 KB
Line 
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 monitor-exception-ports)
29  (declare (ignorable monitor-exception-ports))
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             (if monitor-exception-ports
37               #.(subprim-name->offset '.SPpoweropen-callbackX)
38               #.(subprim-name->offset '.SPpoweropen-callback)))
39           (p (%allocate-callback-pointer 12)))
40      (setf (%get-long p 0) (logior (ldb (byte 8 16) index)
41                                    (ppc-lap-word (lis 11 ??)))   ; unboxed index
42            (%get-long p 4) (logior (ldb (byte 16 0) index)
43                                    (ppc-lap-word (ori 11 11 ??)))
44                                   
45            (%get-long p 8) (logior subprim
46                                    (ppc-lap-word (ba ??))))
47      (ff-call (%kernel-import #.target::kernel-import-makedataexecutable) 
48               :address p 
49               :unsigned-fullword 12
50               :void)
51      p)))
52
53;;; In the 64-bit LinuxPPC ABI, functions are "transfer vectors":
54;;; two-word vectors that contain the entry point in the first word
55;;; and a pointer to the global variables ("table of contents", or
56;;; TOC) the function references in the second word.  We can use the
57;;; TOC word in the transfer vector to store the callback index.
58#+(and linuxppc-target poweropen-target)
59(defun make-callback-trampoline (index &optional monitor-exception-ports)
60  (declare (ignorable monitor-exception-ports))
61  (let* ((p (%allocate-callback-pointer 16)))
62    (setf (%%get-unsigned-longlong p 0) #.(subprim-name->offset '.SPpoweropen-callback)
63          (%%get-unsigned-longlong p 8) index)
64    p))
65
Note: See TracBrowser for help on using the repository browser.