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)