source: branches/arm/level-1/arm-trap-support.lisp @ 13922

Last change on this file since 13922 was 13922, checked in by gb, 9 years ago

More files from last commit.

arm-callback-support.lisp, arm-error-signal.lisp,
arm-trap-support.lisp,l1-boot-3.lisp: try to get basic stuff working
well enough to enable callbacks. Enable callbacks.

arm-backtrace.lisp: a little bit of platform-specific code and some
code from the PPC port, so that backtrace sort of works.

File size: 2.8 KB
Line 
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(defconstant xp-cpsr-regno 16)
34)
35
36(defun xp-gpr-lisp (xp register-number)
37  (with-xp-registers-and-gpr-offset (xp register-number) (registers offset)
38    (values (%get-object registers offset))))
39
40(defun (setf xp-gpr-lisp) (value xp register-number)
41  (with-xp-registers-and-gpr-offset (xp register-number) (registers offset)
42    (%set-object registers offset value)))
43
44(defun xp-gpr-signed-long (xp register-number)
45  (with-xp-registers-and-gpr-offset (xp register-number) (registers offset)
46    (values (%get-signed-long registers offset))))
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  (cond ((eql signal 0) (cmain))
63        ((or (eql signal #$SIGBUS)
64             (eql signal #$SIGSEGV))
65         (%error (make-condition 'invalid-memory-access
66                                 :address arg
67                                 :write-p (eql signal #$SIGBUS))
68                 ()
69                 (%get-frame-ptr)))
70        (t
71         (error "cmain callback: signal = ~d, arg = #x~x, fnreg = ~d, offset = ~d"
72                signal arg fnreg offset))))
Note: See TracBrowser for help on using the repository browser.