From 85a78fd32dd60fb1c066f01cafd4ae8dfdf333e4 Mon Sep 17 00:00:00 2001 From: David Van Horn Date: Sat, 20 Sep 2025 11:14:57 -0400 Subject: [PATCH] Rework Mem. --- a86/ast.rkt | 90 ++++++++++++++++++++----------------------------- a86/printer.rkt | 34 +++++++++---------- 2 files changed, 53 insertions(+), 71 deletions(-) diff --git a/a86/ast.rkt b/a86/ast.rkt index 21f7ee8..208c6a3 100644 --- a/a86/ast.rkt +++ b/a86/ast.rkt @@ -132,7 +132,7 @@ (λ (a dst x n) (unless (register? dst) (error n "expects register; given ~v" dst)) - (unless (exp? x) + (unless (or (exp? x) (Mem? x)) (error n "expects memory expression; given ~v" x)) (values a (arg-normalize dst) (arg-normalize x)))) @@ -303,85 +303,69 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Effective Addresses -(provide Mem Mem? displacement?) +(provide Mem Mem?) ;; type Mem = -;; | (Mem [Maybe Disp] [Maybe Register] [Maybe Register] [Maybe Scale]) -;; where at least one of disp, base, or index must be given, +;; | (Mem [Maybe Label] [Maybe Integer] [Maybe Register] [Maybe Register] [Maybe Scale]) +;; where at least one of label, 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 (make-Mem . args) + (match args + [(list (? exact-integer? o) (? register? r)) + (%mem #f o r #f #f)] + [(list (? register? r)) + (%mem #f #f r #f #f)] + [(list (? register? r1) (? register? r2)) + (%mem #f #f r1 r2 #f)] + [(list (or (? label? l) ($ l))) + (%mem ($ l) #f #f #f #f)] + [(list (? register? r) (? exact-integer? o)) + (%mem #f o r #f #f)] + [(list (or (? label? l) ($ l)) (? exact-integer? o)) + (%mem ($ l) o #f #f #f)] + + [(list (or (? label? l) ($ l)) + (? exact-integer? o) + (? register? r1) + (? register? r2) + (? integer? s)) + (%mem ($ l) o r1 r2 s)] + [_ + (error 'Mem "bad args: ~a" args)])) (define (scale? x) (memq x '(1 2 4 8))) -(struct %mem (disp base index scale) +(struct %mem (label off 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")) + (λ (label off base index scale name) + (when (and label (not ($? label))) + (error name "label must be a label or #f, given ~v" label)) + (when (and off (not (exact-integer? off))) + (error name "offset must be an exact integer or #f, given ~v" off)) (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 (not (or label base index)) + (error name "must have at least one of label, base, or index")) (when (eq? index 'rsp) (error name "index cannot be rsp")) - (values disp base index scale))) + (values label off base index scale))) (define Mem? %mem?) (define-match-expander Mem (λ (stx) (syntax-case stx () - [(_ d b i s) #'(%mem d b i s)])) + [(_ l o b i s) #'(%mem l o b i s)])) (λ (stx) (syntax-case stx () [m (identifier? #'m) #'make-Mem] diff --git a/a86/printer.rkt b/a86/printer.rkt index e61436f..eed362d 100644 --- a/a86/printer.rkt +++ b/a86/printer.rkt @@ -58,34 +58,24 @@ ;; Mem -> String (define (mem->string m) (define (x->string x) - (cond [(displacement? x) (displacement->string x)] - [(symbol? x) (symbol->string x)])) + (match x + [(? integer?) (number->string x)] + [(? symbol?) (symbol->string x)] + [($ x) (label-symbol->string x)])) (match m - [(Mem d b i s) + [(Mem l o b i s) (string-append - "[" - (apply string-append (add-between (map x->string (filter identity (list d b i))) " + ")) + (apply string-append (add-between (map x->string (filter identity (list l o 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))])) + [i (string-append " * " (number->string i))]))])) ;; Exp ∪ Reg ∪ Offset -> String (define (arg->string e) (match e [(? register?) (symbol->string e)] - [(? Mem?) (mem->string e)] + [(? Mem?) (string-append "[" (mem->string e) "]")] [(Offset e) (string-append "[" (exp->string e) "]")] [_ (exp->string e)])) @@ -122,6 +112,10 @@ [(Data n) (string-append tab (data-section n))] [(Extern ($ l)) (string-append tab "extern " (extern-label-decl-symbol->string l))] [(Label ($ l)) (string-append (label-symbol->string l) ":")] + [(Lea d (? Mem? m)) + (string-append tab "lea " + (arg->string d) ", [rel " + (mem->string m) "]")] [(Lea d e) (string-append tab "lea " (arg->string d) ", [rel " @@ -131,6 +125,10 @@ (symbol->string x) " equ " (number->string c))] + [(Dq (? Mem? m)) + (string-append tab "dq " (mem->string m))] + [(Dd (? Mem? m)) + (string-append tab "dd " (mem->string m))] [(Db (? bytes? bs)) (apply string-append tab "db " (add-between (map number->string (bytes->list bs)) ", "))] [_ (common-instruction->string i)]))