4 (define-vop (debug-cur-sp)
5 (:translate current-sp
)
7 (:results
(res :scs
(sap-reg)))
8 (:result-types system-area-pointer
)
12 (define-vop (debug-cur-fp)
13 (:translate current-fp
)
15 (:results
(res :scs
(sap-reg)))
16 (:result-types system-area-pointer
)
20 (define-vop (read-control-stack)
21 (:translate stack-ref
)
23 (:args
(object :scs
(sap-reg) :target sap
)
24 (offset :scs
(any-reg)))
25 (:arg-types system-area-pointer positive-fixnum
)
26 (:temporary
(:scs
(sap-reg) :from
:eval
) sap
)
27 (:results
(result :scs
(descriptor-reg)))
30 (inst add sap object offset
)
31 (inst lw result sap
0)
34 (define-vop (read-control-stack-c)
35 (:translate stack-ref
)
37 (:args
(object :scs
(sap-reg)))
39 (:arg-types system-area-pointer
(:constant
(signed-byte 14)))
40 (:results
(result :scs
(descriptor-reg)))
43 (inst lw result object
(* offset n-word-bytes
))
46 (define-vop (write-control-stack)
47 (:translate %set-stack-ref
)
49 (:args
(object :scs
(sap-reg) :target sap
)
50 (offset :scs
(any-reg))
51 (value :scs
(descriptor-reg) :target result
))
52 (:arg-types system-area-pointer positive-fixnum
*)
53 (:results
(result :scs
(descriptor-reg)))
55 (:temporary
(:scs
(sap-reg) :from
(:argument
1)) sap
)
57 (inst add sap object offset
)
61 (define-vop (write-control-stack-c)
62 (:translate %set-stack-ref
)
64 (:args
(sap :scs
(sap-reg))
65 (value :scs
(descriptor-reg) :target result
))
67 (:arg-types system-area-pointer
(:constant
(signed-byte 14)) *)
68 (:results
(result :scs
(descriptor-reg)))
71 (inst sw value sap
(* offset n-word-bytes
))
75 (define-vop (code-from-mumble)
77 (:args
(thing :scs
(descriptor-reg)))
78 (:results
(code :scs
(descriptor-reg)))
79 (:temporary
(:scs
(non-descriptor-reg)) temp
)
80 (:variant-vars lowtag
)
82 (let ((bogus (gen-label))
84 (loadw temp thing
0 lowtag
)
85 (inst srl temp n-widetag-bits
)
87 (inst sll temp
(1- (integer-length n-word-bytes
)))
88 (unless (= lowtag other-pointer-lowtag
)
89 (inst addu temp
(- lowtag other-pointer-lowtag
)))
90 (inst subu code thing temp
)
92 (assemble (*elsewhere
*)
95 (move code null-tn t
)))))
97 (define-vop (code-from-lra code-from-mumble
)
98 (:translate lra-code-header
)
99 (:variant other-pointer-lowtag
))
101 (define-vop (code-from-fun code-from-mumble
)
102 (:translate fun-code-header
)
103 (:variant fun-pointer-lowtag
))
105 (define-vop (make-lisp-obj)
107 (:translate make-lisp-obj
)
108 (:args
(value :scs
(unsigned-reg) :target result
))
109 (:arg-types unsigned-num
)
110 (:results
(result :scs
(descriptor-reg)))
112 (move result value
)))
114 (define-vop (get-lisp-obj-address)
116 (:translate get-lisp-obj-address
)
117 (:args
(thing :scs
(descriptor-reg) :target result
))
118 (:results
(result :scs
(unsigned-reg)))
119 (:result-types unsigned-num
)
121 (move result thing
)))
123 (define-vop (fun-word-offset)
125 (:translate fun-word-offset
)
126 (:args
(fun :scs
(descriptor-reg)))
127 (:results
(res :scs
(unsigned-reg)))
128 (:result-types positive-fixnum
)
130 (loadw res fun
0 fun-pointer-lowtag
)
131 (inst srl res n-widetag-bits
)))