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
124
125
126
127
128
129
130
131
132
133
134
|
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
]
mul :: A.Expr -> A.Expr -> SourcePos -> [String]
mul a b@(A.Num v _) p
| v == 2 = oCode (emit a) ++ ["\tsla a"]
| v == 4 = oCode (emit a) ++ replicate 2 "\tsla a"
| v == 8 = oCode (emit a) ++ replicate 3 "\tsla a"
| v == 16 = oCode (emit a) ++ replicate 4 "\tsla a"
| v == 32 = oCode (emit a) ++ replicate 5 "\tsla a"
| v < 6 = oCode (emit a) ++ ["\tld c, a"] ++ replicate (fromInteger v - 1) "\tadd c"
| otherwise = mul8 a b p
mul _ _ _ = [";; unimplemented"]
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 0 _) _) ->
o {oCode = ["\txor a"]}
(A.BinOp A.Mul _ (A.Num 1 _) b) -> o {oCode = oCode (emit b)}
(A.BinOp A.Mul _ a (A.Num 1 _)) -> o {oCode = oCode (emit a)}
(A.BinOp A.Mul pos a b@(A.Num _ _)) -> o {oCode = mul a b pos}
(A.BinOp A.Mul pos a@(A.Num _ _) b) -> o {oCode = mul b a pos}
(A.BinOp A.Mul p a b) -> 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
|
