X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Farray.lisp;h=966cb7aab2215b8ef938a196845df743822676c3;hb=22c1de0a40df83bb5628974010a879cb2c17ff53;hp=a7828a0dead74c203f194ee55abc1ffdd8291410;hpb=50305b602c3953440af716137a56f50cd204375d;p=sbcl.git

diff --git a/src/compiler/x86/array.lisp b/src/compiler/x86/array.lisp
index a7828a0d..966cb7a 100644
--- a/src/compiler/x86/array.lisp
+++ b/src/compiler/x86/array.lisp
@@ -72,6 +72,42 @@
 ;;; Note that the immediate SC for the index argument is disabled
 ;;; because it is not possible to generate a valid error code SC for
 ;;; an immediate value.
+;;;
+;;; FIXME: As per the KLUDGE note explaining the :IGNORE-FAILURE-P
+;;; flag in build-order.lisp-expr, compiling this file causes warnings
+;;;    Argument FOO to VOP CHECK-BOUND has SC restriction
+;;;    DESCRIPTOR-REG which is not allowed by the operand type:
+;;;      (:OR POSITIVE-FIXNUM)
+;;; CSR's message "format ~/ /" on sbcl-devel 2002-03-12 contained
+;;; a possible patch, described as
+;;;   Another patch is included more for information than anything --
+;;;   removing the descriptor-reg SCs from the CHECK-BOUND vop in
+;;;   x86/array.lisp seems to allow that file to compile without error[*],
+;;;   and build; I haven't tested rebuilding capability, but I'd be
+;;;   surprised if there were a problem.  I'm not certain that this is the
+;;;   correct fix, though, as the restrictions on the arguments to the VOP
+;;;   aren't the same as in the sparc and alpha ports, where, incidentally,
+;;;   the corresponding file builds without error currently.
+;;; Since neither of us (CSR or WHN) was quite sure that this is the
+;;; right thing, I've just recorded the patch here in hopes it might
+;;; help when someone attacks this problem again:
+;;;   diff -u -r1.7 array.lisp
+;;;   --- src/compiler/x86/array.lisp 11 Oct 2001 14:05:26 -0000      1.7
+;;;   +++ src/compiler/x86/array.lisp 12 Mar 2002 12:23:37 -0000
+;;;   @@ -76,10 +76,10 @@
+;;;      (:translate %check-bound)
+;;;      (:policy :fast-safe)
+;;;      (:args (array :scs (descriptor-reg))
+;;;   -        (bound :scs (any-reg descriptor-reg))
+;;;   -        (index :scs (any-reg descriptor-reg #+nil immediate) :target result))
+;;;   +        (bound :scs (any-reg))
+;;;   +        (index :scs (any-reg #+nil immediate) :target result))
+;;;      (:arg-types * positive-fixnum tagged-num)
+;;;   -  (:results (result :scs (any-reg descriptor-reg)))
+;;;   +  (:results (result :scs (any-reg)))
+;;;      (:result-types positive-fixnum)
+;;;      (:vop-var vop)
+;;;      (:save-p :compute-only)
 (define-vop (check-bound)
   (:translate %check-bound)
   (:policy :fast-safe)
@@ -235,10 +271,11 @@
 	       (unsigned-reg
 		(let ((shift (* extra ,bits)))
 		  (unless (zerop shift)
-		    (inst ror old shift)
-		    (inst and old (lognot ,(1- (ash 1 bits))))
-		    (inst or old value)
-		    (inst rol old shift)))))
+		    (inst ror old shift))
+                  (inst and old (lognot ,(1- (ash 1 bits))))
+                  (inst or old value)
+		  (unless (zerop shift)
+                    (inst rol old shift)))))
 	     (inst mov (make-ea :dword :base object
 				:disp (- (* (+ word vector-data-offset)
 					    n-word-bytes)
@@ -1206,12 +1243,12 @@
 
 ;;; simple-string
 
-(define-vop (data-vector-ref/simple-string)
+(define-vop (data-vector-ref/simple-base-string)
   (:translate data-vector-ref)
   (:policy :fast-safe)
   (:args (object :scs (descriptor-reg))
 	 (index :scs (unsigned-reg)))
-  (:arg-types simple-string positive-fixnum)
+  (:arg-types simple-base-string positive-fixnum)
   (:temporary (:sc unsigned-reg ; byte-reg
 		   :offset eax-offset ; al-offset
 		   :target value
@@ -1227,12 +1264,12 @@
 			    other-pointer-lowtag)))
     (move value al-tn)))
 
-(define-vop (data-vector-ref-c/simple-string)
+(define-vop (data-vector-ref-c/simple-base-string)
   (:translate data-vector-ref)
   (:policy :fast-safe)
   (:args (object :scs (descriptor-reg)))
   (:info index)
-  (:arg-types simple-string (:constant (signed-byte 30)))
+  (:arg-types simple-base-string (:constant (signed-byte 30)))
   (:temporary (:sc unsigned-reg :offset eax-offset :target value
 		   :from (:eval 0) :to (:result 0))
 	      eax)
@@ -1246,13 +1283,13 @@
 			    other-pointer-lowtag)))
     (move value al-tn)))
 
-(define-vop (data-vector-set/simple-string)
+(define-vop (data-vector-set/simple-base-string)
   (:translate data-vector-set)
   (:policy :fast-safe)
   (:args (object :scs (descriptor-reg) :to (:eval 0))
 	 (index :scs (unsigned-reg) :to (:eval 0))
 	 (value :scs (base-char-reg)))
-  (:arg-types simple-string positive-fixnum base-char)
+  (:arg-types simple-base-string positive-fixnum base-char)
   (:results (result :scs (base-char-reg)))
   (:result-types base-char)
   (:generator 5
@@ -1262,13 +1299,13 @@
 	  value)
     (move result value)))
 
-(define-vop (data-vector-set/simple-string-c)
+(define-vop (data-vector-set/simple-base-string-c)
   (:translate data-vector-set)
   (:policy :fast-safe)
   (:args (object :scs (descriptor-reg) :to (:eval 0))
 	 (value :scs (base-char-reg)))
   (:info index)
-  (:arg-types simple-string (:constant (signed-byte 30)) base-char)
+  (:arg-types simple-base-string (:constant (signed-byte 30)) base-char)
   (:results (result :scs (base-char-reg)))
   (:result-types base-char)
   (:generator 4