initial

Makefile

@@ -0,0 +1,14 @@
+exe: code.o
+	ld $< -o $@
+
+code.o: code.asm
+	nasm -felf64 $<
+
+code.asm: header.asm footer.asm compiled.asm
+	cat header.asm compiled.asm footer.asm > $@
+
+compiled.asm: compiler source.stk
+	./compiler < source.stk > compiled.asm
+
+compiler: compiler.hs
+	ghc $< -o $@

compiler.hs

@@ -0,0 +1,60 @@
+module Main where
+
+bits :: Int
+bits = 64
+
+type Assembly = ([String], Int)
+
+emitPush :: Int -> Assembly -> Assembly
+emitPush toPush (code, tos) = (code ++ newCode, newTos)
+  where newCode = [ "; push"
+                  , "mov rcx, " ++ show toPush
+                  , "mov [rsp+" ++ (show $ tos + bits) ++ "], rcx"
+                  ]
+        newTos = tos + bits
+
+emitAdd :: Assembly -> Assembly
+emitAdd (code, tos) = (code ++ newCode, newTos)
+  where newCode = [ "; add"
+                  , "mov rcx, [rsp+" ++ show tos ++ "]"
+                  , "add rcx, [rsp+" ++ show newTos ++ "]"
+                  , "mov [rsp+" ++ show newTos ++ "], rcx"
+                  ]
+        newTos = tos - bits
+
+emitPrint :: Assembly -> Assembly
+emitPrint (code, tos) = (code ++ newCode, newTos)
+  where newCode = [ "; print"
+                  , "mov rbx, [rsp+" ++ show tos ++ "]"
+                  , "call p"
+                  ]
+        newTos = tos - bits
+
+emitDup :: Assembly -> Assembly
+emitDup (code, tos) = (code ++ newCode, newTos)
+  where newCode = [ "; dup"
+                  , "mov rcx, [rsp+" ++ show tos ++ "]"
+                  , "mov [rsp+" ++ show newTos ++ "], rcx"
+                  ]
+        newTos = tos + bits
+
+isNumber :: String -> Bool
+isNumber s = case (reads s) :: [(Int, String)] of
+  [(_, "")] -> True
+  _         -> False
+
+emitCode :: String -> Assembly -> Assembly
+emitCode instr asm
+  | isNumber instr = emitPush (read instr) asm
+  | instr == "+"   = emitAdd asm
+  | instr == "p"   = emitPrint asm
+  | instr == "dup" = emitDup asm
+
+emitLoop :: [String] -> Assembly -> Assembly
+emitLoop [] asm       = asm
+emitLoop instrs asm = emitLoop (tail instrs) $ emitCode (head instrs) asm
+
+emitLoopEntry ss = emitLoop ss ([], 0)
+
+main = interact $ foldr1 (++) . map (\line -> line ++ "\n") . fst . emitLoopEntry . words
+-- main = undefined

footer.asm

@@ -0,0 +1,17 @@
+; beginning of footer
+    mov rax, SYS_EXIT
+    mov rdi, 0
+    syscall
+
+p:
+    mov rax, SYS_WRITE
+    mov rdi, STDOUT
+    mov rsi, msg_buf
+    mov [rsi], rbx
+    mov rdx, 1
+    syscall
+    ret
+
+section .data
+msg_buf:
+    db "!"

header.asm

@@ -0,0 +1,13 @@
+bits 64
+
+%define SYS_WRITE 1
+%define SYS_EXIT 60
+
+%define STDIN  0
+%define STDOUT 1
+%define STDERR 2
+
+global _start
+section .text
+_start:
+; end of header

source.stk

@@ -0,0 +1,2 @@
+32 111 108 dup 101 72 p p p p p p
+10 100 108 114 111 87 p p p p p p