Merge pull request #24 from dvanhorn/next

Next

Author: dvanhorn

www/assignments/3.scrbl

@@ -142,6 +142,7 @@ language based on the following grammar:
 
 @verbatim{
 <expr> ::= integer
+        |  boolean
         |  ( <compound> )
 	|  [ <compound> ]
 
@@ -170,6 +171,7 @@ which are defined as:
 (racketblock
 ;; type Token =
 ;; | Integer
+;; | Boolean
 ;; | 'add1
 ;; | 'sub1
 ;; | 'zero?

www/notes/fraud/compile.rkt

@@ -1,6 +1,5 @@
 #lang racket
 (provide (all-defined-out))
-(require "compile/help.rkt")
 
 ;; type CEnv = [Listof Variable]
 
@@ -42,9 +41,6 @@
          (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))
@@ -59,6 +55,9 @@
          ,l0
          ,@c2
          ,l1))]
+    [(? symbol? x)
+     (let ((i (lookup x c)))
+       `((mov rax (offset rsp ,(- (add1 i))))))]
     [`(let ((,x ,e0)) ,e1)
      (let ((c0 (compile-e e0 c))
            (c1 (compile-e e1 (cons x c))))
@@ -74,3 +73,9 @@
      (match (symbol=? x y)
        [#t (length cenv)]
        [#f (lookup x cenv)])]))
+
+(define assert-integer
+  `((mov rbx rax)
+    (and rbx 1)
+    (cmp rbx 0)
+    (jne err)))

www/notes/fraud/compile/help.rkt

@@ -1,6 +1,5 @@
 #lang racket
 (provide (all-defined-out))
-(require "compile/help.rkt")
 
 ;; type CEnv = [Listof Variable]
 
@@ -18,55 +17,57 @@
 (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))]
     [`(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)]))]   
+           (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))]
     [(? symbol? x)
      (let ((i (lookup x c)))
-       `((mov rax (offset rsp ,(- (add1 i))))))]    
+       `((mov rax (offset rsp ,(- (add1 i))))))]
     [`(let ((,x ,e0)) ,e1)
      (let ((c0 (compile-e e0 c))
            (c1 (compile-e e1 (cons x c))))
        `(,@c0
          (mov (offset rsp ,(- (add1 (length c)))) rax)
          ,@c1))]
+
     [`(+ ,e0 ,e1)
      (let ((c1 (compile-e e1 c))
            (c0 (compile-e e0 (cons #f c))))
-
        `(,@c1
          ,@assert-integer
          (mov (offset rsp ,(- (add1 (length c)))) rax)
@@ -77,7 +78,6 @@
     [`(- ,e0 ,e1)
      (let ((c1 (compile-e e1 c))
            (c0 (compile-e e0 (cons #f c))))
-
        `(,@c1
          ,@assert-integer
          (mov (offset rsp ,(- (add1 (length c)))) rax)
@@ -91,6 +91,12 @@
   (match cenv
     ['() (error "undefined variable:" x)]
     [(cons y cenv)
-     (match (symbol=? x y)
+     (match (eq? x y)
        [#t (length cenv)]
        [#f (lookup x cenv)])]))
+
+(define assert-integer
+  `((mov rbx rax)
+    (and rbx 1)
+    (cmp rbx 0)
+    (jne err)))

www/notes/grift/compile.rkt

@@ -2,28 +2,22 @@
 #include <stdlib.h>
 #include <inttypes.h>
 
-#define fixnum_mask 3
-#define fixnum_tag 0
-#define fixnum_shift 2
-
-#define boolean_tag 31
-#define boolean_mask 127
-#define boolean_shift 7
+#define typeof_mask  1
+#define val_shift    1
+#define type_fixnum  0
+#define type_bool    1
 
 int64_t entry();
 
 int main(int argc, char** argv) {
   int64_t result = entry();
-  if ((result & fixnum_mask) == fixnum_tag) {
-    printf("%" PRId64 "\n", result >> fixnum_shift); 
-  } else if ((result & boolean_mask) == boolean_tag) {
-    if (result >> boolean_shift) {
-      printf("#t\n");
-    } else {
-      printf("#f\n");
-    }
-  } else {
-    printf("unknown value\n");
+  switch (typeof_mask & result) {
+  case type_fixnum:
+    printf("%" PRId64 "\n", result >> val_shift);
+    break;
+  case type_bool:
+    printf("#%c\n", result >> val_shift ? 't' : 'f');
+    break;
   }
   return 0;
 }