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 zero-tn 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)