src/compiler/ppc/subprim.lisp

   1 ;;;
   2 ;;; Written by William Lott.
   3 ;;;
   4 (in-package "SB!VM")
   5
   6
   7 \f
   8 ;;;; Length
   9
  10 (define-vop (length/list)
  11   (:translate length)
  12   (:args (object :scs (descriptor-reg) :target ptr))
  13   (:arg-types list)
  14   (:temporary (:scs (descriptor-reg) :from (:argument 0)) ptr)
  15   (:temporary (:scs (non-descriptor-reg)) temp)
  16   (:temporary (:scs (any-reg) :type fixnum :to (:result 0) :target result)
  17               count)
  18   (:results (result :scs (any-reg descriptor-reg)))
  19   (:policy :fast-safe)
  20   (:vop-var vop)
  21   (:save-p :compute-only)
  22   (:generator 50
  23     (let ((done (gen-label))
  24           (loop (gen-label))
  25           (not-list (generate-cerror-code vop object-not-list-error object)))
  26       (move ptr object)
  27       (move count zero-tn)
  28
  29       (emit-label loop)
  30
  31       (inst cmpw ptr null-tn)
  32       (inst beq done)
  33
  34       (test-type ptr not-list t (list-pointer-lowtag) :temp temp)
  35
  36       (loadw ptr ptr cons-cdr-slot list-pointer-lowtag)
  37       (inst addi count count (fixnumize 1))
  38       (test-type ptr loop nil (list-pointer-lowtag) :temp temp)
  39
  40       (cerror-call vop done object-not-list-error ptr)
  41
  42       (emit-label done)
  43       (move result count))))
  44
  45
  46 (define-static-fun length (object) :translate length)
  47