os = Debian GNU/Linux 2.2 with libc >= 2.1
host lisp = OpenMCL 0.12
host lisp = SBCL itself
+ os = MacOS X.2
+ host lisp = OpenMCL 0.13.6
+ host lisp = SBCL itself
+ cpu = mips and mipsel
+ os = Debian GNU/Linux 3.0
+ host lisp = SBCL itself
Reports of other systems that it works on (or doesn't work on, for
that matter), or help in making it run on more systems, would be
-(in-package "SB!VM")
+;;;; various array operations that are too expensive (in space) to do
+;;;; inline
+
+;;;; 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")
+\f
(define-assembly-routine (allocate-vector
(:policy :fast-safe)
(:translate allocate-vector)
(inst addu alloc-tn words)
(storew ndescr result 0 other-pointer-lowtag)
(storew length result vector-length-slot other-pointer-lowtag)))
-
-\f
-;;;; 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))
-
- ;; These are needed after we jump into sxhash-simple-substring.
- ;;
- ;; FIXME: *BOGGLE* -- CSR, 2002-08-22
- (progn result lip accum data byte retaddr)
-
- (inst j (make-fixup 'sxhash-simple-substring :assembly-routine))
- (loadw length string vector-length-slot other-pointer-lowtag))
-
-(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 subu retaddr lip code-tn)
-
- ;; Get a pointer to the data.
- (inst addu lip string
- (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))
- (inst b test)
- (move accum zero-tn)
-
- loop
-
- (inst and byte data #xff)
- (inst xor accum accum byte)
- (inst sll byte accum 5)
- (inst srl accum accum 27)
- (inst or accum accum byte)
-
- (inst srl byte data 8)
- (inst and byte byte #xff)
- (inst xor accum accum byte)
- (inst sll byte accum 5)
- (inst srl accum accum 27)
- (inst or accum accum byte)
-
- (inst srl byte data 16)
- (inst and byte byte #xff)
- (inst xor accum accum byte)
- (inst sll byte accum 5)
- (inst srl accum accum 27)
- (inst or accum accum byte)
-
- (inst srl byte data 24)
- (inst xor accum accum byte)
- (inst sll byte accum 5)
- (inst srl accum accum 27)
- (inst or accum accum byte)
-
- (inst addu lip lip 4)
-
- test
-
- (inst addu length length (fixnumize -4))
- (inst lw data lip 0)
- (inst bgez length loop)
- (inst nop)
-
- (inst addu length length (fixnumize 3))
- (inst beq length zero-tn one-more)
- (inst addu length length (fixnumize -1))
- (inst beq length zero-tn two-more)
- (inst addu length length (fixnumize -1))
- (inst bne length zero-tn done)
- (inst nop)
-
- (ecase *backend-byte-order*
- (:big-endian (inst srl byte data 8))
- (:little-endian (inst srl byte data 16)))
- (inst and byte byte #xff)
- (inst xor accum accum byte)
- (inst sll byte accum 5)
- (inst srl accum accum 27)
- (inst or accum accum byte)
-
- two-more
-
- (ecase *backend-byte-order*
- (:big-endian (inst srl byte data 16))
- (:little-endian (inst srl byte data 8)))
- (inst and byte byte #xff)
- (inst xor accum accum byte)
- (inst sll byte accum 5)
- (inst srl accum accum 27)
- (inst or accum accum byte)
-
- one-more
-
- (when (eq *backend-byte-order* :big-endian)
- (inst srl data data 24))
- (inst and byte data #xff)
- (inst xor accum accum byte)
- (inst sll byte accum 5)
- (inst srl accum accum 27)
- (inst or accum accum byte)
-
- done
-
- (inst sll result accum 5)
- (inst srl result result 3)
-
- ;; Restore the return address.
- (inst addu lip code-tn retaddr))
-(in-package "SB!VM")
-
+;;;; various array operations that are too expensive (in space) to do
+;;;; inline
+
+;;;; 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")
+\f
(define-assembly-routine (allocate-vector
(:policy :fast-safe)
(:translate allocate-vector)
(storew ndescr vector 0 sb!vm:other-pointer-lowtag)
(storew length vector sb!vm:vector-length-slot sb!vm:other-pointer-lowtag))
(move result vector))
-
-
-\f
-;;;; Hash primitives
-#|
-#+sb-assembling
-(defparameter sxhash-simple-substring-entry (gen-label))
-
-(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 accum non-descriptor-reg nl0-offset)
- (:temp data non-descriptor-reg nl1-offset)
- (:temp temp non-descriptor-reg nl2-offset)
- (:temp offset non-descriptor-reg nl3-offset))
-
- (declare (ignore result accum data temp offset))
-
- (loadw length string sb!vm:vector-length-slot sb!vm:other-pointer-lowtag)
- (inst b sxhash-simple-substring-entry))
-
-
-(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 accum non-descriptor-reg nl0-offset)
- (:temp data non-descriptor-reg nl1-offset)
- (:temp temp non-descriptor-reg nl2-offset)
- (:temp offset non-descriptor-reg nl3-offset))
- (emit-label sxhash-simple-substring-entry)
-
- (inst li offset (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))
- (move accum zero-tn)
- (inst b test)
-
- LOOP
-
- (inst xor accum accum data)
- (inst slwi temp accum 27)
- (inst srwi accum accum 5)
- (inst or accum accum temp)
- (inst addi offset offset 4)
-
- TEST
-
- (inst subic. length length (fixnumize 4))
- (inst lwzx data string offset)
- (inst bge loop)
-
- (inst addic. length length (fixnumize 4))
- (inst neg length length)
- (inst beq done)
- (inst slwi length length 1)
- (inst srw data data length)
- (inst xor accum accum data)
-
- DONE
-
- (inst slwi result accum 5)
- (inst srwi result result 3))
-|#
\ No newline at end of file
;; the kernel doesn't bitch if we pass it the string.
(storew zero-tn alloc-tn 0)
(move result vector))
-
-
-\f
-;;;; Hash primitives
-
-;;; this is commented out in the alpha port. I'm therefore going to
-;;; comment it out here pending explanation -- CSR, 2001-08-31.
-
-#|
-#+assembler
-(defparameter sxhash-simple-substring-entry (gen-label))
-
-(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 accum non-descriptor-reg nl0-offset)
- (:temp data non-descriptor-reg nl1-offset)
- (:temp temp non-descriptor-reg nl2-offset)
- (:temp offset non-descriptor-reg nl3-offset))
-
- (declare (ignore result accum data temp offset))
-
- (inst b sxhash-simple-substring-entry)
- (loadw length string vector-length-slot other-pointer-lowtag))
-
-
-(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 accum non-descriptor-reg nl0-offset)
- (:temp data non-descriptor-reg nl1-offset)
- (:temp temp non-descriptor-reg nl2-offset)
- (:temp offset non-descriptor-reg nl3-offset))
- (emit-label sxhash-simple-substring-entry)
-
- (inst li offset (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))
- (inst b test)
- (move accum zero-tn)
-
- LOOP
-
- (inst xor accum data)
- (inst sll temp accum 27)
- (inst srl accum 5)
- (inst or accum temp)
- (inst add offset 4)
-
- TEST
-
- (inst subcc length (fixnumize 4))
- (inst b :ge loop)
- (inst ld data string offset)
-
- (inst addcc length (fixnumize 4))
- (inst b :eq done)
- (inst neg length)
- (inst sll length 1)
- (inst srl data length)
- (inst xor accum data)
-
- DONE
-
- (inst sll result accum 5)
- (inst srl result result 3))
-|#
(define-vop (fast-ash/unsigned=>unsigned)
(:note "inline ASH")
(:args (number :scs (unsigned-reg) :to :save)
- (amount :scs (signed-reg)))
+ (amount :scs (signed-reg) :to :save))
(:arg-types unsigned-num signed-num)
(:results (result :scs (unsigned-reg)))
(:result-types unsigned-num)
(:generator 3
(inst bgez amount positive)
(inst subu ndesc zero-tn amount)
- (inst slt temp ndesc 31)
+ (inst slt temp ndesc 32)
(inst bne temp zero-tn done)
(inst srl result number ndesc)
(inst b done)
- (inst srl result number 31)
+ (inst move result zero-tn)
POSITIVE
;; The result-type assures us that this shift will not overflow.
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.3.38"
+"0.8.3.39"
projects / sbcl.git / commitdiff