1 ;;; This file contains the MIPS specific runtime stuff.
6 "Returns a string describing the type of the local machine."
9 (defun return-machine-address (scp)
10 (context-register scp lip-offset
))
12 (define-alien-routine ("os_context_bd_cause" context-bd-cause-int
)
14 (context (* os-context-t
) :in
))
16 ;;; This is like CONTEXT-REGISTER, but returns the value of a float
17 ;;; register. FORMAT is the type of float to return.
19 ;;; FIXME: Whether COERCE actually knows how to make a float out of a
20 ;;; long is another question. This stuff still needs testing.
21 (define-alien-type os-context-register-t unsigned-long-long
)
22 (define-alien-routine ("os_context_fpregister_addr" context-float-register-addr
)
23 (* os-context-register-t
)
24 (context (* os-context-t
) :in
)
27 (defun context-float-register (context index format
)
28 (declare (type (alien (* os-context-t
)) context
))
29 (let ((addr (context-float-register-addr context index
)))
30 (declare (type (alien (* os-context-register-t
)) addr
))
31 (coerce (deref addr
) format
)))
33 (defun %set-context-float-register
(context index format new
)
34 (declare (type (alien (* os-context-t
)) context
))
35 (let ((addr (context-float-register-addr context index
)))
36 (declare (type (alien (* os-context-register-t
)) addr
))
37 (setf (deref addr
) (coerce new format
))))
40 ("arch_get_fp_control" floating-point-modes
) unsigned-int
)
43 ("arch_set_fp_control" %floating-point-modes-setter
) void
(fp unsigned-int
:in
))
45 (defun (setf floating-point-modes
) (val) (%floating-point-modes-setter val
))
47 ;;; Given a signal context, return the floating point modes word in
48 ;;; the same format as returned by FLOATING-POINT-MODES.
49 (define-alien-routine ("os_context_fp_control" context-floating-point-modes
)
51 (context (* os-context-t
) :in
))
53 (defun internal-error-args (context)
54 (declare (type (alien (* os-context-t
)) context
))
55 (let* ((pc (context-pc context
))
56 (cause (context-bd-cause-int context
))
57 ;; KLUDGE: This exposure of the branch delay mechanism hurts.
58 (offset (if (logbitp 31 cause
) 4 0))
59 (trap-number (ldb (byte 8 6) (sap-ref-32 pc offset
))))
60 (declare (type system-area-pointer pc
))
61 ;; Pick off invalid-arg-count here. Otherwise call the generic routine
62 (let ((inst (sap-ref-32 pc offset
)))
63 ;; FIXME: recognize the whole gamut of trap instructions
64 (cond ((and (= (ldb (byte 6 0) inst
) #b110110
) ; TNE
65 (= (ldb (byte 10 6) inst
) invalid-arg-count-trap
))
66 (let ((rs (ldb (byte 5 21) inst
))) ; expect this to be NARGS-TN
67 (values (error-number-or-lose 'invalid-arg-count-error
)
68 (list (make-sc+offset
(sc-number-or-lose 'any-reg
) rs
))
69 invalid-arg-count-trap
)))
71 (sb-kernel::decode-internal-error-args
(sap+ pc
(+ offset
4)) trap-number
))))))