;;; 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)
(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)
;;; 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
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)
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
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