1 ;;;; linkage information for standard static functions, and random vops
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
15 (define-vop (length/list
)
17 (:args
(object :scs
(descriptor-reg) :target ptr
))
19 (:temporary
(:scs
(descriptor-reg) :from
(:argument
0)) ptr
)
20 (:temporary
(:scs
(non-descriptor-reg)) temp
)
21 (:temporary
(:scs
(any-reg) :type fixnum
:to
(:result
0) :target result
)
23 (:results
(result :scs
(any-reg descriptor-reg
)))
26 (:save-p
:compute-only
)
28 (let ((done (gen-label))
30 (not-list (generate-cerror-code vop object-not-list-error object
)))
36 (inst cmp ptr null-tn
)
40 ;; FIXME: Maybe rewrite this to remove this TEST-TYPE (and the
41 ;; one below) to put it in line with all other architectures
43 (test-type ptr not-list t
(list-pointer-lowtag) :temp temp
)
45 (loadw ptr ptr cons-cdr-slot list-pointer-lowtag
)
46 (inst add count count
(fixnumize 1))
47 (test-type ptr loop nil
(list-pointer-lowtag) :temp temp
)
49 (cerror-call vop done object-not-list-error ptr
)
52 (move result count
))))
55 (define-static-fun length
(object) :translate length
)