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

Last change on this file was 16782, checked in by rme, 3 years ago

Undo r16779.

  • 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 1994-2009 Clozure Associates
4;;;
5;;; Licensed under the Apache License, Version 2.0 (the "License");
6;;; you may not use this file except in compliance with the License.
7;;; You may obtain a copy of the License at
8;;;
9;;;     http://www.apache.org/licenses/LICENSE-2.0
10;;;
11;;; Unless required by applicable law or agreed to in writing, software
12;;; distributed under the License is distributed on an "AS IS" BASIS,
13;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
14;;; See the License for the specific language governing permissions and
15;;; limitations under the License.
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
Note: See TracBrowser for help on using the repository browser.