diff --git a/a86/ast.rkt b/a86/ast.rkt index 690dd44..21f7ee8 100644 --- a/a86/ast.rkt +++ b/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) diff --git a/a86/printer.rkt b/a86/printer.rkt index df7e130..e61436f 100644 --- a/a86/printer.rkt +++ b/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)]))