Index: /branches/ia32/compiler/X86/X8632/x8632-vinsns.lisp
===================================================================
--- /branches/ia32/compiler/X86/X8632/x8632-vinsns.lisp	(revision 7764)
+++ /branches/ia32/compiler/X86/X8632/x8632-vinsns.lisp	(revision 7765)
@@ -154,4 +154,21 @@
 				     ())
   (movsbl (:@ (:apply + x8632::misc-data-offset idx) (:%l v)) (:%l dest)))
+
+(define-x8632-vinsn misc-set-c-s8  (((val :s8))
+				    ((v :lisp)
+				     (idx :u32const))
+				    ())
+  (movb (:%b val) (:@ (:apply + x8632::misc-data-offset idx) (:%l v))))
+
+(define-x8632-vinsn misc-set-s8  (((val :s8))
+				  ((v :lisp)
+				   (scaled-idx :s32))
+				  ())
+  (movb (:%b val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
+
+(define-x8632-vinsn mem-ref-s8 (((dest :s8))
+				((src :address)
+				 (index :s32)))
+  (movsbl (:@ (:%l src) (:%l index)) (:%l dest)))
 
 (define-x8632-vinsn misc-set-c-node (()
@@ -1711,4 +1728,13 @@
    (movl (:$l val) (:@ offset (:%l dest)))))
 
+(define-x8632-vinsn mem-set-c-halfword (()
+					((val :u16)
+					 (dest :address)
+					 (offset :s32const)))
+  ((:pred = offset 0)
+   (movw (:%w val) (:@ (:%l dest))))
+  ((:not (:pred = offset 0))
+   (movw (:%w val) (:@ offset (:%l dest)))))
+
 (define-x8632-vinsn mem-set-c-constant-halfword (()
                                                  ((val :s16const)
@@ -1729,4 +1755,13 @@
    (movb (:$b val) (:@ offset (:%l dest)))))
 
+(define-x8632-vinsn mem-set-c-byte (()
+				    ((val :u8)
+				     (dest :address)
+				     (offset :s32const)))
+  ((:pred = offset 0)
+   (movb (:%b val) (:@ (:%l dest))))
+  ((:not (:pred = offset 0))
+   (movb (:%b val) (:@ offset (:%l dest)))))
+
 (define-x8632-vinsn mem-ref-c-absolute-u8 (((dest :u8))
                                            ((addr :s32const)))
@@ -1761,4 +1796,17 @@
 				 (index :s32)))
   (movzbl (:@ (:%l src) (:%l index)) (:%l dest)))
+
+(define-x8632-vinsn mem-ref-c-u16 (((dest :u16))
+				   ((src :address)
+				    (index :s32const)))
+  ((:pred = index 0)  
+   (movzwl (:@ (:%l src)) (:%l dest)))
+  ((:not (:pred = index 0))
+   (movzwl (:@ index (:%l src)) (:%l dest))))
+
+(define-x8632-vinsn mem-ref-u16 (((dest :u16))
+				 ((src :address)
+				  (index :s32)))
+  (movzwl (:@ (:%l src) (:%l index)) (:%l dest)))
 
 (define-x8632-vinsn mem-set-constant-fullword (()
@@ -1781,6 +1829,54 @@
   (movb (:$b val) (:@ (:%l ptr) (:%l offset))))
 
+(define-x8632-vinsn misc-set-u8  (((val :u8))
+				  ((v :lisp)
+				   (scaled-idx :s32))
+				  ())
+  (movb (:%b val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
+
+(define-x8632-vinsn misc-set-u16  (()
+                                   ((val :u16)
+                                    (v :lisp)
+                                    (scaled-idx :s32))
+                                   ())
+  (movw (:%w val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
+
+(define-x8632-vinsn misc-set-c-s16  (()
+                                    ((val :s16)
+                                     (v :lisp)
+                                     (idx :s32const))
+                                    ())
+  (movw (:%w val) (:@ (:apply + x8632::misc-data-offset (:apply * 2 idx)) (:%l v))))
+
+(define-x8632-vinsn misc-set-s16  (()
+                                   ((val :s16)
+                                    (v :lisp)
+                                    (scaled-idx :s32))
+                                   ())
+  (movw (:%w val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
+
+(define-x8632-vinsn misc-set-c-u32  (()
+				     ((val :u32)
+                                      (v :lisp)
+				      (idx :u32const)) ; sic
+				     ())
+  (movl (:%l val) (:@ (:apply + x8632::misc-data-offset idx) (:%l v))))
+
 (define-x8632-vinsn misc-set-u32  (()
                                    ((val :u32)
+                                    (v :lisp)
+                                    (scaled-idx :s32))
+                                   ())
+  (movl (:%l val) (:@ x8632::misc-data-offset (:%l v) (:%l scaled-idx))))
+
+(define-x8632-vinsn misc-set-c-s32  (()
+				     ((val :s32)
+                                      (v :lisp)
+				      (idx :u32const)) ; sic
+				     ())
+  (movl (:%l val) (:@ (:apply + x8632::misc-data-offset idx) (:%l v))))
+
+(define-x8632-vinsn misc-set-s32  (()
+                                   ((val :s32)
                                     (v :lisp)
                                     (scaled-idx :s32))
@@ -1987,5 +2083,5 @@
   (cmpb (:$b x8632::fulltag-cons) (:%b tag))
   (je :good)
-  (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-list))
+  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-list))
   (jmp :again)
   :good)
@@ -2004,5 +2100,5 @@
   (je :got-it)
   :bad
-  (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-symbol))
+  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-symbol))
   (jmp :again)
   :got-it)
@@ -2013,5 +2109,113 @@
   (cmpl (:$l x8632::subtag-character) (:%l object))
   (je.pt :ok)
-  (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-character))
+  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-character))
+  (jmp :again)
+  :ok)
+
+(define-x8632-vinsn require-s8 (()
+				((object :lisp))
+				((tag :u32)))
+  :again
+  (movl (:%l object) (:%l tag))
+  (shll (:$ub (- x8632::nbits-in-word (+ 8 x8632::fixnumshift))) (:%l tag))
+  (sarl (:$ub (- x8632::nbits-in-word 8)) (:%l tag))
+  (shll (:$ub x8632::fixnumshift) (:%l tag))
+  (cmpl (:%l object) (:%l tag))
+  (je.pt :ok)
+  :bad
+  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-signed-byte-8))
+  (jmp :again)
+  :ok)
+
+(define-x8632-vinsn require-u8 (()
+				((object :lisp))
+				((tag :u32)))
+  :again
+  (movl (:$l (lognot (ash #xff x8632::fixnumshift))) (:%l tag))
+  (andl (:%l object) (:%l tag))
+  (je.pt :ok)
+  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-unsigned-byte-8))
+  (jmp :again)
+  :ok)
+
+(define-x8632-vinsn require-s16 (()
+				((object :lisp))
+				((tag :s32)))
+  :again
+  (movl (:%l object) (:%l tag))
+  (shll (:$ub (- x8632::nbits-in-word (+ 16 x8632::fixnumshift))) (:%l tag))
+  (sarl (:$ub (- x8632::nbits-in-word 16)) (:%l tag))
+  (shll (:$ub x8632::fixnumshift) (:%l tag))
+  (cmpl (:%l object) (:%l tag))
+  (je.pt :ok)
+  :bad
+  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-signed-byte-16))
+  (jmp :again)
+  :ok)
+
+(define-x8632-vinsn require-u16 (()
+				((object :lisp))
+				((tag :u32)))
+  :again
+  (movl (:$l (lognot (ash #xffff x8632::fixnumshift))) (:%l tag))
+  (andl (:%l object) (:%l tag))
+  (je.pt :ok)
+  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-unsigned-byte-16))
+  (jmp :again)
+  :ok)
+
+(define-x8632-vinsn require-s32 (()
+				 ((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::one-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
+  (je.pt :ok)
+  :bad
+  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-signed-byte-32))
+  (jmp :again)
+  :ok)
+
+(define-x8632-vinsn require-u32 (()
+				 ((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::one-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
+  (je :one)
+  (cmpl (:$l x8632::two-digit-bignum-header) (:@ x8632::misc-header-offset (:%l object)))
+  (jne.pn :bad)
+  (cmpl (:$b 0) (:@ (+ x8632::misc-data-offset 4) (:%l object)))
+  (je :ok)
+  :bad
+  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-unsigned-byte-32))
+  (jmp :again)
+  :one
+  (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))
+                                       ((tag :u32)))
+  :again
+  (testb (:$b x8632::fixnummask) (:%b object))
+  (jne.pn :bad)
+  (cmpl (:$l (ash #x110000 x8632::fixnumshift)) (:%l object))
+  (jb.pt :ok)
+  :bad
+  (uuo-error-reg-not-type (:%l object) (:$ub arch::error-object-not-mod-char-code-limit))
   (jmp :again)
   :ok)
@@ -2144,6 +2348,6 @@
   (je :nilsym)
   ;; tag-misc?
-  (andb (:$b x8664::tagmask) (:%b tag))
-  (cmpb (:$b x8664::tag-misc) (:%b tag))
+  (andb (:$b x8632::tagmask) (:%b tag))
+  (cmpb (:$b x8632::tag-misc) (:%b tag))
   (jne :bad)
   ;; symbol?
@@ -2157,5 +2361,5 @@
   (jmp :ok)
   :bad
-  (uuo-error-reg-not-tag (:%q src) (:$ub x8632::subtag-symbol))
+  (uuo-error-reg-not-tag (:%l src) (:$ub x8632::subtag-symbol))
   :nilsym
   (movl (:$l (+ x8632::nil-value x8632::nilsym-offset)) (:%l dest))
@@ -2271,4 +2475,5 @@
 
 
+;; xxx
 (define-x8632-vinsn setup-double-float-allocation (()
                                                    ())
@@ -2279,5 +2484,5 @@
                                             ((node :lisp)
                                              (val :double-float)))
-  (movsd (:%xmm val) (:@ x8664::double-float.value (:%l node))))
+  (movsd (:%xmm val) (:@ x8632::double-float.value (:%l node))))
 
 (define-x8632-vinsn set-macptr-address (()
@@ -2301,4 +2506,30 @@
                                            ((ptr :lisp)))
   (movd (:%mmx x8632::mm1) (:@ x8632::macptr.address (:%l ptr))))
+
+(define-x8632-vinsn mem-ref-c-fullword (((dest :u32))
+					((src :address)
+					 (index :s32const)))
+  ((:pred = index 0)
+   (movl (:@ (:%l src)) (:%l dest)))
+  ((:not (:pred = index 0))
+   (movl (:@ index (:%l src)) (:%l dest))))
+
+(define-x8632-vinsn mem-ref-c-signed-fullword (((dest :s32))
+                                               ((src :address)
+                                                (index :s32const)))
+  ((:pred = index 0)
+   (movl (:@ (:%l src)) (:%l dest)))
+  ((:not (:pred = index 0))
+   (movl (:@ index (:%l src)) (:%l dest))))
+
+(define-x8632-vinsn mem-ref-fullword (((dest :u32))
+				      ((src :address)
+				       (index :s32)))
+  (movl (:@ (:%l src) (:%l index)) (:%l dest)))
+
+(define-x8632-vinsn mem-ref-signed-fullword (((dest :s32))
+                                             ((src :address)
+                                              (index :s32)))
+  (movl (:@ (:%l src) (:%l index)) (:%l dest)))
 
 ;;; xxx 16? movapd?
@@ -2319,4 +2550,25 @@
   (movl (:%l src) (:%l dest))
   (sarl (:$ub x8632::fixnumshift) (:%l dest)))
+
+(define-x8632-vinsn mem-set-double-float (()
+					  ((val :double-float)
+					   (src :address)
+					   (index :s32)))
+  (movsd (:%xmm val) (:@ (:%l src) (:%l index))))
+
+(define-x8632-vinsn mem-set-single-float (()
+					  ((val :single-float)
+					   (src :address)
+					   (index :s32)))
+  (movss (:%xmm val) (:@ (:%l src) (:%l index))))
+
+(define-x8632-vinsn mem-set-c-fullword (()
+                                          ((val :u32)
+                                           (dest :address)
+                                           (offset :s32const)))
+  ((:pred = offset 0)
+   (movl (:%l val) (:@ (:%l dest))))
+  ((:not (:pred = offset 0))
+   (movl (:%l val) (:@ offset (:%l dest)))))
 
 (define-x8632-vinsn %natural+  (((result :u32))
@@ -2482,5 +2734,5 @@
   (jne :bad)
   :go
-  (jmp (:%l x8664::xfn))
+  (jmp (:%l x8632::xfn))
   :bad
   (uuo-error-not-callable))
@@ -2750,4 +3002,21 @@
   (movsd (:%xmm source) (:@  x8632::double-float.value (:%l dest))))
 
+(define-x8632-vinsn fixnum->char (((dest :lisp))
+				  ((src :imm))
+				  ((temp :u32)))
+  (movl (:%l src) (:%l temp))
+  (sarl (:$ub (+ x8632::fixnumshift 11)) (:%l temp))
+  (cmpl (:$b (ash #xd800 -11))(:%l temp))
+  (movl (:$l x8632::nil-value) (:%l temp))
+  (cmovel (:%l temp) (:%l dest))
+  (je :done)
+  ((:not (:pred =
+                (:apply %hard-regspec-value dest)
+                (:apply %hard-regspec-value src)))
+   (movl (:%l src) (:%l dest)))
+  (shll (:$ub (- x8632::charcode-shift x8632::fixnumshift)) (:%l dest))
+  (addb (:$b x8632::subtag-character) (:%b dest))
+  :done)
+
 
 (define-x8632-subprim-jump-vinsn (tail-funcall-gen) .SPtfuncallgen)
@@ -2829,9 +3098,15 @@
   :ok)
 
+(define-x8632-subprim-lea-jmp-vinsn (heap-cons-rest-arg) .SPheap-cons-rest-arg)
+
+(define-x8632-subprim-lea-jmp-vinsn (stack-cons-rest-arg) .SPstack-cons-rest-arg)
+
+(define-x8632-subprim-lea-jmp-vinsn (make-stack-vector)  .SPmkstackv)
+
 (define-x8632-vinsn  %slot-ref (((dest :lisp))
 				((instance (:lisp (:ne dest)))
 				 (index :lisp)))
   (movl (:@ x8632::misc-data-offset (:%l instance) (:%l index)) (:%l dest))
-  (cmpl (:$l x8664::slot-unbound-marker) (:%l dest))
+  (cmpl (:$l x8632::slot-unbound-marker) (:%l dest))
   (jne.pt :ok)
   (uuo-error-slot-unbound (:%l dest) (:%l instance) (:%l index))
@@ -2882,5 +3157,5 @@
 (define-x8632-vinsn one-opt-supplied-p (()
                                         ())
-  (testw (:%w x8664::nargs) (:%w x8664::nargs))
+  (testw (:%w x8632::nargs) (:%w x8632::nargs))
   (je :one)
   (pushl (:$l x8632::nil-value))
@@ -2925,4 +3200,21 @@
   (btsl (:$ub (:apply %hard-regspec-value reg)) (:@ (:%seg :rcontext) x8632::tcr.node-regs-mask)))
 
+;;; need 16 byte alignment here?
+(define-x8632-vinsn (temp-push-unboxed-word :push :word :csp)
+    (()
+     ((w :u32)))
+  (movd (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%mmx x8632::stack-temp))
+  (subl (:$b 8) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
+  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l x8632::ra0))  
+  (movd (:%mmx x8632::stack-temp) (:@ (:%l x8632::ra0)))
+  (movl (:%l w) (:@ 4 (:%l x8632::ra0))))
+
+(define-x8632-vinsn (temp-pop-unboxed-word :pop :word :csp)
+    (((w :u32))
+     ())
+  (movl (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%l x8632::ra0))
+  (movl (:@ 4 (:%l x8632::ra0)) (:%l w))
+  (addl (:$b 8) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp)))
+
 (queue-fixup
  (fixup-x86-vinsn-templates