src/code/sparc-vm.lisp

   1 ;;;; SPARC-specific runtime stuff
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   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.
  11 (in-package "SB!VM")
  12 \f
  13 ;;; See x86-vm.lisp for a description of this.
  14 #-sb-xc-host
  15 (defun machine-type ()
  16   "Returns a string describing the type of the local machine."
  17   "SPARC")
  18 \f
  19 (!with-bigvec-or-sap
  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))
  24   (without-gcing
  25    (let ((sap (code-instructions code)))
  26      (ecase kind
  27        (:call
  28         (error "Can't deal with CALL fixups, yet."))
  29        (:sethi
  30         (setf (ldb (byte 22 0) (sap-ref-32 sap offset))
  31               (ldb (byte 22 10) fixup)))
  32        (:add
  33         (setf (ldb (byte 10 0) (sap-ref-32 sap offset))
  34               (ldb (byte 10 0) fixup)))
  35        (:absolute
  36         (setf (sap-ref-32 sap offset)
  37               fixup)))))))
  38
  39 \f
  40 ;;;; "Sigcontext" access functions, cut & pasted from alpha-vm.lisp.
  41 ;;;;
  42 ;;;; See also x86-vm for commentary on signed vs unsigned.
  43
  44 #-sb-xc-host (progn
  45 ;;; This is like CONTEXT-REGISTER, but returns the value of a float
  46 ;;; register. FORMAT is the type of float to return.
  47
  48 ;;; FIXME: Whether COERCE actually knows how to make a float out of a
  49 ;;; long is another question. This stuff still needs testing.
  50 #+nil
  51 (define-alien-routine ("os_context_float_register_addr" context-float-register-addr)
  52   (* long)
  53   (context (* os-context-t))
  54   (index int))
  55 #+nil
  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))
  59 #+nil
  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))
  63         (coerce new format)))
  64
  65 ;;; Given a signal context, return the floating point modes word in
  66 ;;; the same format as returned by FLOATING-POINT-MODES.
  67
  68 ;;; Under SunOS, we have a straightforward implementation in C:
  69 #!+sunos
  70 (define-alien-routine ("os_context_fp_control" context-floating-point-modes)
  71     (unsigned 32)
  72   (context (* os-context-t)))
  73
  74 ;;; Under Linux, we have to contend with utterly broken signal handling.
  75 #!+linux
  76 (defun context-floating-point-modes (context)
  77   (declare (ignore context))
  78   (warn "stub CONTEXT-FLOATING-POINT-MODES")
  79   0)
  80 \f
  81 ;;;; INTERNAL-ERROR-ARGS.
  82
  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)
  88 ;;;  (pc)
  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))
  95     (values error-number
  96             (sb!kernel::decode-internal-error-args (sap+ pc 5) error-number))))
  97 ) ; end PROGN