1 (* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
2 * Jagannathan, and Stephen Weeks.
3 * Copyright (C) 1997-2000 NEC Research Institute.
5 * MLton is released under a BSD-style license.
6 * See the file MLton-LICENSE for details.
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).
16 functor amd64LiveTransfers(S: AMD64_LIVE_TRANSFERS_STRUCTS) : AMD64_LIVE_TRANSFERS =
24 structure CFunction = CFunction
27 structure LiveSet = amd64Liveness.LiveSet
28 structure LiveInfo = amd64Liveness.LiveInfo
32 val track = amd64Liveness.track
34 val tracerTop = amd64.tracerTop
36 fun temp_uses_defs {uses : Operand.t list,
37 defs : Operand.t list}
43 fn (operand, baseUses)
44 => case Operand.deMemloc operand
45 of SOME memloc => if amd64Liveness.track memloc
46 then MemLocSet.add(baseUses, memloc)
52 fun doit (operands, tempUses)
56 fn (operand, tempUses)
57 => case Operand.deMemloc operand
59 => List.fold(MemLoc.utilized memloc,
62 => if amd64Liveness.track memloc
63 then MemLocSet.add(tempUses, memloc)
76 fn (operand, baseDefs)
77 => case Operand.deMemloc operand
78 of SOME memloc => if amd64Liveness.track memloc
79 then MemLocSet.add(baseDefs, memloc)
82 val tempDefs = baseDefs
88 datatype t = T of {get: Label.t ->
89 ((MemLoc.t * Register.t * bool) list *
90 (MemLoc.t * XmmRegister.t * bool) list),
92 ((MemLoc.t * Register.t * bool) list *
93 (MemLoc.t * XmmRegister.t * bool) list) -> unit}
100 fun sign x = if x = 0
108 datatype t = NegInfinity
112 = fn NegInfinity => "-inf"
113 | Finite n => I'.toString n
114 | PosInfinity => "+inf"
115 val zero = Finite (I'.zero)
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
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
131 | (Finite _) + PosInfinity = PosInfinity
132 | PosInfinity + NegInfinity = zero
133 | PosInfinity + _ = PosInfinity
135 fun NegInfinity * NegInfinity = PosInfinity
136 | NegInfinity * (Finite x)
141 | NegInfinity * PosInfinity = NegInfinity
142 | (Finite x) * 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
153 | (Finite x) * PosInfinity
158 | PosInfinity * NegInfinity = NegInfinity
159 | PosInfinity * (Finite x)
164 | PosInfinity * PosInfinity = PosInfinity
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}
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)
186 val cutoff = !Control.Native.cutoff
187 datatype u = Position of I.t | Length of I'.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},
204 = Property.destGetSetOnce
206 Property.initRaise ("amd64LiveTransfers:getInfo", Label.layout))
212 fn (block as Block.T {entry, transfer, ...}, (labels, funcs))
214 val label = Entry.label entry
215 val succ = Transfer.nearTargets transfer
216 val live = LiveInfo.getLive(liveInfo, label)
221 => LiveSet.+(live, LiveInfo.getLive(liveInfo, label)))
222 val live = LiveSet.toList live
228 live = Vector.fromListMap
232 distanceF' = ref NONE,
233 distanceF = ref NONE,
234 distanceB' = ref NONE,
235 distanceB = ref NONE}),
236 liveTransfers = ref NONE,
238 val labels = label::labels
239 val funcs = case entry
240 of Entry.Func _ => label::funcs
246 val labels = Vector.fromList labels
247 val funcs = Vector.fromList funcs
254 val {block, ...} = getInfo label
257 val {pred = pred', ...} = getInfo target
259 List.push (pred', label)
261 val Block.T {transfer, ...} = block
262 datatype z = datatype Transfer.t
265 of Goto {target, ...}
267 | Iff {truee, falsee, ...}
270 | Switch {cases, default, ...}
272 Transfer.Cases.foreach(cases, doit o #2))
275 | NonTail {return, handler, ...}
278 of SOME handler => doit handler
284 | CCall {return, ...}
285 => Option.app (return, doit)
293 val {block, live, ...} = getInfo label
294 val Block.T {entry, statements, transfer, ...} = block
300 fn (Assembly.Comment _, l) => l
301 | (_, l) => I'.+(l, I'.one))
305 val {uses, defs, ...}
306 = Transfer.uses_defs_kills transfer
308 = temp_uses_defs {uses = uses,
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)
320 fn {memloc, distanceB', ...}
321 => if MemLocSet.contains(uses,memloc)
323 MemLocSet.contains(defs,memloc)
324 then distanceB' := SOME (Position (I.Finite m))
327 | pos ((Assembly.Comment _)::assembly,n,m)
329 | pos (asm::assembly,n,m)
332 = Assembly.uses_defs_kills asm
334 = temp_uses_defs {uses = uses,
339 fn {memloc, distanceF' as ref NONE, ...}
340 => if MemLocSet.contains(uses,memloc)
341 then distanceF' := SOME (Position (I.Finite n))
346 fn {memloc, distanceB', ...}
347 => if MemLocSet.contains(uses,memloc)
349 MemLocSet.contains(defs,memloc)
350 then distanceB' := SOME (Position (I.Finite m))
352 pos(assembly, I'.+(n, I'.one), I'.-(m, I'.one))
357 val m = I'.-(l, I'.one)
359 = Entry.uses_defs_kills entry
361 = temp_uses_defs {uses = uses,
366 fn {memloc, distanceF' as ref NONE, ...}
367 => if MemLocSet.contains(uses,memloc)
368 then distanceF' := SOME (Position (I.Finite n))
373 fn {memloc, distanceB', ...}
374 => if MemLocSet.contains(uses,memloc)
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))
383 fun get_distanceF {temp: MemLoc.t,
386 val {block, succ, live, ...} = getInfo label
387 val Block.T {transfer, ...} = block
391 fn {memloc, ...} => MemLoc.eq(temp, memloc))
392 of SOME {distanceF = ref (SOME (df, dfl)), ...}
394 | SOME {distanceF', distanceF, ...}
395 => (case valOf (!distanceF')
396 of Position n => (distanceF := SOME (n, SOME label);
400 val loopLabels = getLoopLabels (loopInfo, label)
401 val _ = distanceF := SOME (I.PosInfinity, NONE)
408 (I.PosInfinity, NONE),
409 fn (label, (min, minl))
412 = get_distanceF {temp = temp,
424 else I.*(I.Finite 5, n')
434 datatype z = datatype Transfer.t
437 of Tail _ => (I.PosInfinity, NONE)
438 | NonTail _ => (I.PosInfinity, NONE)
439 | Return _ => (I.PosInfinity, NONE)
440 | Raise _ => (I.PosInfinity, NONE)
442 => if CFunction.maySwitchThreads func
443 orelse Size.class (MemLoc.size temp) <> Size.INT
444 then (I.PosInfinity, NONE)
448 distanceF := SOME (n, l) ; (n, l)
450 | _ => (I.PosInfinity, NONE)
453 fun get_distanceB {temp: MemLoc.t,
456 val {block, pred, live, ...} = getInfo label
457 val Block.T {entry, ...} = block
461 fn {memloc, ...} => MemLoc.eq(temp, memloc))
462 of SOME {distanceB = ref (SOME (db, dbl)), ...}
464 | SOME {distanceB, ...}
466 val loopLabels = getLoopLabels(loopInfo, label)
467 val _ = distanceB := SOME (I.PosInfinity, NONE)
471 (I.PosInfinity, NONE),
472 fn (label, (min, minl))
474 val {live, ...} = getInfo label
478 fn {memloc, ...} => MemLoc.eq(temp, memloc))
479 of SOME {distanceB', ...}
480 => (case valOf(!distanceB')
489 = get_distanceB {temp = temp,
501 else I.*(I.Finite 5, n')
510 datatype z = datatype Entry.t
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)
523 distanceB := SOME (n, l) ; (n, l)
525 | _ => (I.PosInfinity, NONE)
529 val queue = ref (Queue.empty ())
531 fun enque x = queue := Queue.enque(!queue, x)
533 case Queue.deque (!queue) of
535 | SOME (queue', x) => (queue := queue'; SOME x)
538 fun doit {label, hints}
540 val {block as Block.T {entry, ...},
541 live = liveData, liveTransfers, ...} = getInfo label
547 val loopLabels = getLoopLabels(loopInfo, label)
548 val Block.T {transfer, ...} = block
550 val (regHints, xmmregHints) = hints
552 val live = LiveSet.toList(LiveInfo.getLive(liveInfo, label))
557 (print (Label.toString label);
558 print "\nloopLabels: ";
559 print (List.toString Label.toString loopLabels);
560 print "\nliveData:\n";
563 fn {memloc, distanceF', distanceB', ...} =>
564 (print (MemLoc.toString memloc);
568 | SOME (Position i) => (print "Pos "; print (I.toString i))
569 | SOME (Length i) => (print "Len "; print (I'.toString i));
573 | SOME (Position i) => (print "Pos "; print (I.toString i))
574 | SOME (Length i) => (print "Len "; print (I'.toString i));
579 fn (memloc,register,sync) =>
580 (print (MemLoc.toString memloc);
582 print (Register.toString register);
584 print (Bool.toString (!sync));
586 print "xmmregHints:\n";
589 fn (memloc,register,sync) =>
590 (print (MemLoc.toString memloc);
592 print (XmmRegister.toString register);
594 print (Bool.toString (!sync));
600 => (print (MemLoc.toString memloc);
602 print "distance_F:\n";
606 => (print (MemLoc.toString memloc);
609 val (n, l) = get_distanceF {temp = memloc,
612 print (I.toString n);
614 print (Option.toString Label.toString l)
617 print "distance_B:\n";
621 => (print (MemLoc.toString memloc);
624 val (n, l) = get_distanceB {temp = memloc,
627 print (I.toString n);
629 print (Option.toString Label.toString l)
638 => case get_distanceF {temp = memloc,
640 of (I.Finite n, SOME l)
643 then if List.contains
646 then SOME (memloc, n)
647 else SOME (memloc, n * 5)
648 else SOME (memloc, n)
654 "amd64LiveTransfers.computeLiveTransfers.live: get_distanceF")
658 => case (get_distanceB {temp = memloc,
660 get_distanceF {temp = memloc,
662 of ((I.PosInfinity, _), _)
664 | (_, (I.PosInfinity, _))
666 | ((I.Finite n, SOME nl),
667 (I.Finite m, SOME ml))
668 => if (n + m) < cutoff
670 then case (List.contains
677 => SOME (memloc, n + m)
687 else SOME (memloc, n + m)
691 "amd64LiveTransfers.computeLiveTransfers.live: get_distanceB")
693 (* List.partition will reverse the lists.
694 * So sort in increasing order.
698 (live, fn ((_,n1),(_,n2)) => I'.>(n1, n2))
701 = if true then () else
706 => (print (MemLoc.toString memloc);
708 print (I'.toString n);
711 val {yes = liveRegs, no = liveXmmRegs}
715 => Size.class (MemLoc.size memloc) = Size.INT)
724 => MemLoc.eq(memloc,memloc'))
725 of SOME (_,register',_)
726 => (memloc,weight,SOME register')
728 => (memloc,weight,NONE))
731 = fn ([],_,liveTransfers) => liveTransfers
732 | (_,[],liveTransfers) => liveTransfers
734 (memloc,_,register)::live,
743 => Register.coincide(register,
749 (memloc,register,ref true)::liveTransfers)
754 val size = MemLoc.size memloc
761 Register.size register)
766 fn (_,_,SOME register')
770 | (_,_,NONE) => false))
775 fn ((_,SOME index1),(_,SOME index2))
776 => Int.>(index1, index2)
784 => doitRegs (transferRegs,
793 => if List.contains(transferRegs,
801 val liveRegsTransfers = doitRegs(transferRegs entry, liveRegs, [])
810 => MemLoc.eq(memloc,memloc'))
811 of SOME (_,register',_)
812 => (memloc,weight,SOME register')
814 => (memloc,weight,NONE))
817 = fn ([],_,liveTransfers) => liveTransfers
818 | (_,[],liveTransfers) => liveTransfers
820 (memloc,_,register)::live,
829 => XmmRegister.coincide(register,
835 (memloc,register,ref true)::liveTransfers)
840 val size = MemLoc.size memloc
847 XmmRegister.size register)
852 fn (_,_,SOME register')
856 | (_,_,NONE) => false))
861 fn ((_,SOME index1),(_,SOME index2))
862 => Int.>(index1, index2)
868 case transferXmmRegs'
870 => doitXmmRegs (transferXmmRegs,
879 => if List.contains(transferXmmRegs,
887 val liveXmmRegsTransfers = doitXmmRegs(transferXmmRegs entry, liveXmmRegs, [])
889 val _ = liveTransfers := SOME (liveRegsTransfers,
890 liveXmmRegsTransfers)
894 = (print "liveRegsTransfers:\n";
897 fn (memloc,register,sync) =>
898 (print (MemLoc.toString memloc);
900 print (Register.toString register);
902 print (Bool.toString (!sync));
904 print "liveFltRegsTransfers:\n";
906 (liveFltRegsTransfers,
908 (print (MemLoc.toString memloc);
910 print (Bool.toString (!sync));
915 fun doit' label = enque {label = label,
916 hints = (liveRegsTransfers,
917 liveXmmRegsTransfers)}
918 fun doit'' label = enque {label = label,
920 fun doit''' func label =
924 (Operand.cReturnTemps (CFunction.return func),
926 fn ({src, dst}, (regHints, xmmregHints)) =>
928 Operand.Register reg =>
929 ((dst, reg, ref true) :: regHints,
931 | Operand.XmmRegister reg =>
933 (dst, reg, ref true) :: xmmregHints)
934 | _ => (regHints, xmmregHints))
936 enque {hints = hints,
939 datatype z = datatype Transfer.t
942 of Goto {target, ...}
944 | Iff {truee, falsee, ...}
947 | Switch {cases, default, ...}
949 Transfer.Cases.foreach(cases, doit' o #2))
952 | NonTail {return, handler, ...}
955 of SOME handler => doit'' handler
961 | CCall {func, return, ...}
962 => if CFunction.maySwitchThreads func
963 then Option.app (return, doit'')
964 else Option.app (return, doit''' func)
968 val _ = Vector.foreach
970 fn label => enque {label = label, hints = ([],[])})
975 | SOME {label, hints}
976 => (doit {label = label, hints = hints};
980 fun doit {label, defed = defed'}
983 val {block, liveTransfers, defed, ...} = getInfo label
984 val (liveRegs, liveXmmRegs) = valOf (!liveTransfers)
987 = case getNear(jumpInfo, label)
988 of None => MemLocSet.empty
989 | Count 0 => MemLocSet.empty
997 fn (memloc',_,_) => MemLoc.eq(memloc', memloc))
1001 fn (memloc',_,_) => MemLoc.eq(memloc', memloc)))
1005 val Block.T {entry, statements, transfer, ...} = block
1007 val _ = List.foreach
1010 => if MemLocSet.contains(defed', memloc)
1013 val _ = List.foreach
1016 => if MemLocSet.contains(defed', memloc)
1020 val defed' = MemLocSet.+(defed'', defed')
1021 val _ = defed := SOME defed'
1023 fun doit' (defed', defs)
1028 => case Operand.deMemloc def
1029 of SOME def => if track def
1030 then MemLocSet.add(defed', def)
1034 val {defs, ...} = Entry.uses_defs_kills entry
1035 val defed' = doit' (defed', defs)
1043 val {defs, ...} = Assembly.uses_defs_kills asm
1045 doit' (defed', defs)
1048 val {defs, ...} = Transfer.uses_defs_kills transfer
1049 val defed' = doit' (defed', defs)
1051 fun doit' label = doit {label = label,
1053 fun doit'' label = doit {label = label,
1054 defed = MemLocSet.empty}
1056 datatype z = datatype Transfer.t
1059 of Goto {target, ...}
1061 | Iff {truee, falsee, ...}
1064 | Switch {cases, default, ...}
1065 => (Transfer.Cases.foreach(cases, doit' o #2);
1069 | NonTail {return, handler, ...}
1072 of SOME handler => doit'' handler
1078 | CCall {func, return, ...}
1079 => if CFunction.maySwitchThreads func
1080 then Option.app (return, doit'')
1081 else Option.app (return, doit')
1085 of NONE => default MemLocSet.empty
1086 | SOME defed => if MemLocSet.<=(defed',defed)
1091 val _ = Vector.foreach
1093 fn label => doit {label = label,
1094 defed = MemLocSet.empty})
1096 val {get = getLiveTransfers :
1097 Label.t -> ((MemLoc.t * Register.t * bool) list *
1098 (MemLoc.t * XmmRegister.t * bool) list),
1099 set = setLiveTransfers, ...}
1102 Property.initRaise ("amd64LiveTransfers:getLiveTransfers", Label.layout))
1104 val _ = Vector.foreach
1108 val {liveTransfers, ...} = getInfo label
1109 val (liveRegs, liveXmmRegs) = valOf (!liveTransfers)
1110 val (liveRegs, liveXmmRegs)
1114 fn (memloc,reg, sync) => (memloc, reg, !sync)),
1117 fn (memloc,reg, sync) => (memloc, reg, !sync)))
1120 fn (memloc,reg, _) => (memloc, reg, false)),
1123 fn (memloc,reg, _) => (memloc, reg, false)))
1125 setLiveTransfers(label, (liveRegs, liveXmmRegs))
1130 T {get = getLiveTransfers,
1131 set = setLiveTransfers}
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}
1145 val {get = getLiveTransfers,
1146 set = setLiveTransfers, ...}
1147 = Property.getSetOnce(Label.plist,
1148 Property.initConst ([], []))
1150 T {get = getLiveTransfers,
1151 set = setLiveTransfers}
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)
1162 "computeLiveTransfers"
1163 computeLiveTransfers
1165 fun computeLiveTransfers_totals ()
1166 = (computeLiveTransfers_msg ())
1168 fun getLiveTransfers (T {get, ...}, label) = get label
1170 fun setLiveTransfersEmpty (T {set, ...}, label) = set(label, ([], []))