1 ;;;; SPARC-specific runtime stuff
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
13 ;;; See x86-vm.lisp for a description of this.
15 (defun machine-type ()
16 "Returns a string describing the type of the local machine."
20 (defun fixup-code-object (code offset fixup kind
)
21 (declare (type index offset
))
22 (unless (zerop (rem offset n-word-bytes
))
23 (error "Unaligned instruction? offset=#x~X." offset
))
25 (let ((sap (code-instructions code
)))
28 (error "Can't deal with CALL fixups, yet."))
30 (setf (ldb (byte 22 0) (sap-ref-32 sap offset
))
31 (ldb (byte 22 10) fixup
)))
33 (setf (ldb (byte 10 0) (sap-ref-32 sap offset
))
34 (ldb (byte 10 0) fixup
)))
36 (setf (sap-ref-32 sap offset
)
40 ;;;; "Sigcontext" access functions, cut & pasted from alpha-vm.lisp.
42 ;;;; See also x86-vm for commentary on signed vs unsigned.
45 ;;; This is like CONTEXT-REGISTER, but returns the value of a float
46 ;;; register. FORMAT is the type of float to return.
48 ;;; FIXME: Whether COERCE actually knows how to make a float out of a
49 ;;; long is another question. This stuff still needs testing.
51 (define-alien-routine ("os_context_float_register_addr" context-float-register-addr
)
53 (context (* os-context-t
))
56 (defun context-float-register (context index format
)
57 (declare (type (alien (* os-context-t
)) context
))
58 (coerce (deref (context-float-register-addr context index
)) format
))
60 (defun %set-context-float-register
(context index format new
)
61 (declare (type (alien (* os-context-t
)) context
))
62 (setf (deref (context-float-register-addr context index
))
65 ;;; Given a signal context, return the floating point modes word in
66 ;;; the same format as returned by FLOATING-POINT-MODES.
68 ;;; Under SunOS, we have a straightforward implementation in C:
70 (define-alien-routine ("os_context_fp_control" context-floating-point-modes
)
72 (context (* os-context-t
)))
74 ;;; Under Linux, we have to contend with utterly broken signal handling.
76 (defun context-floating-point-modes (context)
77 (declare (ignore context
))
78 (warn "stub CONTEXT-FLOATING-POINT-MODES")
81 ;;;; INTERNAL-ERROR-ARGS.
83 ;;; Given a (POSIX) signal context, extract the internal error
84 ;;; arguments from the instruction stream. This is e.g.
85 ;;; 4 23 254 240 2 0 0 0
86 ;;; | ~~~~~~~~~~~~~~~~~~~~~~~~~
87 ;;; length data (everything is an octet)
89 (defun internal-error-args (context)
90 (declare (type (alien (* os-context-t
)) context
))
91 (/show0
"entering INTERNAL-ERROR-ARGS")
92 (let* ((pc (context-pc context
))
93 (error-number (sap-ref-8 pc
4)))
94 (declare (type system-area-pointer pc
))
96 (sb!kernel
::decode-internal-error-args
(sap+ pc
5) error-number
))))