Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 2009-2010,2014 Matthew Fluet. |
2 | * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh | |
3 | * Jagannathan, and Stephen Weeks. | |
4 | * Copyright (C) 1997-2000 NEC Research Institute. | |
5 | * | |
6 | * MLton is released under a BSD-style license. | |
7 | * See the file MLton-LICENSE for details. | |
8 | *) | |
9 | ||
10 | functor amd64Codegen (S: AMD64_CODEGEN_STRUCTS): AMD64_CODEGEN = | |
11 | struct | |
12 | open S | |
13 | ||
14 | structure amd64 = amd64 (open Machine | |
15 | structure RepType = Type) | |
16 | structure amd64Pseudo = amd64PseudoCheck (structure S = amd64) | |
17 | ||
18 | structure amd64MLtonBasic | |
19 | = amd64MLtonBasic (structure amd64 = amd64Pseudo | |
20 | structure Machine = Machine) | |
21 | ||
22 | structure amd64Liveness | |
23 | = amd64Liveness (structure amd64 = amd64 | |
24 | structure amd64MLtonBasic = amd64MLtonBasic) | |
25 | ||
26 | structure amd64JumpInfo | |
27 | = amd64JumpInfo (structure amd64 = amd64) | |
28 | ||
29 | structure amd64LoopInfo | |
30 | = amd64LoopInfo (structure amd64 = amd64) | |
31 | ||
32 | structure amd64EntryTransfer | |
33 | = amd64EntryTransfer (structure amd64 = amd64) | |
34 | ||
35 | structure amd64MLton | |
36 | = amd64MLton (structure amd64MLtonBasic = amd64MLtonBasic | |
37 | structure amd64Liveness = amd64Liveness) | |
38 | ||
39 | val implementsPrim = amd64MLton.implementsPrim | |
40 | ||
41 | structure amd64Translate | |
42 | = amd64Translate (structure amd64 = amd64 | |
43 | structure amd64MLton = amd64MLton | |
44 | structure amd64Liveness = amd64Liveness) | |
45 | ||
46 | structure amd64Simplify | |
47 | = amd64Simplify (structure amd64 = amd64 | |
48 | structure amd64Liveness = amd64Liveness | |
49 | structure amd64JumpInfo = amd64JumpInfo | |
50 | structure amd64EntryTransfer = amd64EntryTransfer) | |
51 | ||
52 | structure amd64GenerateTransfers | |
53 | = amd64GenerateTransfers (structure amd64 = amd64 | |
54 | structure amd64MLton = amd64MLton | |
55 | structure amd64Liveness = amd64Liveness | |
56 | structure amd64JumpInfo = amd64JumpInfo | |
57 | structure amd64LoopInfo = amd64LoopInfo | |
58 | structure amd64EntryTransfer = amd64EntryTransfer) | |
59 | ||
60 | structure amd64AllocateRegisters | |
61 | = amd64AllocateRegisters (structure amd64 = amd64 | |
62 | structure amd64MLton = amd64MLton) | |
63 | ||
64 | open amd64 | |
65 | fun output {program as Machine.Program.T {chunks, frameLayouts, handlesSignals, | |
66 | main, ...}, | |
67 | outputC: unit -> {file: File.t, | |
68 | print: string -> unit, | |
69 | done: unit -> unit}, | |
70 | outputS: unit -> {file: File.t, | |
71 | print: string -> unit, | |
72 | done: unit -> unit}}: unit | |
73 | = let | |
74 | val reserveRsp = | |
75 | (* There is no sigaltstack on cygwin, we need to reserve %rsp to | |
76 | * hold the C stack pointer. We only need to do this in programs | |
77 | * that handle signals. | |
78 | *) | |
79 | handlesSignals andalso let open Control.Target in !os = Cygwin end | |
80 | ||
81 | val makeC = outputC | |
82 | val makeS = outputS | |
83 | ||
84 | val Machine.Program.T {profileInfo, ...} = program | |
85 | val profileInfo = | |
86 | case profileInfo of | |
87 | NONE => Machine.ProfileInfo.empty | |
88 | | SOME pi => pi | |
89 | val {newProfileLabel, delProfileLabel, getProfileInfo} = | |
90 | Machine.ProfileInfo.modify profileInfo | |
91 | ||
92 | (* C specific *) | |
93 | fun outputC () | |
94 | = let | |
95 | local | |
96 | val Machine.Program.T | |
97 | {chunks, | |
98 | frameLayouts, | |
99 | frameOffsets, | |
100 | handlesSignals, | |
101 | main, | |
102 | maxFrameSize, | |
103 | objectTypes, | |
104 | reals, | |
105 | vectors, ...} = | |
106 | program | |
107 | in | |
108 | val program = | |
109 | Machine.Program.T | |
110 | {chunks = chunks, | |
111 | frameLayouts = frameLayouts, | |
112 | frameOffsets = frameOffsets, | |
113 | handlesSignals = handlesSignals, | |
114 | main = main, | |
115 | maxFrameSize = maxFrameSize, | |
116 | objectTypes = objectTypes, | |
117 | profileInfo = SOME (getProfileInfo ()), | |
118 | reals = reals, | |
119 | vectors = vectors} | |
120 | end | |
121 | val {print, done, ...} = makeC () | |
122 | val additionalMainArgs = | |
123 | let | |
124 | val mainLabel = Label.toString (#label main) | |
125 | (* Drop the leading _, because gcc will add it. *) | |
126 | val mainLabel = | |
127 | if !Control.labelsHaveExtra_ | |
128 | then String.dropPrefix (mainLabel, 1) | |
129 | else mainLabel | |
130 | in | |
131 | [mainLabel] | |
132 | end | |
133 | fun declareLocals () = | |
134 | List.foreach | |
135 | (CType.all, | |
136 | fn t => | |
137 | let | |
138 | val m = | |
139 | List.fold | |
140 | (chunks, ~1, fn (Machine.Chunk.T {regMax, ...}, max) => | |
141 | Int.max (max, regMax t)) | |
142 | val m = m + 1 | |
143 | in | |
144 | print (concat ["PRIVATE ", CType.toString t, | |
145 | " local", CType.toString t, | |
146 | "[", Int.toString m, "];\n"]) | |
147 | end) | |
148 | fun rest () = | |
149 | declareLocals () | |
150 | in | |
151 | CCodegen.outputDeclarations | |
152 | {additionalMainArgs = additionalMainArgs, | |
153 | includes = ["amd64-main.h"], | |
154 | print = print, | |
155 | program = program, | |
156 | rest = rest} | |
157 | ; done () | |
158 | end | |
159 | ||
160 | val outputC = Control.trace (Control.Pass, "outputC") outputC | |
161 | ||
162 | (* Assembly specific *) | |
163 | ||
164 | val _ = amd64MLtonBasic.init () | |
165 | ||
166 | fun outputJumpToSML print = | |
167 | let | |
168 | val win64 = case !Control.Target.os of | |
169 | MLton.Platform.OS.Cygwin => true | |
170 | | MLton.Platform.OS.MinGW => true | |
171 | | _ => false | |
172 | val jumpToSML = amd64.Label.fromString "MLton_jumpToSML" | |
173 | val returnToC = amd64.Label.fromString "Thread_returnToC" | |
174 | val {frontierReg, stackTopReg} = | |
175 | {frontierReg = amd64.Register.r12, | |
176 | stackTopReg = amd64.Register.rbp} | |
177 | val asm = | |
178 | [ | |
179 | amd64.Assembly.pseudoop_text (), | |
180 | amd64.Assembly.pseudoop_p2align | |
181 | (amd64.Immediate.int 4, NONE, NONE), | |
182 | amd64.Assembly.pseudoop_global jumpToSML, | |
183 | amd64.Assembly.pseudoop_hidden jumpToSML, | |
184 | amd64.Assembly.label jumpToSML, | |
185 | amd64.Assembly.instruction_binal | |
186 | {oper = amd64.Instruction.SUB, | |
187 | src = amd64.Operand.immediate_int 72, | |
188 | dst = amd64.Operand.register amd64.Register.rsp, | |
189 | size = amd64.Size.QUAD}, | |
190 | amd64.Assembly.instruction_mov | |
191 | {src = amd64.Operand.register amd64.Register.rbp, | |
192 | dst = (amd64.Operand.address o amd64.Address.T) | |
193 | {disp = SOME (amd64.Immediate.int 64), | |
194 | base = SOME amd64.Register.rsp, | |
195 | index= NONE, scale = NONE}, | |
196 | size = amd64.Size.QUAD}, | |
197 | amd64.Assembly.instruction_mov | |
198 | {src = amd64.Operand.register amd64.Register.rbx, | |
199 | dst = (amd64.Operand.address o amd64.Address.T) | |
200 | {disp = SOME (amd64.Immediate.int 56), | |
201 | base = SOME amd64.Register.rsp, | |
202 | index= NONE, scale = NONE}, | |
203 | size = amd64.Size.QUAD}, | |
204 | amd64.Assembly.instruction_mov | |
205 | {src = amd64.Operand.register amd64.Register.r12, | |
206 | dst = (amd64.Operand.address o amd64.Address.T) | |
207 | {disp = SOME (amd64.Immediate.int 48), | |
208 | base = SOME amd64.Register.rsp, | |
209 | index= NONE, scale = NONE}, | |
210 | size = amd64.Size.QUAD}, | |
211 | amd64.Assembly.instruction_mov | |
212 | {src = amd64.Operand.register amd64.Register.r13, | |
213 | dst = (amd64.Operand.address o amd64.Address.T) | |
214 | {disp = SOME (amd64.Immediate.int 40), | |
215 | base = SOME amd64.Register.rsp, | |
216 | index= NONE, scale = NONE}, | |
217 | size = amd64.Size.QUAD}, | |
218 | amd64.Assembly.instruction_mov | |
219 | {src = amd64.Operand.register amd64.Register.r14, | |
220 | dst = (amd64.Operand.address o amd64.Address.T) | |
221 | {disp = SOME (amd64.Immediate.int 32), | |
222 | base = SOME amd64.Register.rsp, | |
223 | index= NONE, scale = NONE}, | |
224 | size = amd64.Size.QUAD}, | |
225 | amd64.Assembly.instruction_mov | |
226 | {src = amd64.Operand.register amd64.Register.r15, | |
227 | dst = (amd64.Operand.address o amd64.Address.T) | |
228 | {disp = SOME (amd64.Immediate.int 24), | |
229 | base = SOME amd64.Register.rsp, | |
230 | index= NONE, scale = NONE}, | |
231 | size = amd64.Size.QUAD}, | |
232 | amd64.Assembly.instruction_mov | |
233 | {src = (amd64.Operand.address o amd64.Address.T) | |
234 | {disp = SOME (amd64.Immediate.label amd64MLton.c_stackP), | |
235 | base = SOME amd64.Register.rip, index = NONE, scale = NONE}, | |
236 | dst = amd64.Operand.register amd64.Register.rbx, | |
237 | size = amd64.Size.QUAD}, | |
238 | amd64.Assembly.instruction_mov | |
239 | {src = amd64.Operand.register amd64.Register.rbx, | |
240 | dst = (amd64.Operand.address o amd64.Address.T) | |
241 | {disp = SOME (amd64.Immediate.int 16), | |
242 | base = SOME amd64.Register.rsp, | |
243 | index = NONE, scale = NONE}, | |
244 | size = amd64.Size.QUAD}, | |
245 | amd64.Assembly.instruction_mov | |
246 | {src = amd64.Operand.register amd64.Register.rsp, | |
247 | dst = (amd64.Operand.address o amd64.Address.T) | |
248 | {disp = SOME (amd64.Immediate.label amd64MLton.c_stackP), | |
249 | base = SOME amd64.Register.rip, index = NONE, scale = NONE}, | |
250 | size = amd64.Size.QUAD}, | |
251 | amd64.Assembly.instruction_mov | |
252 | {src = (amd64.Operand.address o amd64.Address.T) | |
253 | {disp = (SOME o amd64.Immediate.labelPlusInt) | |
254 | (amd64MLton.gcState_label, | |
255 | Bytes.toInt | |
256 | (Machine.Runtime.GCField.offset | |
257 | Machine.Runtime.GCField.StackTop)), | |
258 | base = SOME amd64.Register.rip, index = NONE, scale = NONE}, | |
259 | dst = amd64.Operand.register stackTopReg, | |
260 | size = amd64.Size.QUAD}, | |
261 | amd64.Assembly.instruction_mov | |
262 | {src = (amd64.Operand.address o amd64.Address.T) | |
263 | {disp = (SOME o amd64.Immediate.labelPlusInt) | |
264 | (amd64MLton.gcState_label, | |
265 | Bytes.toInt | |
266 | (Machine.Runtime.GCField.offset | |
267 | Machine.Runtime.GCField.Frontier)), | |
268 | base = SOME amd64.Register.rip, index = NONE, scale = NONE}, | |
269 | dst = amd64.Operand.register frontierReg, | |
270 | size = amd64.Size.QUAD}, | |
271 | amd64.Assembly.instruction_jmp | |
272 | {target = amd64.Operand.register | |
273 | (if win64 then amd64.Register.rcx | |
274 | else amd64.Register.rdi), | |
275 | absolute = true}, | |
276 | amd64.Assembly.pseudoop_p2align | |
277 | (amd64.Immediate.int 4, NONE, NONE), | |
278 | amd64.Assembly.pseudoop_global returnToC, | |
279 | amd64.Assembly.pseudoop_hidden returnToC, | |
280 | amd64.Assembly.label returnToC, | |
281 | amd64.Assembly.instruction_mov | |
282 | {src = (amd64.Operand.address o amd64.Address.T) | |
283 | {disp = SOME (amd64.Immediate.label amd64MLton.c_stackP), | |
284 | base = SOME amd64.Register.rip, index = NONE, scale = NONE}, | |
285 | dst = amd64.Operand.register amd64.Register.rsp, | |
286 | size = amd64.Size.QUAD}, | |
287 | amd64.Assembly.instruction_mov | |
288 | {src = (amd64.Operand.address o amd64.Address.T) | |
289 | {disp = SOME (amd64.Immediate.int 16), | |
290 | base = SOME amd64.Register.rsp, | |
291 | index = NONE, scale = NONE}, | |
292 | dst = amd64.Operand.register amd64.Register.rbx, | |
293 | size = amd64.Size.QUAD}, | |
294 | amd64.Assembly.instruction_mov | |
295 | {src = amd64.Operand.register amd64.Register.rbx, | |
296 | dst = (amd64.Operand.address o amd64.Address.T) | |
297 | {disp = SOME (amd64.Immediate.label amd64MLton.c_stackP), | |
298 | base = SOME amd64.Register.rip, index = NONE, scale = NONE}, | |
299 | size = amd64.Size.QUAD}, | |
300 | amd64.Assembly.instruction_mov | |
301 | {src = (amd64.Operand.address o amd64.Address.T) | |
302 | {disp = SOME (amd64.Immediate.int 24), | |
303 | base = SOME amd64.Register.rsp, | |
304 | index = NONE, scale = NONE}, | |
305 | dst = amd64.Operand.register amd64.Register.r15, | |
306 | size = amd64.Size.QUAD}, | |
307 | amd64.Assembly.instruction_mov | |
308 | {src = (amd64.Operand.address o amd64.Address.T) | |
309 | {disp = SOME (amd64.Immediate.int 32), | |
310 | base = SOME amd64.Register.rsp, | |
311 | index = NONE, scale = NONE}, | |
312 | dst = amd64.Operand.register amd64.Register.r14, | |
313 | size = amd64.Size.QUAD}, | |
314 | amd64.Assembly.instruction_mov | |
315 | {src = (amd64.Operand.address o amd64.Address.T) | |
316 | {disp = SOME (amd64.Immediate.int 40), | |
317 | base = SOME amd64.Register.rsp, | |
318 | index = NONE, scale = NONE}, | |
319 | dst = amd64.Operand.register amd64.Register.r13, | |
320 | size = amd64.Size.QUAD}, | |
321 | amd64.Assembly.instruction_mov | |
322 | {src = (amd64.Operand.address o amd64.Address.T) | |
323 | {disp = SOME (amd64.Immediate.int 48), | |
324 | base = SOME amd64.Register.rsp, | |
325 | index = NONE, scale = NONE}, | |
326 | dst = amd64.Operand.register amd64.Register.r12, | |
327 | size = amd64.Size.QUAD}, | |
328 | amd64.Assembly.instruction_mov | |
329 | {src = (amd64.Operand.address o amd64.Address.T) | |
330 | {disp = SOME (amd64.Immediate.int 56), | |
331 | base = SOME amd64.Register.rsp, | |
332 | index = NONE, scale = NONE}, | |
333 | dst = amd64.Operand.register amd64.Register.rbx, | |
334 | size = amd64.Size.QUAD}, | |
335 | amd64.Assembly.instruction_mov | |
336 | {src = (amd64.Operand.address o amd64.Address.T) | |
337 | {disp = SOME (amd64.Immediate.int 64), | |
338 | base = SOME amd64.Register.rsp, | |
339 | index = NONE, scale = NONE}, | |
340 | dst = amd64.Operand.register amd64.Register.rbp, | |
341 | size = amd64.Size.QUAD}, | |
342 | amd64.Assembly.instruction_binal | |
343 | {oper = amd64.Instruction.ADD, | |
344 | src = amd64.Operand.immediate_int 72, | |
345 | dst = amd64.Operand.register amd64.Register.rsp, | |
346 | size = amd64.Size.QUAD}, | |
347 | amd64.Assembly.instruction_ret {src = NONE} | |
348 | ] | |
349 | in | |
350 | List.foreach | |
351 | (asm, | |
352 | fn asm => (Layout.print(Assembly.layout asm, print); | |
353 | print "\n")) | |
354 | end | |
355 | ||
356 | val liveInfo = amd64Liveness.LiveInfo.newLiveInfo () | |
357 | val jumpInfo = amd64JumpInfo.newJumpInfo () | |
358 | ||
359 | fun frameInfoToAMD64 (Machine.FrameInfo.T {frameLayoutsIndex, ...}) = | |
360 | amd64.FrameInfo.T | |
361 | {frameLayoutsIndex = frameLayoutsIndex, | |
362 | size = Bytes.toInt (#size (Vector.sub (frameLayouts, | |
363 | frameLayoutsIndex)))} | |
364 | ||
365 | fun outputChunk (chunk as Machine.Chunk.T {blocks, chunkLabel, ...}, | |
366 | print) | |
367 | = let | |
368 | val isMain | |
369 | = Machine.ChunkLabel.equals(#chunkLabel main, chunkLabel) | |
370 | ||
371 | val () | |
372 | = if isMain | |
373 | then outputJumpToSML print | |
374 | else () | |
375 | ||
376 | val {chunk} | |
377 | = amd64Translate.translateChunk | |
378 | {chunk = chunk, | |
379 | frameInfoToAMD64 = frameInfoToAMD64, | |
380 | liveInfo = liveInfo} | |
381 | ||
382 | val chunk : amd64.Chunk.t | |
383 | = amd64Simplify.simplify | |
384 | {chunk = chunk, | |
385 | (* don't perform optimizations on | |
386 | * the main function (initGlobals) | |
387 | *) | |
388 | optimize = if isMain | |
389 | then 0 | |
390 | else !Control.Native.optimize, | |
391 | delProfileLabel = delProfileLabel, | |
392 | liveInfo = liveInfo, | |
393 | jumpInfo = jumpInfo} | |
394 | ||
395 | val unallocated_assembly : amd64.Assembly.t list list | |
396 | = (amd64GenerateTransfers.generateTransfers | |
397 | {chunk = chunk, | |
398 | optimize = !Control.Native.optimize, | |
399 | newProfileLabel = newProfileLabel, | |
400 | liveInfo = liveInfo, | |
401 | jumpInfo = jumpInfo, | |
402 | reserveRsp = reserveRsp}) | |
403 | ||
404 | val allocated_assembly : Assembly.t list list | |
405 | = amd64AllocateRegisters.allocateRegisters | |
406 | {assembly = unallocated_assembly, | |
407 | (* don't calculate liveness info | |
408 | * on the main function (initGlobals) | |
409 | *) | |
410 | liveness = not isMain} | |
411 | ||
412 | val _ = Vector.foreach (blocks, Label.clear o Machine.Block.label) | |
413 | val _ = amd64.Immediate.clearAll () | |
414 | val _ = amd64.MemLoc.clearAll () | |
415 | in | |
416 | List.fold | |
417 | (allocated_assembly, | |
418 | if isMain then 30 else 0, | |
419 | fn (block, n) | |
420 | => List.fold | |
421 | (block, | |
422 | n, | |
423 | fn (asm, n) | |
424 | => (Layout.print (Assembly.layout asm, print); | |
425 | print "\n"; | |
426 | n + 1))) | |
427 | end | |
428 | ||
429 | fun outputAssembly () | |
430 | = let | |
431 | val split = !Control.Native.split | |
432 | fun loop chunks | |
433 | = let | |
434 | val {print, done, ...} = makeS() | |
435 | fun loop' (chunks, size) | |
436 | = case chunks | |
437 | of [] => done () | |
438 | | chunk::chunks | |
439 | => if (case split | |
440 | of NONE => false | |
441 | | SOME maxSize => size > maxSize) | |
442 | then (done (); loop (chunk::chunks)) | |
443 | else loop'(chunks, | |
444 | size + outputChunk (chunk, print)) | |
445 | in | |
446 | loop' (chunks, 0) | |
447 | end | |
448 | in | |
449 | loop chunks | |
450 | ; amd64Translate.translateChunk_totals () | |
451 | ; amd64Simplify.simplify_totals () | |
452 | ; amd64GenerateTransfers.generateTransfers_totals () | |
453 | ; amd64AllocateRegisters.allocateRegisters_totals () | |
454 | end | |
455 | ||
456 | val outputAssembly = | |
457 | Control.trace (Control.Pass, "outputAssembly") outputAssembly | |
458 | in | |
459 | outputAssembly() | |
460 | ; outputC() | |
461 | end | |
462 | end |