From 1b650be8b800cf96e2c268ae317fb26d0bf36827 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sat, 6 Sep 2003 11:03:20 +0000 Subject: [PATCH] 0.8.3.39: Fix the ASH bugs for mips (I think) ... just one vop to fix While I'm at it, delete unused or bogus SXHASH assembly routines; Add mips to INSTALL as suggested by Lars Brinkhoff. --- INSTALL | 6 ++ src/assembly/mips/array.lisp | 147 ++++------------------------------------- src/assembly/ppc/array.lisp | 87 ++++-------------------- src/assembly/sparc/array.lisp | 76 --------------------- src/compiler/mips/arith.lisp | 6 +- version.lisp-expr | 2 +- 6 files changed, 36 insertions(+), 288 deletions(-) diff --git a/INSTALL b/INSTALL index 5839336..307e925 100644 --- a/INSTALL +++ b/INSTALL @@ -77,6 +77,12 @@ This software has been built successfully on these systems: 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 diff --git a/src/assembly/mips/array.lisp b/src/assembly/mips/array.lisp index d59d5ee..aaaff08 100644 --- a/src/assembly/mips/array.lisp +++ b/src/assembly/mips/array.lisp @@ -1,5 +1,17 @@ -(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") + (define-assembly-routine (allocate-vector (:policy :fast-safe) (:translate allocate-vector) @@ -26,136 +38,3 @@ (inst addu alloc-tn words) (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)) - - ;; 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)) diff --git a/src/assembly/ppc/array.lisp b/src/assembly/ppc/array.lisp index ba9ebf0..4b68ace 100644 --- a/src/assembly/ppc/array.lisp +++ b/src/assembly/ppc/array.lisp @@ -1,6 +1,17 @@ -(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") + (define-assembly-routine (allocate-vector (:policy :fast-safe) (:translate allocate-vector) @@ -24,75 +35,3 @@ (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)) - - - -;;;; 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 diff --git a/src/assembly/sparc/array.lisp b/src/assembly/sparc/array.lisp index 5b4f5fd..7f428e7 100644 --- a/src/assembly/sparc/array.lisp +++ b/src/assembly/sparc/array.lisp @@ -36,79 +36,3 @@ ;; the kernel doesn't bitch if we pass it the string. (storew zero-tn alloc-tn 0) (move result vector)) - - - -;;;; 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)) -|# diff --git a/src/compiler/mips/arith.lisp b/src/compiler/mips/arith.lisp index 05a47b5..a0f9b35 100644 --- a/src/compiler/mips/arith.lisp +++ b/src/compiler/mips/arith.lisp @@ -190,7 +190,7 @@ (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) @@ -201,11 +201,11 @@ (: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. diff --git a/version.lisp-expr b/version.lisp-expr index 5044d09..d4e7204 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; 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" -- 1.7.10.4