Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh |
2 | * Jagannathan, and Stephen Weeks. | |
3 | * Copyright (C) 1997-2000 NEC Research Institute. | |
4 | * | |
5 | * MLton is released under a BSD-style license. | |
6 | * See the file MLton-LICENSE for details. | |
7 | *) | |
8 | ||
9 | (* | |
10 | * Some of this doesn't make sense if we track the liveness of the GCHold class. | |
11 | * Need to update the enque'' of returns, handlers of NonTail and Runtime | |
12 | * so they reflect what happens at these transfers; (i.e., stackTop and frontier | |
13 | * are defed on return from NonTail). | |
14 | *) | |
15 | ||
16 | functor amd64LiveTransfers(S: AMD64_LIVE_TRANSFERS_STRUCTS) : AMD64_LIVE_TRANSFERS = | |
17 | struct | |
18 | open S | |
19 | open amd64 | |
20 | ||
21 | local | |
22 | open Runtime | |
23 | in | |
24 | structure CFunction = CFunction | |
25 | end | |
26 | ||
27 | structure LiveSet = amd64Liveness.LiveSet | |
28 | structure LiveInfo = amd64Liveness.LiveInfo | |
29 | open amd64JumpInfo | |
30 | open amd64LoopInfo | |
31 | ||
32 | val track = amd64Liveness.track | |
33 | ||
34 | val tracerTop = amd64.tracerTop | |
35 | ||
36 | fun temp_uses_defs {uses : Operand.t list, | |
37 | defs : Operand.t list} | |
38 | = let | |
39 | val baseUses | |
40 | = List.fold | |
41 | (uses, | |
42 | MemLocSet.empty, | |
43 | fn (operand, baseUses) | |
44 | => case Operand.deMemloc operand | |
45 | of SOME memloc => if amd64Liveness.track memloc | |
46 | then MemLocSet.add(baseUses, memloc) | |
47 | else baseUses | |
48 | | NONE => baseUses) | |
49 | ||
50 | val tempUses | |
51 | = let | |
52 | fun doit (operands, tempUses) | |
53 | = List.fold | |
54 | (operands, | |
55 | tempUses, | |
56 | fn (operand, tempUses) | |
57 | => case Operand.deMemloc operand | |
58 | of SOME memloc | |
59 | => List.fold(MemLoc.utilized memloc, | |
60 | tempUses, | |
61 | fn (memloc, tempUses) | |
62 | => if amd64Liveness.track memloc | |
63 | then MemLocSet.add(tempUses, memloc) | |
64 | else tempUses) | |
65 | | NONE => tempUses) | |
66 | in | |
67 | doit(defs, | |
68 | doit(uses, | |
69 | baseUses)) | |
70 | end | |
71 | ||
72 | val baseDefs | |
73 | = List.fold | |
74 | (defs, | |
75 | MemLocSet.empty, | |
76 | fn (operand, baseDefs) | |
77 | => case Operand.deMemloc operand | |
78 | of SOME memloc => if amd64Liveness.track memloc | |
79 | then MemLocSet.add(baseDefs, memloc) | |
80 | else baseDefs | |
81 | | NONE => baseDefs) | |
82 | val tempDefs = baseDefs | |
83 | in | |
84 | {uses = tempUses, | |
85 | defs = tempDefs} | |
86 | end | |
87 | ||
88 | datatype t = T of {get: Label.t -> | |
89 | ((MemLoc.t * Register.t * bool) list * | |
90 | (MemLoc.t * XmmRegister.t * bool) list), | |
91 | set: Label.t * | |
92 | ((MemLoc.t * Register.t * bool) list * | |
93 | (MemLoc.t * XmmRegister.t * bool) list) -> unit} | |
94 | ||
95 | local | |
96 | ||
97 | in | |
98 | structure I' = struct | |
99 | open Int | |
100 | fun sign x = if x = 0 | |
101 | then 0 | |
102 | else if x > 0 | |
103 | then 1 | |
104 | else ~1 | |
105 | end | |
106 | structure I = | |
107 | struct | |
108 | datatype t = NegInfinity | |
109 | | Finite of I'.t | |
110 | | PosInfinity | |
111 | val toString | |
112 | = fn NegInfinity => "-inf" | |
113 | | Finite n => I'.toString n | |
114 | | PosInfinity => "+inf" | |
115 | val zero = Finite (I'.zero) | |
116 | ||
117 | fun NegInfinity < NegInfinity = false | |
118 | | NegInfinity < _ = true | |
119 | | (Finite _) < NegInfinity = false | |
120 | | (Finite x) < (Finite y) = I'.<(x,y) | |
121 | | (Finite _) < PosInfinity = true | |
122 | | PosInfinity < _ = false | |
123 | ||
124 | fun NegInfinity + PosInfinity = zero | |
125 | | NegInfinity + _ = NegInfinity | |
126 | | (Finite _) + NegInfinity = NegInfinity | |
127 | | (Finite x) + (Finite y) | |
128 | = ((Finite (I'.+(x,y))) handle Overflow => if x > 0 | |
129 | then PosInfinity | |
130 | else NegInfinity) | |
131 | | (Finite _) + PosInfinity = PosInfinity | |
132 | | PosInfinity + NegInfinity = zero | |
133 | | PosInfinity + _ = PosInfinity | |
134 | ||
135 | fun NegInfinity * NegInfinity = PosInfinity | |
136 | | NegInfinity * (Finite x) | |
137 | = (case I'.sign x | |
138 | of ~1 => PosInfinity | |
139 | | 0 => zero | |
140 | | _ => NegInfinity) | |
141 | | NegInfinity * PosInfinity = NegInfinity | |
142 | | (Finite x) * NegInfinity | |
143 | = (case I'.sign x | |
144 | of ~1 => PosInfinity | |
145 | | 0 => zero | |
146 | | _ => NegInfinity) | |
147 | | (Finite x) * (Finite y) | |
148 | = ((Finite (I'.*(x, y))) handle Overflow => (case (I'.sign x, I'.sign y) | |
149 | of (~1, ~1) => PosInfinity | |
150 | | (1, ~1) => NegInfinity | |
151 | | (~1, 1) => NegInfinity | |
152 | | _ => PosInfinity)) | |
153 | | (Finite x) * PosInfinity | |
154 | = (case I'.sign x | |
155 | of ~1 => NegInfinity | |
156 | | 0 => zero | |
157 | | _ => PosInfinity) | |
158 | | PosInfinity * NegInfinity = NegInfinity | |
159 | | PosInfinity * (Finite x) | |
160 | = (case I'.sign x | |
161 | of ~1 => NegInfinity | |
162 | | 0 => zero | |
163 | | _ => PosInfinity) | |
164 | | PosInfinity * PosInfinity = PosInfinity | |
165 | end | |
166 | end | |
167 | ||
168 | fun computeLiveTransfers {chunk = Chunk.T {blocks,...}, | |
169 | transferRegs : Entry.t -> Register.t list, | |
170 | transferXmmRegs : Entry.t -> XmmRegister.t list, | |
171 | liveInfo : amd64Liveness.LiveInfo.t, | |
172 | jumpInfo : amd64JumpInfo.t, | |
173 | loopInfo : amd64LoopInfo.t} | |
174 | = let | |
175 | val (useLF, useB, sync) | |
176 | = case !Control.Native.liveTransfer | |
177 | of 1 => (false, false, false) | |
178 | | 2 => (false, false, true) | |
179 | | 3 => (false, true, false) | |
180 | | 4 => (false, true, true) | |
181 | | 5 => (true, false, false) | |
182 | | 6 => (true, false, true) | |
183 | | 7 => (true, true, false) | |
184 | | _ => (true, true, true) | |
185 | ||
186 | val cutoff = !Control.Native.cutoff | |
187 | datatype u = Position of I.t | Length of I'.t | |
188 | ||
189 | val {get = getInfo : | |
190 | Label.t -> | |
191 | {block: Block.t, | |
192 | pred: Label.t list ref, | |
193 | succ: Label.t list ref, | |
194 | live: {memloc: MemLoc.t, | |
195 | distanceF': u option ref, | |
196 | distanceF: (I.t * Label.t option) option ref, | |
197 | distanceB': u option ref, | |
198 | distanceB: (I.t * Label.t option) option ref} vector, | |
199 | liveTransfers: ((MemLoc.t * Register.t * bool ref) list * | |
200 | (MemLoc.t * XmmRegister.t * bool ref) list) option ref, | |
201 | defed: MemLocSet.t option ref}, | |
202 | set = setInfo, | |
203 | destroy = destInfo} | |
204 | = Property.destGetSetOnce | |
205 | (Label.plist, | |
206 | Property.initRaise ("amd64LiveTransfers:getInfo", Label.layout)) | |
207 | ||
208 | val (labels, funcs) | |
209 | = List.fold | |
210 | (blocks, | |
211 | ([], []), | |
212 | fn (block as Block.T {entry, transfer, ...}, (labels, funcs)) | |
213 | => let | |
214 | val label = Entry.label entry | |
215 | val succ = Transfer.nearTargets transfer | |
216 | val live = LiveInfo.getLive(liveInfo, label) | |
217 | val live = List.fold | |
218 | (succ, | |
219 | live, | |
220 | fn (label, live) | |
221 | => LiveSet.+(live, LiveInfo.getLive(liveInfo, label))) | |
222 | val live = LiveSet.toList live | |
223 | val _ | |
224 | = setInfo(label, | |
225 | {block = block, | |
226 | pred = ref [], | |
227 | succ = ref succ, | |
228 | live = Vector.fromListMap | |
229 | (live, | |
230 | fn memloc | |
231 | => {memloc = memloc, | |
232 | distanceF' = ref NONE, | |
233 | distanceF = ref NONE, | |
234 | distanceB' = ref NONE, | |
235 | distanceB = ref NONE}), | |
236 | liveTransfers = ref NONE, | |
237 | defed = ref NONE}) | |
238 | val labels = label::labels | |
239 | val funcs = case entry | |
240 | of Entry.Func _ => label::funcs | |
241 | | _ => funcs | |
242 | in | |
243 | (labels, funcs) | |
244 | end) | |
245 | ||
246 | val labels = Vector.fromList labels | |
247 | val funcs = Vector.fromList funcs | |
248 | ||
249 | val _ | |
250 | = Vector.foreach | |
251 | (labels, | |
252 | fn label | |
253 | => let | |
254 | val {block, ...} = getInfo label | |
255 | fun doit target | |
256 | = let | |
257 | val {pred = pred', ...} = getInfo target | |
258 | in | |
259 | List.push (pred', label) | |
260 | end | |
261 | val Block.T {transfer, ...} = block | |
262 | datatype z = datatype Transfer.t | |
263 | in | |
264 | case transfer | |
265 | of Goto {target, ...} | |
266 | => doit target | |
267 | | Iff {truee, falsee, ...} | |
268 | => (doit truee; | |
269 | doit falsee) | |
270 | | Switch {cases, default, ...} | |
271 | => (doit default; | |
272 | Transfer.Cases.foreach(cases, doit o #2)) | |
273 | | Tail {...} | |
274 | => () | |
275 | | NonTail {return, handler, ...} | |
276 | => (doit return; | |
277 | case handler | |
278 | of SOME handler => doit handler | |
279 | | NONE => ()) | |
280 | | Return {...} | |
281 | => () | |
282 | | Raise {...} | |
283 | => () | |
284 | | CCall {return, ...} | |
285 | => Option.app (return, doit) | |
286 | end) | |
287 | ||
288 | val _ | |
289 | = Vector.foreach | |
290 | (labels, | |
291 | fn label | |
292 | => let | |
293 | val {block, live, ...} = getInfo label | |
294 | val Block.T {entry, statements, transfer, ...} = block | |
295 | ||
296 | val l | |
297 | = List.fold | |
298 | (statements, | |
299 | I'.two, | |
300 | fn (Assembly.Comment _, l) => l | |
301 | | (_, l) => I'.+(l, I'.one)) | |
302 | ||
303 | fun pos ([], n, m) | |
304 | = let | |
305 | val {uses, defs, ...} | |
306 | = Transfer.uses_defs_kills transfer | |
307 | val {uses,defs} | |
308 | = temp_uses_defs {uses = uses, | |
309 | defs = defs} | |
310 | in | |
311 | Vector.foreach | |
312 | (live, | |
313 | fn {memloc, distanceF' as ref NONE, ...} | |
314 | => if MemLocSet.contains(uses,memloc) | |
315 | then distanceF' := SOME (Position (I.Finite n)) | |
316 | else distanceF' := SOME (Length l) | |
317 | | _ => ()); | |
318 | Vector.foreach | |
319 | (live, | |
320 | fn {memloc, distanceB', ...} | |
321 | => if MemLocSet.contains(uses,memloc) | |
322 | orelse | |
323 | MemLocSet.contains(defs,memloc) | |
324 | then distanceB' := SOME (Position (I.Finite m)) | |
325 | else ()) | |
326 | end | |
327 | | pos ((Assembly.Comment _)::assembly,n,m) | |
328 | = pos (assembly,n,m) | |
329 | | pos (asm::assembly,n,m) | |
330 | = let | |
331 | val {uses,defs,...} | |
332 | = Assembly.uses_defs_kills asm | |
333 | val {uses,defs} | |
334 | = temp_uses_defs {uses = uses, | |
335 | defs = defs} | |
336 | in | |
337 | Vector.foreach | |
338 | (live, | |
339 | fn {memloc, distanceF' as ref NONE, ...} | |
340 | => if MemLocSet.contains(uses,memloc) | |
341 | then distanceF' := SOME (Position (I.Finite n)) | |
342 | else () | |
343 | | _ => ()); | |
344 | Vector.foreach | |
345 | (live, | |
346 | fn {memloc, distanceB', ...} | |
347 | => if MemLocSet.contains(uses,memloc) | |
348 | orelse | |
349 | MemLocSet.contains(defs,memloc) | |
350 | then distanceB' := SOME (Position (I.Finite m)) | |
351 | else ()); | |
352 | pos(assembly, I'.+(n, I'.one), I'.-(m, I'.one)) | |
353 | end | |
354 | in | |
355 | let | |
356 | val n = I'.zero | |
357 | val m = I'.-(l, I'.one) | |
358 | val {uses,defs,...} | |
359 | = Entry.uses_defs_kills entry | |
360 | val {uses,defs} | |
361 | = temp_uses_defs {uses = uses, | |
362 | defs = defs} | |
363 | in | |
364 | Vector.foreach | |
365 | (live, | |
366 | fn {memloc, distanceF' as ref NONE, ...} | |
367 | => if MemLocSet.contains(uses,memloc) | |
368 | then distanceF' := SOME (Position (I.Finite n)) | |
369 | else () | |
370 | | _ => ()); | |
371 | Vector.foreach | |
372 | (live, | |
373 | fn {memloc, distanceB', ...} | |
374 | => if MemLocSet.contains(uses,memloc) | |
375 | orelse | |
376 | MemLocSet.contains(defs,memloc) | |
377 | then distanceB' := SOME (Position (I.Finite m)) | |
378 | else distanceB' := SOME (Length l)); | |
379 | pos(statements, I'.+(n, I'.one), I'.-(m, I'.one)) | |
380 | end | |
381 | end) | |
382 | ||
383 | fun get_distanceF {temp: MemLoc.t, | |
384 | label: Label.t} | |
385 | = let | |
386 | val {block, succ, live, ...} = getInfo label | |
387 | val Block.T {transfer, ...} = block | |
388 | in | |
389 | case Vector.peek | |
390 | (live, | |
391 | fn {memloc, ...} => MemLoc.eq(temp, memloc)) | |
392 | of SOME {distanceF = ref (SOME (df, dfl)), ...} | |
393 | => (df, dfl) | |
394 | | SOME {distanceF', distanceF, ...} | |
395 | => (case valOf (!distanceF') | |
396 | of Position n => (distanceF := SOME (n, SOME label); | |
397 | (n, SOME label)) | |
398 | | Length n | |
399 | => let | |
400 | val loopLabels = getLoopLabels (loopInfo, label) | |
401 | val _ = distanceF := SOME (I.PosInfinity, NONE) | |
402 | fun default () | |
403 | = let | |
404 | val n = I.Finite n | |
405 | val (min, minl) | |
406 | = List.fold | |
407 | (!succ, | |
408 | (I.PosInfinity, NONE), | |
409 | fn (label, (min, minl)) | |
410 | => let | |
411 | val (n', l') | |
412 | = get_distanceF {temp = temp, | |
413 | label = label} | |
414 | val n' = I.+(n, n') | |
415 | val n'' | |
416 | = case (l', useLF) | |
417 | of (NONE, _) => n' | |
418 | | (_, false) => n' | |
419 | | (SOME l', true) | |
420 | => if List.contains | |
421 | (loopLabels, | |
422 | l', Label.equals) | |
423 | then n' | |
424 | else I.*(I.Finite 5, n') | |
425 | in | |
426 | if I.<(n'', min) | |
427 | then (n', l') | |
428 | else (min, minl) | |
429 | end) | |
430 | in | |
431 | (min, minl) | |
432 | end | |
433 | ||
434 | datatype z = datatype Transfer.t | |
435 | val (n, l) | |
436 | = case transfer | |
437 | of Tail _ => (I.PosInfinity, NONE) | |
438 | | NonTail _ => (I.PosInfinity, NONE) | |
439 | | Return _ => (I.PosInfinity, NONE) | |
440 | | Raise _ => (I.PosInfinity, NONE) | |
441 | | CCall {func, ...} | |
442 | => if CFunction.maySwitchThreads func | |
443 | orelse Size.class (MemLoc.size temp) <> Size.INT | |
444 | then (I.PosInfinity, NONE) | |
445 | else default () | |
446 | | _ => default () | |
447 | in | |
448 | distanceF := SOME (n, l) ; (n, l) | |
449 | end) | |
450 | | _ => (I.PosInfinity, NONE) | |
451 | end | |
452 | ||
453 | fun get_distanceB {temp: MemLoc.t, | |
454 | label: Label.t} | |
455 | = let | |
456 | val {block, pred, live, ...} = getInfo label | |
457 | val Block.T {entry, ...} = block | |
458 | in | |
459 | case Vector.peek | |
460 | (live, | |
461 | fn {memloc, ...} => MemLoc.eq(temp, memloc)) | |
462 | of SOME {distanceB = ref (SOME (db, dbl)), ...} | |
463 | => (db, dbl) | |
464 | | SOME {distanceB, ...} | |
465 | => let | |
466 | val loopLabels = getLoopLabels(loopInfo, label) | |
467 | val _ = distanceB := SOME (I.PosInfinity, NONE) | |
468 | fun default () | |
469 | = List.fold | |
470 | (!pred, | |
471 | (I.PosInfinity, NONE), | |
472 | fn (label, (min, minl)) | |
473 | => let | |
474 | val {live, ...} = getInfo label | |
475 | in | |
476 | case Vector.peek | |
477 | (live, | |
478 | fn {memloc, ...} => MemLoc.eq(temp, memloc)) | |
479 | of SOME {distanceB', ...} | |
480 | => (case valOf(!distanceB') | |
481 | of Position n | |
482 | => if I.<(n, min) | |
483 | then (n, SOME label) | |
484 | else (min, minl) | |
485 | | Length n | |
486 | => let | |
487 | val n = I.Finite n | |
488 | val (n', l') | |
489 | = get_distanceB {temp = temp, | |
490 | label = label} | |
491 | val n' = I.+(n, n') | |
492 | val n'' | |
493 | = case (l', useLF) | |
494 | of (NONE, _) => n' | |
495 | | (_, false) => n' | |
496 | | (SOME l', true) | |
497 | => if List.contains | |
498 | (loopLabels, | |
499 | l', Label.equals) | |
500 | then n' | |
501 | else I.*(I.Finite 5, n') | |
502 | in | |
503 | if I.<(n'', min) | |
504 | then (n', l') | |
505 | else (min, minl) | |
506 | end) | |
507 | | _ => (min, minl) | |
508 | end) | |
509 | ||
510 | datatype z = datatype Entry.t | |
511 | val (n, l) | |
512 | = case entry | |
513 | of Func {...} => (I.PosInfinity, NONE) | |
514 | | Cont {...} => (I.PosInfinity, NONE) | |
515 | | Handler {...} => (I.PosInfinity, NONE) | |
516 | | CReturn {func, ...} | |
517 | => if (CFunction.maySwitchThreads func | |
518 | orelse Size.class (MemLoc.size temp) <> Size.INT) | |
519 | then (I.PosInfinity, NONE) | |
520 | else default () | |
521 | | _ => default () | |
522 | in | |
523 | distanceB := SOME (n, l) ; (n, l) | |
524 | end | |
525 | | _ => (I.PosInfinity, NONE) | |
526 | end | |
527 | ||
528 | local | |
529 | val queue = ref (Queue.empty ()) | |
530 | in | |
531 | fun enque x = queue := Queue.enque(!queue, x) | |
532 | fun deque () = | |
533 | case Queue.deque (!queue) of | |
534 | NONE => NONE | |
535 | | SOME (queue', x) => (queue := queue'; SOME x) | |
536 | end | |
537 | ||
538 | fun doit {label, hints} | |
539 | = let | |
540 | val {block as Block.T {entry, ...}, | |
541 | live = liveData, liveTransfers, ...} = getInfo label | |
542 | in | |
543 | case !liveTransfers | |
544 | of SOME _ => () | |
545 | | NONE | |
546 | => let | |
547 | val loopLabels = getLoopLabels(loopInfo, label) | |
548 | val Block.T {transfer, ...} = block | |
549 | ||
550 | val (regHints, xmmregHints) = hints | |
551 | ||
552 | val live = LiveSet.toList(LiveInfo.getLive(liveInfo, label)) | |
553 | ||
554 | val _ | |
555 | = if true then () | |
556 | else | |
557 | (print (Label.toString label); | |
558 | print "\nloopLabels: "; | |
559 | print (List.toString Label.toString loopLabels); | |
560 | print "\nliveData:\n"; | |
561 | Vector.foreach | |
562 | (liveData, | |
563 | fn {memloc, distanceF', distanceB', ...} => | |
564 | (print (MemLoc.toString memloc); | |
565 | print ": "; | |
566 | case !distanceF' of | |
567 | NONE => print "?" | |
568 | | SOME (Position i) => (print "Pos "; print (I.toString i)) | |
569 | | SOME (Length i) => (print "Len "; print (I'.toString i)); | |
570 | print " "; | |
571 | case !distanceB' of | |
572 | NONE => print "?" | |
573 | | SOME (Position i) => (print "Pos "; print (I.toString i)) | |
574 | | SOME (Length i) => (print "Len "; print (I'.toString i)); | |
575 | print "\n")); | |
576 | print "regHints:\n"; | |
577 | List.foreach | |
578 | (regHints, | |
579 | fn (memloc,register,sync) => | |
580 | (print (MemLoc.toString memloc); | |
581 | print ": "; | |
582 | print (Register.toString register); | |
583 | print ": "; | |
584 | print (Bool.toString (!sync)); | |
585 | print "\n")); | |
586 | print "xmmregHints:\n"; | |
587 | List.foreach | |
588 | (xmmregHints, | |
589 | fn (memloc,register,sync) => | |
590 | (print (MemLoc.toString memloc); | |
591 | print ": "; | |
592 | print (XmmRegister.toString register); | |
593 | print ": "; | |
594 | print (Bool.toString (!sync)); | |
595 | print "\n")); | |
596 | print "live:\n"; | |
597 | List.foreach | |
598 | (live, | |
599 | fn memloc | |
600 | => (print (MemLoc.toString memloc); | |
601 | print "\n")); | |
602 | print "distance_F:\n"; | |
603 | List.foreach | |
604 | (live, | |
605 | fn memloc | |
606 | => (print (MemLoc.toString memloc); | |
607 | print ": "; | |
608 | let | |
609 | val (n, l) = get_distanceF {temp = memloc, | |
610 | label = label} | |
611 | in | |
612 | print (I.toString n); | |
613 | print " "; | |
614 | print (Option.toString Label.toString l) | |
615 | end; | |
616 | print "\n")); | |
617 | print "distance_B:\n"; | |
618 | List.foreach | |
619 | (live, | |
620 | fn memloc | |
621 | => (print (MemLoc.toString memloc); | |
622 | print ": "; | |
623 | let | |
624 | val (n, l) = get_distanceB {temp = memloc, | |
625 | label = label} | |
626 | in | |
627 | print (I.toString n); | |
628 | print " "; | |
629 | print (Option.toString Label.toString l) | |
630 | end; | |
631 | print "\n"))) | |
632 | ||
633 | val live | |
634 | = if not useB | |
635 | then List.keepAllMap | |
636 | (live, | |
637 | fn memloc | |
638 | => case get_distanceF {temp = memloc, | |
639 | label = label} | |
640 | of (I.Finite n, SOME l) | |
641 | => if n < cutoff | |
642 | then if useLF | |
643 | then if List.contains | |
644 | (loopLabels, | |
645 | l, Label.equals) | |
646 | then SOME (memloc, n) | |
647 | else SOME (memloc, n * 5) | |
648 | else SOME (memloc, n) | |
649 | else NONE | |
650 | | (I.PosInfinity, _) | |
651 | => NONE | |
652 | | _ | |
653 | => Error.bug | |
654 | "amd64LiveTransfers.computeLiveTransfers.live: get_distanceF") | |
655 | else List.keepAllMap | |
656 | (live, | |
657 | fn memloc | |
658 | => case (get_distanceB {temp = memloc, | |
659 | label = label}, | |
660 | get_distanceF {temp = memloc, | |
661 | label = label}) | |
662 | of ((I.PosInfinity, _), _) | |
663 | => NONE | |
664 | | (_, (I.PosInfinity, _)) | |
665 | => NONE | |
666 | | ((I.Finite n, SOME nl), | |
667 | (I.Finite m, SOME ml)) | |
668 | => if (n + m) < cutoff | |
669 | then if useLF | |
670 | then case (List.contains | |
671 | (loopLabels, | |
672 | nl, Label.equals), | |
673 | List.contains | |
674 | (loopLabels, | |
675 | ml, Label.equals)) | |
676 | of (true, true) | |
677 | => SOME (memloc, n + m) | |
678 | | (true, false) | |
679 | => SOME (memloc, | |
680 | n + 5 * m) | |
681 | | (false, true) | |
682 | => SOME (memloc, | |
683 | 5 * n + m) | |
684 | | (false, false) | |
685 | => SOME (memloc, | |
686 | 5 * n + 5 * m) | |
687 | else SOME (memloc, n + m) | |
688 | else NONE | |
689 | | _ | |
690 | => Error.bug | |
691 | "amd64LiveTransfers.computeLiveTransfers.live: get_distanceB") | |
692 | ||
693 | (* List.partition will reverse the lists. | |
694 | * So sort in increasing order. | |
695 | *) | |
696 | val live | |
697 | = List.insertionSort | |
698 | (live, fn ((_,n1),(_,n2)) => I'.>(n1, n2)) | |
699 | ||
700 | val _ | |
701 | = if true then () else | |
702 | (print "live:\n"; | |
703 | List.foreach | |
704 | (live, | |
705 | fn (memloc,n) | |
706 | => (print (MemLoc.toString memloc); | |
707 | print ": "; | |
708 | print (I'.toString n); | |
709 | print "\n"))) | |
710 | ||
711 | val {yes = liveRegs, no = liveXmmRegs} | |
712 | = List.partition | |
713 | (live, | |
714 | fn (memloc,_) | |
715 | => Size.class (MemLoc.size memloc) = Size.INT) | |
716 | ||
717 | val liveRegs | |
718 | = List.map | |
719 | (liveRegs, | |
720 | fn (memloc,weight) | |
721 | => case List.peek | |
722 | (regHints, | |
723 | fn (memloc',_,_) | |
724 | => MemLoc.eq(memloc,memloc')) | |
725 | of SOME (_,register',_) | |
726 | => (memloc,weight,SOME register') | |
727 | | NONE | |
728 | => (memloc,weight,NONE)) | |
729 | ||
730 | val rec doitRegs | |
731 | = fn ([],_,liveTransfers) => liveTransfers | |
732 | | (_,[],liveTransfers) => liveTransfers | |
733 | | (transferRegs, | |
734 | (memloc,_,register)::live, | |
735 | liveTransfers) | |
736 | => let | |
737 | fun finish register | |
738 | = let | |
739 | val transferRegs | |
740 | = List.removeAll | |
741 | (transferRegs, | |
742 | fn register' | |
743 | => Register.coincide(register, | |
744 | register')) | |
745 | in | |
746 | doitRegs | |
747 | (transferRegs, | |
748 | live, | |
749 | (memloc,register,ref true)::liveTransfers) | |
750 | end | |
751 | ||
752 | fun default () | |
753 | = let | |
754 | val size = MemLoc.size memloc | |
755 | val transferRegs' | |
756 | = List.keepAllMap | |
757 | (transferRegs, | |
758 | fn register | |
759 | => if Size.eq | |
760 | (size, | |
761 | Register.size register) | |
762 | then SOME | |
763 | (register, | |
764 | List.index | |
765 | (live, | |
766 | fn (_,_,SOME register') | |
767 | => Register.eq | |
768 | (register, | |
769 | register') | |
770 | | (_,_,NONE) => false)) | |
771 | else NONE) | |
772 | val transferRegs' | |
773 | = List.insertionSort | |
774 | (transferRegs', | |
775 | fn ((_,SOME index1),(_,SOME index2)) | |
776 | => Int.>(index1, index2) | |
777 | | ((_, NONE),_) | |
778 | => true | |
779 | | (_, (_, NONE)) | |
780 | => false) | |
781 | in | |
782 | case transferRegs' | |
783 | of nil | |
784 | => doitRegs (transferRegs, | |
785 | live, | |
786 | liveTransfers) | |
787 | | (register,_)::_ | |
788 | => finish register | |
789 | end | |
790 | in | |
791 | case register | |
792 | of SOME register | |
793 | => if List.contains(transferRegs, | |
794 | register, | |
795 | Register.eq) | |
796 | then finish register | |
797 | else default () | |
798 | | NONE => default () | |
799 | end | |
800 | ||
801 | val liveRegsTransfers = doitRegs(transferRegs entry, liveRegs, []) | |
802 | ||
803 | val liveXmmRegs | |
804 | = List.map | |
805 | (liveXmmRegs, | |
806 | fn (memloc,weight) | |
807 | => case List.peek | |
808 | (xmmregHints, | |
809 | fn (memloc',_,_) | |
810 | => MemLoc.eq(memloc,memloc')) | |
811 | of SOME (_,register',_) | |
812 | => (memloc,weight,SOME register') | |
813 | | NONE | |
814 | => (memloc,weight,NONE)) | |
815 | ||
816 | val rec doitXmmRegs | |
817 | = fn ([],_,liveTransfers) => liveTransfers | |
818 | | (_,[],liveTransfers) => liveTransfers | |
819 | | (transferXmmRegs, | |
820 | (memloc,_,register)::live, | |
821 | liveTransfers) | |
822 | => let | |
823 | fun finish register | |
824 | = let | |
825 | val transferXmmRegs | |
826 | = List.removeAll | |
827 | (transferXmmRegs, | |
828 | fn register' | |
829 | => XmmRegister.coincide(register, | |
830 | register')) | |
831 | in | |
832 | doitXmmRegs | |
833 | (transferXmmRegs, | |
834 | live, | |
835 | (memloc,register,ref true)::liveTransfers) | |
836 | end | |
837 | ||
838 | fun default () | |
839 | = let | |
840 | val size = MemLoc.size memloc | |
841 | val transferXmmRegs' | |
842 | = List.keepAllMap | |
843 | (transferXmmRegs, | |
844 | fn register | |
845 | => if Size.eq | |
846 | (size, | |
847 | XmmRegister.size register) | |
848 | then SOME | |
849 | (register, | |
850 | List.index | |
851 | (live, | |
852 | fn (_,_,SOME register') | |
853 | => XmmRegister.eq | |
854 | (register, | |
855 | register') | |
856 | | (_,_,NONE) => false)) | |
857 | else NONE) | |
858 | val transferXmmRegs' | |
859 | = List.insertionSort | |
860 | (transferXmmRegs', | |
861 | fn ((_,SOME index1),(_,SOME index2)) | |
862 | => Int.>(index1, index2) | |
863 | | ((_, NONE),_) | |
864 | => true | |
865 | | (_, (_, NONE)) | |
866 | => false) | |
867 | in | |
868 | case transferXmmRegs' | |
869 | of nil | |
870 | => doitXmmRegs (transferXmmRegs, | |
871 | live, | |
872 | liveTransfers) | |
873 | | (register,_)::_ | |
874 | => finish register | |
875 | end | |
876 | in | |
877 | case register | |
878 | of SOME register | |
879 | => if List.contains(transferXmmRegs, | |
880 | register, | |
881 | XmmRegister.eq) | |
882 | then finish register | |
883 | else default () | |
884 | | NONE => default () | |
885 | end | |
886 | ||
887 | val liveXmmRegsTransfers = doitXmmRegs(transferXmmRegs entry, liveXmmRegs, []) | |
888 | ||
889 | val _ = liveTransfers := SOME (liveRegsTransfers, | |
890 | liveXmmRegsTransfers) | |
891 | ||
892 | (* | |
893 | val _ | |
894 | = (print "liveRegsTransfers:\n"; | |
895 | List.foreach | |
896 | (liveRegsTransfers, | |
897 | fn (memloc,register,sync) => | |
898 | (print (MemLoc.toString memloc); | |
899 | print ": "; | |
900 | print (Register.toString register); | |
901 | print ": "; | |
902 | print (Bool.toString (!sync)); | |
903 | print "\n")); | |
904 | print "liveFltRegsTransfers:\n"; | |
905 | List.foreach | |
906 | (liveFltRegsTransfers, | |
907 | fn (memloc,sync) => | |
908 | (print (MemLoc.toString memloc); | |
909 | print ": "; | |
910 | print (Bool.toString (!sync)); | |
911 | print "\n")); | |
912 | print "") | |
913 | *) | |
914 | ||
915 | fun doit' label = enque {label = label, | |
916 | hints = (liveRegsTransfers, | |
917 | liveXmmRegsTransfers)} | |
918 | fun doit'' label = enque {label = label, | |
919 | hints = ([],[])} | |
920 | fun doit''' func label = | |
921 | let | |
922 | val hints = | |
923 | List.fold | |
924 | (Operand.cReturnTemps (CFunction.return func), | |
925 | ([],[]), | |
926 | fn ({src, dst}, (regHints, xmmregHints)) => | |
927 | case src of | |
928 | Operand.Register reg => | |
929 | ((dst, reg, ref true) :: regHints, | |
930 | xmmregHints) | |
931 | | Operand.XmmRegister reg => | |
932 | (regHints, | |
933 | (dst, reg, ref true) :: xmmregHints) | |
934 | | _ => (regHints, xmmregHints)) | |
935 | in | |
936 | enque {hints = hints, | |
937 | label = label} | |
938 | end | |
939 | datatype z = datatype Transfer.t | |
940 | in | |
941 | case transfer | |
942 | of Goto {target, ...} | |
943 | => (doit' target) | |
944 | | Iff {truee, falsee, ...} | |
945 | => (doit' truee; | |
946 | doit' falsee) | |
947 | | Switch {cases, default, ...} | |
948 | => (doit' default; | |
949 | Transfer.Cases.foreach(cases, doit' o #2)) | |
950 | | Tail {...} | |
951 | => () | |
952 | | NonTail {return, handler, ...} | |
953 | => (doit'' return; | |
954 | case handler | |
955 | of SOME handler => doit'' handler | |
956 | | NONE => ()) | |
957 | | Return {...} | |
958 | => () | |
959 | | Raise {...} | |
960 | => () | |
961 | | CCall {func, return, ...} | |
962 | => if CFunction.maySwitchThreads func | |
963 | then Option.app (return, doit'') | |
964 | else Option.app (return, doit''' func) | |
965 | end | |
966 | end | |
967 | ||
968 | val _ = Vector.foreach | |
969 | (funcs, | |
970 | fn label => enque {label = label, hints = ([],[])}) | |
971 | ||
972 | fun loop () | |
973 | = (case deque () | |
974 | of NONE => () | |
975 | | SOME {label, hints} | |
976 | => (doit {label = label, hints = hints}; | |
977 | loop ())) | |
978 | val _ = loop () | |
979 | ||
980 | fun doit {label, defed = defed'} | |
981 | = let | |
982 | ||
983 | val {block, liveTransfers, defed, ...} = getInfo label | |
984 | val (liveRegs, liveXmmRegs) = valOf (!liveTransfers) | |
985 | ||
986 | val defed' | |
987 | = case getNear(jumpInfo, label) | |
988 | of None => MemLocSet.empty | |
989 | | Count 0 => MemLocSet.empty | |
990 | | Count 1 => defed' | |
991 | | Count _ | |
992 | => MemLocSet.subset | |
993 | (defed', | |
994 | fn memloc | |
995 | => List.exists | |
996 | (liveRegs, | |
997 | fn (memloc',_,_) => MemLoc.eq(memloc', memloc)) | |
998 | orelse | |
999 | List.exists | |
1000 | (liveXmmRegs, | |
1001 | fn (memloc',_,_) => MemLoc.eq(memloc', memloc))) | |
1002 | ||
1003 | fun default defed'' | |
1004 | = let | |
1005 | val Block.T {entry, statements, transfer, ...} = block | |
1006 | ||
1007 | val _ = List.foreach | |
1008 | (liveRegs, | |
1009 | fn (memloc,_,sync) | |
1010 | => if MemLocSet.contains(defed', memloc) | |
1011 | then sync := false | |
1012 | else ()) | |
1013 | val _ = List.foreach | |
1014 | (liveXmmRegs, | |
1015 | fn (memloc,_,sync) | |
1016 | => if MemLocSet.contains(defed', memloc) | |
1017 | then sync := false | |
1018 | else ()) | |
1019 | ||
1020 | val defed' = MemLocSet.+(defed'', defed') | |
1021 | val _ = defed := SOME defed' | |
1022 | ||
1023 | fun doit' (defed', defs) | |
1024 | = List.fold | |
1025 | (defs, | |
1026 | defed', | |
1027 | fn (def,defed') | |
1028 | => case Operand.deMemloc def | |
1029 | of SOME def => if track def | |
1030 | then MemLocSet.add(defed', def) | |
1031 | else defed' | |
1032 | | NONE => defed') | |
1033 | ||
1034 | val {defs, ...} = Entry.uses_defs_kills entry | |
1035 | val defed' = doit' (defed', defs) | |
1036 | ||
1037 | val defed' | |
1038 | = List.fold | |
1039 | (statements, | |
1040 | defed', | |
1041 | fn (asm,defed') | |
1042 | => let | |
1043 | val {defs, ...} = Assembly.uses_defs_kills asm | |
1044 | in | |
1045 | doit' (defed', defs) | |
1046 | end) | |
1047 | ||
1048 | val {defs, ...} = Transfer.uses_defs_kills transfer | |
1049 | val defed' = doit' (defed', defs) | |
1050 | ||
1051 | fun doit' label = doit {label = label, | |
1052 | defed = defed'} | |
1053 | fun doit'' label = doit {label = label, | |
1054 | defed = MemLocSet.empty} | |
1055 | ||
1056 | datatype z = datatype Transfer.t | |
1057 | in | |
1058 | case transfer | |
1059 | of Goto {target, ...} | |
1060 | => (doit' target) | |
1061 | | Iff {truee, falsee, ...} | |
1062 | => (doit' truee; | |
1063 | doit' falsee) | |
1064 | | Switch {cases, default, ...} | |
1065 | => (Transfer.Cases.foreach(cases, doit' o #2); | |
1066 | doit' default) | |
1067 | | Tail {...} | |
1068 | => () | |
1069 | | NonTail {return, handler, ...} | |
1070 | => (doit'' return; | |
1071 | case handler | |
1072 | of SOME handler => doit'' handler | |
1073 | | NONE => ()) | |
1074 | | Return {...} | |
1075 | => () | |
1076 | | Raise {...} | |
1077 | => () | |
1078 | | CCall {func, return, ...} | |
1079 | => if CFunction.maySwitchThreads func | |
1080 | then Option.app (return, doit'') | |
1081 | else Option.app (return, doit') | |
1082 | end | |
1083 | in | |
1084 | case !defed | |
1085 | of NONE => default MemLocSet.empty | |
1086 | | SOME defed => if MemLocSet.<=(defed',defed) | |
1087 | then () | |
1088 | else default defed | |
1089 | end | |
1090 | ||
1091 | val _ = Vector.foreach | |
1092 | (funcs, | |
1093 | fn label => doit {label = label, | |
1094 | defed = MemLocSet.empty}) | |
1095 | ||
1096 | val {get = getLiveTransfers : | |
1097 | Label.t -> ((MemLoc.t * Register.t * bool) list * | |
1098 | (MemLoc.t * XmmRegister.t * bool) list), | |
1099 | set = setLiveTransfers, ...} | |
1100 | = Property.getSet | |
1101 | (Label.plist, | |
1102 | Property.initRaise ("amd64LiveTransfers:getLiveTransfers", Label.layout)) | |
1103 | ||
1104 | val _ = Vector.foreach | |
1105 | (labels, | |
1106 | fn label | |
1107 | => let | |
1108 | val {liveTransfers, ...} = getInfo label | |
1109 | val (liveRegs, liveXmmRegs) = valOf (!liveTransfers) | |
1110 | val (liveRegs, liveXmmRegs) | |
1111 | = if sync | |
1112 | then (List.map | |
1113 | (liveRegs, | |
1114 | fn (memloc,reg, sync) => (memloc, reg, !sync)), | |
1115 | List.map | |
1116 | (liveXmmRegs, | |
1117 | fn (memloc,reg, sync) => (memloc, reg, !sync))) | |
1118 | else (List.map | |
1119 | (liveRegs, | |
1120 | fn (memloc,reg, _) => (memloc, reg, false)), | |
1121 | List.map | |
1122 | (liveXmmRegs, | |
1123 | fn (memloc,reg, _) => (memloc, reg, false))) | |
1124 | in | |
1125 | setLiveTransfers(label, (liveRegs, liveXmmRegs)) | |
1126 | end) | |
1127 | ||
1128 | val _ = destInfo () | |
1129 | in | |
1130 | T {get = getLiveTransfers, | |
1131 | set = setLiveTransfers} | |
1132 | end | |
1133 | ||
1134 | ||
1135 | val computeLiveTransfers | |
1136 | = fn {chunk, transferRegs, transferXmmRegs, liveInfo, jumpInfo, loopInfo} | |
1137 | => if !Control.Native.liveTransfer > 0 | |
1138 | then computeLiveTransfers {chunk = chunk, | |
1139 | transferRegs = transferRegs, | |
1140 | transferXmmRegs = transferXmmRegs, | |
1141 | liveInfo = liveInfo, | |
1142 | jumpInfo = jumpInfo, | |
1143 | loopInfo = loopInfo} | |
1144 | else let | |
1145 | val {get = getLiveTransfers, | |
1146 | set = setLiveTransfers, ...} | |
1147 | = Property.getSetOnce(Label.plist, | |
1148 | Property.initConst ([], [])) | |
1149 | in | |
1150 | T {get = getLiveTransfers, | |
1151 | set = setLiveTransfers} | |
1152 | end | |
1153 | ||
1154 | val (computeLiveTransfers : {chunk : Chunk.t, | |
1155 | transferRegs : Entry.t -> Register.t list, | |
1156 | transferXmmRegs : Entry.t -> XmmRegister.t list, | |
1157 | liveInfo : LiveInfo.t, | |
1158 | jumpInfo : amd64JumpInfo.t, | |
1159 | loopInfo : amd64LoopInfo.t} -> t, | |
1160 | computeLiveTransfers_msg) | |
1161 | = tracerTop | |
1162 | "computeLiveTransfers" | |
1163 | computeLiveTransfers | |
1164 | ||
1165 | fun computeLiveTransfers_totals () | |
1166 | = (computeLiveTransfers_msg ()) | |
1167 | ||
1168 | fun getLiveTransfers (T {get, ...}, label) = get label | |
1169 | ||
1170 | fun setLiveTransfersEmpty (T {set, ...}, label) = set(label, ([], [])) | |
1171 | end |