1 ;;;; linkage information for standard static functions, and
2 ;;;; miscellaneous VOPs
4 ;;;; This software is part of the SBCL system. See the README file for
7 ;;;; This software is derived from the CMU CL system, which was
8 ;;;; written at Carnegie Mellon University and released into the
9 ;;;; public domain. The software is in the public domain and is
10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
11 ;;;; files for more information.
17 (define-vop (length/list
)
19 (:args
(object :scs
(descriptor-reg control-stack
) :target ptr
))
21 (:temporary
(:sc dword-reg
:offset eax-offset
) eax
)
22 (:temporary
(:sc descriptor-reg
:from
(:argument
0)) ptr
)
23 (:results
(count :scs
(any-reg)))
24 (:result-types positive-fixnum
)
27 (:save-p
:compute-only
)
30 ;; Move OBJECT into a temp we can bash on, and initialize the count.
33 ;; If we are starting with NIL, then it's really easy.
34 (inst cmp ptr nil-value
)
36 ;; Note: we don't have to test to see whether the original argument is a
37 ;; list, because this is a :fast-safe vop.
39 ;; Get the CDR and boost the count.
40 (loadw ptr ptr cons-cdr-slot list-pointer-lowtag
)
41 (inst add count
(fixnumize 1))
42 ;; If we hit NIL, then we are done.
43 (inst cmp ptr nil-value
)
45 ;; Otherwise, check to see whether we hit the end of a dotted list. If
46 ;; not, loop back for more.
47 (%test-lowtag ptr LOOP nil list-pointer-lowtag
)
48 ;; It's dotted all right. Flame out.
49 (error-call vop
'object-not-list-error ptr
)
53 (define-vop (fast-length/list
)
55 (:args
(object :scs
(descriptor-reg control-stack
) :target ptr
))
57 (:temporary
(:sc descriptor-reg
:from
(:argument
0)) ptr
)
58 (:results
(count :scs
(any-reg)))
59 (:result-types positive-fixnum
)
62 (:save-p
:compute-only
)
64 ;; Get a copy of OBJECT in a register we can bash on, and
68 ;; If we are starting with NIL, we be done.
69 (inst cmp ptr nil-value
)
71 ;; Indirect the next cons cell, and boost the count.
73 (loadw ptr ptr cons-cdr-slot list-pointer-lowtag
)
74 (inst add count
(fixnumize 1))
75 ;; If we aren't done, go back for more.
76 (inst cmp ptr nil-value
)
80 (define-static-fun length
(object) :translate length
)
81 (define-static-fun %coerce-callable-to-fun
(callable)
82 :translate %coerce-callable-to-fun
)