Merge branch 'main' into jo

Author: dvanhorn

langs/a86/ast.rkt

@@ -43,6 +43,8 @@
       (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-length a2) 32))
+      (error n "literal must not exceed 32-bits; given ~v (~v bits); go through a register instead" a2 (integer-length a2)))
     (values a1 a2)))
 
 (define check:register
@@ -59,6 +61,22 @@
       (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-length a2) 32))
+      (error n "literal must not exceed 32-bits; given ~v (~v bits); go through a register instead" a2 (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))
+    (values a1 a2)))
+
+(define check:mov
+  (λ (a1 a2 n)
+    (unless (or (register? a1) (offset? a1))
+      (error n "expects register or offset; given ~v" a1))
+    (unless (or (register? a2) (offset? a2) (exact-integer? a2) (Const? a2))
+      (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-length a2) 64))
+      (error n "literal must not exceed 64-bits; given ~v (~v bits)" a2 (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))
     (values a1 a2)))
@@ -84,6 +102,8 @@
   (λ (a1 n)
     (unless (or (exact-integer? a1) (register? a1))
       (error n "expects exact integer or register; given ~v" a1))
+    (when (and (exact-integer? a1) (> (integer-length a1) 32))
+      (error n "literal must not exceed 32-bits; given ~v (~v bits); go through a register instead" a1 (integer-length a1)))
     a1))
 
 (define check:lea
@@ -134,7 +154,7 @@
 (instruct Label  (x)       check:label-symbol)
 (instruct Call   (x)       check:target)
 (instruct Ret    ()        check:none)
-(instruct Mov    (dst src) check:src-dest)
+(instruct Mov    (dst src) check:mov)
 (instruct Add    (dst src) check:arith)
 (instruct Sub    (dst src) check:arith)
 (instruct Cmp    (a1 a2)   check:src-dest)
@@ -192,14 +212,22 @@
       (symbol? x)
       (integer? x)))
 
-(provide offset? register? instruction? label?)
+(provide offset? register? instruction? label? 64-bit-integer? 32-bit-integer?)
 
 (define offset? Offset?)
 
 (define (register? x)
   (and (memq x '(cl eax rax rbx rcx rdx rbp rsp rsi rdi r8 r9 r10 r11 r12 r13 r14 r15))
        #t))
 
+(define (64-bit-integer? x)
+  (and (exact-integer? x)
+       (<= (integer-length x) 64)))
+
+(define (32-bit-integer? x)
+  (and (exact-integer? x)
+       (<= (integer-length x) 32)))
+
 (define (label? x)
   (and (symbol? x)
        (nasm-label? x)

langs/a86/test/errors.rkt

@@ -2,3 +2,21 @@
 (require rackunit "../ast.rkt")
 (check-exn exn:fail?
            (thunk (Mov (Offset 'rax 0) 100)))
+
+;; Checking literal widths
+(check-exn exn:fail? (thunk (Mov 'rax (expt 2 64))))
+(check-not-exn       (thunk (Mov 'rax (sub1 (expt 2 64)))))
+(check-exn exn:fail? (thunk (Cmp 'rax (expt 2 32))))
+(check-not-exn       (thunk (Cmp 'rax (sub1 (expt 2 32)))))
+(check-exn exn:fail? (thunk (And 'rax (expt 2 32))))
+(check-not-exn       (thunk (And 'rax (sub1 (expt 2 32)))))
+(check-exn exn:fail? (thunk (Or 'rax (expt 2 32))))
+(check-not-exn       (thunk (Or 'rax (sub1 (expt 2 32)))))
+(check-exn exn:fail? (thunk (Xor 'rax (expt 2 32))))
+(check-not-exn       (thunk (Xor 'rax (sub1 (expt 2 32)))))
+(check-exn exn:fail? (thunk (Push (expt 2 32))))
+(check-not-exn       (thunk (Push (sub1 (expt 2 32)))))
+(check-exn exn:fail? (thunk (Add 'rax (expt 2 32))))
+(check-not-exn       (thunk (Add 'rax (sub1 (expt 2 32)))))
+(check-exn exn:fail? (thunk (Sub 'rax (expt 2 32))))
+(check-not-exn       (thunk (Sub 'rax (sub1 (expt 2 32)))))

langs/abscond/parse.rkt

@@ -5,5 +5,5 @@
 ;; S-Expr -> Expr
 (define (parse s)
   (match s
-    [(? integer?) (Int s)]
-    [_            (error "Parse error")]))
+    [(? exact-integer?) (Int s)]
+    [_ (error "Parse error")]))

langs/blackmail/parse.rkt

@@ -5,7 +5,7 @@
 ;; S-Expr -> Expr
 (define (parse s)
   (match s
-    [(? integer?) (Int s)]
+    [(? exact-integer?) (Int s)]
     [(list (? op1? o) e) (Prim1 o (parse e))]
     [_ (error "Parse error")]))
 

langs/con/parse.rkt

@@ -5,7 +5,7 @@
 ;; S-Expr -> Expr
 (define (parse s)
   (match s
-    [(? integer?) (Int s)]
+    [(? exact-integer?) (Int s)]
     [(list (? op1? o) e) (Prim1 o (parse e))]    
     [(list 'if (list 'zero? e1) e2 e3)
      (IfZero (parse e1) (parse e2) (parse e3))]

langs/dodger/parse.rkt

@@ -5,7 +5,7 @@
 ;; S-Expr -> Expr
 (define (parse s)
   (match s
-    [(? integer?) (Int s)]
+    [(? exact-integer?) (Int s)]
     [(? boolean?) (Bool s)]
     [(? char?)    (Char s)]
     [(list (? op1? o) e)  (Prim1 o (parse e))]

langs/dupe/parse.rkt

@@ -5,7 +5,7 @@
 ;; S-Expr -> Expr
 (define (parse s)
   (match s
-    [(? integer?) (Int s)]
+    [(? exact-integer?) (Int s)]
     [(? boolean?) (Bool s)]
     [(list (? op1? o) e) (Prim1 o (parse e))]        
     [(list 'if e1 e2 e3)

langs/evildoer/parse.rkt

@@ -6,7 +6,7 @@
 (define (parse s)
   (match s
     ['eof                (Eof)]
-    [(? integer?)        (Int s)]
+    [(? exact-integer?)  (Int s)]
     [(? boolean?)        (Bool s)]
     [(? char?)           (Char s)]
     [(list (? op0? o))   (Prim0 o)]

langs/extort/parse.rkt

@@ -5,7 +5,7 @@
 ;; S-Expr -> Expr
 (define (parse s)
   (match s
-    [(? integer? s) (Int s)]
+    [(? exact-integer? s) (Int s)]
     [(? boolean? s) (Bool s)]
     [(? char? s)    (Char s)]    
     ['eof           (Eof)]

langs/fraud/parse.rkt

@@ -5,7 +5,7 @@
 ;; S-Expr -> Expr
 (define (parse s)
   (match s
-    [(? integer?)            (Int s)]
+    [(? exact-integer?)      (Int s)]
     [(? boolean? s)          (Bool s)]
     [(? char? s)             (Char s)]
     ['eof                    (Eof)]