2 ;;; Written by Rob MacLachlan
4 ;;; Mips conversion by William Lott and Christopher Hoover.
10 ;;;; Type frobbing VOPs
12 (define-vop (lowtag-of)
13 (:translate lowtag-of)
15 (:args (object :scs (any-reg descriptor-reg)))
16 (:results (result :scs (unsigned-reg)))
17 (:result-types positive-fixnum)
19 (inst andi. result object sb!vm:lowtag-mask)))
21 (define-vop (widetag-of)
22 (:translate widetag-of)
24 (:args (object :scs (descriptor-reg) :to (:eval 1)))
25 (:results (result :scs (unsigned-reg) :from (:eval 0)))
26 (:result-types positive-fixnum)
29 (inst andi. result object lowtag-mask)
30 ;; Check for various pointer types.
31 (inst cmpwi result list-pointer-lowtag)
33 (inst cmpwi result other-pointer-lowtag)
34 (inst beq other-pointer)
35 (inst cmpwi result fun-pointer-lowtag)
36 (inst beq function-pointer)
37 (inst cmpwi result instance-pointer-lowtag)
39 ;; Okay, it is an immediate. If fixnum, we want zero. Otherwise,
40 ;; we want the low 8 bits.
41 (inst andi. result object #b11)
43 ;; It wasn't a fixnum, so get the low 8 bits.
44 (inst andi. result object widetag-mask)
48 (load-type result object (- fun-pointer-lowtag))
52 (load-type result object (- other-pointer-lowtag))
57 (define-vop (fun-subtype)
58 (:translate fun-subtype)
60 (:args (function :scs (descriptor-reg)))
61 (:results (result :scs (unsigned-reg)))
62 (:result-types positive-fixnum)
64 (load-type result function (- sb!vm:fun-pointer-lowtag))))
66 (define-vop (set-fun-subtype)
67 (:translate (setf fun-subtype))
69 (:args (type :scs (unsigned-reg) :target result)
70 (function :scs (descriptor-reg)))
71 (:arg-types positive-fixnum *)
72 (:results (result :scs (unsigned-reg)))
73 (:result-types positive-fixnum)
75 (inst stb type function (- 3 fun-pointer-lowtag))
78 (define-vop (get-header-data)
79 (:translate get-header-data)
81 (:args (x :scs (descriptor-reg)))
82 (:results (res :scs (unsigned-reg)))
83 (:result-types positive-fixnum)
85 (loadw res x 0 sb!vm:other-pointer-lowtag)
86 (inst srwi res res sb!vm:n-widetag-bits)))
88 (define-vop (get-closure-length)
89 (:translate get-closure-length)
91 (:args (x :scs (descriptor-reg)))
92 (:results (res :scs (unsigned-reg)))
93 (:result-types positive-fixnum)
95 (loadw res x 0 sb!vm:fun-pointer-lowtag)
96 (inst srwi res res sb!vm:n-widetag-bits)))
98 (define-vop (set-header-data)
99 (:translate set-header-data)
101 (:args (x :scs (descriptor-reg) :target res)
102 (data :scs (any-reg immediate zero)))
103 (:arg-types * positive-fixnum)
104 (:results (res :scs (descriptor-reg)))
105 (:temporary (:scs (non-descriptor-reg)) t1 t2)
107 (loadw t1 x 0 sb!vm:other-pointer-lowtag)
108 (inst andi. t1 t1 sb!vm:widetag-mask)
111 (inst slwi t2 data (- sb!vm:n-widetag-bits 2))
114 (inst ori t1 t1 (ash (tn-value data) sb!vm:n-widetag-bits)))
116 (storew t1 x 0 sb!vm:other-pointer-lowtag)
120 (define-vop (make-fixnum)
121 (:args (ptr :scs (any-reg descriptor-reg)))
122 (:results (res :scs (any-reg descriptor-reg)))
125 ;; Some code (the hash table code) depends on this returning a
126 ;; positive number so make sure it does.
127 (inst slwi res ptr 3)
128 (inst srwi res res 1)))
130 (define-vop (make-other-immediate-type)
131 (:args (val :scs (any-reg descriptor-reg))
132 (type :scs (any-reg descriptor-reg immediate)
134 (:results (res :scs (any-reg descriptor-reg)))
135 (:temporary (:scs (non-descriptor-reg)) temp)
139 (inst slwi temp val sb!vm:n-widetag-bits)
140 (inst ori res temp (tn-value type)))
142 (inst srawi temp type 2)
143 (inst slwi res val (- sb!vm:n-widetag-bits 2))
144 (inst or res res temp)))))
149 (define-vop (dynamic-space-free-pointer)
150 (:results (int :scs (sap-reg)))
151 (:result-types system-area-pointer)
152 (:translate dynamic-space-free-pointer)
155 (move int alloc-tn)))
157 (define-vop (binding-stack-pointer-sap)
158 (:results (int :scs (sap-reg)))
159 (:result-types system-area-pointer)
160 (:translate binding-stack-pointer-sap)
165 (define-vop (control-stack-pointer-sap)
166 (:results (int :scs (sap-reg)))
167 (:result-types system-area-pointer)
168 (:translate control-stack-pointer-sap)
174 ;;;; Code object frobbing.
176 (define-vop (code-instructions)
177 (:translate code-instructions)
179 (:args (code :scs (descriptor-reg)))
180 (:temporary (:scs (non-descriptor-reg)) ndescr)
181 (:results (sap :scs (sap-reg)))
182 (:result-types system-area-pointer)
184 (loadw ndescr code 0 sb!vm:other-pointer-lowtag)
185 (inst srwi ndescr ndescr sb!vm:n-widetag-bits)
186 (inst slwi ndescr ndescr sb!vm:word-shift)
187 (inst subi ndescr ndescr sb!vm:other-pointer-lowtag)
188 (inst add sap code ndescr)))
190 (define-vop (compute-fun)
191 (:args (code :scs (descriptor-reg))
192 (offset :scs (signed-reg unsigned-reg)))
193 (:arg-types * positive-fixnum)
194 (:results (func :scs (descriptor-reg)))
195 (:temporary (:scs (non-descriptor-reg)) ndescr)
197 (loadw ndescr code 0 sb!vm:other-pointer-lowtag)
198 (inst srwi ndescr ndescr sb!vm:n-widetag-bits)
199 (inst slwi ndescr ndescr sb!vm:word-shift)
200 (inst add ndescr ndescr offset)
201 (inst addi ndescr ndescr (- sb!vm:fun-pointer-lowtag sb!vm:other-pointer-lowtag))
202 (inst add func code ndescr)))
206 ;;;; Other random VOPs.
209 (defknown sb!unix::do-pending-interrupt () (values))
210 (define-vop (sb!unix::do-pending-interrupt)
212 (:translate sb!unix::do-pending-interrupt)
214 (inst unimp pending-interrupt-trap)))
219 (inst unimp halt-trap)))
223 ;;;; Dynamic vop count collection support
225 (define-vop (count-me)
226 (:args (count-vector :scs (descriptor-reg)))
228 (:temporary (:scs (non-descriptor-reg)) count)
231 (- (* (+ index vector-data-offset) n-word-bytes) other-pointer-lowtag)))
232 (assert (typep offset '(signed-byte 16)))
233 (inst lwz count count-vector offset)
234 (inst addi count count 1)
235 (inst stw count count-vector offset))))