Changeset 5213

Timestamp:

Sep 19, 2006, 12:15:45 AM (18 years ago)

Author:

Gary Byers

Message:

x8664 vinsns for typechecking signed/unsigned bytes of sizes 8,16,32,64.

File:

• trunk/ccl/compiler/X86/X8664/x8664-vinsns.lisp (modified) (1 diff)

trunk/ccl/compiler/X86/X8664/x8664-vinsns.lisp

@@ -2553 +2553 @@
   :ok)
 
+(define-x8664-vinsn require-s8 (()
+                                ((object :lisp))
+                                ((tag :u32)))
+  :again
+  (movq (:%q object) (:%q tag))
+  (shlq (:$ub (- x8664::nbits-in-word (+ 8 x8664::fixnumshift))) (:%q tag))
+  (sarq (:$ub (- x8664::nbits-in-word (+ 8 x8664::fixnumshift))) (:%q tag))
+  (cmpq (:%q object) (:%q tag))
+  (jne.pn :bad)
+  (testb (:$b x8664::fixnummask) (:%b object))
+  (je.pt :bad)
+  :bad
+  (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-signed-byte-8))
+  (jmp :again)
+  :ok)
+
 (define-x8664-vinsn require-u8 (()
                                 ((object :lisp))
                                 ((tag :u32)))
   :again
-  (movq (:$l (lognot (ash #xff x8664::fixnumshift))) (:%q tag))
+  (movl (:$l (lognot (ash #xff x8664::fixnumshift))) (:%l tag))
   (andq (:% object) (:% tag))
   (je.pt :ok)
   (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-unsigned-byte-8))
   (jmp :again)
+  :ok)
+
+(define-x8664-vinsn require-s16 (()
+                                ((object :lisp))
+                                ((tag :s64)))
+  :again
+  (movq (:%q object) (:%q tag))
+  (shlq (:$ub (- x8664::nbits-in-word (+ 16 x8664::fixnumshift))) (:%q tag))
+  (sarq (:$ub (- x8664::nbits-in-word (+ 16 x8664::fixnumshift))) (:%q tag))
+  (cmpq (:%q object) (:%q tag))
+  (jne.pn :bad)
+  (testb (:$b x8664::fixnummask) (:%b object))
+  (je.pt :bad)
+  :bad
+  (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-signed-byte-16))
+  (jmp :again)
+  :ok)
+
+(define-x8664-vinsn require-u16 (()
+                                ((object :lisp))
+                                ((tag :u32)))
+  :again
+  (movl (:$l (lognot (ash #xffff x8664::fixnumshift))) (:%l tag))
+  (andq (:% object) (:% tag))
+  (je.pt :ok)
+  (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-unsigned-byte-16))
+  (jmp :again)
+  :ok)
+
+(define-x8664-vinsn require-s32 (()
+                                ((object :lisp))
+                                ((tag :s64)))
+  :again
+  (movq (:%q object) (:%q tag))
+  (shlq (:$ub (- x8664::nbits-in-word (+ 32 x8664::fixnumshift))) (:%q tag))
+  (sarq (:$ub (- x8664::nbits-in-word (+ 32 x8664::fixnumshift))) (:%q tag))
+  (cmpq (:%q object) (:%q tag))
+  (jne.pn :bad)
+  (testb (:$b x8664::fixnummask) (:%b object))
+  (je.pt :bad)
+  :bad
+  (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-signed-byte-32))
+  (jmp :again)
+  :ok)
+
+(define-x8664-vinsn require-u32 (()
+                                 ((object :lisp))
+                                 ((tag :u32)))
+  :again
+  (movq (:$q (lognot (ash #xffffffff x8664::fixnumshift))) (:%q tag))
+  (andq (:% object) (:% tag))
+  (je.pt :ok)
+  (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-unsigned-byte-32))
+  (jmp :again)
+  :ok)
+
+(define-x8664-vinsn require-s64 (()
+                                ((object :lisp))
+                                ((tag :s64)))
+  :again
+  (testb (:$b x8664::fixnummask) (:%b object))
+  (movq (:%q object) (:%q tag))
+  (je.pt :ok)
+  (andb (:$b x8664::fulltagmask) (:%b tag))
+  (cmpb (:$b x8664::fulltag-misc) (:%b tag))
+  (jne.pn :bad)
+  (cmpq (:$l x8664::two-digit-bignum-header) (:@ x8664::misc-header-offset (:%q object)))
+  (je.pt :ok)
+  :bad
+  (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-signed-byte-64))
+  (jmp :again)
+  :ok)
+
+(define-x8664-vinsn require-s64 (()
+                                ((object :lisp))
+                                ((tag :s64)))
+  :again
+  (testb (:$b x8664::fixnummask) (:%b object))
+  (movq (:%q object) (:%q tag))
+  (je.pt :ok-if-non-negative)
+  (andb (:$b x8664::fulltagmask) (:%b tag))
+  (cmpb (:$b x8664::fulltag-misc) (:%b tag))
+  (jne.pn :bad)
+  (cmpq (:$l x8664::two-digit-bignum-header) (:@ x8664::misc-header-offset (:%q object)))
+  (je :two)
+  (cmpq (:$l x8664::three-digit-bignum-header) (:@ x8664::misc-header-offset (:%q object)))
+  (je.pn :bad)
+  (cmpl (:$b 0) (:@ (+ x8664::misc-data-offset 8) (:%q object)))
+  (je :ok)
+  :bad
+  (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-unsigned-byte-64))
+  (jmp :again)
+  :two
+  (movq (:@ x8664::misc-data-offset (:%q object)) (:%q tag))
+  :ok-if-non-negative
+  (testq (:%q tag) (:%q tag))
+  (jl :bad)
   :ok)