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

;;;-*-Mode: LISP; Package: CCL -*-
;;;
;;;   Copyright (C) 2010 Clozure Associates
;;;   This file is part of Clozure CL.  
;;;
;;;   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
;;;   License , known as the LLGPL and distributed with Clozure CL as the
;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
;;;   which is distributed with Clozure CL as the file "LGPL".  Where these
;;;   conflict, the preamble takes precedence.  
;;;
;;;   Clozure CL is referenced in the preamble as the "LIBRARY."
;;;
;;;   The LLGPL is also available online at
;;;   http://opensource.franz.com/preamble.html

(in-package "CCL")

#+linuxarm-target
(progn
(defmacro with-xp-registers-and-gpr-offset ((xp register-number)
                                            (registers offset) &body body)
  (let* ((regform `(pref ,xp :ucontext.uc_mcontext)))
    `(with-macptrs ((,registers ,regform))
      (let ((,offset (xp-gpr-offset ,register-number)))
        ,@body))))
(defun xp-gpr-offset (register-number)
  (unless (and (fixnump register-number)
               (<= -3 (the fixnum register-number))
               (< (the fixnum register-number) 18))
    (setq register-number (require-type register-number '(integer -3 (18)))))
  (the fixnum (* (the fixnum (+ register-number 3)) arm::node-size)))
)

(defun xp-gpr-lisp (xp register-number)
  (with-xp-registers-and-gpr-offset (xp register-number) (registers offset)
    (values (%get-object registers offset))))

(defun (setf xp-gpr-lisp) (value xp register-number)
  (with-xp-registers-and-gpr-offset (xp register-number) (registers offset)
    (%set-object registers offset value)))

(defun xp-gpr-signed-long (xp register-number)
  (with-xp-registers-and-gpr-offset (xp register-number) (registers offset)
    (values (%get-signed-long registers offset))))


(defun xp-gpr-signed-doubleword (xp register-number)
  (with-xp-registers-and-gpr-offset (xp register-number) (registers offset)
    (values (%%get-signed-longlong registers offset))))
  

(defun xp-gpr-macptr (xp register-number)
  (with-xp-registers-and-gpr-offset (xp register-number) (registers offset)
    (values (%get-ptr registers offset))))

(defcallback xcmain (:address xp
                     :signed-fullword signal
                     :signed-fullword arg
                     :signed-fullword fnreg
                     :signed-fullword offset)
  (error "xcmain callback")
  )