1%% -*- erlang-indent-level: 2 -*-
2%%
3%% Licensed under the Apache License, Version 2.0 (the "License");
4%% you may not use this file except in compliance with the License.
5%% You may obtain a copy of the License at
6%%
7%%     http://www.apache.org/licenses/LICENSE-2.0
8%%
9%% Unless required by applicable law or agreed to in writing, software
10%% distributed under the License is distributed on an "AS IS" BASIS,
11%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12%% See the License for the specific language governing permissions and
13%% limitations under the License.
14%%
15%% ===========================================================================
16%%@doc
17%%		  GRAPH COLORING STACK SLOT SPILL MINIMIZER
18%%
19%% A simple pessimistic graph coloring stack slot spill minimizer
20%%
21%% - build interference graph
22%% - estimate number of stack slots needed
23%% - simplify graph (push on stack, abort and retry with more stack slots if spill)
24%% - select colors
25%%
26%% Emits a coloring: a list of {TempName,Location}
27%%  where Location is {spill,M}.
28%% {spill,M} denotes the Mth spilled node
29%%
30%% This version uses ETS tables
31%%
32%% Deficiencies:
33%% - pessimistic coloring
34%%
35
36-module(hipe_spillmin_color).
37
38-export([stackalloc/8]).
39
40%%-ifndef(DO_ASSERT).
41%%-define(DO_ASSERT, true).
42%%-endif.
43
44%%-ifndef(DEBUG).
45%%-define(DEBUG,0).
46%%-endif.
47
48%%---------------------------------------------------------------------------
49
50-include("../main/hipe.hrl").
51-include("../flow/cfg.hrl").
52
53%% Define these as 'ok' or 'report(X,Y)' depending on how much output you want.
54-define(report0(X,Y), ?IF_DEBUG_LEVEL(0,?msg(X, Y),ok)).
55-define(report(X,Y),  ?IF_DEBUG_LEVEL(1,?msg(X, Y),ok)).
56-define(report2(X,Y), ?IF_DEBUG_LEVEL(2,?msg(X, Y),ok)).
57-define(report3(X,Y), ?IF_DEBUG_LEVEL(3,?msg(X, Y),ok)).
58
59%% Emits a coloring: a list of {TempName,Location}
60%%  where Location is {spill,M}.
61%% {spill,M} denotes the Mth spilled node
62
63-type target_context() :: any().
64
65-spec stackalloc(#cfg{}, _, [_], non_neg_integer(),
66		 comp_options(), module(), target_context(), hipe_temp_map()) ->
67                                {hipe_spill_map(), non_neg_integer()}.
68
69stackalloc(CFG, Live, _StackSlots, SpillIndex, _Options, TargetMod,
70	   TargetContext, TempMap) ->
71  Target = {TargetMod, TargetContext},
72  ?report2("building IG~n", []),
73  {IG, NumNodes} = build_ig(CFG, Live, Target, TempMap),
74  {Cols, MaxColors} =
75    color_heuristic(IG, 0, NumNodes, NumNodes, NumNodes, Target, 1),
76  SortedCols = lists:sort(Cols),
77  {remap_temp_map(SortedCols, TempMap, SpillIndex), SpillIndex+MaxColors}.
78
79%% Rounds a floating point value upwards
80ceiling(X) ->
81  T = trunc(X),
82  case (X - T) of
83    Neg when Neg < 0.0 -> T;
84    Pos when Pos > 0.0 -> T + 1;
85    _ -> T
86  end.
87
88%% Emits a coloring: an unsorted list of {Temp,Location}
89%%  where Location is {spill,M}.
90%% {spill,M} denotes the Mth spilled node
91%%
92%% Notes:
93%% - Arguments:
94%%   IG: The interference graph
95%%   Min: The lower bound, the minimal number of colors tried.
96%%   Max: The upper bound, the maximal number of colors tried.
97%%   Safe: The number of colors that are guaranteed to work. This is
98%%         needed, because we reuse information from color() about how
99%%         many colors it used at the last try, but this is not guaranteed to
100%%         be a feasible solution because color might work differently using
101%%         more colors although it has successfully colored the graph with
102%%         fewer colors previously. Example: color(666) colors with 23 colors,
103%%                                           but color(23) fails.
104%%         We use Safe inefficently, because we run color 1 additional
105%%         time with the same argument if Safe is needed.
106%%   MaxNodes: The number of nodes in IG.
107%%   Target: Target specific information.
108%%   MaxDepth: The maximum recursion depth.
109color_heuristic(IG, Min, Max, Safe, MaxNodes, Target, MaxDepth) ->
110  case MaxDepth of
111    0 ->
112      case color(IG, ordsets:from_list(init_stackslots(Max)),
113		 MaxNodes, Target) of
114	not_easily_colorable ->
115	  color(IG, ordsets:from_list(init_stackslots(Safe)),
116		MaxNodes, Target);
117	Else ->
118	  Else
119      end;
120    _ ->
121      %% This can be increased from 2, and by this the heuristic can be
122      %% exited earlier, but the same can be achieved by decreasing the
123      %% recursion depth. This should not be decreased below 2.
124      case (Max - Min) < 2 of
125        true ->
126          case color(IG, ordsets:from_list(init_stackslots(Max)),
127		     MaxNodes, Target) of
128            not_easily_colorable ->
129              color(IG, ordsets:from_list(init_stackslots(Safe)),
130                    MaxNodes, Target);
131            Else ->
132              Else
133          end;
134        false ->
135	  NumSlots = ceiling((Max - Min)/2) + Min,
136	  case color(IG, ordsets:from_list(init_stackslots(NumSlots)),
137		     MaxNodes, Target) of
138	    not_easily_colorable ->
139	      color_heuristic(IG, NumSlots, Max,
140			      Safe, MaxNodes, Target, MaxDepth - 1);
141	    {_TmpCols, TmpMaxColors} ->
142	      color_heuristic(IG, Min, TmpMaxColors,
143			      NumSlots, MaxNodes, Target, MaxDepth - 1)
144	  end
145      end
146  end.
147
148%% Returns a new temp map with the spilled temporaries mapped to stack slots,
149%% located after SpillIndex, according to Cols.
150remap_temp_map(Cols, TempMap, SpillIndex) ->
151  remap_temp_map0(Cols, hipe_temp_map:to_substlist(TempMap), SpillIndex).
152
153remap_temp_map0([], _TempMap, _SpillIndex) ->
154  [];
155remap_temp_map0([{_M, {spill, N}}|Xs], [{TempNr, {spill,_}}|Ys], SpillIndex) ->
156  [{TempNr, {spill, SpillIndex + N-1}}|remap_temp_map0(Xs, Ys, SpillIndex)];
157remap_temp_map0(Cols, [_Y|Ys], SpillIndex) ->
158  remap_temp_map0(Cols, Ys, SpillIndex).
159
160
161%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
162%%
163%% *** BUILD THE INTERFERENCE GRAPH ***
164%%
165%% Returns {Interference_graph, Number_Of_Nodes}
166%%
167
168build_ig(CFG, Live, Target, TempMap) ->
169  TempMapping = map_spilled_temporaries(TempMap),
170  TempMappingTable = setup_ets(TempMapping),
171  NumSpilled = length(TempMapping),
172  IG = build_ig_bbs(labels(CFG, Target), CFG, Live, empty_ig(NumSpilled),
173		    Target, TempMap, TempMappingTable),
174  ets:delete(TempMappingTable),
175  {normalize_ig(IG), NumSpilled}.
176
177%% Creates an ETS table consisting of the keys given in List, with the values
178%% being an integer which is the position of the key in List.
179%% [1,5,7] -> {1,0} {5,1} {7,2}
180%% etc.
181setup_ets(List) ->
182  setup_ets0(List, ets:new(tempMappingTable, []), 0).
183
184setup_ets0([], Table, _N) ->
185  Table;
186setup_ets0([X|Xs], Table, N) ->
187  ets:insert(Table, {X, N}),
188  setup_ets0(Xs, Table, N+1).
189
190build_ig_bbs([], _CFG, _Live, IG, _Target, _TempMap, _TempMapping) ->
191  IG;
192build_ig_bbs([L|Ls], CFG, Live, IG, Target, TempMap, TempMapping) ->
193  Xs = bb(CFG, L, Target),
194  LiveOut = [X || X <- liveout(Live, L, Target),
195		  hipe_temp_map:is_spilled(X, TempMap)],
196  LiveOutList = ordsets:to_list(LiveOut),
197  LiveOutListMapped = list_map(LiveOutList, TempMapping, []),
198  LiveOutSetMapped = ordsets:from_list(LiveOutListMapped),
199  {_, NewIG} =
200    build_ig_bb(Xs, LiveOutSetMapped, IG, Target, TempMap, TempMapping),
201  build_ig_bbs(Ls, CFG, Live, NewIG, Target, TempMap, TempMapping).
202
203build_ig_bb([], LiveOut, IG, _Target, _TempMap, _TempMapping) ->
204  {LiveOut, IG};
205build_ig_bb([X|Xs], LiveOut, IG, Target, TempMap, TempMapping) ->
206  {Live,NewIG} =
207    build_ig_bb(Xs, LiveOut, IG, Target, TempMap, TempMapping),
208  build_ig_instr(X, Live, NewIG, Target, TempMap, TempMapping).
209
210build_ig_instr(X, Live0, IG0, Target, TempMap, TempMapping) ->
211  {Def, Use} = def_use(X, Target, TempMap),
212  ?report3("Live ~w\n~w : Def: ~w Use ~w\n",[Live0, X, Def,Use]),
213  DefListMapped = list_map(Def, TempMapping, []),
214  UseListMapped = list_map(Use, TempMapping, []),
215  DefSetMapped = ordsets:from_list(DefListMapped),
216  UseSetMapped = ordsets:from_list(UseListMapped),
217  {Live1, IG1} =
218    analyze_move(X, Live0, IG0, Target, DefSetMapped, UseSetMapped),
219  IG = interference_arcs(DefListMapped, ordsets:to_list(Live1), IG1),
220  Live = ordsets:union(UseSetMapped, ordsets:subtract(Live1, DefSetMapped)),
221  {Live, IG}.
222
223analyze_move(X, Live0, IG0, Target, DefSetMapped, UseSetMapped) ->
224  case {is_spill_move(X, Target), DefSetMapped, UseSetMapped} of
225    {true, [Dst], [Src]} ->
226      {ordsets:del_element(Src, Live0), add_move(Src, Dst, IG0)};
227    {_, _, _} ->
228      {Live0, IG0}
229  end.
230
231%% Given a list of Keys and an ets-table returns a list of the elements
232%% in Mapping corresponding to the Keys and appends Acc to this list.
233list_map([], _Mapping, Acc) ->
234  Acc;
235list_map([X|Xs], Mapping, Acc) ->
236  {_Key, Val} = hd(ets:lookup(Mapping, X)),
237  list_map(Xs, Mapping, [Val | Acc]).
238
239%% Returns an ordered list of spilled temporaries in TempMap
240map_spilled_temporaries(TempMap) ->
241  map_spilled_temporaries0(hipe_temp_map:to_substlist(TempMap)).
242
243map_spilled_temporaries0([]) ->
244  [];
245map_spilled_temporaries0([{N, {spill, _}}|Xs]) ->
246  [N | map_spilled_temporaries0(Xs)];
247map_spilled_temporaries0([_X|Xs]) ->
248  map_spilled_temporaries0(Xs).
249
250%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
251
252interference_arcs([], _Live, IG) ->
253  IG;
254interference_arcs([X|Xs], Live, IG) ->
255  interference_arcs(Xs, Live, i_arcs(X, Live, IG)).
256
257i_arcs(_X, [], IG) ->
258  IG;
259i_arcs(X, [Y|Ys], IG) ->
260  i_arcs(X, Ys, add_edge(X, Y, IG)).
261
262%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
263%%
264%% *** COLORING ***
265%%
266%% Coloring is done straightforwardly:
267%% - find the low-degree nodes, put them in low
268%% - while low non-empty:
269%%   * remove x from low
270%%   * push x on stack
271%%   * decrement degree of neighbors of x
272%%   * for each neighbor y of low degree, put y on low
273%% - when low empty:
274%%   - if graph empty, return stack
275%%   - otherwise
276%%     throw an exception (the caller should retry with more stack slots)
277
278color(IG, StackSlots, NumNodes, Target) ->
279  ?report("simplification of IG~n", []),
280  K = ordsets:size(StackSlots),
281  Nodes = list_ig(IG),
282  Low = low_degree_nodes(Nodes, K),
283  ?report(" starting with low degree nodes ~p~n", [Low]),
284  EmptyStk = [],
285  case simplify(Low, NumNodes, IG, K, EmptyStk, Target) of
286    non_simplifiable -> not_easily_colorable;
287    Stk ->
288      ?report(" selecting colors~n", []),
289      select(Stk, IG, StackSlots, NumNodes)
290  end.
291
292%%%%%%%%%%%%%%%%%%%%
293%%
294%% Simplification: push all easily colored nodes on a stack;
295%%  when the list of easy nodes becomes empty, see if graph is
296%%  empty as well. If it is not, throw an exception and abort.
297%%  If it is empty, return the stack.
298%%
299%% Notes:
300%% - Arguments:
301%%   Low: low-degree nodes (ready to color)
302%%   NumNodes: number of remaining nodes in graph
303%%   IG: interference graph
304%%   K: number of colors
305%%   Stk: stack of already simplified nodes
306%%   Target: Machine to compile for
307
308simplify(Low, NumNodes, IG, K, Stk, Target) ->
309  Vis = none_visited(NumNodes),
310  simplify_ig(Low, NumNodes, IG, K, Stk, Vis, Target).
311
312simplify_ig([], 0, _IG, _K, Stk, _Vis, _Target) ->
313  Stk;
314simplify_ig([], N, _IG, _K, _Stk, _Vis, _Target) when N > 0 ->
315  ?report3("N: ~w Stk: ~w N+Stk ~w\n", [N,length(Stk),N+length(Stk)]),
316  non_simplifiable;
317simplify_ig([X|Xs], N, IG, K, Stk, Vis, Target) ->
318  ?report3("N: ~w Stk: ~w N+Stk ~w\n", [N,length(Stk),N+length(Stk)]),
319  case is_visited(X, Vis) of
320    true ->
321      ?report("  node ~p already visited~n", [X]),
322      simplify_ig(Xs, N, IG, K, Stk, Vis, Target);
323    false ->
324      ?report("Stack ~w\n", [Stk]),
325      {NewLow, NewIG} = decrement_neighbors(X, Xs, IG, Vis, K),
326      ?report("  node ~w pushed\n(~w now ready)~n", [X, NewLow]),
327      NewStk = push_colored(X, Stk),
328      simplify_ig(NewLow, N-1, NewIG, K, NewStk, visit(X, Vis), Target)
329  end.
330
331decrement_neighbors(X, Xs, IG, Vis, K) ->
332  Ns = unvisited_neighbors(X, Vis, IG),
333  ?report("  node ~p has neighbors ~w\n(unvisited ~p)~n",
334	  [X, neighbors(X, IG), Ns]),
335  decrement_each(Ns, Xs, IG, Vis, K).
336
337%% For each node, decrement its degree and check if it is now
338%% a low-degree node. In that case, add it to the 'low list'.
339decrement_each([], Low, IG, _Vis, _K) ->
340  {Low, IG};
341decrement_each([N|Ns], OldLow, IG, Vis, K) ->
342  {Low, CurrIG} = Res = decrement_each(Ns, OldLow, IG, Vis, K),
343  case is_visited(N, Vis) of
344    true ->
345      Res;
346    false ->
347      {D, NewIG} = decrement_degree(N, CurrIG),
348      if
349	D =:= K-1 ->
350	  {[N|Low], NewIG};
351	true ->
352	  {Low, NewIG}
353      end
354  end.
355
356%%%%%%%%%%%%%%%%%%%%
357%%
358%% Returns a list of {Name,Location}, where Location is {spill,M}
359%%
360%% Note: we use pessimistic coloring here.
361%% - we could use optimistic coloring: for spilled node, check if there is
362%%   an unused color among the neighbors and choose that.
363
364select(Stk, IG, PhysRegs, NumNodes) ->
365  select_colors(Stk, IG, none_colored(NumNodes), PhysRegs).
366
367select_colors([], _IG, _Cols, _PhysRegs) ->
368  ?report("all nodes colored~n", []),
369  {[], 0};
370select_colors([{X,colorable}|Xs], IG, Cols, PhysRegs) ->
371  ?report("color of ~p\n", [X]),
372  {Slot,NewCols} = select_color(X, IG, Cols, PhysRegs),
373  ?report("~p~n", [Slot]),
374  {Tail, MaxColor} = select_colors(Xs, IG, NewCols, PhysRegs),
375  NewMaxColor = erlang:max(Slot, MaxColor),
376  %% Since we are dealing with spills we label all our temporaries accordingly.
377  {[{X,{spill,Slot}} | Tail], NewMaxColor}.
378
379select_color(X, IG, Cols, PhysRegs) ->
380  UsedColors = get_colors(neighbors(X, IG), Cols),
381  Preferences = get_colors(move_connected(X, IG), Cols),
382  Reg = select_unused_color(UsedColors, Preferences, PhysRegs),
383  {Reg, set_color(X, Reg, Cols)}.
384
385%%%%%%%%%%%%%%%%%%%%
386
387get_colors([], _Cols) -> [];
388get_colors([X|Xs], Cols) ->
389  case color_of(X, Cols) of
390    uncolored ->
391      get_colors(Xs, Cols);
392    {color, R} ->
393      [R|get_colors(Xs, Cols)]
394  end.
395
396select_unused_color(UsedColors, Preferences, PhysRegs) ->
397  Summary = ordsets:from_list(UsedColors),
398  case ordsets:subtract(ordsets:from_list(Preferences), Summary) of
399    [PreferredColor|_] -> PreferredColor;
400    _ ->
401      AvailRegs = ordsets:to_list(ordsets:subtract(PhysRegs, Summary)),
402      hd(AvailRegs)
403  end.
404
405push_colored(X, Stk) ->
406  [{X, colorable} | Stk].
407
408low_degree_nodes([], _K) -> [];
409low_degree_nodes([{N,Info}|Xs], K) ->
410  ?report0("node ~p has degree ~p: ~w~n", [N, degree(Info), neighbors(Info)]),
411  Deg = degree(Info),
412  if
413    Deg < K ->
414      [N|low_degree_nodes(Xs, K)];
415    true ->
416      low_degree_nodes(Xs, K)
417  end.
418
419%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
420
421unvisited_neighbors(X, Vis, IG) ->
422  ordsets:from_list(unvisited(neighbors(X, IG), Vis)).
423
424unvisited([], _Vis) -> [];
425unvisited([X|Xs], Vis) ->
426  case is_visited(X, Vis) of
427    true ->
428      unvisited(Xs, Vis);
429    false ->
430      [X|unvisited(Xs, Vis)]
431  end.
432
433%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
434%%
435%% *** ABSTRACT DATATYPES ***
436%%
437%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
438
439%%
440%% The stack slot datatype
441%%
442
443init_stackslots(NumSlots) ->
444  init_stackslots(NumSlots, []).
445
446init_stackslots(0, Acc) ->
447  Acc;
448init_stackslots(NumSlots, Acc) ->
449  init_stackslots(NumSlots - 1, [NumSlots|Acc]).
450
451%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
452%%
453%% The ig datatype:
454%%
455%% Note: if we know the number of temps used, we can use a VECTOR
456%% instead, which will speed up things.
457%%
458%% Note: later on, we may wish to add 'move-related' support.
459
460-record(ig_info, {
461	  neighbors = []      :: [_],
462	  degree = 0          :: non_neg_integer(),
463	  move_connected = [] :: [_]
464	 }).
465
466empty_ig(NumNodes) ->
467  hipe_vectors:new(NumNodes, #ig_info{}).
468
469degree(Info) ->
470  Info#ig_info.degree.
471
472neighbors(Info) ->
473  Info#ig_info.neighbors.
474
475move_connected(Info) ->
476  Info#ig_info.move_connected.
477
478add_edge(X, X, IG) -> IG;
479add_edge(X, Y, IG) ->
480  add_arc(X, Y, add_arc(Y, X, IG)).
481
482add_move(X, X, IG) -> IG;
483add_move(X, Y, IG) ->
484  add_move_arc(X, Y, add_move_arc(Y, X, IG)).
485
486add_arc(X, Y, IG) ->
487  Info = hipe_vectors:get(IG, X),
488  Old = neighbors(Info),
489  New = Info#ig_info{neighbors = [Y|Old]},
490  hipe_vectors:set(IG,X,New).
491
492add_move_arc(X, Y, IG) ->
493  Info = hipe_vectors:get(IG, X),
494  Old = move_connected(Info),
495  New = Info#ig_info{move_connected = [Y|Old]},
496  hipe_vectors:set(IG,X,New).
497
498normalize_ig(IG) ->
499  Size = hipe_vectors:size(IG),
500  normalize_ig(Size-1, IG).
501
502normalize_ig(-1, IG) ->
503  IG;
504normalize_ig(I, IG) ->
505  Info = hipe_vectors:get(IG, I),
506  N = ordsets:from_list(neighbors(Info)),
507  M = ordsets:subtract(ordsets:from_list(move_connected(Info)), N),
508  NewInfo = Info#ig_info{neighbors = N, degree = length(N), move_connected = M},
509  NewIG = hipe_vectors:set(IG, I, NewInfo),
510  normalize_ig(I-1, NewIG).
511
512neighbors(X, IG) ->
513  Info = hipe_vectors:get(IG, X),
514  Info#ig_info.neighbors.
515
516move_connected(X, IG) ->
517  Info = hipe_vectors:get(IG, X),
518  Info#ig_info.move_connected.
519
520decrement_degree(X, IG) ->
521  Info = hipe_vectors:get(IG, X),
522  Degree = degree(Info),
523  NewDegree = Degree-1,
524  NewInfo = Info#ig_info{degree = NewDegree},
525  {NewDegree, hipe_vectors:set(IG, X, NewInfo)}.
526
527list_ig(IG) ->
528  hipe_vectors:list(IG).
529
530%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
531%%
532%% The coloring datatype:
533
534none_colored(NumNodes) ->
535  hipe_vectors:new(NumNodes, uncolored).
536
537color_of(X, Cols) ->
538  hipe_vectors:get(Cols, X).
539
540set_color(X, R, Cols) ->
541  hipe_vectors:set(Cols, X, {color, R}).
542
543%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
544%%
545%% Note: there might be a slight gain in separating the two versions
546%% of visit/2 and visited/2. (So that {var,X} selects X and calls
547%% the integer version.
548
549none_visited(NumNodes) ->
550  hipe_vectors:new(NumNodes, false).
551
552visit(X, Vis) ->
553  hipe_vectors:set(Vis, X, true).
554
555is_visited(X, Vis) ->
556  hipe_vectors:get(Vis, X).
557
558%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
559%%
560%% *** INTERFACES TO OTHER MODULES ***
561%%
562
563labels(CFG, {TgtMod,TgtCtx}) ->
564  TgtMod:labels(CFG, TgtCtx).
565
566liveout(CFG, L, Target={TgtMod,TgtCtx}) ->
567  ordsets:from_list(reg_names(TgtMod:liveout(CFG, L, TgtCtx), Target)).
568
569bb(CFG, L, {TgtMod,TgtCtx}) ->
570   hipe_bb:code(TgtMod:bb(CFG, L, TgtCtx)).
571
572def_use(X, Target={TgtMod,TgtCtx}, TempMap) ->
573  Defines = [Y || Y <- reg_names(TgtMod:defines(X,TgtCtx), Target),
574		  hipe_temp_map:is_spilled(Y, TempMap)],
575  Uses = [Z || Z <- reg_names(TgtMod:uses(X,TgtCtx), Target),
576	       hipe_temp_map:is_spilled(Z, TempMap)],
577  {Defines, Uses}.
578
579reg_names(Regs, {TgtMod,TgtCtx}) ->
580  [TgtMod:reg_nr(X,TgtCtx) || X <- Regs].
581
582is_spill_move(Instr, {TgtMod,TgtCtx}) ->
583  TgtMod:is_spill_move(Instr, TgtCtx).
584