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
135
136
137
138
139
140
141
142
143
144
145
146
|
functor Emit(I: IL) = struct
structure I = I
structure P = I.P
structure D = P.D
structure PP = P.P
val file = ref NONE
local
fun output s =
let
val outstream = valOf $ !file
in
TextIO.output (outstream, s)
end
val ctx = ((false, makePrintfBase output),
fn (_: bool * ((string -> unit) * (unit -> unit))) => ())
in
fun fprint g = Fold.fold ctx g
end
fun fprintt g = fprint `"\t" g
fun fprinttn g =
fprintt (fn (a, _) => g (a, fn (_, out) => (Printf out `"\n" %)))
fun handleBSS objsZI =
let
val () = fprint `"section .bss\n" %
fun handleObj (id, _, t, _, _) =
let
val align = P.alignOfType t
val size = P.sizeOfType t
in
fprinttn `"align\t" W align %;
fprint PP.? id `":\tresb " W size `"\n" %
end
in
List.app handleObj objsZI
end
fun dd size w =
let
val cmd =
case size of
0w1 => "db"
| 0w2 => "dw"
| 0w4 => "dd"
| 0w8 => "dq"
| _ => raise Unreachable
in
fprint `cmd `" " W w %
end
fun emitScalarIni size w = (
fprint `"\t" %; dd size w; fprint `"\n" %
)
fun emitAggrLayout id =
let
val (_, size, layout) = D.get P.iniLayouts id
val () = fprint `"\n" %
fun getPadding offset t [] = size - (offset + P.sizeOfType t)
| getPadding offset t ({ offset = offset', ... } :: _) =
offset' - (offset + P.sizeOfType t)
fun emitScalars ({ offset, t, value } :: tail) =
let
val () = fprint `"\t" %
val () = dd (P.sizeOfType t) value
val padding = getPadding offset t tail
in
if padding > 0w0 then
fprint `"\n\tresb " W padding `"\n" %
else
fprint `"\n" %;
emitScalars tail
end
| emitScalars [] = ()
in
emitScalars layout
end
fun handleData objs =
let
val () = fprint `"section .data\n" %
fun emitLayout (id, _, t, ini, _) =
let
val align = P.alignOfType t
val size = P.sizeOfType t
val () = fprinttn `"align\t" W align %
val () = fprint PP.? id `":" %
in
case ini of
P.CiniConst w => emitScalarIni size w
| P.CiniLayout id => emitAggrLayout id
| P.CiniExpr _ => raise Unreachable
end
in
List.app emitLayout objs
end
fun handleStrlits strlits =
let
fun f id = fprint `".S" I id `":\tdb " `(PP.?? id) `", 0\n" %
in
fprint `"\n" %;
List.app f strlits
end
fun handleLocalIniLayouts () =
let
fun f (_, (true, _, _)) = ()
| f (n, (false, _, _)) = (
fprint `"\talign 16\n" %;
fprint `".I" I n `":" %;
emitAggrLayout n
)
in
D.appi f P.iniLayouts
end
fun openFile fname = file := SOME (TextIO.openOut fname)
fun emit fname
(I.Ctx { globSyms, extSyms, objsZI, objs, strlits, ... }) =
let
val () = openFile fname
val () = List.app (fn gs => fprint `"global " PP.? gs `"\n" %) globSyms
val () = List.app (fn es => fprint `"extern " PP.? es `"\n" %) extSyms
val () = handleBSS objsZI
val () = handleData objs
val () = handleStrlits strlits
val () = handleLocalIniLayouts ()
in
()
end
end
|