95 lines
2.5 KiB
Haskell
95 lines
2.5 KiB
Haskell
module Compiler where
|
|
|
|
import Parser
|
|
import Text.Printf (printf)
|
|
import Control.Monad (void)
|
|
import System.Process
|
|
import System.IO
|
|
|
|
handleSymbol :: Handle -> ZorthExpr -> IO ()
|
|
|
|
handleSymbol h (ZorthASTInteger i) = hPutStrLn h $ " push "<>show i
|
|
|
|
handleSymbol h (ZorthASTWord "+") = do
|
|
hPutStr h
|
|
" pop rbx\n\
|
|
\ pop rax\n\
|
|
\ add rax, rbx\n\
|
|
\ push rax\n"
|
|
|
|
handleSymbol h (ZorthASTWord "-") = do
|
|
hPutStr h
|
|
" pop rbx\n\
|
|
\ pop rax\n\
|
|
\ sub rax, rbx\n\
|
|
\ push rax\n"
|
|
|
|
handleSymbol h (ZorthASTWord "ret") = do
|
|
hPutStr h
|
|
" mov rax,60\n\
|
|
\ mov rdi,0\n\
|
|
\ syscall\n"
|
|
|
|
handleSymbol h (ZorthASTWord "dup") = do
|
|
hPutStr h
|
|
" pop rax\n\
|
|
\ push rax\n\
|
|
\ push rax\n"
|
|
|
|
handleSymbol h (ZorthASTWord "swap") = do
|
|
hPutStr h
|
|
" pop rax\n\
|
|
\ pop rbx\n\
|
|
\ push rax\n\
|
|
\ push rbx\n"
|
|
|
|
handleSymbol h (ZorthASTWord "drop") = do
|
|
hPutStr h " add rsp, 8\n"
|
|
|
|
handleSymbol h (ZorthASTWord ".") = do
|
|
hPutStr h
|
|
" pop rbx\n\
|
|
\ call print_number\n"
|
|
|
|
forthPrelude :: Handle -> IO ()
|
|
forthPrelude h = do
|
|
hPutStr h
|
|
"global _start\n\
|
|
\print_number:\n\
|
|
\ push rbp\n\
|
|
\ mov rbp, rsp\n\
|
|
\ sub rsp, 128 \n\
|
|
\ mov rdx, -1 \n\
|
|
\ jmp l2\n\
|
|
\ add rsp, 28\n\
|
|
\ pop rbp\n\
|
|
\ ret\n\
|
|
\l1:\n\
|
|
\ dec rdx\n\
|
|
\ imul rax, rbx, 1717986919\n\
|
|
\ shr rax, 34\n\
|
|
\ imul rcx, rax, 10\n\
|
|
\ sub rbx, rcx\n\
|
|
\ add rbx, '0'\n\
|
|
\ mov qword[rbp+8*rdx], rbx\n\
|
|
\\n\
|
|
\ mov rbx, rax\n\
|
|
\l2:\n\
|
|
\ cmp rbx, 0\n\
|
|
\ jne l1\n\
|
|
\ mov qword[rbp-8], `\\n` \n\
|
|
\ mov rax, 1\n\
|
|
\ mov rdi, 1\n\
|
|
\ lea rsi, [rbp+8*rdx]\n\
|
|
\ neg rdx\n\
|
|
\ imul rdx, 8\n\
|
|
\ syscall\n\
|
|
\ leave\n\
|
|
\ ret\n\
|
|
\_start:\n"
|
|
|
|
compileZorth :: Handle -> ZorthAST -> IO ()
|
|
compileZorth h [] = return ()
|
|
compileZorth h xs = do
|
|
forthPrelude h
|
|
foldr ((>>) . handleSymbol h) (return ()) xs |