1 ;;; This file contains the ARM specific runtime stuff.
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
))
11 "Return a string describing the type of the local machine."
14 ;;;; FIXUP-CODE-OBJECT
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
))
21 (let ((sap (%primitive sb
!kernel
::code-instructions code
)))
24 (setf (sap-ref-32 sap offset
) fixup
))))))
26 ;;;; "Sigcontext" access functions, cut & pasted from sparc-vm.lisp,
27 ;;;; then modified for ARM.
29 ;;;; See also x86-vm for commentary on signed vs unsigned.
31 (define-alien-routine ("os_context_register_addr" context-register-addr
)
33 (context (* os-context-t
))
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
)))
42 (defun %set-context-register
(context index new
)
43 (declare (type (alien (* os-context-t
)) context
))
44 (setf (deref (context-register-addr context index
))
47 (defun context-pc (context)
48 (int-sap (context-register context pc-offset
)))
50 ;;;; INTERNAL-ERROR-ARGS.
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
)
64 (error-number (sb!c
:read-var-integer vector index
)))
65 (collect ((sc-offsets))
67 (when (>= index length
)
69 (sc-offsets (sb!c
:read-var-integer vector index
)))
70 (values error-number
(sc-offsets))))))