Changeset 7765 for branches

Timestamp:

Nov 26, 2007, 9:22:11 PM (17 years ago)

Author:

R. Matthew Emerson

Message:

More.

File:

• branches/ia32/compiler/X86/X8632/x8632-vinsns.lisp (modified) (19 diffs)

branches/ia32/compiler/X86/X8632/x8632-vinsns.lisp

@@ -154 +154 @@
                                      ())
   (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 +1728 @@
    (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 +1755 @@
    (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 +1796 @@
                                  (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 +1829 @@
   (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 +2083 @@
   (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 +2100 @@
   (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 +2109 @@
   (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 +2348 @@
   (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 +2361 @@
   (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 +2475 @@
 
 
+;; xxx
 (define-x8632-vinsn setup-double-float-allocation (()
                                                    ())
@@ -2279 +2484 @@
                                             ((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 +2506 @@
                                            ((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 +2550 @@
   (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 +2734 @@
   (jne :bad)
   :go
-  (jmp (:%l x8664::xfn))
+  (jmp (:%l x8632::xfn))
   :bad
   (uuo-error-not-callable))
@@ -2750 +3002 @@
   (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 +3098 @@
   :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 +3157 @@
 (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 +3200 @@
   (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