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

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

arm-asm.lisp: had cs and cc condition names backwards. (not used very
often, I guess.) umull and umulls had the wrong opcode.

arm-bignum.lisp: %ADD-WITH-CARRY needs to use adcs to propagate carry out.
Define %SUBTRACT-WITH-BORROW, fix %NORMALIZE-BIGNUM-2.

arm-float: implement, fix some things.

arm-numbers: steal %FIXNUM-GCD from Wikipedia.

l0-array.lisp: *IMMHEADER-ARRAY-TYPES*, *NODEHEADER-ARRAY-TYPES* for ARM.

arm-trap-support.lisp: started.

ffi-linuxarm.lisp: more plausible callback support.

ARM stuff for MACHINE-TYPE, HEAP-UTILIZATION.

arm-exceptions.c: callback glue functions return Boolean.

arm-exceptions.h: typos in opcode test macros.

arm-spentry.s: .SPeabi_callback.

File size: 2.4 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)
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  )
Note: See TracBrowser for help on using the repository browser.