1.0.29.38: better DESCRIBE
[sbcl.git] / src / compiler / mips / subprim.lisp
1 (in-package "SB!VM")
2
3
4 \f
5 ;;;; Length
6
7 (define-vop (length/list)
8   (:translate length)
9   (:args (object :scs (descriptor-reg) :target ptr))
10   (:arg-types list)
11   (:temporary (:scs (descriptor-reg) :from (:argument 0)) ptr)
12   (:temporary (:scs (non-descriptor-reg)) temp)
13   (:temporary (:scs (any-reg) :type fixnum :to (:result 0) :target result)
14               count)
15   (:results (result :scs (any-reg descriptor-reg)))
16   (:policy :fast-safe)
17   (:vop-var vop)
18   (:save-p :compute-only)
19   (:generator 50
20     (let ((done (gen-label))
21           (loop (gen-label))
22           (not-list (gen-label)))
23       (move ptr object)
24       (move count zero-tn)
25
26       (emit-label loop)
27
28       (inst beq ptr null-tn done)
29       (inst and temp ptr lowtag-mask)
30       (inst xor temp list-pointer-lowtag)
31       (inst bne temp not-list)
32       (inst nop)
33
34       (loadw ptr ptr cons-cdr-slot list-pointer-lowtag)
35       (inst b loop)
36       (inst addu count count (fixnumize 1))
37
38       (emit-label not-list)
39       (cerror-call vop done object-not-list-error ptr)
40
41       (emit-label done)
42       (move result count))))
43
44
45 (define-static-fun length (object) :translate length)