1 files changed, 132 insertions, 0 deletions
diff --git a/lib/csc/codegen-test.csc b/lib/csc/codegen-test.csc
new file mode 100644
index 0000000..29d1da5
--- /dev/null
+++ b/lib/csc/codegen-test.csc
@@ -0,0 +1,132 @@
+(define-library (csc codegen-test)
+  (import (scheme base)
+          (only (csc gensym)
+            gensym)
+          (only (csc ir2)
+            *globals*
+            make-apply
+            make-branch
+            make-closure
+            make-constant
+            make-fix
+            make-label
+            make-library-ref
+            make-primitive
+            make-variable)
+          (only (csc loop)
+            loop
+            return)
+          (only (csc match)
+            match)
+          (only (csc testing)
+            assert-equal
+            test)
+          (csc codegen))
+  (begin
+
+
+    (define (test-var)
+      (make-variable (gensym)))
+
+
+    (define (test-label)
+      (make-label (gensym)))
+
+
+    (test codegen-apply
+      (define p (test-var))
+      (assert-equal
+        '((peek (local 1) (local 0) (const 5))
+          (mov (local 2) (local 1))
+          (mov (local 1) (const 10))
+          (jmp (local 2))
+          (label 0))
+        (ir2->ir3
+          (make-fix '()
+            (make-primitive 'peek (list *globals* (make-constant 5)) (list p)
+              (make-apply p (list (make-constant 10))))))))
+
+
+    (test codegen-call-global
+      (define p (test-var))
+      (assert-equal
+        '((peek (local 1) (local 0) (global cons (csc based)))
+          (mov (local 3) (local 1))
+          (mov (local 1) (const 5))
+          (mov (local 2) (const ()))
+          (jmp (local 3))
+          (label 0))
+        (ir2->ir3
+          (make-fix '()
+            (make-primitive 'peek (list *globals* (make-library-ref 'cons '(csc based))) (list p)
+              (make-apply p (list (make-constant 5) (make-constant '()))))))))
+
+
+    (test codegen-call-known
+      (define f (test-label))
+      (define ret (test-var))
+      (assert-equal
+        '((mov (local 1) (label 1))
+          (jmp (label 1))
+          (label 1)
+          (mov (local 2) (local 1))
+          (jmp (local 2))
+          (label 0))
+        (ir2->ir3
+          (make-fix
+            (list (make-closure f (list ret)
+                    (make-apply ret (list ret))))
+            (make-apply f (list f))))))
+
+
+    (test codegen-permute
+      (define f (test-label))
+      (define g (test-label))
+      (define f1 (test-var))
+      (define f2 (test-var))
+      (define g1 (test-var))
+      (define g2 (test-var))
+      (define g3 (test-var))
+      (assert-equal
+        '((mov (local 1) (const 0))
+          (mov (local 2) (const 1))
+          (jmp (label 1))
+          (label 1)
+          (mov (local 127) (local 1))
+          (mov (local 1) (local 2))
+          (mov (local 2) (local 127))
+          (mov (local 3) (const 0))
+          (jmp (label 2))
+          (label 2)
+          (mov (local 2) (local 1))
+          (mov (local 1) (local 3))
+          (jmp (label 1))
+          (label 0))
+        (ir2->ir3
+          (make-fix
+            (list (make-closure f (list f1 f2)
+                    (make-apply g (list f2 f1 (make-constant 0))))
+                  (make-closure g (list g1 g2 g3)
+                    (make-apply f (list g3 g1))))
+            (make-apply f (list (make-constant 0) (make-constant 1)))))))
+
+
+    (test codegen-branch
+      (define p (test-var))
+      (assert-equal
+        '((peek (local 1) (local 0) (const 1))
+          (jmpif (const #t) (label 1))
+          (mov (local 2) (local 1))
+          (mov (local 1) (const 10))
+          (jmp (local 2))
+          (label 1)
+          (mov (local 2) (local 1))
+          (mov (local 1) (const 5))
+          (jmp (local 2))
+          (label 0))
+        (ir2->ir3
+          (make-fix '()
+            (make-primitive 'peek (list *globals* (make-constant 1)) (list p)
+              (make-branch (make-constant #t)
+                (make-apply p (list (make-constant 5)))
+                (make-apply p (list (make-constant 10)))))))))))