blob: ef655d47806d0f53e58bf2fd965a3b14fd92ead0 (
plain)
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
|
module Micro.Asm.Sdcc where
import qualified Data.Map as Map
import qualified Micro.Ast as A
import Micro.Env (Sym (..), SymMap)
toIdent :: A.Ident -> Bool -> String
toIdent id False = "_" ++ id
toIdent id True = id
toLabel :: A.Ident -> Bool -> String
toLabel id False = toIdent id False ++ "::"
toLabel id True = 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 -> String
toInit (A.Type t)
| t == "bool" || t == "u8" || t == "s8" = ".db"
| t == "u16" || t == "s16" = ".dw"
| otherwise = ".dw"
toInit (A.FuncType _ _) = ".dw"
onlyData :: SymMap -> [Sym]
onlyData symm =
filter (\sym -> symRef sym) $
Map.elems symm
header :: [String]
header = [";", "; File created by $$$ v?.?.? (SDCC)", ";"]
module' :: A.Expr -> [String]
module' (A.Module name _) = ["\t.module " ++ name, "\t.optsdcc -mz80"]
module' _ = ["\t.module main"] -- won't happen
exports :: SymMap -> [String]
exports symm =
[""]
++ ( map (\sym -> "\t.globl " ++ toIdent (symId sym) False) $
Map.elems $ Map.filter (\sym -> not $ symPriv sym) symm
)
dataVars :: SymMap -> [String]
dataVars symm =
["\n\t.area _DATA", "\t.area _INITIALIZED"]
++ ( map (\sym -> toLabel (symId sym) (symPriv sym) ++ "\n\t" ++ toData (symType sym)) $
onlyData symm
)
initVars :: SymMap -> [String]
initVars symm =
["\n\t.area _INITIALIZER"]
++ ( map (\sym -> "__xinit_" ++ toLabel (symId sym) True ++ "\n\t" ++ toInit (symType sym) ++ " FIXME") $ onlyData symm
)
++ ["\n\t.area _GSINIT", "\t.area _GSFINAL"]
code :: [String]
code = ["\n\t.area _CODE"]
generate :: SymMap -> [A.Expr] -> String
generate symm ast = unlines $ header ++ module' (head ast) ++ exports symm ++ dataVars symm ++ code ++ initVars symm
|
