1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
module Micro.Asm.Sdcc where
import qualified Micro.Ast as A
import Text.Parsec (SourcePos, sourceColumn, sourceLine)
toIdent :: A.Ident -> String
toIdent id = "_" ++ id
toLabel :: A.Ident -> Bool -> String
toLabel id False = toIdent id ++ "::"
toLabel id True = toIdent id ++ ":"
toData :: A.Type -> String
toData (A.Type t)
| t == "bool" || t == "u8" || t == "s8" = ".ds 1"
| t == "u16" || t == "s16" = ".ds 2"
| otherwise = ".ds 2"
toData (A.FuncType _ _) = ".ds 2"
toInit :: A.Type -> A.Expr -> String
toInit (A.Type t) (A.Num v _)
| t == "bool" || t == "u8" || t == "s8" = ".db " ++ show v
| t == "u16" || t == "s16" = ".dw " ++ show v
| otherwise = ".dw " ++ show v
toInit _ v = ".dw " ++ show v
posToIdent :: SourcePos -> String
posToIdent p = "l" ++ show (sourceLine p) ++ "$" ++ show (sourceColumn p)
header :: String -> [String]
header version = [";", "; File created by Micro v" ++ version ++ " (SDCC)", ";"]
module' :: String -> String
module' name = "\t.module " ++ name
optsdcc :: String
optsdcc = "\t.optsdcc -mz80"
area :: String -> String
area name = "\n\t.area " ++ name
globl :: String -> String
globl id = "\t.globl " ++ id
mul8 :: A.Expr -> A.Expr -> SourcePos -> [String]
mul8 a b p = do
let loop = posToIdent p
let loop0 = loop ++ "z"
oCode (emit a)
++ [ "\tor a",
"\tjr z, " ++ toIdent loop0,
"\tld b, a",
"\tdec b",
"\tjr z, " ++ toIdent loop0
]
++ oCode (emit b)
++ [ "\tld c, a",
toLabel loop True,
"\tadd c",
"\tdjnz "
++ toIdent loop,
toLabel loop0 True
]
data Output = Output
{ oPre :: [String],
oInit :: [String],
oData :: [String],
oCode :: [String]
}
emit :: A.Expr -> Output
emit x =
case x of
(A.Module name _) -> o {oPre = [module' name, optsdcc, ""]}
(A.Var id typ val priv False _) ->
o
{ oPre = [globl $ toIdent id | not priv],
oData = [toLabel id priv, "\t" ++ toData typ],
oInit = ["__init" ++ toLabel id True, "\t" ++ toInit typ val]
}
(A.Num v _) -> o {oCode = ["\tld a, #" ++ show v]}
(A.Variable id _) -> o {oCode = ["\tld a, (" ++ toIdent id ++ ")"]}
-- cases where constant folding didn't happen
(A.BinOp A.Plus _ (A.Num a _) (A.Num b _)) -> o {oCode = [show a ++ "+" ++ show b]}
(A.BinOp A.Minus _ (A.Num a _) (A.Num b _)) -> o {oCode = [show a ++ "-" ++ show b]}
(A.BinOp A.Mul _ (A.Num a _) (A.Num b _)) -> o {oCode = [show a ++ "*" ++ show b]}
(A.BinOp A.Div _ (A.Num a _) (A.Num b _)) -> o {oCode = [show a ++ "/" ++ show b]}
(A.BinOp A.Plus _ a (A.Num 1 _)) ->
o {oCode = oCode (emit a) ++ ["\tinc a"]}
(A.BinOp A.Plus _ a (A.Num v _)) ->
o {oCode = oCode (emit a) ++ ["\tadd #" ++ show v]}
(A.BinOp A.Plus _ a b) ->
o {oCode = oCode (emit a) ++ ["\tld c, a"] ++ oCode (emit b) ++ ["\tadd c"]}
(A.BinOp A.Minus _ a (A.Num 1 _)) ->
o {oCode = oCode (emit a) ++ ["\tdec a"]}
(A.BinOp A.Minus _ a (A.Num v _)) ->
o {oCode = oCode (emit a) ++ ["\tsub #" ++ show v]}
(A.BinOp A.Minus _ a b) ->
o {oCode = oCode (emit a) ++ ["\tld c, a"] ++ oCode (emit b) ++ ["\tld b, a", "\tld a, c", "\tsub b"]}
(A.BinOp A.Mul _ _ (A.Num 0 _)) ->
o {oCode = ["\txor a"]}
(A.BinOp A.Mul _ _ (A.Num 1 _)) -> o
(A.BinOp A.Mul _ a (A.Num 2 _)) ->
o {oCode = oCode (emit a) ++ ["\tsla a"]}
(A.BinOp A.Mul _ a (A.Num v _)) ->
o {oCode = oCode (emit a) ++ ["\tld c, a"] ++ replicate (fromInteger v - 1) "\tadd c"}
(A.BinOp A.Mul p a b) -> do
o {oCode = mul8 a b p}
(A.BinOp A.Assign _ (A.Variable id _) b) ->
o {oCode = oCode (emit b) ++ ["\tld (" ++ toIdent id ++ "), a"]}
_ -> o {oCode = [";; unimplemented " ++ show x]}
where
o = Output [] [] [] []
generate :: String -> [A.Expr] -> String
generate version ast = do
let out = map emit ast
let pre = concatMap oPre out
let dat = [area "_DATA", area "_INITIALIZED"] ++ concatMap oData out
let code = [area "_CODE"] ++ concatMap oCode out ++ ["hlt0:", "\tjr hlt0"]
let init = [area "_INITIALIZER"] ++ concatMap oInit out ++ [area "_GSINIT", area "_GSFINAL"]
unlines $ header version ++ pre ++ dat ++ code ++ init
|
