src/compiler/hppa/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) :type random) 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 object ptr)
  21     (inst comb := ptr null-tn done)
  22     (inst li 0 count)
  23
  24     (inst extru ptr 31 3 temp)
  25     (inst comib :<> list-pointer-lowtag temp lose :nullify t)
  26     (loadw ptr ptr cons-cdr-slot list-pointer-lowtag)
  27
  28     LOOP
  29     (inst addi (fixnumize 1) count count)
  30     (inst comb := ptr null-tn done :nullify t)
  31     (inst extru ptr 31 3 temp)
  32     (inst comib := list-pointer-lowtag temp loop :nullify t)
  33     (loadw ptr ptr cons-cdr-slot list-pointer-lowtag)
  34
  35     LOSE
  36     (cerror-call vop done object-not-list-error ptr)
  37
  38     DONE
  39     (move count result)))
  40
  41 (define-static-fun length (object) :translate length)