src/code/arm-vm.lisp

   1 ;;; This file contains the ARM specific runtime stuff.
   2 ;;;
   3 (in-package "SB!VM")
   4
   5 ;;; See x86-vm.lisp for a description of this.
   6 ;;; FIXME: Why is this present in every ARCH-vm.lisp with the the same definition. Is there something like common-vm?
   7 (define-alien-type os-context-t (struct os-context-t-struct))
   8 \f
   9 (defun machine-type ()
  10   #!+sb-doc
  11   "Return a string describing the type of the local machine."
  12   "ARM")
  13 \f
  14 ;;;; FIXUP-CODE-OBJECT
  15
  16 (defun fixup-code-object (code offset fixup kind)
  17   (declare (type index offset))
  18   (unless (zerop (rem offset n-word-bytes))
  19     (error "Unaligned instruction?  offset=#x~X." offset))
  20   (sb!sys:without-gcing
  21    (let ((sap (%primitive sb!kernel::code-instructions code)))
  22      (ecase kind
  23        (:absolute
  24         (setf (sap-ref-32 sap offset) fixup))))))
  25 \f
  26 ;;;; "Sigcontext" access functions, cut & pasted from sparc-vm.lisp,
  27 ;;;; then modified for ARM.
  28 ;;;;
  29 ;;;; See also x86-vm for commentary on signed vs unsigned.
  30
  31 (define-alien-routine ("os_context_register_addr" context-register-addr)
  32   (* unsigned-int)
  33   (context (* os-context-t))
  34   (index int))
  35
  36 ;;; FIXME: Should this and CONTEXT-PC be INLINE to reduce consing?
  37 ;;; (Are they used in anything time-critical, or just the debugger?)
  38 (defun context-register (context index)
  39   (declare (type (alien (* os-context-t)) context))
  40   (deref (context-register-addr context index)))
  41
  42 (defun %set-context-register (context index new)
  43   (declare (type (alien (* os-context-t)) context))
  44   (setf (deref (context-register-addr context index))
  45         new))
  46
  47 (defun context-pc (context)
  48   (int-sap (context-register context pc-offset)))
  49 \f
  50 ;;;; INTERNAL-ERROR-ARGS.
  51
  52 ;;; Given a (POSIX) signal context, extract the internal error
  53 ;;; arguments from the instruction stream.
  54 (defun internal-error-args (context)
  55   (declare (type (alien (* os-context-t)) context))
  56   (let* ((pc (context-pc context))
  57          (length (sap-ref-8 pc 5)) ;; Skip trap instruction and kind byte
  58          (vector (make-array length :element-type '(unsigned-byte 8))))
  59     (declare (type system-area-pointer pc)
  60              (type (unsigned-byte 8) length)
  61              (type (simple-array (unsigned-byte 8) (*)) vector))
  62     (copy-ub8-from-system-area pc 6 vector 0 length)
  63     (let* ((index 0)
  64            (error-number (sb!c:read-var-integer vector index)))
  65       (collect ((sc-offsets))
  66                (loop
  67                 (when (>= index length)
  68                   (return))
  69                 (sc-offsets (sb!c:read-var-integer vector index)))
  70                (values error-number (sc-offsets))))))