src/compiler/x86/debug.lisp

   1 ;;;; x86 support for the 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 (file-comment
  15  "$Header$")
  16
  17 (define-vop (debug-cur-sp)
  18   (:translate current-sp)
  19   (:policy :fast-safe)
  20   (:results (res :scs (sap-reg sap-stack)))
  21   (:result-types system-area-pointer)
  22   (:generator 1
  23     (move res esp-tn)))
  24
  25 (define-vop (debug-cur-fp)
  26   (:translate current-fp)
  27   (:policy :fast-safe)
  28   (:results (res :scs (sap-reg sap-stack)))
  29   (:result-types system-area-pointer)
  30   (:generator 1
  31     (move res ebp-tn)))
  32
  33 ;;; Stack-ref and %set-stack-ref can be used to read and store
  34 ;;; descriptor objects on the control stack. Use the sap-ref
  35 ;;; functions to access other data types.
  36 (define-vop (read-control-stack)
  37   (:translate stack-ref)
  38   (:policy :fast-safe)
  39   (:args (sap :scs (sap-reg) :to :eval)
  40          (offset :scs (any-reg) :target temp))
  41   (:arg-types system-area-pointer positive-fixnum)
  42   (:temporary (:sc unsigned-reg :from (:argument 1)) temp)
  43   (:results (result :scs (descriptor-reg)))
  44   (:result-types *)
  45   (:generator 9
  46     (move temp offset)
  47     (inst neg temp)
  48     (inst mov result
  49           (make-ea :dword :base sap :disp (- word-bytes) :index temp))))
  50
  51 (define-vop (read-control-stack-c)
  52   (:translate stack-ref)
  53   (:policy :fast-safe)
  54   (:args (sap :scs (sap-reg)))
  55   (:info index)
  56   (:arg-types system-area-pointer (:constant (signed-byte 30)))
  57   (:results (result :scs (descriptor-reg)))
  58   (:result-types *)
  59   (:generator 5
  60     (inst mov result (make-ea :dword :base sap
  61                               :disp (- (* (1+ index) word-bytes))))))
  62
  63 (define-vop (write-control-stack)
  64   (:translate %set-stack-ref)
  65   (:policy :fast-safe)
  66   (:args (sap :scs (sap-reg) :to :eval)
  67          (offset :scs (any-reg) :target temp)
  68          (value :scs (descriptor-reg) :to :result :target result))
  69   (:arg-types system-area-pointer positive-fixnum *)
  70   (:temporary (:sc unsigned-reg :from (:argument 1) :to :result) temp)
  71   (:results (result :scs (descriptor-reg)))
  72   (:result-types *)
  73   (:generator 9
  74     (move temp offset)
  75     (inst neg temp)
  76     (inst mov
  77           (make-ea :dword :base sap :disp (- word-bytes) :index temp) value)
  78     (move result value)))
  79
  80 (define-vop (write-control-stack-c)
  81   (:translate %set-stack-ref)
  82   (:policy :fast-safe)
  83   (:args (sap :scs (sap-reg))
  84          (value :scs (descriptor-reg) :target result))
  85   (:info index)
  86   (:arg-types system-area-pointer (:constant (signed-byte 30)) *)
  87   (:results (result :scs (descriptor-reg)))
  88   (:result-types *)
  89   (:generator 5
  90     (inst mov (make-ea :dword :base sap
  91                        :disp (- (* (1+ index) word-bytes)))
  92           value)
  93     (move result value)))
  94
  95 (define-vop (code-from-mumble)
  96   (:policy :fast-safe)
  97   (:args (thing :scs (descriptor-reg)))
  98   (:results (code :scs (descriptor-reg)))
  99   (:temporary (:sc unsigned-reg) temp)
 100   (:variant-vars lowtag)
 101   (:generator 5
 102     (let ((bogus (gen-label))
 103           (done (gen-label)))
 104       (loadw temp thing 0 lowtag)
 105       (inst shr temp type-bits)
 106       (inst jmp :z bogus)
 107       (inst shl temp (1- (integer-length word-bytes)))
 108       (unless (= lowtag other-pointer-type)
 109         (inst add temp (- lowtag other-pointer-type)))
 110       (move code thing)
 111       (inst sub code temp)
 112       (emit-label done)
 113       (assemble (*elsewhere*)
 114         (emit-label bogus)
 115         (inst mov code *nil-value*)
 116         (inst jmp done)))))
 117
 118 (define-vop (code-from-lra code-from-mumble)
 119   (:translate sb!di::lra-code-header)
 120   (:variant other-pointer-type))
 121
 122 (define-vop (code-from-function code-from-mumble)
 123   (:translate sb!di::function-code-header)
 124   (:variant function-pointer-type))
 125
 126 (define-vop (make-lisp-obj)
 127   (:policy :fast-safe)
 128   (:translate sb!di::make-lisp-obj)
 129   (:args (value :scs (unsigned-reg unsigned-stack) :target result))
 130   (:arg-types unsigned-num)
 131   (:results (result :scs (descriptor-reg)
 132                     :load-if (not (sc-is value unsigned-reg))
 133                     ))
 134   (:generator 1
 135     (move result value)))
 136
 137 (define-vop (get-lisp-obj-address)
 138   (:policy :fast-safe)
 139   (:translate sb!di::get-lisp-obj-address)
 140   (:args (thing :scs (descriptor-reg control-stack) :target result))
 141   (:results (result :scs (unsigned-reg)
 142                     :load-if (not (and (sc-is thing descriptor-reg)
 143                                        (sc-is result unsigned-stack)))))
 144   (:result-types unsigned-num)
 145   (:generator 1
 146     (move result thing)))
 147
 148
 149 (define-vop (function-word-offset)
 150   (:policy :fast-safe)
 151   (:translate sb!di::function-word-offset)
 152   (:args (fun :scs (descriptor-reg)))
 153   (:results (res :scs (unsigned-reg)))
 154   (:result-types positive-fixnum)
 155   (:generator 5
 156     (loadw res fun 0 function-pointer-type)
 157     (inst shr res type-bits)))