src/code/arm64-vm.lisp

   1 ;;; This file contains the ARM specific runtime stuff.
   2 ;;;
   3 (in-package "SB!VM")
   4
   5 #-sb-xc-host
   6 (defun machine-type ()
   7   "Return a string describing the type of the local machine."
   8   "ARM64")
   9 \f
  10 ;;;; FIXUP-CODE-OBJECT
  11
  12 (!with-bigvec-or-sap
  13 (defun fixup-code-object (code offset fixup kind)
  14   (declare (type index offset))
  15   (unless (zerop (rem offset 4))
  16     (error "Unaligned instruction?  offset=#x~X." offset))
  17   (without-gcing
  18     (let ((sap (code-instructions code)))
  19       (ecase kind
  20         (:absolute
  21          (setf (sap-ref-word sap offset) fixup))
  22         (:cond-branch
  23          (setf (ldb (byte 19 5) (sap-ref-32 sap offset))
  24                (ash (- fixup (+ (sap-int sap) offset)) -2)))
  25         (:uncond-branch
  26          (setf (ldb (byte 26 0) (sap-ref-32 sap offset))
  27                (ash (- fixup (+ (sap-int sap) offset)) -2))))))))
  28 \f
  29 ;;;; "Sigcontext" access functions, cut & pasted from sparc-vm.lisp,
  30 ;;;; then modified for ARM.
  31 ;;;;
  32 ;;;; See also x86-vm for commentary on signed vs unsigned.
  33
  34 #-sb-xc-host (progn
  35 (define-alien-routine ("os_context_float_register_addr" context-float-register-addr)
  36   (* unsigned) (context (* os-context-t)) (index int))
  37
  38 (defun context-float-register (context index format)
  39   (let ((sap (alien-sap (context-float-register-addr context index))))
  40     (ecase format
  41       (single-float
  42        (sap-ref-single sap 0))
  43       (double-float
  44        (sap-ref-double sap 0))
  45       (complex-single-float
  46        (complex (sap-ref-single sap 0)
  47                 (sap-ref-single sap 4)))
  48       (complex-double-float
  49        (complex (sap-ref-double sap 0)
  50                 (sap-ref-double sap 8))))))
  51
  52 (defun %set-context-float-register (context index format value)
  53   (let ((sap (alien-sap (context-float-register-addr context index))))
  54     (ecase format
  55       (single-float
  56        (setf (sap-ref-single sap 0) value))
  57       (double-float
  58        (setf (sap-ref-double sap 0) value))
  59       (complex-single-float
  60        (locally
  61            (declare (type (complex single-float) value))
  62          (setf (sap-ref-single sap 0) (realpart value)
  63                (sap-ref-single sap 4) (imagpart value))))
  64       (complex-double-float
  65        (locally
  66            (declare (type (complex double-float) value))
  67          (setf (sap-ref-double sap 0) (realpart value)
  68                (sap-ref-double sap 8) (imagpart value)))))))
  69 \f
  70 ;;;; INTERNAL-ERROR-ARGS.
  71
  72 ;;; Given a (POSIX) signal context, extract the internal error
  73 ;;; arguments from the instruction stream.
  74 (defun internal-error-args (context)
  75   (declare (type (alien (* os-context-t)) context))
  76   (let* ((pc (context-pc context))
  77          (instruction (sap-ref-32 pc 0))
  78          (error-number (ldb (byte 8 13) instruction)))
  79     (declare (type system-area-pointer pc))
  80     (values error-number
  81             (if (= (ldb (byte 8 5) instruction) invalid-arg-count-trap)
  82                 '(#.arg-count-sc)
  83                 (sb!kernel::decode-internal-error-args (sap+ pc 4) error-number)))))
  84 ) ; end PROGN