Merge pull request #37 from laelath/arith-op-immediate-widths

Disallow immediate values that are too many bits

Author: pdarragh

a86/ast.rkt

@@ -61,8 +61,12 @@
       (error n "expects register; given ~v" a1))
     (unless (or (exact-integer? a2) (register? a2) (offset? a2))
       (error n "expects exact integer, register, or offset; given ~v" a2))
-    (when (and (exact-integer? a2) (> (integer-size a2) 32))
-      (error n "literal must not exceed 32-bits; given ~v (~v bits); go through a register instead" a2 (integer-size a2)))
+    (when (and (register? a1) (exact-integer? a2) (> (integer-size a2) (register-size a1)))
+      (error n "literal must not exceed register size (~v-bits); given ~v (~v bits)"
+             (register-size a1) a2 (integer-size a2)))
+    (when (and (register? a1) (= (register-size a1) 64) (exact-integer? a2) (> (integer-length a2) 31))
+      (error n "literal must not exceed 32-bits signed; given ~v (~v bits signed); go through a register instead"
+             a2 (add1 (integer-length a2))))
     (when (and (register? a1) (register? a2) (not (= (register-size a1) (register-size a2))))
       (error n "cannot move between registers of unequal size; given ~v (~v-bit), ~v (~v-bit)"
              a1 (register-size a1)
@@ -83,8 +87,12 @@
       (error n "expects register, offset, exact integer, or defined constant; given ~v" a2))
     (when (and (offset? a1) (offset? a2))
       (error n "cannot use two memory locations; given ~v, ~v" a1 a2))
-    (when (and (exact-integer? a2) (> (integer-size a2) 32))
-      (error n "literal must not exceed 32-bits; given ~v (~v bits); go through a register instead" a2 (integer-size a2)))
+    (when (and (register? a1) (exact-integer? a2) (> (integer-size a2) (register-size a1)))
+      (error n "literal must not exceed register size (~v-bits); given ~v (~v bits)"
+             (register-size a1) a2 (integer-size a2)))
+    (when (and (register? a1) (= (register-size a1) 64) (exact-integer? a2) (> (integer-length a2) 31))
+      (error n "literal must not exceed 32-bits signed; given ~v (~v bits signed); go through a register instead"
+             a2 (add1 (integer-length a2))))
     (when (and (offset? a1) (exact-integer? a2))
       (error n "cannot use a memory locations and literal; given ~v, ~v; go through a register instead" a1 a2))
     (when (and (register? a1) (register? a2) (not (= (register-size a1) (register-size a2))))

a86/test/errors.rkt

@@ -10,38 +10,50 @@
 (check-not-exn       (thunk (Mov 'rax (- (expt 2 63)))))
 (check-exn exn:fail? (thunk (Cmp 'rax (expt 2 32))))
 (check-exn exn:fail? (thunk (Cmp 'rax (- (add1 (expt 2 31))))))
-(check-not-exn       (thunk (Cmp 'rax (sub1 (expt 2 32)))))
+(check-not-exn       (thunk (Cmp 'rax (sub1 (expt 2 31)))))
 (check-not-exn       (thunk (Cmp 'rax (- (expt 2 31)))))
 (check-exn exn:fail? (thunk (And 'rax (expt 2 32))))
 (check-exn exn:fail? (thunk (And 'rax (- (add1 (expt 2 31))))))
-(check-not-exn       (thunk (And 'rax (sub1 (expt 2 32)))))
+(check-not-exn       (thunk (And 'rax (sub1 (expt 2 31)))))
 (check-not-exn       (thunk (And 'rax (- (expt 2 31)))))
 (check-exn exn:fail? (thunk (Or 'rax (expt 2 32))))
 (check-exn exn:fail? (thunk (Or 'rax (- (add1 (expt 2 31))))))
-(check-not-exn       (thunk (Or 'rax (sub1 (expt 2 32)))))
+(check-not-exn       (thunk (Or 'rax (sub1 (expt 2 31)))))
 (check-not-exn       (thunk (Or 'rax (- (expt 2 31)))))
 (check-exn exn:fail? (thunk (Xor 'rax (expt 2 32))))
 (check-exn exn:fail? (thunk (Xor 'rax (- (add1 (expt 2 31))))))
-(check-not-exn       (thunk (Xor 'rax (sub1 (expt 2 32)))))
+(check-not-exn       (thunk (Xor 'rax (sub1 (expt 2 31)))))
 (check-not-exn       (thunk (Xor 'rax (- (expt 2 31)))))
 (check-exn exn:fail? (thunk (Push (expt 2 32))))
 (check-exn exn:fail? (thunk (Push (- (add1 (expt 2 31))))))
 (check-not-exn       (thunk (Push (sub1 (expt 2 32)))))
 (check-not-exn       (thunk (Push (- (expt 2 31)))))
 (check-exn exn:fail? (thunk (Add 'rax (expt 2 32))))
 (check-exn exn:fail? (thunk (Add 'rax (- (add1 (expt 2 31))))))
-(check-not-exn       (thunk (Add 'rax (sub1 (expt 2 32)))))
+(check-not-exn       (thunk (Add 'rax (sub1 (expt 2 31)))))
 (check-not-exn       (thunk (Add 'rax (- (expt 2 31)))))
 (check-exn exn:fail? (thunk (Sub 'rax (expt 2 32))))
 (check-exn exn:fail? (thunk (Sub 'rax (- (add1 (expt 2 31))))))
-(check-not-exn       (thunk (Sub 'rax (sub1 (expt 2 32)))))
+(check-not-exn       (thunk (Sub 'rax (sub1 (expt 2 31)))))
 (check-not-exn       (thunk (Sub 'rax (- (expt 2 31)))))
 
 ;; Checking literal widths with sub-64-bit registers
 (check-exn exn:fail? (thunk (Mov 'eax (expt 2 32))))
 (check-not-exn       (thunk (Mov 'eax (sub1 (expt 2 32)))))
 (check-exn exn:fail? (thunk (Mov 'al (expt 2 8))))
 (check-not-exn       (thunk (Mov 'al (sub1 (expt 2 8)))))
+(check-not-exn       (thunk (Cmp 'eax (sub1 (expt 2 31)))))
+(check-exn exn:fail? (thunk (Cmp 'al (expt 2 8))))
+(check-not-exn       (thunk (And 'eax (sub1 (expt 2 31)))))
+(check-exn exn:fail? (thunk (And 'al (expt 2 8))))
+(check-not-exn       (thunk (Or 'eax (sub1 (expt 2 31)))))
+(check-exn exn:fail? (thunk (Or 'al (expt 2 8))))
+(check-not-exn       (thunk (Xor 'eax (sub1 (expt 2 31)))))
+(check-exn exn:fail? (thunk (Xor 'al (expt 2 8))))
+(check-not-exn       (thunk (Add 'eax (sub1 (expt 2 31)))))
+(check-exn exn:fail? (thunk (Add 'al (expt 2 8))))
+(check-not-exn       (thunk (Sub 'eax (sub1 (expt 2 31)))))
+(check-exn exn:fail? (thunk (Sub 'al (expt 2 8))))
 
 ;; Check prog
 (check-exn exn:fail? (thunk (prog (Ret))))