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-float-register (context index format
)
48 (declare (ignorable context index
))
49 (warn "stub CONTEXT-FLOAT-REGISTER")
52 (defun %set-context-float-register
(context index format new-value
)
53 (declare (ignore context index
))
54 (warn "stub %SET-CONTEXT-FLOAT-REGISTER")
55 (coerce new-value format
))
57 (defun context-pc (context)
58 (int-sap (context-register context pc-offset
)))
60 ;;;; INTERNAL-ERROR-ARGS.
62 ;;; Given a (POSIX) signal context, extract the internal error
63 ;;; arguments from the instruction stream.
64 (defun internal-error-args (context)
65 (declare (type (alien (* os-context-t
)) context
))
66 (let* ((pc (context-pc context
))
67 (length (sap-ref-8 pc
5)) ;; Skip trap instruction and kind byte
68 (vector (make-array length
:element-type
'(unsigned-byte 8))))
69 (declare (type system-area-pointer pc
)
70 (type (unsigned-byte 8) length
)
71 (type (simple-array (unsigned-byte 8) (*)) vector
))
72 (copy-ub8-from-system-area pc
6 vector
0 length
)
74 (error-number (sb!c
:read-var-integer vector index
)))
75 (collect ((sc-offsets))
77 (when (>= index length
)
79 (sc-offsets (sb!c
:read-var-integer vector index
)))
80 (values error-number
(sc-offsets))))))