Add Mem structure for effective addresses.

a86/ast.rkt

@@ -237,6 +237,7 @@
   (match x
     [(? register?) x]
     [(? nasm-label?) ($ x)]
+    [(? Mem?) x]
     ;[(Offset e1) (Offset (exp-normalize e1))]
     [(Plus e1 e2)
      (list '+
@@ -299,6 +300,94 @@
              (recur s port)))))])
 
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Effective Addresses
+
+(provide Mem Mem? displacement?)
+
+;; type Mem =
+;; | (Mem [Maybe Disp] [Maybe Register] [Maybe Register] [Maybe Scale])
+;; where at least one of disp, base, or index must be given,
+;; index cannot be 'rsp
+
+;; type Scale = 1 | 2 | 4 | 8
+
+;; type Disp =
+;; | Label
+;; | (Plus Label Integer)
+
+(define (displacement? x)
+  (and (normalize-disp x) #t))
+
+(define (normalize-disp d)
+  (match d
+    [($ _) d]
+    [(? label?) ($ d)]
+    [(? integer?) d]
+    [(Plus ($ _) (? integer? i)) d]
+    [(Plus (? label? l) (? integer? i)) (Plus ($ l) i)]
+    [_ #f]))
+
+(define make-Mem
+  (case-lambda
+    [(d b i s) (%mem (normalize-disp d) b i s)]
+    [(x)
+     (match x
+       [(? register? r) (make-Mem #f r #f #f)]
+       [(? displacement? d) (make-Mem d #f #f #f)]
+       [_
+        (error 'Mem "unknown argument type, given ~a" x)])]
+    [(x y)
+     (match* (x y)
+       [((? register?) (? register?))
+        (make-Mem #f x y #f)]
+       [((? displacement?) (? register?))
+        (make-Mem x y #f #f)]
+       [(_ _) (error 'Mem "unknown argument type, given ~a ~a" x y)])]
+    [(x y z)
+     (match* (x y z)
+       [((? register?) (? register?) (? scale?))
+        (make-Mem #f x y z)]
+       [((? displacement?) (? register?) (? scale?))
+        (make-Mem x #f y z)]
+       [((? register?) (? register?) (? scale?))
+        (make-Mem #f x y z)]
+       [(_ _ _) (error 'Mem "unknown argument type, given ~a ~a ~a" x y z)])]))
+
+(define (scale? x)
+  (memq x '(1 2 4 8)))
+
+(struct %mem (disp base index scale)
+  #:reflection-name 'Mem
+  #:transparent
+  #:guard
+  (λ (disp base index scale name)
+     (when (and disp (not (displacement? disp)))
+       (error name "displacement must be a displacement or #f, given ~v" disp))
+     (when (not (or disp base index))
+       (error name "must have at least one of displacement, base, or index"))
+     (when (and base (not (register? base)))
+       (error name "base must be a register or #f, given ~v" base))
+     (when (and index (not (register? index)))
+       (error name "index must be a register (other than rsp) or #f, given ~v" index))
+     (when (and scale (not (scale? scale)))
+       (error name "scale must be 1,2,4,8 or #f, given ~v" scale))
+     (when (eq? index 'rsp)
+       (error name "index cannot be rsp"))
+     (values disp base index scale)))
+
+(define Mem? %mem?)
+
+(define-match-expander Mem
+  (λ (stx)
+    (syntax-case stx ()
+      [(_ d b i s)  #'(%mem d b i s)]))
+  (λ (stx)
+    (syntax-case stx ()
+      [m (identifier? #'m) #'make-Mem]
+      [(_ . m) #'(make-Mem . m)])))
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Offsets
 
@@ -507,7 +596,9 @@
 
 (provide offset? 64-bit-integer? 32-bit-integer? 16-bit-integer? 8-bit-integer?)
 
-(define offset? Offset?)
+(define (offset? x)
+  (or (Offset? x)
+      (Mem? x)))
 
 (define (integer-size x)
   (if (negative? x)

a86/printer.rkt

@@ -55,10 +55,37 @@
             (format "~a ; ~.s" s (instruction-annotation i)))
         s)))
 
+;; Mem -> String
+(define (mem->string m)
+  (define (x->string x)
+    (cond [(displacement? x) (displacement->string x)]
+          [(symbol? x) (symbol->string x)]))
+  (match m
+    [(Mem d b i s)
+     (string-append
+      "["
+      (apply string-append (add-between (map x->string (filter identity (list d b i))) " + "))
+      (match s
+        [#f ""]
+        [1  ""]
+        [i (string-append " * " (number->string i))])
+      "]")]))
+
+(define (displacement->string d)
+  (match d
+    [(? integer?) (number->string d)]
+    [(or (Plus ($ l) 0) ($ l))
+     (label-symbol->string l)]
+    [(Plus ($ l) i)
+     (string-append (label-symbol->string l)
+                    " + "
+                    (number->string i))]))
+
 ;; Exp ∪ Reg ∪ Offset -> String
 (define (arg->string e)
   (match e
     [(? register?) (symbol->string e)]
+    [(? Mem?) (mem->string e)]
     [(Offset e)
      (string-append "[" (exp->string e) "]")]
     [_ (exp->string e)]))