Polishing compilers.

Author: dvanhorn

www/notes/fraud/compile-refactor.rkt

@@ -3,6 +3,14 @@
 
 ;; type CEnv = [Listof Variable]
 
+(define imm-shift        3)
+(define imm-type-mask    (sub1 (arithmetic-shift 1 imm-shift)))
+(define imm-type-int     #b000)
+(define imm-type-true    #b001)
+(define imm-type-false   #b010)
+(define imm-type-empty   #b011)
+(define imm-type-char    #b100)
+
 ;; Expr -> Asm
 (define (compile e)
   `(entry
@@ -27,25 +35,25 @@
 
 ;; Integer -> Asm
 (define (compile-integer i)
-  `((mov rax ,(* i 2))))
+  `((mov rax ,(arithmetic-shift i imm-shift))))
 
 ;; Boolean -> Asm
 (define (compile-boolean b)
-  `((mov rax ,(if b #b11 #b01))))
+  `((mov rax ,(if b imm-type-true imm-type-false))))
 
 ;; Expr CEnv -> Asm
 (define (compile-add1 e0 c)
   (let ((c0 (compile-e e0 c)))
     `(,@c0
       ,@assert-integer
-      (add rax 2))))
+      (add rax ,(arithmetic-shift 1 imm-shift)))))
 
 ;; Expr CEnv -> Asm
 (define (compile-sub1 e0 c)
   (let ((c0 (compile-e e0 c)))
     `(,@c0
       ,@assert-integer
-      (sub rax 2))))
+      (sub rax ,(arithmetic-shift 1 imm-shift)))))
 
 ;; Expr CEnv -> Asm
 (define (compile-zero? e0 c)
@@ -55,9 +63,9 @@
     `(,@c0
       ,@assert-integer
       (cmp rax 0)
-      (mov rax #b01) ; #f
+      (mov rax ,imm-type-false)
       (jne ,l0)
-      (mov rax #b11) ; #t
+      (mov rax ,imm-type-true)
       ,l0)))
 
 ;; Expr Expr Expr CEnv -> Asm
@@ -68,7 +76,7 @@
         (l0 (gensym))
         (l1 (gensym)))
     `(,@c0
-      (cmp rax #b01) ; compare to #f
+      (cmp rax ,imm-type-false)
       (je ,l0)       ; jump to c2 if #f
       ,@c1
       (jmp ,l1)      ; jump past c2
@@ -100,6 +108,6 @@
 
 (define assert-integer
   `((mov rbx rax)
-    (and rbx 1)
-    (cmp rbx 0)
+    (and rbx ,imm-type-mask)
+    (cmp rbx ,imm-type-int)
     (jne err)))

www/notes/grift/compile.rkt

@@ -1,5 +1,13 @@
 #lang racket
 
+(define imm-shift        3)
+(define imm-type-mask    (sub1 (arithmetic-shift 1 imm-shift)))
+(define imm-type-int     #b000)
+(define imm-type-true    #b001)
+(define imm-type-false   #b010)
+(define imm-type-empty   #b011)
+(define imm-type-char    #b100)
+
 ;; Expr -> Asm
 (define (compile e)
   `(entry
@@ -26,25 +34,25 @@
 
 ;; Integer -> Asm
 (define (compile-integer i)
-  `((mov rax ,(* i 2))))
+  `((mov rax ,(arithmetic-shift i imm-shift))))
 
 ;; Boolean -> Asm
 (define (compile-boolean b)
-  `((mov rax ,(if b #b11 #b01))))
+  `((mov rax ,(if b imm-type-true imm-type-false))))
 
 ;; Expr CEnv -> Asm
-(define (compile-add1 e0 c)    
+(define (compile-add1 e0 c)
   (let ((c0 (compile-e e0 c)))
     `(,@c0
       ,@assert-integer
-      (add rax 2))))
+      (add rax ,(arithmetic-shift 1 imm-shift)))))
 
 ;; Expr CEnv -> Asm
 (define (compile-sub1 e0 c)
   (let ((c0 (compile-e e0 c)))
     `(,@c0
       ,@assert-integer
-      (sub rax 2))))
+      (sub rax ,(arithmetic-shift 1 imm-shift)))))
 
 ;; Expr CEnv -> Asm
 (define (compile-zero? e0 c)
@@ -54,9 +62,9 @@
     `(,@c0
       ,@assert-integer
       (cmp rax 0)
-      (mov rax #b01) ; #f
+      (mov rax ,imm-type-false)
       (jne ,l0)
-      (mov rax #b11) ; #t
+      (mov rax ,imm-type-true)
       ,l0)))
 
 ;; Expr Expr Expr CEnv -> Asm
@@ -67,7 +75,7 @@
         (l0 (gensym))
         (l1 (gensym)))
     `(,@c0
-      (cmp rax #b01) ; compare to #f
+      (cmp rax ,imm-type-false)
       (je ,l0)       ; jump to c2 if #f
       ,@c1
       (jmp ,l1)      ; jump past c2
@@ -121,6 +129,6 @@
 
 (define assert-integer
   `((mov rbx rax)
-    (and rbx 1)
-    (cmp rbx 0)
+    (and rbx ,imm-type-mask)
+    (cmp rbx ,imm-type-int)
     (jne err)))

www/notes/hustle/compile.rkt

@@ -27,9 +27,6 @@
 ;; Expr -> Asm
 (define (compile e)
   `(entry
-    (sar rdi 4)  ;; align on quad boundary
-    (sal rdi 4)
-    (add rdi 16)
     ,@(compile-e e '())
     ret
     err
@@ -195,21 +192,6 @@
       ,@assert-integer
       (sub rax (offset rsp ,(- (add1 (length c))))))))
 
-;; code for "abc"
-'((mov (offset rdi 0)
-       (integer->bits 3))
-  (mov (offset rdi 1)
-       (compile-char #\a))
-  (mov (offset rdi 1)
-       (char->bits #\b))
-  (mov (offset-rdi 2)
-       (char->bits #\c))
-  (mov rdi rax)
-  (or rax ,str-tag))
-  
-       
-
-
 ;; Variable CEnv -> Natural
 (define (lookup x cenv)
   (match cenv