1 ;;;; x86 support for the debugger
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.
14 (define-vop (debug-cur-sp)
15 (:translate current-sp
)
17 (:results
(res :scs
(sap-reg sap-stack
)))
18 (:result-types system-area-pointer
)
22 (define-vop (debug-cur-fp)
23 (:translate current-fp
)
25 (:results
(res :scs
(sap-reg sap-stack
)))
26 (:result-types system-area-pointer
)
30 ;;; Stack-ref and %set-stack-ref can be used to read and store
31 ;;; descriptor objects on the control stack. Use the sap-ref
32 ;;; functions to access other data types.
33 (define-vop (read-control-stack)
34 (:translate stack-ref
)
36 (:args
(sap :scs
(sap-reg) :to
:eval
)
37 (offset :scs
(any-reg) :target temp
))
38 (:arg-types system-area-pointer positive-fixnum
)
39 (:temporary
(:sc unsigned-reg
:from
(:argument
1)) temp
)
40 (:results
(result :scs
(descriptor-reg)))
46 (make-ea :dword
:base sap
:disp
(frame-byte-offset 0) :index temp
))))
48 (define-vop (read-control-stack-c)
49 (:translate stack-ref
)
51 (:args
(sap :scs
(sap-reg)))
53 (:arg-types system-area-pointer
(:constant
(signed-byte 30)))
54 (:results
(result :scs
(descriptor-reg)))
57 (inst mov result
(make-ea :dword
:base sap
58 :disp
(frame-byte-offset index
)))))
60 (define-vop (write-control-stack)
61 (:translate %set-stack-ref
)
63 (:args
(sap :scs
(sap-reg) :to
:eval
)
64 (offset :scs
(any-reg) :target temp
)
65 (value :scs
(descriptor-reg) :to
:result
:target result
))
66 (:arg-types system-area-pointer positive-fixnum
*)
67 (:temporary
(:sc unsigned-reg
:from
(:argument
1) :to
:result
) temp
)
68 (:results
(result :scs
(descriptor-reg)))
74 (make-ea :dword
:base sap
:disp
(frame-byte-offset 0) :index temp
) value
)
77 (define-vop (write-control-stack-c)
78 (:translate %set-stack-ref
)
80 (:args
(sap :scs
(sap-reg))
81 (value :scs
(descriptor-reg) :target result
))
83 (:arg-types system-area-pointer
(:constant
(signed-byte 30)) *)
84 (:results
(result :scs
(descriptor-reg)))
87 (inst mov
(make-ea :dword
:base sap
88 :disp
(frame-byte-offset index
))
92 (define-vop (code-from-mumble)
94 (:args
(thing :scs
(descriptor-reg)))
95 (:results
(code :scs
(descriptor-reg)))
96 (:temporary
(:sc unsigned-reg
) temp
)
97 (:variant-vars lowtag
)
99 (let ((bogus (gen-label))
101 (loadw temp thing
0 lowtag
)
102 (inst shr temp n-widetag-bits
)
104 (inst shl temp
(1- (integer-length n-word-bytes
)))
105 (unless (= lowtag other-pointer-lowtag
)
106 (inst add temp
(- lowtag other-pointer-lowtag
)))
110 (assemble (*elsewhere
*)
112 (inst mov code nil-value
)
115 (define-vop (code-from-lra code-from-mumble
)
116 (:translate sb
!di
::lra-code-header
)
117 (:variant other-pointer-lowtag
))
119 (define-vop (code-from-function code-from-mumble
)
120 (:translate sb
!di
::fun-code-header
)
121 (:variant fun-pointer-lowtag
))
123 (define-vop (%make-lisp-obj
)
125 (:translate %make-lisp-obj
)
126 (:args
(value :scs
(unsigned-reg unsigned-stack
) :target result
))
127 (:arg-types unsigned-num
)
128 (:results
(result :scs
(descriptor-reg)
129 :load-if
(not (sc-is value unsigned-reg
))
132 (move result value
)))
134 (define-vop (get-lisp-obj-address)
136 (:translate sb
!di
::get-lisp-obj-address
)
137 (:args
(thing :scs
(descriptor-reg control-stack
) :target result
))
138 (:results
(result :scs
(unsigned-reg)
139 :load-if
(not (and (sc-is thing descriptor-reg
)
140 (sc-is result unsigned-stack
)))))
141 (:result-types unsigned-num
)
143 (move result thing
)))
146 (define-vop (fun-word-offset)
148 (:translate sb
!di
::fun-word-offset
)
149 (:args
(fun :scs
(descriptor-reg)))
150 (:results
(res :scs
(unsigned-reg)))
151 (:result-types positive-fixnum
)
153 (loadw res fun
0 fun-pointer-lowtag
)
154 (inst shr res n-widetag-bits
)))