refactor: Define variables/procedures for registers/instructions.

1 files changed, 99 insertions, 44 deletions

diff --git a/compiler.scm b/compiler.scm
index 3baf0e5..b373ecc 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -78,62 +78,117 @@
 (define (body x)
   (third x))
 
+(define (register name)
+  (format #f "%~a" name))
+
+(define (immediate value)
+  (format #f "$~a" value))
+
+(define rax (register "rax"))
+(define rsp (register "rsp"))
+(define al (register "al"))
+
+(define (offset n register)
+  (format #f "~a(~a)" n register))
+
 (define (emit template-string . args)
   (display "        ")
   (apply format #t template-string args)
   (newline))
 
+(define (emit-mov src dest)
+  (emit "mov ~a, ~a" src dest))
+
+(define (emit-and mask dest)
+  (emit "and ~a, ~a" mask dest))
+
+(define (emit-or addend dest)
+  (emit "or ~a, ~a" addend dest))
+
+(define (emit-add addend dest)
+  (emit "add ~a, ~a" addend dest))
+
+(define (emit-sub subtrahend dest)
+  (emit "sub ~a, ~a" subtrahend dest))
+
+(define (emit-imul multiplicand dest)
+  (emit "imul ~a, ~a" multiplicand dest))
+
+(define (emit-sal n dest)
+  (emit "sal ~a, ~a" n dest))
+
+(define (emit-shr n dest)
+  (emit "shr ~a, ~a" n dest))
+
+(define (emit-cmp a b)
+  (emit "cmp ~a, ~a" a b))
+
+(define (emit-setl dest)
+  (emit "setl ~a" dest))
+
+(define (emit-setle dest)
+  (emit "setle ~a" dest))
+
+(define (emit-setg dest)
+  (emit "setg ~a" dest))
+
+(define (emit-setge dest)
+  (emit "setge ~a" dest))
+
+(define (emit-sete dest)
+  (emit "sete ~a" dest))
+
 (define (emit-tag-check x mask tag si env)
   (emit-expr x si env)
-  (emit "and $~a, %rax" mask)
-  (emit "cmp $~a, %rax" tag)
-  (emit "mov $0, %rax")
-  (emit "sete %al")
-  (emit "sal $~a, %rax" boolean-shift)
-  (emit "or $~a, %rax" boolean-tag))
+  (emit-and (immediate mask) rax)
+  (emit-cmp (immediate tag) rax)
+  (emit-mov (immediate 0) rax)
+  (emit-sete al)
+  (emit-sal (immediate boolean-shift) rax)
+  (emit-or (immediate boolean-tag) rax))
 
 (define (emit-comparison x y instruction si env)
   (emit-expr y si env)
-  (emit "mov %rax, ~a(%rsp)" si)
+  (emit-mov rax (offset si rsp))
   (emit-expr x (- si wordsize) env)
-  (emit "cmp ~a(%rsp), %rax" si)
-  (emit "mov $0, %rax")
-  (emit "~a %al" instruction)
-  (emit "sal $~a, %rax" boolean-shift)
-  (emit "or $~a, %rax" boolean-tag))
+  (emit-cmp (offset si rsp) rax)
+  (emit-mov (immediate 0) rax)
+  (instruction al)
+  (emit-sal (immediate boolean-shift) rax)
+  (emit-or (immediate boolean-tag) rax))
 
 (define (emit-primitive-call x si env)
   (case (primcall-op x)
     ((add1)
      (emit-expr (primcall-operand1 x) si env)
-     (emit "add $~a, %rax" (immediate-rep 1)))
+     (emit-add (immediate (immediate-rep 1)) rax))
     ((sub1)
      (emit-expr (primcall-operand1 x) si env)
-     (emit "sub $~a, %rax" (immediate-rep 1)))
+     (emit-sub (immediate (immediate-rep 1)) rax))
     ((integer->char)
      (emit-expr (primcall-operand1 x) si env)
-     (emit "sal $~a, %rax" (- char-shift fixnum-shift))
-     (emit "or $~a, %rax" char-tag))
+     (emit-sal (immediate (- char-shift fixnum-shift)) rax)
+     (emit-or (immediate char-tag) rax))
     ((char->integer)
      (emit-expr (primcall-operand1 x) si env)
-     (emit "shr $~a, %rax" (- char-shift fixnum-shift)))
+     (emit-shr (immediate (- char-shift fixnum-shift)) rax))
     ((zero?)
      (emit-expr (primcall-operand1 x) si env)
      ;; Since the tag of fixnums is 0, we can skip an 'andl'
      ;; instruction that would apply the mask to the immediate
      ;; value.
-     (emit "cmp $0, %rax")
-     (emit "mov $0, %rax")
-     (emit "sete %al")
-     (emit "sal $~a, %rax" boolean-shift)
-     (emit "or $~a, %rax" boolean-tag))
+     (emit-cmp (immediate 0) rax)
+     (emit-mov (immediate 0) rax)
+     (emit-sete al)
+     (emit-sal (immediate boolean-shift) rax)
+     (emit-or (immediate boolean-tag) rax))
     ((null?)
      (emit-expr (primcall-operand1 x) si env)
-     (emit "cmp $~a, %rax" empty-list)
-     (emit "mov $0, %rax")
-     (emit "sete %al")
-     (emit "sal $~a, %rax" boolean-shift)
-     (emit "or $~a, %rax" boolean-tag))
+     (emit-cmp (immediate empty-list) rax)
+     (emit-mov (immediate 0) rax)
+     (emit-sete al)
+     (emit-sal (immediate boolean-shift) rax)
+     (emit-or (immediate boolean-tag) rax))
     ((integer?)
      (emit-tag-check (primcall-operand1 x) fixnum-mask fixnum-tag si env))
     ((char?)
@@ -142,37 +197,37 @@
      (emit-tag-check (primcall-operand1 x) boolean-mask boolean-tag si env))
     ((+)
      (emit-expr (primcall-operand2 x) si env)
-     (emit "mov %rax, ~a(%rsp)" si)
+     (emit-mov rax (offset si rsp))
      (emit-expr (primcall-operand1 x) (- si wordsize) env)
-     (emit "add ~a(%rsp), %rax" si))
+     (emit-add (offset si rsp) rax))
     ((-)
      (emit-expr (primcall-operand2 x) si env)
-     (emit "mov %rax, ~a(%rsp)" si)
+     (emit-mov rax (offset si rsp))
      (emit-expr (primcall-operand1 x) (- si wordsize) env)
-     (emit "sub ~a(%rsp), %rax" si))
+     (emit-sub (offset si rsp) rax))
     ((*)
      (emit-expr (primcall-operand2 x) si env)
-     (emit "mov %rax, ~a(%rsp)" si)
+     (emit-mov rax (offset si rsp))
      (emit-expr (primcall-operand1 x) (- si wordsize) env)
-     (emit "imul ~a(%rsp), %rax" si)
+     (emit-imul (offset si rsp) rax)
      ;; When two fixnums (which have 2 tag bits) are multiplied, the
      ;; relevant bits for the result are now 4 bytes to the left, so
      ;; we have to shift back 2 bytes.
-     (emit "shr $~a, %rax" fixnum-shift))
+     (emit-shr (immediate fixnum-shift) rax))
     ((=)
-     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) "sete" si env))
+     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) emit-sete si env))
     ((<)
-     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) "setl" si env))
+     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) emit-setl si env))
     ((<=)
-     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) "setle" si env))
+     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) emit-setle si env))
     ((>)
-     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) "setg" si env))
+     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) emit-setg si env))
     ((>=)
-     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) "setge" si env)
+     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) emit-setge si env))
     ((eq?)
-     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) "sete" si env)))
+     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) emit-sete si env))
     ((char=?)
-     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) "sete" si env))
+     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) emit-sete si env))
     (else
      (error "unknown primcall op" (primcall-op x)))))
 
@@ -186,7 +241,7 @@
         (emit-expr body si new-env)
         (let ((b (first b*)))
           (emit-expr (rhs b) si env)
-          (emit "mov %rax, ~a(%rsp)" si)
+          (emit-mov rax (offset si rsp))
           (loop (cdr b*)
                 (extend-env (lhs b) si new-env)
                 (- si wordsize))))))
@@ -194,9 +249,9 @@
 (define (emit-expr x si env)
   (cond
    ((immediate? x)
-    (emit "mov $~a, %rax" (immediate-rep x)))
+    (emit-mov (immediate (immediate-rep x)) rax))
    ((variable? x)
-    (emit "mov ~a(%rsp), %rax" (lookup x env)))
+    (emit-mov (offset (lookup x env) rsp) rax))
    ((let? x)
     (emit-let (bindings x) (body x) si env))
    ((primcall? x)