Fix-up Fraud compiler.

Author: dvanhorn

www/notes/fraud/compile.rkt

@@ -10,53 +10,55 @@
     ,@(compile-e e '())
     ret
     err
-    (push rbp) 
+    (push rbp)
     (call error)
     ret))
 
 ;; Expr CEnv -> Asm
 (define (compile-e e c)
   (match e
     [(? integer? i)
-     `((mov rax ,(arithmetic-shift i fixnum-shift)))]
+     `((mov rax ,(* i 2)))]
     [(? boolean? b)
-     `((mov rax ,(if b true-rep false-rep)))]
+     `((mov rax ,(if b #b11 #b01)))]
     [`(add1 ,e0)
      (let ((c0 (compile-e e0 c)))
        `(,@c0
          ,@assert-integer
-         (add rax ,(arithmetic-shift 1 fixnum-shift))))]
+         (add rax 2)))]
     [`(sub1 ,e0)
      (let ((c0 (compile-e e0 c)))
        `(,@c0
          ,@assert-integer
-         (sub rax ,(arithmetic-shift 1 fixnum-shift))))]             
+         (sub rax 2)))]
     [`(zero? ,e0)
-     (let ((c0 (compile-e e0 c)))
+     (let ((c0 (compile-e e0 c))
+           (l0 (gensym))
+           (l1 (gensym)))
        `(,@c0
          ,@assert-integer
          (cmp rax 0)
-         (sete al)
-         (movzx rax al)
-         (sal rax ,bool-shift)
-         (or eax ,false-rep)))]         
+         (mov rax #b01) ; #f
+         (jne ,l0)
+         (mov rax #b11) ; #t
+         ,l0))]
+    [(? symbol? x)
+     (let ((i (lookup x c)))
+       `((mov rax (offset rsp ,(- (add1 i))))))]
     [`(if ,e0 ,e1 ,e2)
      (let ((c0 (compile-e e0 c))
            (c1 (compile-e e1 c))
-           (c2 (compile-e e2 c)))
-       (match (gen-if-labels)
-         [(list if-f if-x)
-          `(,@c0
-            (cmp rax ,false-rep)
-            (je ,if-f)
-            ,@c1
-            (jmp ,if-x)
-            ,if-f
-            ,@c2
-            ,if-x)]))]   
-    [(? symbol? x)
-     (let ((i (lookup x c)))
-       `((mov rax (offset rsp ,(- (add1 i))))))]    
+           (c2 (compile-e e2 c))
+           (l0 (gensym))
+           (l1 (gensym)))
+       `(,@c0
+         (cmp rax #b01) ; compare to #f
+         (je ,l0)       ; jump to c2 if #f
+         ,@c1
+         (jmp ,l1)      ; jump past c2
+         ,l0
+         ,@c2
+         ,l1))]
     [`(let ((,x ,e0)) ,e1)
      (let ((c0 (compile-e e0 c))
            (c1 (compile-e e1 (cons x c))))

www/notes/fraud/compile/help.rkt

@@ -1,28 +1,8 @@
 #lang racket
 (provide (all-defined-out))
 
-;; -> [List Label Label]
-;; Guaranteed to be unique on each call
-(define gen-if-labels
-  (let ((i 0))
-    (λ ()
-      (set! i (add1 i))
-      (list (lab "f" i)
-            (lab "x" i)))))
-
-;; String Integer -> Symbol
-(define (lab s i)
-  (string->symbol (string-append "if_" s "_" (number->string i))))
-
-
-(define true-rep  #b10011111)
-(define false-rep #b00011111)
-(define fixnum-mask #b11)
-(define fixnum-shift 2)
-(define bool-shift   8)
-
 (define assert-integer
   `((mov rbx rax)
-    (and rbx ,fixnum-mask)
+    (and rbx 1)
     (cmp rbx 0)
     (jne err)))