Index: /branches/ia32/compiler/X86/X8632/x8632-vinsns.lisp
===================================================================
--- /branches/ia32/compiler/X86/X8632/x8632-vinsns.lisp	(revision 7816)
+++ /branches/ia32/compiler/X86/X8632/x8632-vinsns.lisp	(revision 7817)
@@ -412,4 +412,12 @@
 (define-x8632-vinsn (lri :constant-ref) (((dest :imm))
                                          ((intval :s32const))
+                                         ())
+  ((:pred = intval 0)
+   (xorl (:%l dest) (:%l dest)))
+  ((:not (:pred = intval 0))
+   (movl (:$l intval) (:%l dest))))
+
+(define-x8632-vinsn (lriu :constant-ref) (((dest :imm))
+                                         ((intval :u32const))
                                          ())
   ((:pred = intval 0)
@@ -1810,4 +1818,17 @@
   (movzwl (:@ (:%l src) (:%l index)) (:%l dest)))
 
+(define-x8632-vinsn mem-ref-c-s16 (((dest :s16))
+				   ((src :address)
+				    (index :s32const)))
+  ((:pred = index 0)
+   (movswl (:@ (:%l src)) (:%l dest)))
+  ((:not (:pred = index 0))
+   (movswl (:@ index (:%l src)) (:%l dest))))
+
+(define-x8632-vinsn mem-ref-s16 (((dest :s16))
+				 ((src :address)
+				  (index :s32)))
+  (movswl (:@ (:%l src) (:%l index)) (:%l dest)))
+
 (define-x8632-vinsn mem-ref-c-u8 (((dest :u8))
 				  ((src :address)
@@ -1921,4 +1942,23 @@
                                    ())
   (movl (:%l val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
+
+(define-x8632-vinsn %iasr (((dest :imm))
+			   ((count :imm)
+			    (src :imm))
+			   ((temp :s32)
+                            (shiftcount (:s32 #.x8664::rcx))))
+  (movl (:%l count) (:%l temp))
+  (sarl (:$ub x8632::fixnumshift) (:%l temp))
+  (rcmpl (:%l temp) (:$l 31))
+  (cmovbw (:%w temp) (:%w shiftcount))
+  (movl (:%l src) (:%l temp))
+  (jae :shift-max)
+  (sarl (:%shift x8632::cl) (:%l temp))
+  (jmp :done)
+  :shift-max
+  (sarl (:$ub 31) (:%l temp))
+  :done
+  (andl (:$l (lognot x8632::fixnummask)) (:%l temp))
+  (movl (:%l temp) (:%l dest)))
 
 (define-x8632-vinsn %ilsr (((dest :imm))
@@ -1986,4 +2026,57 @@
    (movl (:%l src) (:%l dest)))
   (shll (:$ub count) (:%l dest)))
+
+;;; In safe code, something else has ensured that the value is of type
+;;; BIT.
+(define-x8632-vinsn set-variable-bit-to-variable-value (()
+                                                        ((vec :lisp)
+                                                         (word-index :s32)
+                                                         (bitnum :u8)
+                                                         (value :lisp)))
+  (testl (:%l value) (:%l value))
+  (je :clr)
+  (btsl (:%l bitnum) (:@ x8632::misc-data-offset (:%l vec) (:%l word-index) 4))
+  (jmp :done)
+  :clr
+  (btrl (:%l bitnum) (:@ x8632::misc-data-offset (:%l vec) (:%l word-index) 4))
+  :done)
+
+(define-x8632-vinsn set-variable-bit-to-zero (()
+                                              ((vec :lisp)
+                                               (word-index :s32)
+                                               (bitnum :u8)))
+  (btrl (:%l bitnum) (:@ x8632::misc-data-offset (:%l vec) (:%l word-index) 4)))
+
+(define-x8632-vinsn set-variable-bit-to-one (()
+					     ((vec :lisp)
+					      (word-index :s32)
+					      (bitnum :u8)))
+  (btsl (:%l bitnum) (:@ x8632::misc-data-offset (:%l vec) (:%l word-index) 4)))
+
+(define-x8632-vinsn set-constant-bit-to-zero (()
+                                              ((src :lisp)
+                                               (idx :u32const)))
+  (btrl (:$ub (:apply logand 31 idx))
+        (:@ (:apply + x8632::misc-data-offset (:apply ash (:apply ash idx -5) x8632::word-shift)) (:%l src))))
+
+(define-x8632-vinsn set-constant-bit-to-one (()
+                                             ((src :lisp)
+                                              (idx :u32const)))
+  (btsl (:$ub (:apply logand 31 idx))
+        (:@ (:apply + x8632::misc-data-offset (:apply ash (:apply ash idx -5) x8632::word-shift)) (:%l src))))
+
+(define-x8632-vinsn set-constant-bit-to-variable-value (()
+                                                        ((src :lisp)
+                                                         (idx :u32const)
+                                                         (value :lisp)))
+  (testl (:%l value) (:%l value))
+  (je :clr)
+  (btsl (:$ub (:apply logand 31 idx))
+        (:@ (:apply + x8632::misc-data-offset (:apply ash (:apply ash idx -5) x8632::word-shift)) (:%l src)))
+  (jmp :done)
+  :clr
+  (btrl (:$ub (:apply logand 31 idx))
+        (:@ (:apply + x8632::misc-data-offset (:apply ash (:apply ash idx -5) x8632::word-shift)) (:%l src)))
+  :done)
 
 (define-x8632-vinsn require-fixnum (()
@@ -2246,4 +2339,47 @@
   :ok)
 
+(define-x8632-vinsn require-s64 (()
+				 ((object :lisp))
+				 ((tag :s32)))
+  :again
+  (testl (:$l x8632::fixnummask) (:%l object))
+  (movl (:%l object) (:%l tag))
+  (je.pt :ok)
+  (andl (:$l x8632::fulltagmask) (:%l tag))
+  (cmpl (:$l x8632::fulltag-misc) (:%l tag))
+  (jne.pn :bad)
+  (cmpl (:$l x8632::two-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
+  (jne.pt :ok)
+  :bad
+  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-signed-byte-64))
+  (jmp :again)
+  :ok)
+
+(define-x8632-vinsn require-u64 (()
+				 ((object :lisp))
+				 ((tag :s32)))
+  :again
+  (testl (:$l x8632::fixnummask) (:%l object))
+  (movl (:%l object) (:%l tag))
+  (je.pt :ok-if-non-negative)
+  (andl (:$l x8632::fulltagmask) (:%l tag))
+  (cmpl (:$l x8632::fulltag-misc) (:%l tag))
+  (jne.pn :bad)
+  (cmpl (:$l x8632::two-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
+  (je :two)
+  (cmpl (:$l x8632::three-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
+  (jne.pn :bad)
+  (cmpl (:$b 0) (:@ (+ x8632::misc-data-offset 8) (:%l object)))
+  (je :ok)
+  :bad
+  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-unsigned-byte-64))
+  (jmp :again)
+  :two
+  (movl (:@ x8632::misc-data-offset (:%l object)) (:%l tag))
+  :ok-if-non-negative
+  (testl (:%l tag) (:%l tag))
+  (js :bad)
+  :ok)
+
 (define-x8632-vinsn require-char-code (()
                                        ((object :lisp))
@@ -2513,9 +2649,20 @@
 
 
-;; xxx
+(define-x8632-vinsn setup-single-float-allocation (()
+						   ())
+  (movl (:$l (arch::make-vheader x8632::single-float.element-count x8632::subtag-single-float)) (:%l x8632::imm0))
+  (movd (:%l x8632::imm0) (:%mmx x8632::mm0))
+  (movl (:$l (- x8632::single-float.size x8632::fulltag-misc)) (:%l x8632::imm0)))
+  
 (define-x8632-vinsn setup-double-float-allocation (()
                                                    ())
   (movl (:$l (arch::make-vheader x8632::double-float.element-count x8632::subtag-double-float)) (:%l x8632::imm0))
-  (movl (:$l (- x8632::double-float.size x8632::fulltag-misc)) (:%l x8664::imm1.l)))
+  (movd (:%l x8632::imm0) (:%mmx x8632::mm0))
+  (movl (:$l (- x8632::double-float.size x8632::fulltag-misc)) (:%l x8632::imm0)))
+
+(define-x8632-vinsn set-single-float-value (()
+                                            ((node :lisp)
+                                             (val :single-float)))
+  (movss (:%xmm val) (:@ x8632::single-float.value (:%l node))))
 
 (define-x8632-vinsn set-double-float-value (()
@@ -2523,4 +2670,24 @@
                                              (val :double-float)))
   (movsd (:%xmm val) (:@ x8632::double-float.value (:%l node))))
+
+(define-x8632-vinsn word-index-and-bitnum-from-index (((word-index :u32)
+                                                       (bitnum :u8))
+                                                      ((index :imm)))
+  (movl (:%l index) (:%l word-index))
+  (shrl (:$ub x8632::fixnumshift) (:%l word-index))
+  (movl (:$l 31) (:%l bitnum))
+  (andl (:%l word-index) (:%l bitnum))
+  (shrl (:$ub 5) (:%l word-index)))
+
+(define-x8632-vinsn ref-bit-vector-fixnum (((dest :imm)
+                                            (bitnum :u8))
+                                           ((bitnum :u8)
+                                            (bitvector :lisp)
+                                            (word-index :u32)))
+  (btl (:%l bitnum) (:@ x8632::misc-data-offset (:%l bitvector) (:%l word-index) 4))
+  (setb (:%b bitnum))
+  (negb (:%b bitnum))
+  (andl (:$l x8632::fixnumone) (:%l bitnum))
+  (movl (:%l bitnum) (:%l dest)))
 
 (define-x8632-vinsn set-macptr-address (()
@@ -2591,4 +2758,20 @@
    (movl (:@ index (:%l src)) (:%l dest))))
 
+(define-x8632-vinsn mem-ref-c-double-float (((dest :double-float))
+                                            ((src :address)
+                                             (index :s32const)))
+  ((:pred = index 0)
+   (movsd (:@ (:%l src)) (:%xmm dest)))
+  ((:not (:pred = index 0))
+   (movsd (:@ index (:%l src)) (:%xmm dest))))
+
+(define-x8632-vinsn mem-set-c-double-float (()
+					    ((val :double-float)
+					     (src :address)
+					     (index :s32const)))
+  ((:pred = index 0)
+   (movsd (:%xmm val) (:@ (:%l src))))
+  ((:not (:pred = index 0))
+   (movsd (:%xmm val) (:@ index (:%l src)))))
 
 (define-x8632-vinsn mem-ref-fullword (((dest :u32))
@@ -2640,4 +2823,23 @@
   ((:not (:pred = offset 0))
    (movl (:%l val) (:@ offset (:%l dest)))))
+
+(define-x8632-vinsn mem-set-bit-variable-value (((src :address))
+                                                ((src :address)
+                                                 (offset :lisp)
+                                                 (value :lisp))
+                                                ((temp :u32)))
+  (movl (:%l offset) (:%l temp))
+  (shrl (:$ub (+ 5 x8632::fixnumshift)) (:%l temp))
+  (leal (:@ (:%l src) (:%l temp) 4) (:%l src))
+  (movl (:%l offset) (:%l temp))
+  (shrl (:$ub x8632::fixnumshift) (:%l temp))
+  (andl (:$l 31) (:%l temp))
+  (testl (:%l value) (:%l value))
+  (jne :set)
+  (btrl (:%l temp) (:@ (:%l src)))
+  (jmp :done)
+  :set
+  (btsl (:%l temp) (:@ (:%l src)))
+  :done)
 
 (define-x8632-vinsn %natural+  (((result :u32))
@@ -2986,4 +3188,26 @@
   (movl (:$self 0) (:%l x8632::fn)))
 
+(define-x8632-vinsn %set-scharcode32 (()
+				    ((str :lisp)
+				     (idx :imm)
+				     (code :imm))
+				    ((imm :u32)
+				     (imm1 :u32)))
+  (movl (:%l code) (:%l imm1))
+  (movl (:%l idx) (:%l imm))
+  (shrl (:$ub x8632::fixnumshift) (:%l imm1))
+  (shrl (:$ub 2) (:%l imm))
+  (movl (:%l imm1) (:@ x8632::misc-data-offset (:%l str) (:%l imm))))
+
+(define-x8632-vinsn pop-argument-registers (()
+                                            ())
+  (testw (:%w x8632::nargs) (:%w x8632::nargs))
+  (je :done)
+  (rcmpw (:%w x8632::nargs) (:$w (ash 1 x8632::word-shift)))
+  (popl (:%l x8632::arg_z))
+  (je :done)
+  (popl (:%l x8664::arg_y))
+  :done)
+
 (define-x8632-vinsn %symptr->symvector (((target :lisp))
                                         ((target :lisp)))
@@ -3096,4 +3320,11 @@
 
 ;;; "dest" is preallocated, presumably on a stack somewhere.
+(define-x8632-vinsn store-single (()
+				  ((dest :lisp)
+				   (source :single-float))
+				  ())
+  (movss (:%xmm source) (:@  x8632::single-float.value (:%l dest))))
+
+;;; "dest" is preallocated, presumably on a stack somewhere.
 (define-x8632-vinsn store-double (()
 				  ((dest :lisp)
@@ -3235,4 +3466,20 @@
                     (:apply ash cellno 2))
               (:%l src)) (:%l dest)))
+
+(define-x8632-vinsn mem-ref-bit-fixnum (((dest :lisp)
+                                         (src :address))
+                                        ((src :address)
+                                         (offset :lisp))
+                                        ((temp :u32)))
+  (movl (:%l offset) (:%l temp))
+  (shrl (:$ub (+ 5 x8632::fixnumshift)) (:%l temp))
+  (leal (:@ (:%l src) (:%l temp) 4) (:%l src))
+  (movl (:%l offset) (:%l temp))
+  (shrl (:$ub x8632::fixnumshift) (:%l temp))
+  (andl (:$l 31) (:%l temp))
+  (btl (:%l temp) (:@ (:%l src)))
+  (movl (:$l x8632::fixnumone) (:%l temp))
+  (leal (:@ (- x8632::fixnumone) (:%l temp)) (:%l dest))
+  (cmovbl (:%l temp) (:%l dest)))
 
 (define-x8632-subprim-call-vinsn (progvsave) .SPprogvsave)
@@ -3370,4 +3617,26 @@
   (addl (:$b 8) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp)))
 
+(define-x8632-vinsn (temp-push-node :push :word :tsp)
+    (()
+     ((w :lisp))
+     ((temp :imm)))
+  (subl (:$b (* 2 x8632::dnode-size)) (:@ (:%seg :rcontext) x8632::tcr.next-tsp))
+  (movd (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%mmx x8632::stack-temp))
+  (movl (:@ (:%seg :rcontext) x8632::tcr.next-tsp) (:%l temp))
+  (movapd (:%xmm x8632::fpzero) (:@ (:%l temp)))
+  (movd (:%mmx x8632::stack-temp) (:@ (:%l temp)))
+  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))
+  (movl (:%l w) (:@ x8632::dnode-size (:%l temp))))
+
+(define-x8632-vinsn (temp-pop-node :pop :word :tsp)
+    (((w :lisp))
+     ()
+     ((temp :imm)))
+  (movl (:@ (:%seg :rcontext) x8632::tcr.save-tsp) (:%l temp))
+  (movl (:@ x8632::dnode-size (:%l temp)) (:%l w))
+  (movl (:@ (:%l temp)) (:%l temp))
+  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.save-tsp))  
+  (movl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.next-tsp)))
+
 (queue-fixup
  (fixup-x86-vinsn-templates