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 x86Codegen (S: X86_CODEGEN_STRUCTS): X86_CODEGEN = | |
11 | struct | |
12 | open S | |
13 | ||
14 | structure x86 = x86 (open Machine | |
15 | structure RepType = Type) | |
16 | structure x86Pseudo = x86PseudoCheck (structure S = x86) | |
17 | ||
18 | structure x86MLtonBasic | |
19 | = x86MLtonBasic (structure x86 = x86Pseudo | |
20 | structure Machine = Machine) | |
21 | ||
22 | structure x86Liveness | |
23 | = x86Liveness (structure x86 = x86 | |
24 | structure x86MLtonBasic = x86MLtonBasic) | |
25 | ||
26 | structure x86JumpInfo | |
27 | = x86JumpInfo (structure x86 = x86) | |
28 | ||
29 | structure x86LoopInfo | |
30 | = x86LoopInfo (structure x86 = x86) | |
31 | ||
32 | structure x86EntryTransfer | |
33 | = x86EntryTransfer (structure x86 = x86) | |
34 | ||
35 | structure x86MLton | |
36 | = x86MLton (structure x86MLtonBasic = x86MLtonBasic | |
37 | structure x86Liveness = x86Liveness) | |
38 | ||
39 | val implementsPrim = x86MLton.implementsPrim | |
40 | ||
41 | structure x86Translate | |
42 | = x86Translate (structure x86 = x86 | |
43 | structure x86MLton = x86MLton | |
44 | structure x86Liveness = x86Liveness) | |
45 | ||
46 | structure x86Simplify | |
47 | = x86Simplify (structure x86 = x86 | |
48 | structure x86Liveness = x86Liveness | |
49 | structure x86JumpInfo = x86JumpInfo | |
50 | structure x86EntryTransfer = x86EntryTransfer) | |
51 | ||
52 | structure x86GenerateTransfers | |
53 | = x86GenerateTransfers (structure x86 = x86 | |
54 | structure x86MLton = x86MLton | |
55 | structure x86Liveness = x86Liveness | |
56 | structure x86JumpInfo = x86JumpInfo | |
57 | structure x86LoopInfo = x86LoopInfo | |
58 | structure x86EntryTransfer = x86EntryTransfer) | |
59 | ||
60 | structure x86AllocateRegisters | |
61 | = x86AllocateRegisters (structure x86 = x86 | |
62 | structure x86MLton = x86MLton) | |
63 | ||
64 | open x86 | |
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 reserveEsp = | |
75 | (* There is no sigaltstack on cygwin, we need to reserve %esp 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 (picMungeLabel, picBase) = x86AllocateRegisters.picRelative () | |
82 | ||
83 | val makeC = outputC | |
84 | val makeS = outputS | |
85 | ||
86 | val Machine.Program.T {profileInfo, ...} = program | |
87 | val profileInfo = | |
88 | case profileInfo of | |
89 | NONE => Machine.ProfileInfo.empty | |
90 | | SOME pi => pi | |
91 | val {newProfileLabel, delProfileLabel, getProfileInfo} = | |
92 | Machine.ProfileInfo.modify profileInfo | |
93 | ||
94 | (* C specific *) | |
95 | fun outputC () | |
96 | = let | |
97 | local | |
98 | val Machine.Program.T | |
99 | {chunks, | |
100 | frameLayouts, | |
101 | frameOffsets, | |
102 | handlesSignals, | |
103 | main, | |
104 | maxFrameSize, | |
105 | objectTypes, | |
106 | reals, | |
107 | vectors, ...} = | |
108 | program | |
109 | in | |
110 | val program = | |
111 | Machine.Program.T | |
112 | {chunks = chunks, | |
113 | frameLayouts = frameLayouts, | |
114 | frameOffsets = frameOffsets, | |
115 | handlesSignals = handlesSignals, | |
116 | main = main, | |
117 | maxFrameSize = maxFrameSize, | |
118 | objectTypes = objectTypes, | |
119 | profileInfo = SOME (getProfileInfo ()), | |
120 | reals = reals, | |
121 | vectors = vectors} | |
122 | end | |
123 | val {print, done, ...} = makeC () | |
124 | val additionalMainArgs = | |
125 | let | |
126 | val mainLabel = Label.toString (#label main) | |
127 | (* Drop the leading _, because gcc will add it. *) | |
128 | val mainLabel = | |
129 | if !Control.labelsHaveExtra_ | |
130 | then String.dropPrefix (mainLabel, 1) | |
131 | else mainLabel | |
132 | in | |
133 | [mainLabel] | |
134 | end | |
135 | fun declareLocals () = | |
136 | List.foreach | |
137 | (CType.all, | |
138 | fn t => | |
139 | let | |
140 | val m = | |
141 | List.fold | |
142 | (chunks, ~1, fn (Machine.Chunk.T {regMax, ...}, max) => | |
143 | Int.max (max, regMax t)) | |
144 | val m = m + 1 | |
145 | in | |
146 | print (concat ["PRIVATE ", CType.toString t, | |
147 | " local", CType.toString t, | |
148 | "[", Int.toString m, "];\n"]) | |
149 | end) | |
150 | fun rest () = | |
151 | declareLocals () | |
152 | in | |
153 | CCodegen.outputDeclarations | |
154 | {additionalMainArgs = additionalMainArgs, | |
155 | includes = ["x86-main.h"], | |
156 | print = print, | |
157 | program = program, | |
158 | rest = rest} | |
159 | ; done () | |
160 | end | |
161 | ||
162 | val outputC = Control.trace (Control.Pass, "outputC") outputC | |
163 | ||
164 | (* Assembly specific *) | |
165 | ||
166 | val _ = x86MLtonBasic.init () | |
167 | ||
168 | fun outputJumpToSML print = | |
169 | let | |
170 | val jumpToSML = x86.Label.fromString "MLton_jumpToSML" | |
171 | val findEIP = x86.Label.fromString "MLton_findEIP" | |
172 | val returnToC = x86.Label.fromString "Thread_returnToC" | |
173 | val c_stackP = picMungeLabel x86MLton.c_stackP | |
174 | val gcState = picMungeLabel x86MLton.gcState_label | |
175 | val {frontierReg, stackTopReg} = | |
176 | if reserveEsp | |
177 | then {frontierReg = x86.Register.edi, | |
178 | stackTopReg = x86.Register.ebp} | |
179 | else {frontierReg = x86.Register.esp, | |
180 | stackTopReg = x86.Register.ebp} | |
181 | val prefixJumpToSML = [ | |
182 | x86.Assembly.pseudoop_text (), | |
183 | x86.Assembly.pseudoop_p2align | |
184 | (x86.Immediate.int 4, NONE, NONE), | |
185 | x86.Assembly.pseudoop_global jumpToSML, | |
186 | x86.Assembly.pseudoop_hidden jumpToSML, | |
187 | x86.Assembly.label jumpToSML, | |
188 | x86.Assembly.instruction_binal | |
189 | {oper = x86.Instruction.SUB, | |
190 | src = x86.Operand.immediate_int 28, | |
191 | dst = x86.Operand.register x86.Register.esp, | |
192 | size = x86.Size.LONG}, | |
193 | x86.Assembly.instruction_mov | |
194 | {src = (x86.Operand.address o x86.Address.T) | |
195 | {disp = SOME (x86.Immediate.int 32), | |
196 | base = SOME x86.Register.esp, | |
197 | index= NONE, scale = NONE}, | |
198 | dst = x86.Operand.register x86.Register.eax, | |
199 | size = x86.Size.LONG}, | |
200 | x86.Assembly.instruction_mov | |
201 | {src = x86.Operand.register x86.Register.ebp, | |
202 | dst = (x86.Operand.address o x86.Address.T) | |
203 | {disp = SOME (x86.Immediate.int 24), | |
204 | base = SOME x86.Register.esp, | |
205 | index= NONE, scale = NONE}, | |
206 | size = x86.Size.LONG}, | |
207 | x86.Assembly.instruction_mov | |
208 | {src = x86.Operand.register x86.Register.ebx, | |
209 | dst = (x86.Operand.address o x86.Address.T) | |
210 | {disp = SOME (x86.Immediate.int 20), | |
211 | base = SOME x86.Register.esp, | |
212 | index= NONE, scale = NONE}, | |
213 | size = x86.Size.LONG}, | |
214 | x86.Assembly.instruction_mov | |
215 | {src = x86.Operand.register x86.Register.edi, | |
216 | dst = (x86.Operand.address o x86.Address.T) | |
217 | {disp = SOME (x86.Immediate.int 16), | |
218 | base = SOME x86.Register.esp, | |
219 | index= NONE, scale = NONE}, | |
220 | size = x86.Size.LONG}, | |
221 | x86.Assembly.instruction_mov | |
222 | {src = x86.Operand.register x86.Register.esi, | |
223 | dst = (x86.Operand.address o x86.Address.T) | |
224 | {disp = SOME (x86.Immediate.int 12), | |
225 | base = SOME x86.Register.esp, | |
226 | index = NONE, scale = NONE}, | |
227 | size = x86.Size.LONG} | |
228 | ] | |
229 | (* This is only included if PIC *) | |
230 | val loadGOT = [ | |
231 | x86.Assembly.instruction_call | |
232 | {target = x86.Operand.label findEIP, | |
233 | absolute = false}, | |
234 | x86.Assembly.instruction_binal | |
235 | {oper = x86.Instruction.ADD, | |
236 | src = x86.Operand.immediate_label x86MLton.globalOffsetTable, | |
237 | dst = x86.Operand.register x86.Register.ebx, | |
238 | size = x86.Size.LONG} | |
239 | ] | |
240 | val suffixJumpToSML = [ | |
241 | x86.Assembly.instruction_mov | |
242 | {src = (x86.Operand.address o x86.Address.T) | |
243 | {disp = SOME (x86.Immediate.label c_stackP), | |
244 | base = picBase, index = NONE, scale = NONE}, | |
245 | dst = x86.Operand.register x86.Register.ebp, | |
246 | size = x86.Size.LONG}, | |
247 | x86.Assembly.instruction_mov | |
248 | {src = x86.Operand.register x86.Register.ebp, | |
249 | dst = (x86.Operand.address o x86.Address.T) | |
250 | {disp = SOME (x86.Immediate.int 8), | |
251 | base = SOME x86.Register.esp, | |
252 | index = NONE, scale = NONE}, | |
253 | size = x86.Size.LONG}, | |
254 | x86.Assembly.instruction_mov | |
255 | {src = x86.Operand.register x86.Register.esp, | |
256 | dst = (x86.Operand.address o x86.Address.T) | |
257 | {disp = SOME (x86.Immediate.label c_stackP), | |
258 | base = picBase, index = NONE, scale = NONE}, | |
259 | size = x86.Size.LONG}, | |
260 | x86.Assembly.instruction_mov | |
261 | {src = (x86.Operand.address o x86.Address.T) | |
262 | {disp = (SOME o x86.Immediate.labelPlusInt) | |
263 | (gcState, | |
264 | Bytes.toInt | |
265 | (Machine.Runtime.GCField.offset | |
266 | Machine.Runtime.GCField.StackTop)), | |
267 | base = picBase, index = NONE, scale = NONE}, | |
268 | dst = x86.Operand.register stackTopReg, | |
269 | size = x86.Size.LONG}, | |
270 | x86.Assembly.instruction_mov | |
271 | {src = (x86.Operand.address o x86.Address.T) | |
272 | {disp = (SOME o x86.Immediate.labelPlusInt) | |
273 | (gcState, | |
274 | Bytes.toInt | |
275 | (Machine.Runtime.GCField.offset | |
276 | Machine.Runtime.GCField.Frontier)), | |
277 | base = picBase, index = NONE, scale = NONE}, | |
278 | dst = x86.Operand.register frontierReg, | |
279 | size = x86.Size.LONG}, | |
280 | x86.Assembly.instruction_jmp | |
281 | {target = x86.Operand.register x86.Register.eax, | |
282 | absolute = true} | |
283 | ] | |
284 | val bodyReturnToC = [ | |
285 | x86.Assembly.pseudoop_p2align | |
286 | (x86.Immediate.int 4, NONE, NONE), | |
287 | x86.Assembly.pseudoop_global returnToC, | |
288 | x86.Assembly.pseudoop_hidden returnToC, | |
289 | x86.Assembly.label returnToC, | |
290 | x86.Assembly.instruction_mov | |
291 | {src = (x86.Operand.address o x86.Address.T) | |
292 | {disp = SOME (x86.Immediate.label c_stackP), | |
293 | base = picBase, index = NONE, scale = NONE}, | |
294 | dst = x86.Operand.register x86.Register.esp, | |
295 | size = x86.Size.LONG}, | |
296 | x86.Assembly.instruction_mov | |
297 | {src = (x86.Operand.address o x86.Address.T) | |
298 | {disp = SOME (x86.Immediate.int 8), | |
299 | base = SOME x86.Register.esp, | |
300 | index = NONE, scale = NONE}, | |
301 | dst = x86.Operand.register x86.Register.ebp, | |
302 | size = x86.Size.LONG}, | |
303 | x86.Assembly.instruction_mov | |
304 | {src = x86.Operand.register x86.Register.ebp, | |
305 | dst = (x86.Operand.address o x86.Address.T) | |
306 | {disp = SOME (x86.Immediate.label c_stackP), | |
307 | base = picBase, index = NONE, scale = NONE}, | |
308 | size = x86.Size.LONG}, | |
309 | x86.Assembly.instruction_mov | |
310 | {src = (x86.Operand.address o x86.Address.T) | |
311 | {disp = SOME (x86.Immediate.int 12), | |
312 | base = SOME x86.Register.esp, | |
313 | index = NONE, scale = NONE}, | |
314 | dst = x86.Operand.register x86.Register.esi, | |
315 | size = x86.Size.LONG}, | |
316 | x86.Assembly.instruction_mov | |
317 | {src = (x86.Operand.address o x86.Address.T) | |
318 | {disp = SOME (x86.Immediate.int 16), | |
319 | base = SOME x86.Register.esp, | |
320 | index = NONE, scale = NONE}, | |
321 | dst = x86.Operand.register x86.Register.edi, | |
322 | size = x86.Size.LONG}, | |
323 | x86.Assembly.instruction_mov | |
324 | {src = (x86.Operand.address o x86.Address.T) | |
325 | {disp = SOME (x86.Immediate.int 20), | |
326 | base = SOME x86.Register.esp, | |
327 | index = NONE, scale = NONE}, | |
328 | dst = x86.Operand.register x86.Register.ebx, | |
329 | size = x86.Size.LONG}, | |
330 | x86.Assembly.instruction_mov | |
331 | {src = (x86.Operand.address o x86.Address.T) | |
332 | {disp = SOME (x86.Immediate.int 24), | |
333 | base = SOME x86.Register.esp, | |
334 | index = NONE, scale = NONE}, | |
335 | dst = x86.Operand.register x86.Register.ebp, | |
336 | size = x86.Size.LONG}, | |
337 | x86.Assembly.instruction_binal | |
338 | {oper = x86.Instruction.ADD, | |
339 | src = x86.Operand.immediate_int 28, | |
340 | dst = x86.Operand.register x86.Register.esp, | |
341 | size = x86.Size.LONG}, | |
342 | x86.Assembly.instruction_ret {src = NONE} | |
343 | ] | |
344 | (* This is only included if PIC *) | |
345 | val bodyFindEIP = [ | |
346 | x86.Assembly.pseudoop_p2align | |
347 | (x86.Immediate.int 4, NONE, NONE), | |
348 | x86.Assembly.pseudoop_global findEIP, | |
349 | x86.Assembly.pseudoop_hidden findEIP, | |
350 | x86.Assembly.label findEIP, | |
351 | x86.Assembly.instruction_mov | |
352 | {src = (x86.Operand.address o x86.Address.T) | |
353 | {base = SOME x86.Register.esp, | |
354 | disp = NONE, index = NONE, scale = NONE}, | |
355 | dst = x86.Operand.register x86.Register.ebx, | |
356 | size = x86.Size.LONG}, | |
357 | x86.Assembly.instruction_ret {src = NONE} | |
358 | ] | |
359 | ||
360 | val asm = | |
361 | List.concat | |
362 | (if picBase <> NONE | |
363 | then [prefixJumpToSML, loadGOT, suffixJumpToSML, | |
364 | bodyReturnToC, bodyFindEIP] | |
365 | else [prefixJumpToSML, suffixJumpToSML, | |
366 | bodyReturnToC]) | |
367 | in | |
368 | List.foreach | |
369 | (asm, | |
370 | fn asm => (Layout.print(Assembly.layout asm, print); | |
371 | print "\n")) | |
372 | end | |
373 | ||
374 | val liveInfo = x86Liveness.LiveInfo.newLiveInfo () | |
375 | val jumpInfo = x86JumpInfo.newJumpInfo () | |
376 | ||
377 | fun frameInfoToX86 (Machine.FrameInfo.T {frameLayoutsIndex, ...}) = | |
378 | x86.FrameInfo.T | |
379 | {frameLayoutsIndex = frameLayoutsIndex, | |
380 | size = Bytes.toInt (#size (Vector.sub (frameLayouts, | |
381 | frameLayoutsIndex)))} | |
382 | ||
383 | fun outputChunk (chunk as Machine.Chunk.T {blocks, chunkLabel, ...}, | |
384 | print) | |
385 | = let | |
386 | val isMain | |
387 | = Machine.ChunkLabel.equals(#chunkLabel main, chunkLabel) | |
388 | ||
389 | val () | |
390 | = if isMain | |
391 | then outputJumpToSML print | |
392 | else () | |
393 | ||
394 | val {chunk} | |
395 | = x86Translate.translateChunk | |
396 | {chunk = chunk, | |
397 | frameInfoToX86 = frameInfoToX86, | |
398 | liveInfo = liveInfo} | |
399 | ||
400 | val chunk : x86.Chunk.t | |
401 | = x86Simplify.simplify | |
402 | {chunk = chunk, | |
403 | (* don't perform optimizations on | |
404 | * the main function (initGlobals) | |
405 | *) | |
406 | optimize = if isMain | |
407 | then 0 | |
408 | else !Control.Native.optimize, | |
409 | delProfileLabel = delProfileLabel, | |
410 | liveInfo = liveInfo, | |
411 | jumpInfo = jumpInfo} | |
412 | ||
413 | val unallocated_assembly : x86.Assembly.t list list | |
414 | = (x86GenerateTransfers.generateTransfers | |
415 | {chunk = chunk, | |
416 | optimize = !Control.Native.optimize, | |
417 | newProfileLabel = newProfileLabel, | |
418 | liveInfo = liveInfo, | |
419 | jumpInfo = jumpInfo, | |
420 | reserveEsp = reserveEsp, | |
421 | picUsesEbx = picBase <> NONE}) | |
422 | ||
423 | val allocated_assembly : Assembly.t list list | |
424 | = x86AllocateRegisters.allocateRegisters | |
425 | {assembly = unallocated_assembly, | |
426 | (* don't calculate liveness info | |
427 | * on the main function (initGlobals) | |
428 | *) | |
429 | liveness = not isMain} | |
430 | ||
431 | val _ = Vector.foreach (blocks, Label.clear o Machine.Block.label) | |
432 | val _ = x86.Immediate.clearAll () | |
433 | val _ = x86.MemLoc.clearAll () | |
434 | in | |
435 | List.fold | |
436 | (allocated_assembly, | |
437 | if isMain then 30 else 0, | |
438 | fn (block, n) | |
439 | => List.fold | |
440 | (block, | |
441 | n, | |
442 | fn (asm, n) | |
443 | => (Layout.print (Assembly.layout asm, print); | |
444 | print "\n"; | |
445 | n + 1))) | |
446 | end | |
447 | ||
448 | fun outputAssembly () | |
449 | = let | |
450 | val split = !Control.Native.split | |
451 | fun loop chunks | |
452 | = let | |
453 | val {print, done, ...} = makeS() | |
454 | fun loop' (chunks, size) | |
455 | = case chunks | |
456 | of [] => done () | |
457 | | chunk::chunks | |
458 | => if (case split | |
459 | of NONE => false | |
460 | | SOME maxSize => size > maxSize) | |
461 | then (done (); loop (chunk::chunks)) | |
462 | else loop'(chunks, | |
463 | size + outputChunk (chunk, print)) | |
464 | in | |
465 | loop' (chunks, 0) | |
466 | end | |
467 | in | |
468 | loop chunks | |
469 | ; x86Translate.translateChunk_totals () | |
470 | ; x86Simplify.simplify_totals () | |
471 | ; x86GenerateTransfers.generateTransfers_totals () | |
472 | ; x86AllocateRegisters.allocateRegisters_totals () | |
473 | end | |
474 | ||
475 | val outputAssembly = | |
476 | Control.trace (Control.Pass, "outputAssembly") outputAssembly | |
477 | in | |
478 | outputAssembly() | |
479 | ; outputC() | |
480 | end | |
481 | end |