1 | ;;;-*-Mode: LISP; Package: CCL -*- |
---|
2 | ;;; |
---|
3 | ;;; Copyright (C) 2010 Clozure Associates |
---|
4 | ;;; This file is part of Clozure CL. |
---|
5 | ;;; |
---|
6 | ;;; Clozure CL is licensed under the terms of the Lisp Lesser GNU Public |
---|
7 | ;;; License , known as the LLGPL and distributed with Clozure CL as the |
---|
8 | ;;; file "LICENSE". The LLGPL consists of a preamble and the LGPL, |
---|
9 | ;;; which is distributed with Clozure CL as the file "LGPL". Where these |
---|
10 | ;;; conflict, the preamble takes precedence. |
---|
11 | ;;; |
---|
12 | ;;; Clozure CL 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 | (in-package "CCL") |
---|
18 | |
---|
19 | #+linuxarm-target |
---|
20 | (progn |
---|
21 | (defmacro with-xp-registers-and-gpr-offset ((xp register-number) |
---|
22 | (registers offset) &body body) |
---|
23 | (let* ((regform `(pref ,xp :ucontext.uc_mcontext))) |
---|
24 | `(with-macptrs ((,registers ,regform)) |
---|
25 | (let ((,offset (xp-gpr-offset ,register-number))) |
---|
26 | ,@body)))) |
---|
27 | (defun xp-gpr-offset (register-number) |
---|
28 | (unless (and (fixnump register-number) |
---|
29 | (<= -3 (the fixnum register-number)) |
---|
30 | (< (the fixnum register-number) 18)) |
---|
31 | (setq register-number (require-type register-number '(integer -3 (18))))) |
---|
32 | (the fixnum (* (the fixnum (+ register-number 3)) arm::node-size))) |
---|
33 | ) |
---|
34 | |
---|
35 | (defun xp-gpr-lisp (xp register-number) |
---|
36 | (with-xp-registers-and-gpr-offset (xp register-number) (registers offset) |
---|
37 | (values (%get-object registers offset)))) |
---|
38 | |
---|
39 | (defun (setf xp-gpr-lisp) (value xp register-number) |
---|
40 | (with-xp-registers-and-gpr-offset (xp register-number) (registers offset) |
---|
41 | (%set-object registers offset value))) |
---|
42 | |
---|
43 | (defun xp-gpr-signed-long (xp register-number) |
---|
44 | (with-xp-registers-and-gpr-offset (xp register-number) (registers offset) |
---|
45 | (values (%get-signed-long registers offset)))) |
---|
46 | |
---|
47 | |
---|
48 | (defun xp-gpr-signed-doubleword (xp register-number) |
---|
49 | (with-xp-registers-and-gpr-offset (xp register-number) (registers offset) |
---|
50 | (values (%%get-signed-longlong registers offset)))) |
---|
51 | |
---|
52 | |
---|
53 | (defun xp-gpr-macptr (xp register-number) |
---|
54 | (with-xp-registers-and-gpr-offset (xp register-number) (registers offset) |
---|
55 | (values (%get-ptr registers offset)))) |
---|
56 | |
---|
57 | (defcallback xcmain (:address xp |
---|
58 | :signed-fullword signal |
---|
59 | :signed-fullword arg |
---|
60 | :signed-fullword fnreg |
---|
61 | :signed-fullword offset) |
---|
62 | (error "xcmain callback") |
---|
63 | ) |
---|