X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fassembly%2Fppc%2Farray.lisp;h=e59c3c08917adb8c2d5514da5755e2eb50152c2a;hb=2ad50715571eb8ccfb9ab55c13b8c038c89f2dfd;hp=ba9ebf04b904173df390fd6611a7154f8172cdce;hpb=1419c1d2d50f039be46a8667351b7738ac4965e4;p=sbcl.git diff --git a/src/assembly/ppc/array.lisp b/src/assembly/ppc/array.lisp index ba9ebf0..e59c3c0 100644 --- a/src/assembly/ppc/array.lisp +++ b/src/assembly/ppc/array.lisp @@ -1,98 +1,51 @@ -(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) - (: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) - (:temp pa-flag non-descriptor-reg nl3-offset) - (:temp vector descriptor-reg a3-offset)) + (: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) + (:temp pa-flag non-descriptor-reg nl3-offset) + (:temp vector descriptor-reg a3-offset) + (:temp temp non-descriptor-reg nl2-offset)) (pseudo-atomic (pa-flag) - (inst ori vector alloc-tn sb!vm:other-pointer-lowtag) - (inst addi ndescr words (* (1+ sb!vm:vector-data-offset) sb!vm:n-word-bytes)) + ;; boxed words == unboxed bytes + (inst addi ndescr words (* (1+ vector-data-offset) n-word-bytes)) (inst clrrwi ndescr ndescr n-lowtag-bits) - (inst add alloc-tn alloc-tn ndescr) - (inst srwi ndescr type sb!vm:word-shift) - (storew ndescr vector 0 sb!vm:other-pointer-lowtag) - (storew length vector sb!vm:vector-length-slot sb!vm:other-pointer-lowtag)) + (allocation vector ndescr other-pointer-lowtag + :temp-tn temp + :flag-tn pa-flag) + (inst srwi ndescr type word-shift) + (storew ndescr vector 0 other-pointer-lowtag) + (storew length vector vector-length-slot other-pointer-lowtag)) + ;; This makes sure the zero byte at the end of a string is paged in so + ;; the kernel doesn't bitch if we pass it the string. + ;; + ;; rtoy says to turn this off as it causes problems with CMUCL. + ;; + ;; I don't think we need to do this anymore. It looks like this + ;; inherited from the SPARC port and does not seem to be + ;; necessary. Turning this on worked at some point, but I have not + ;; tested with the final GENGC-related changes. CLH 20060221 + ;; + ;; (storew zero-tn alloc-tn 0) (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