1 ;;; This file contains the MIPS specific runtime stuff.
6 (define-alien-type os-context-t
(struct os-context-t-struct
))
7 (define-alien-type os-context-register-t unsigned-long-long
)
12 (defun machine-type ()
13 "Returns a string describing the type of the local machine."
16 ;;;; FIXUP-CODE-OBJECT
18 (defun fixup-code-object (code offset value kind
)
19 (declare (type index offset
))
20 (unless (zerop (rem offset n-word-bytes
))
21 (error "Unaligned instruction? offset=#x~X." offset
))
23 (let ((sap (%primitive sb
!c
::code-instructions code
)))
26 (setf (sap-ref-32 sap offset
) fixup
))
28 (aver (zerop (ash value -
28)))
29 (setf (ldb (byte 26 0) (sap-ref-32 sap offset
))
32 (setf (ldb (byte 16 0) (sap-ref-32 sap offset
))
33 (ash (1+ (ash value -
15)) -
1)))
35 (setf (ldb (byte 16 0) (sap-ref-32 sap offset
))
36 (ldb (byte 16 0) value
)))))))
39 (define-alien-routine ("os_context_pc_addr" context-pc-addr
)
40 (* os-context-register-t
)
41 (context (* os-context-t
) :in
))
43 (defun context-pc (context)
44 (declare (type (alien (* os-context-t
)) context
))
45 (int-sap (deref (context-pc-addr context
))))
47 (define-alien-routine ("os_context_register_addr" context-register-addr
)
48 (* os-context-register-t
)
49 (context (* os-context-t
) :in
)
52 (define-alien-routine ("os_context_bd_cause" context-bd-cause-int
)
54 (context (* os-context-t
) :in
))
56 ;;; FIXME: Should this and CONTEXT-PC be INLINE to reduce consing?
57 ;;; (Are they used in anything time-critical, or just the debugger?)
58 (defun context-register (context index
)
59 (declare (type (alien (* os-context-t
)) context
))
60 (let ((addr (context-register-addr context index
)))
61 (declare (type (alien (* os-context-register-t
)) addr
))
62 ;; The 32-bit Linux ABI uses 64-bit slots for register storage in
63 ;; the context structure. At least some hardware sign extends
64 ;; 32-bit values in these registers, leading to badness in the
65 ;; debugger. Mask it down here.
66 (mask-field (byte 32 0) (deref addr
))))
68 (defun %set-context-register
(context index new
)
69 (declare (type (alien (* os-context-t
)) context
))
70 (let ((addr (context-register-addr context index
)))
71 (declare (type (alien (* os-context-register-t
)) addr
))
72 (setf (deref addr
) new
)))
74 ;;; This is like CONTEXT-REGISTER, but returns the value of a float
75 ;;; register. FORMAT is the type of float to return.
77 ;;; FIXME: Whether COERCE actually knows how to make a float out of a
78 ;;; long is another question. This stuff still needs testing.
79 (define-alien-routine ("os_context_fpregister_addr" context-float-register-addr
)
80 (* os-context-register-t
)
81 (context (* os-context-t
) :in
)
84 (defun context-float-register (context index format
)
85 (declare (type (alien (* os-context-t
)) context
))
86 (let ((addr (context-float-register-addr context index
)))
87 (declare (type (alien (* os-context-register-t
)) addr
))
88 (coerce (deref addr
) format
)))
90 (defun %set-context-float-register
(context index format new
)
91 (declare (type (alien (* os-context-t
)) context
))
92 (let ((addr (context-float-register-addr context index
)))
93 (declare (type (alien (* os-context-register-t
)) addr
))
94 (setf (deref addr
) (coerce new format
))))
97 ("arch_get_fp_control" floating-point-modes
) unsigned-int
)
100 ("arch_set_fp_control" %floating-point-modes-setter
) void
(fp unsigned-int
:in
))
102 (defun (setf floating-point-modes
) (val) (%floating-point-modes-setter val
))
104 ;;; Given a signal context, return the floating point modes word in
105 ;;; the same format as returned by FLOATING-POINT-MODES.
106 (define-alien-routine ("os_context_fp_control" context-floating-point-modes
)
108 (context (* os-context-t
) :in
))
110 (defun internal-error-args (context)
111 (declare (type (alien (* os-context-t
)) context
))
112 (/show0
"entering INTERNAL-ERROR-ARGS, CONTEXT=..")
114 (let* ((pc (context-pc context
))
115 (cause (context-bd-cause-int context
))
116 ;; KLUDGE: This exposure of the branch delay mechanism hurts.
117 (offset (if (logbitp 31 cause
) 8 4))
118 (error-number (sap-ref-8 pc offset
)))
119 (declare (type system-area-pointer pc
))
121 (sb!kernel
::decode-internal-error-args
(sap+ pc
(1+ offset
))