1.0.0.32: support for FreeBSD/x86-64
[sbcl.git] / src / compiler / hppa / 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) :type random) 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     (move object ptr)
21     (inst comb := ptr null-tn done)
22     (inst li 0 count)
23
24     (inst extru ptr 31 3 temp)
25     (inst comib :<> list-pointer-lowtag temp loose :nullify t)
26     (loadw ptr ptr cons-cdr-slot list-pointer-lowtag)
27
28     LOOP
29     (inst addi (fixnumize 1) count count)
30     (inst comb := ptr null-tn done :nullify t)
31     (inst extru ptr 31 3 temp)
32     (inst comib := list-pointer-lowtag temp loop :nullify t)
33     (loadw ptr ptr cons-cdr-slot list-pointer-lowtag)
34
35     LOOSE
36     (cerror-call vop done object-not-list-error ptr)
37
38     DONE
39     (move count result)))
40
41 (define-static-fun length (object) :translate length)