2 ;;; Written by William Lott.
6 (define-vop (debug-cur-sp)
7 (:translate sb!di::current-sp)
9 (:results (res :scs (sap-reg)))
10 (:result-types system-area-pointer)
14 (define-vop (debug-cur-fp)
15 (:translate sb!di::current-fp)
17 (:results (res :scs (sap-reg)))
18 (:result-types system-area-pointer)
22 (define-vop (read-control-stack)
23 (:translate sb!kernel:stack-ref)
25 (:args (sap :scs (sap-reg))
26 (offset :scs (any-reg)))
27 (:arg-types system-area-pointer positive-fixnum)
28 (:results (result :scs (descriptor-reg)))
31 (inst lwzx result sap offset)))
33 (define-vop (write-control-stack)
34 (:translate sb!kernel:%set-stack-ref)
36 (:args (sap :scs (sap-reg))
37 (offset :scs (any-reg))
38 (value :scs (descriptor-reg) :target result))
39 (:arg-types system-area-pointer positive-fixnum *)
40 (:results (result :scs (descriptor-reg)))
43 (inst stwx value sap offset)
46 (define-vop (code-from-mumble)
48 (:args (thing :scs (descriptor-reg)))
49 (:results (code :scs (descriptor-reg)))
50 (:temporary (:scs (non-descriptor-reg)) temp)
51 (:variant-vars lowtag)
53 (let ((bogus (gen-label))
55 (loadw temp thing 0 lowtag)
56 (inst srwi temp temp sb!vm:n-widetag-bits)
58 (inst slwi temp temp (1- (integer-length sb!vm:n-word-bytes)))
60 (unless (= lowtag sb!vm:other-pointer-lowtag)
61 (inst addi temp temp (- lowtag sb!vm:other-pointer-lowtag)))
62 (inst sub code thing temp)
64 (assemble (*elsewhere*)
69 (define-vop (code-from-lra code-from-mumble)
70 (:translate sb!di::lra-code-header)
71 (:variant sb!vm:other-pointer-lowtag))
73 (define-vop (code-from-fun code-from-mumble)
74 (:translate sb!di::fun-code-header)
75 (:variant sb!vm:fun-pointer-lowtag))
77 (define-vop (make-lisp-obj)
79 (:translate sb!di::make-lisp-obj)
80 (:args (value :scs (unsigned-reg) :target result))
81 (:arg-types unsigned-num)
82 (:results (result :scs (descriptor-reg)))
86 (define-vop (get-lisp-obj-address)
88 (:translate sb!di::get-lisp-obj-address)
89 (:args (thing :scs (descriptor-reg) :target result))
90 (:results (result :scs (unsigned-reg)))
91 (:result-types unsigned-num)
96 (define-vop (fun-word-offset)
98 (:translate sb!di::fun-word-offset)
99 (:args (fun :scs (descriptor-reg)))
100 (:results (res :scs (unsigned-reg)))
101 (:result-types positive-fixnum)
103 (loadw res fun 0 fun-pointer-lowtag)
104 (inst srwi res res sb!vm:n-widetag-bits)))