From 85a78fd32dd60fb1c066f01cafd4ae8dfdf333e4 Mon Sep 17 00:00:00 2001
From: David Van Horn <dvanhorn@cs.umd.edu>
Date: Sat, 20 Sep 2025 11:14:57 -0400
Subject: [PATCH 1/2] 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)]))

From 684958654050249b93dae19a0547cbb61102d0fc Mon Sep 17 00:00:00 2001
From: David Van Horn <dvanhorn@cs.umd.edu>
Date: Sat, 18 Oct 2025 18:00:03 -0400
Subject: [PATCH 2/2] Better approach to constructing and printing Mem structs.

---
 a86/ast.rkt     | 160 +++++++++++++++++++++++++++++++++---------------
 a86/printer.rkt |   2 +-
 2 files changed, 113 insertions(+), 49 deletions(-)

diff --git a/a86/ast.rkt b/a86/ast.rkt
index 208c6a3..a37174d 100644
--- a/a86/ast.rkt
+++ b/a86/ast.rkt
@@ -21,7 +21,7 @@
        (unless (nasm-label? x)
          (error n "label names must conform to nasm restrictions"))
        (values a ($ x))]
-      [($ _)      
+      [($ _)
        (values a x)]
       [_
        (error n "expects valid label name; given ~v" x)])))
@@ -275,7 +275,7 @@
     (values x))
 
   #;#;#;#:methods gen:equal+hash
-  [(define equal-proc     
+  [(define equal-proc
      (λ (i1 i2 equal?)
        (equal? (->symbol i1)
                (->symbol i2))))
@@ -283,7 +283,7 @@
    (define hash2-proc (λ (i hash) (hash (->symbol i))))]
   #:property prop:custom-print-quotable 'never
   #;#;#;#:methods gen:custom-write
-  [(define (write-proc label port mode)     
+  [(define (write-proc label port mode)
      (let ([recur (case mode
                     [(#t) write]
                     [(#f) display]
@@ -293,12 +293,12 @@
              (begin (if (number? mode)
                         (write-string "($ " port)
                         (write-string "#(struct:$ " port))
-                    (recur s port)                        
+                    (recur s port)
                     (if (number? mode)
                         (write-string ")" port)
                         (write-string ")" port)))
              (recur s port)))))])
-  
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Effective Addresses
@@ -306,66 +306,130 @@
 (provide Mem Mem?)
 
 ;; type Mem =
-;; | (Mem [Maybe Label] [Maybe Integer] [Maybe Register] [Maybe Register] [Maybe Scale])
+;; | (Mem [Maybe Label] [Maybe Register] [Maybe Register] [Maybe Integer] [Maybe Scale])
 ;; where at least one of label, base, or index must be given,
 ;; index cannot be 'rsp
 
 ;; type Scale = 1 | 2 | 4 | 8
 
+(define (parse-mem-args orig)
+  (define (parse-mem-args-lab args)
+    (match args
+      [(cons #f args)
+       (cons #f (parse-mem-args-r1 args))]
+      [(cons (or (? label? l) ($ l)) args)
+       (cons ($ l) (parse-mem-args-r1 args))]
+      [_
+       (cons #f (parse-mem-args-r1 args))]))
+
+  (define (parse-mem-args-r1 args)
+    (match args
+      [(cons #f args)
+       (cons #f (parse-mem-args-r2 args))]
+      [(cons (? register? r1) args)
+       (cons r1 (parse-mem-args-r2 args))]
+      [_
+       (cons #f (parse-mem-args-r2 args))]))
+
+  (define (parse-mem-args-r2 args)
+    (match args
+      [(cons #f args)
+       (cons #f (parse-mem-args-off args))]
+      [(cons (? register? r2) args)
+       (cons r2 (parse-mem-args-off args))]
+      [_
+       (cons #f (parse-mem-args-off args))]))
+
+  (define (parse-mem-args-off args)
+    (match args
+      [(cons #f args)
+       (cons #f (parse-mem-args-scale args))]
+      [(cons (? exact-integer? o) args)
+       (cons o (parse-mem-args-scale args))]
+      [_
+       (cons #f (parse-mem-args-scale args))]))
+
+  (define (parse-mem-args-scale args)
+    (match args
+      [(list #f) (list #f)]
+      [(list (? scale? s)) (list s)]
+      [(list) (list #f)]
+      [else (error "Mem: bad args" orig)]))
+
+  (match (parse-mem-args-lab orig)
+    [(list #f #f #f _ _)
+     (error "Mem: at least one of label, base, or index must be given" orig)]
+    [(list _ _ 'rsp _ _)
+     (error "Mem: index cannot be rsp")]
+    [as
+     (apply %mem as)]))
+
+;; Given list of 5 fields, construct unambiguous argument list with
+;; fewest #f's possible
+(define (unparse-mem-args args)
+  (define (unparse-mem-args-lab args)
+    (match args
+      [(cons #f args)
+       (unparse-mem-args-r1 args)]
+      [(cons l args)
+       (cons l (unparse-mem-args-r1 args))]))
+
+  (define (unparse-mem-args-r1 args)
+    (match args
+      [(cons #f (cons #f args))
+       (unparse-mem-args-off args)]
+      [(cons #f (cons r args))
+       (cons #f (cons r (unparse-mem-args-off args)))]
+      [(cons r (cons #f args))
+       (cons r (unparse-mem-args-off args))]
+      [(cons r1 (cons r2 args))
+       (cons r1 (cons r2 (unparse-mem-args-off args)))]))
+
+  (define (unparse-mem-args-off args)
+    (match args
+      [(list #f #f) '()]
+      [(list o #f) (list o)]
+      [(list o s) (list o s)]))
+  (unparse-mem-args-lab args))
+
 (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)]))
+  (parse-mem-args args))
 
 (define (scale? x)
   (memq x '(1 2 4 8)))
 
-(struct %mem (label off base index scale)
+(struct %mem (label base index off scale)
   #:reflection-name 'Mem
   #:transparent
-  #:guard
-  (λ (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 label off base index scale)))
+  #:property prop:custom-print-quotable 'never
+  #:methods gen:custom-write
+  [(define (write-proc mem port mode) (mem-print mem port mode))]
+  )
+
+(define (mem-print mem port mode)
+  (if (number? mode)
+      (write-string "(" port)
+      (write-string "#(struct:" port))
+  (write-string "Mem " port)
+  (let ([recur (case mode
+                 [(#t) write]
+                 [(#f) display]
+                 [else (lambda (p port) (print p port mode))])])
+    (for-each
+     (λ (t) (t))
+     (add-between
+      (map
+       (λ (x) (λ () (recur x port)))
+       (unparse-mem-args (rest (vector->list (struct->vector mem)))))
+      (λ () (write-string " " port)))))
+  (write-string ")" port))
 
 (define Mem? %mem?)
 
 (define-match-expander Mem
   (λ (stx)
     (syntax-case stx ()
-      [(_ l o b i s)  #'(%mem l o b i s)]))
+      [(_ l b i o s)  #'(%mem l b i o s)]))
   (λ (stx)
     (syntax-case stx ()
       [m (identifier? #'m) #'make-Mem]
@@ -451,7 +515,7 @@
                 #:property prop:custom-print-quotable 'never
                 #:methods gen:custom-write
                 [(define write-proc
-		   (instr-print 'Name)
+                   (instr-print 'Name)
                    #;(make-constructor-style-printer
                     (lambda (obj) 'Name)
                     (lambda (obj)
diff --git a/a86/printer.rkt b/a86/printer.rkt
index eed362d..fa23552 100644
--- a/a86/printer.rkt
+++ b/a86/printer.rkt
@@ -63,7 +63,7 @@
       [(? symbol?) (symbol->string x)]
       [($ x) (label-symbol->string x)]))
   (match m
-    [(Mem l o b i s)
+    [(Mem l b i o s)
      (string-append
       (apply string-append (add-between (map x->string (filter identity (list l o b i))) " + "))
       (match s