src/compiler/sparc/debug.lisp

   1 ;;;; Sparc compiler support for the new whizzy debugger
   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
  12 (in-package "SB-VM")
  13
  14 (define-vop ()
  15   (:translate current-sp)
  16   (:policy :fast-safe)
  17   (:results (res :scs (sap-reg)))
  18   (:result-types system-area-pointer)
  19   (:generator 1
  20     (move res csp-tn)))
  21
  22 (define-vop (current-fp-sap)
  23   (:translate current-fp)
  24   (:policy :fast-safe)
  25   (:results (res :scs (sap-reg)))
  26   (:result-types system-area-pointer)
  27   (:generator 1
  28     (move res cfp-tn)))
  29
  30 (define-vop ()
  31   (:translate stack-ref)
  32   (:policy :fast-safe)
  33   (:args (sap :scs (sap-reg))
  34          (offset :scs (any-reg)))
  35   (:arg-types system-area-pointer positive-fixnum)
  36   (:results (result :scs (descriptor-reg)))
  37   (:result-types *)
  38   (:generator 5
  39     (inst ld result sap offset)))
  40
  41 (define-vop ()
  42   (:translate %set-stack-ref)
  43   (:policy :fast-safe)
  44   (:args (sap :scs (sap-reg))
  45          (offset :scs (any-reg))
  46          (value :scs (descriptor-reg)))
  47   (:arg-types system-area-pointer positive-fixnum *)
  48   (:generator 5
  49     (inst st value sap offset)))
  50
  51 (define-vop (code-from-mumble)
  52   (:policy :fast-safe)
  53   (:args (thing :scs (descriptor-reg)))
  54   (:results (code :scs (descriptor-reg)))
  55   (:temporary (:scs (non-descriptor-reg)) temp)
  56   (:variant-vars lowtag)
  57   (:generator 5
  58     (let ((bogus (gen-label))
  59           (done (gen-label)))
  60       (loadw temp thing 0 lowtag)
  61       (inst srl temp n-widetag-bits)
  62       (inst cmp temp)
  63       (inst b :eq bogus)
  64       (inst sll temp word-shift)
  65       (unless (= lowtag other-pointer-lowtag)
  66         (inst add temp (- lowtag other-pointer-lowtag)))
  67       (inst sub code thing temp)
  68       (emit-label done)
  69       (assemble (:elsewhere)
  70         (emit-label bogus)
  71         (inst b done)
  72         (move code null-tn)))))
  73
  74 (define-vop (code-from-lra code-from-mumble)
  75   (:translate lra-code-header)
  76   (:variant other-pointer-lowtag))
  77
  78 (define-vop (code-from-function code-from-mumble)
  79   (:translate fun-code-header)
  80   (:variant fun-pointer-lowtag))
  81
  82 (define-vop (%make-lisp-obj)
  83   (:policy :fast-safe)
  84   (:translate %make-lisp-obj)
  85   (:args (value :scs (unsigned-reg) :target result))
  86   (:arg-types unsigned-num)
  87   (:results (result :scs (descriptor-reg)))
  88   (:generator 1
  89     (move result value)))
  90
  91 (define-vop (get-lisp-obj-address)
  92   (:policy :fast-safe)
  93   (:translate get-lisp-obj-address)
  94   (:args (thing :scs (descriptor-reg any-reg) :target result))
  95   (:results (result :scs (unsigned-reg)))
  96   (:result-types unsigned-num)
  97   (:generator 1
  98     (move result thing)))