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     (move ptr object)
  21     (move count zero-tn)
  22
  23     LOOP
  24
  25     (inst beq ptr null-tn done)
  26     (inst nop)
  27
  28     (inst and temp ptr lowtag-mask)
  29     (inst xor temp list-pointer-lowtag)
  30     (inst bne temp zero-tn not-list)
  31     (inst nop)
  32
  33     (loadw ptr ptr cons-cdr-slot list-pointer-lowtag)
  34     (inst b loop)
  35     (inst addu count count (fixnumize 1))
  36
  37     NOT-LIST
  38     (cerror-call vop done object-not-list-error ptr)
  39
  40     DONE
  41     (move result count)))
  42
  43
  44 (define-static-fun length (object) :translate length)
  45
  46
  47