array.lisp

开源跨平台Lisp编译器

;;;; support routines for arrays and vectors

;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;;;
;;;; This software is derived from the CMU CL system, which was
;;;; written at Carnegie Mellon University and released into the
;;;; public domain. The software is in the public domain and is
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.

(in-package "SB!VM")


(define-assembly-routine (allocate-vector
                          (:policy :fast-safe)
                          (:translate allocate-vector)
                          (:arg-types positive-fixnum
                                      positive-fixnum
                                      positive-fixnum))
                         ((:arg type any-reg a0-offset)
                          (:arg length any-reg a1-offset)
                          (:arg words any-reg a2-offset)
                          (:res result descriptor-reg a0-offset)

                          (:temp ndescr non-descriptor-reg nl0-offset))
  ;; This is kinda sleezy, changing words like this.  But we can because
  ;; the vop thinks it is temporary.
  (inst addq words (+ (1- (ash 1 n-lowtag-bits))
                      (* vector-data-offset n-word-bytes))
        words)
  (inst li (lognot lowtag-mask) ndescr)
  (inst and words ndescr words)
  (inst srl type word-shift ndescr)

  (pseudo-atomic ()
    (inst bis alloc-tn other-pointer-lowtag result)
    (inst addq alloc-tn words alloc-tn)
    (storew ndescr result 0 other-pointer-lowtag)
    (storew length result vector-length-slot other-pointer-lowtag)))

;;;; hash primitives
#|
(define-assembly-routine (sxhash-simple-string
                          (:translate %sxhash-simple-string)
                          (:policy :fast-safe)
                          (:result-types positive-fixnum))
                         ((:arg string descriptor-reg a0-offset)
                          (:res result any-reg a0-offset)

                          (:temp length any-reg a1-offset)

                          (:temp lip interior-reg lip-offset)
                          (:temp accum non-descriptor-reg nl0-offset)
                          (:temp data non-descriptor-reg nl1-offset)
                          (:temp byte non-descriptor-reg nl2-offset)
                          (:temp retaddr non-descriptor-reg nl3-offset)
                          (:temp temp1 non-descriptor-reg nl4-offset))

  ;; These are needed after we jump into sxhash-simple-substring.
  (progn result lip accum data byte  retaddr)

  (inst li (make-fixup 'sxhash-simple-substring :assembly-routine) temp1)
  (loadw length string vector-length-slot other-pointer-lowtag)
  (inst jmp zero-tn temp1
        (make-fixup 'sxhash-simple-substring :assembly-routine)))

(define-assembly-routine (sxhash-simple-substring
                          (:translate %sxhash-simple-substring)
                          (:policy :fast-safe)
                          (:arg-types * positive-fixnum)
                          (:result-types positive-fixnum))
                         ((:arg string descriptor-reg a0-offset)
                          (:arg length any-reg a1-offset)
                          (:res result any-reg a0-offset)

                          (:temp lip interior-reg lip-offset)
                          (:temp accum non-descriptor-reg nl0-offset)
                          (:temp data non-descriptor-reg nl1-offset)
                          (:temp byte non-descriptor-reg nl2-offset)
                          (:temp retaddr non-descriptor-reg nl3-offset))

  ;; Save the return address
  (inst subq lip code-tn retaddr)

  ;; Get a pointer to the data.
  (inst addq string
        (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)
        lip)
  (move zero-tn accum)
  (inst br zero-tn test)

  loop

  (inst and data #xff byte)
  (inst xor accum byte accum)
  (inst sll accum 5 byte)
  (inst srl accum 27 accum)
  (inst mskll accum 4 accum)
  (inst bis accum byte accum)

  (inst srl data 8 byte)
  (inst and byte #xff byte)
  (inst xor accum byte accum)
  (inst sll accum 5 byte)
  (inst srl accum 27 accum)
  (inst mskll accum 4 accum)
  (inst bis accum byte accum)

  (inst srl data 16 byte)
  (inst and byte #xff byte)
  (inst xor accum byte accum)
  (inst sll accum 5 byte)
  (inst srl accum 27 accum)
  (inst mskll accum 4 accum)
  (inst bis accum byte accum)

  (inst srl data 24 byte)
  (inst xor accum byte accum)
  (inst sll accum 5 byte)
  (inst srl accum 27 accum)
  (inst mskll accum 4 accum)
  (inst bis accum byte accum)

  (inst addq lip 4 lip)

  test

  (inst subq length (fixnum 4) length)
  (inst ldl data 0 lip)
  (inst bge length loop)

  (inst addq length (fixnum 3) length)
  (inst beq length one-more)
  (inst subq length (fixnum 1) length)
  (inst beq length two-more)
  (inst bne length done)

  (inst srl data 16 byte)
  (inst and byte #xff byte)
  (inst xor accum byte accum)
  (inst sll accum 5 byte)
  (inst srl accum 27 accum)
  (inst mskll accum 4 accum)
  (inst bis accum byte accum)
  (inst addq length (fixnum 1) length)

  two-more

  (inst subq length (fixnum 1) length)
  (inst srl data 8 byte)
  (inst and byte #xff byte)
  (inst xor accum byte accum)
  (inst sll accum 5 byte)
  (inst srl accum 27 accum)
  (inst mskll accum 4 accum)
  (inst bis accum byte accum)
  (inst addq length (fixnum 1) length)

  one-more

  (inst subq length (fixnum 1) length)
  (inst and data #xff byte)
  (inst xor accum byte accum)
  (inst sll accum 5 byte)
  (inst srl accum 27 accum)
  (inst mskll accum 4 accum)
  (inst bis accum byte accum)

  done

  (inst sll accum 5 result)
  (inst mskll result 4 result)
  (inst srl result 3 result)

  ;; Restore the return address.
  (inst addq code-tn retaddr lip))
|#