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

Last change on this file was 16685, checked in by rme, 4 years ago

Update copyright/license headers in files.

File size: 1.7 KB
Line 
1;;;-*-Mode: LISP; Package: CCL -*-
2;;;
3;;; Copyright 2010 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(in-package "CCL")
18
19(defun make-callback-trampoline (index &optional info)
20  (declare (ignore info))
21  (let* ((p (%allocate-callback-pointer 16)))
22    (macrolet ((arm-lap-word (instruction-form)
23                 (uvref (uvref (compile nil `(lambda (&lap 0) (arm-lap-function () ((?? 0)) ,instruction-form))) 1) 0)))
24      (setf (%get-unsigned-long p 0)
25            (dpb (ldb (byte 8 0) index)
26                 (byte 8 0)
27                 (arm-lap-word (mov r12 (:$ ??))))
28            (%get-unsigned-long p 4)
29            (dpb (ldb (byte 8 8) index)
30                 (byte 8 0)
31                 (dpb 12 (byte 4 8)
32                      (arm-lap-word (orr r12 r12  (:$ ??)))))
33            (%get-unsigned-long p 8)
34            (arm-lap-word (ldr pc (:@ pc (:$ -4))))
35            (%get-unsigned-long p 12)
36            (%lookup-subprim-address #.(subprim-name->offset '.SPeabi-callback)))
37      (ff-call (%kernel-import #.arm::kernel-import-makedataexecutable) 
38               :address p 
39               :unsigned-fullword 16
40               :void)
41      p)))
42                   
Note: See TracBrowser for help on using the repository browser.