Move scheme compiler into a separate directory.

1 files changed, 53 insertions, 0 deletions

diff --git a/csc/encoding.csc b/csc/encoding.csc
new file mode 100644
index 0000000..21ee88f
--- /dev/null
+++ b/csc/encoding.csc
@@ -0,0 +1,53 @@
+(define-library (csc encoding)
+  (export encode)
+  (import (scheme base)
+          (only (csc match) match))
+  (begin
+
+
+    (define (right-shift n1 n2)
+      (floor-quotient n1 (expt 2 n2)))  ; Yikes.
+
+
+    (define (low-byte n)
+      (modulo n #x100))
+
+
+    (define (64->le-bytes n)
+      (list
+        (low-byte n)
+        (low-byte (right-shift n 8))
+        (low-byte (right-shift n 16))
+        (low-byte (right-shift n 24))
+        (low-byte (right-shift n 32))
+        (low-byte (right-shift n 40))
+        (low-byte (right-shift n 48))
+        (low-byte (right-shift n 56))))
+
+
+    (define (opcode-switch opcode)
+      (match opcode
+        (((! 'const) n) (append (64->le-bytes 1010) (64->le-bytes n)))
+        ((! 'add) (64->le-bytes 1020))
+        ((! 'sub) (64->le-bytes 1030))
+        ((! 'mul) (64->le-bytes 1040))
+        ((! 'div) (64->le-bytes 1050))
+        ((! 'mod) (64->le-bytes 1060))
+        ((! 'alloc) (64->le-bytes 2010))
+        (((! 'peek) n) (append (64->le-bytes 2020) (list n)))
+        (((! 'poke) n) (append (64->le-bytes 2030) (list n)))
+        ((! 'peekbyte) (64->le-bytes 2040))
+        ((! 'pokebyte) (64->le-bytes 2050))
+        ((! 'pop) (64->le-bytes 3010))
+        (((! 'local) n) (append (64->le-bytes 3020) (list n)))
+        (((! 'if) n) (append (64->le-bytes 4010) (64->le-bytes n)))
+        (((! 'call) n) (append (64->le-bytes 4020) (list n)))
+        ((! 'ret) (64->le-bytes 4030))
+        ((! 'exit) (64->le-bytes 4040))
+        ((! 'putc) (64->le-bytes 5010))
+        ((! 'getc) (64->le-bytes 5020))
+        (_ (error "invalid opcode" opcode))))
+
+
+    (define (encode program)
+      (apply append (map opcode-switch program)))))