~ubuntu-branches/debian/squeeze/erlang/squeeze

« back to all changes in this revision

Viewing changes to lib/hipe/opt/hipe_spill_minimize.erl

  • Committer: Bazaar Package Importer
  • Author(s): Erlang Packagers, Sergei Golovan
  • Date: 2006-12-03 17:07:44 UTC
  • mfrom: (2.1.11 feisty)
  • Revision ID: james.westby@ubuntu.com-20061203170744-rghjwupacqlzs6kv
Tags: 1:11.b.2-4
[ Sergei Golovan ]
Fixed erlang-base and erlang-base-hipe prerm scripts.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
%% -*- erlang-indent-level: 2 -*-
2
 
%% ==========================================================================
3
 
%% Copyright (c) 2002 by Niklas Andersson, Andreas Lundin and Erik Johansson.
4
 
%% ==========================================================================
5
 
%%  Filename :  hipe_spill_minimize.erl
6
 
%%  Module   :  hipe_spill_minimize
7
 
%%  Purpose  :  Optimizes the number of stack slots used by using a
8
 
%%              "linear-scan algorithm" to allocate stack slots.
9
 
%%  Notes    :  * This is a simplified implementation of 
10
 
%%                "Linear Scan Register Allocation" by 
11
 
%%                Massimiliano Poletto & Vivek Sarkar described in
12
 
%%                ACM TOPLAS Vol 21, No 5, September 1999.
13
 
%%
14
 
%%              * This implementation is target-independent and
15
 
%%                requires a target specific interface module
16
 
%%                as argument.  
17
 
%% 
18
 
%%              * Based on the hipe_ls_regalloc module by Erik Johansson
19
 
%%
20
 
%%              
21
 
%%  History  :  * 2002-04-01 NA & AL: Created
22
 
%%              * 2002-10-08 Happi, Cleanup and speedup
23
 
%%
24
 
%% CVS:
25
 
%%    $Author: happi $
26
 
%%    $Date: 2002/10/10 06:18:29 $
27
 
%%    $Revision: 1.1 $
28
 
%% =====================================================================
29
 
%% Exported functions (short description):
30
 
%%   stackalloc(CFG,StackSlots,SpillIndex, Options, Target, TempMap) -> 
31
 
%%    {Coloring, NumberOfSpills}
32
 
%%    Takes a CFG and the TempMap from register allocation and returns 
33
 
%%    a coloring of stack slots.  
34
 
%%    StackSlots should be a list of used stack slots, usually empty at
35
 
%%    first call to function.
36
 
%%    SpillIndex is the the first position we will spill to, usually 0.
37
 
%%    TempMap is the TempMap from the register allocation
38
 
%%
39
 
%%    The Coloring will be in the form of the "allocation datastructure"
40
 
%%     described below, that is, a list of tuples on the form
41
 
%%      {Name, {spill, SpillIndex}}
42
 
%%    The NumberOfSpills is either 0 indicating no spill or the 
43
 
%%     SpillIndex of the last spilled register.
44
 
%%
45
 
%%  mapmerge
46
 
%%
47
 
%%
48
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
49
 
 
50
 
-module(hipe_spill_minimize).
51
 
-export([stackalloc/6, mapmerge/2, mapstrip/1]).
52
 
%-define(DEBUG,1).
53
 
-define(HIPE_INSTRUMENT_COMPILER, true).
54
 
-include("../main/hipe.hrl").
55
 
 
56
 
 
57
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
58
 
%%
59
 
%% stackalloc(CFG, StackSlots,  SpillIndex, Options, Target, TempMap) 
60
 
%%   Calculates an allocation of stack slots using a linear_scan algorithm.
61
 
%%   There are three steps in the algorithm:
62
 
%%    1. Calculate live-ranges for all spilled temporaries.
63
 
%%    2. Calculate live-intervals for each temporary.
64
 
%%       The live interval consists of a start position and a end position
65
 
%%       these are the first definition and last use of the temporary 
66
 
%%       given as instruction numbers in a breadth-first traversal of the
67
 
%%       control-flow-graph.
68
 
%%    3. Do a linear scan allocation over the live intervals.
69
 
%%
70
 
%%-  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -
71
 
stackalloc(CFG, StackSlots, SpillIndex, Options, Target, TempMap) ->
72
 
  ?debug_msg("LinearScan: ~w\n",[erlang:statistics(runtime)]),
73
 
  %%     Step 1: Calculate liveness (Call external implementation.)
74
 
  Liveness = liveness(CFG, Target),
75
 
  ?debug_msg("liveness (done)~w\n",[erlang:statistics(runtime)]),
76
 
  USIntervals = calculate_intervals(CFG, Liveness,
77
 
                                     Options,
78
 
                                    Target, TempMap),
79
 
  %% ?debug_msg("intervals (done) ~w\n",[erlang:statistics(runtime)]),
80
 
  Intervals = sort_on_start(USIntervals),
81
 
  ?debug_msg("sort intervals (done) ~w\n",[erlang:statistics(runtime)]),
82
 
  ?debug_msg("Intervals ~w\n",[Intervals]),
83
 
  ?debug_msg("No intervals: ~w\n",[length(Intervals)]),
84
 
  %% --> remove io:format("Intervals: ~p\n", [Intervals]),
85
 
 
86
 
  ?debug_msg("count intervals (done) ~w\n",[erlang:statistics(runtime)]),
87
 
  Allocation = allocate(Intervals,StackSlots, SpillIndex,  Target),
88
 
  ?debug_msg("allocation (done) ~w\n",[erlang:statistics(runtime)]),
89
 
  Allocation.
90
 
 
91
 
%%^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
92
 
 
93
 
 
94
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
95
 
%%                                                                    %%
96
 
%%        Step 2: Calculate live-intervals for each temporary.        %%
97
 
%%                                                                    %%
98
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
99
 
 
100
 
%%-  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -
101
 
%% calculate_intervals(CFG,Liveness, Options, Target, TempMap)
102
 
%%  CFG: The Control-Flow Graph.
103
 
%%  Liveness: A map of live-in and live-out sets for each Basic-Block.
104
 
%%  TempMap: The TempMap from the register allocation
105
 
%%
106
 
%%  This function will only consider the intervals of the temporaries
107
 
%%  that have been spilled during register allocation, and will ignore 
108
 
%%  all other.
109
 
%%-  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -
110
 
calculate_intervals(CFG,Liveness, _Options, Target, TempMap) ->
111
 
  Interval = empty_interval(Target:number_of_temporaries(CFG)),
112
 
 
113
 
  Worklist = Target:reverse_postorder(CFG),
114
 
 
115
 
  intervals(Worklist, Interval, 1, 
116
 
            CFG, Liveness, 
117
 
            succ_map(CFG, Target), 
118
 
            Target, TempMap).
119
 
 
120
 
%%-  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -
121
 
%% intervals(WorkList, Intervals, InstructionNr,
122
 
%%           CFG, Liveness, SuccMap, TempMap)
123
 
%%  WorkList: List of BB-names to handle.
124
 
%%  Intervals: Intervals seen so far (sorted on register names).
125
 
%%  InstructionNr: The number of examined insturctions.
126
 
%%  CFG: The Control-Flow Graph.
127
 
%%  Liveness: A map of live-in and live-out sets for each Basic-Block.
128
 
%%  SuccMap: A map of successors for each BB name.
129
 
%%  TempMap: The TempMap from the register allocation
130
 
%%
131
 
%%  This function will only consider the intervals of the temporaries
132
 
%%  that have been spilled during register allocation, and will ignore 
133
 
%%  all other.
134
 
%%-  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -
135
 
intervals([L|ToDO],Intervals,InstructionNr,CFG,Liveness,SuccMap, Target, 
136
 
          TempMap) ->
137
 
 
138
 
  ?debug_msg("Block ~w\n",[L]),
139
 
  %% Add all variables that are live at the entry of this block
140
 
  %% to the interval data structure.
141
 
 
142
 
  %% Only consider spilled temporaries in LiveIn
143
 
  LiveIn = [ X || X <- livein(Liveness, L, Target), 
144
 
                   hipe_temp_map:is_spilled(X, TempMap)] ,
145
 
 
146
 
  Intervals2 = add_def_point(LiveIn,InstructionNr,Intervals),
147
 
 
148
 
  %% Only consider spilled temporaries in LiveOut
149
 
  LiveOut = [ X2 || X2 <- liveout(Liveness, L, Target), 
150
 
                   hipe_temp_map:is_spilled(X2, TempMap)] ,
151
 
 
152
 
%%  io:format("LiveIn: ~w\n", [LiveIn]),
153
 
%%  io:format("LiveOut: ~w\n", [LiveOut]),
154
 
 
155
 
  ?debug_msg("In ~w -> Out ~w\n",[LiveIn, LiveOut]),
156
 
 
157
 
  %% Traverse this block instruction by instruction and add all
158
 
  %% uses and defines to the intervals.
159
 
  Code = hipe_bb:code(bb(CFG,L, Target)),
160
 
  {Intervals3, NewINr} = traverse_block(Code, InstructionNr+1,
161
 
                                        Intervals2,
162
 
                                        Target,
163
 
                                        TempMap),
164
 
  
165
 
  %% Add end points for the temporaries that are in the live-out set.
166
 
  Intervals4 = add_use_point(LiveOut, NewINr+1, Intervals3),
167
 
  
168
 
  intervals(ToDO, Intervals4, NewINr+1, CFG, Liveness, SuccMap, Target, 
169
 
            TempMap);
170
 
 
171
 
intervals([],Intervals,_,_,_,_,_,_) -> 
172
 
  %% Return the calculated intervals
173
 
  interval_to_list(Intervals).
174
 
  %% Intervals.
175
 
 
176
 
%%-  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -
177
 
%% traverse_block(Code, InstructionNo, Intervals, Unchanged) 
178
 
%%  Examine each instruction in the Code:
179
 
%%   For each temporary T used or defined by instruction number N:
180
 
%%    extend the interval of T to include N.
181
 
%%  TempMap: The TempMap from the register allocation
182
 
%%
183
 
%%  This function will only consider the the instruction that have temporaries
184
 
%%  that have been spilled during register allocation, and will ignore 
185
 
%%  all other.
186
 
%%-  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -
187
 
 
188
 
traverse_block([Instruction|Is],InstrNo,Intervals, Target, TempMap) ->
189
 
 
190
 
  %% Get used temps.
191
 
  %% Only consider spilled temporaries in the Use set.
192
 
  UsesSet = [ X || X <- uses(Instruction, Target), 
193
 
                   hipe_temp_map:is_spilled(X, TempMap)] ,
194
 
 
195
 
  %% Get defined temps.
196
 
  %% Only consider spilled temporaries in the Def set.
197
 
  DefsSet = [ X2 || X2 <- defines(Instruction, Target), 
198
 
                   hipe_temp_map:is_spilled(X2, TempMap)] ,
199
 
 
200
 
  %% Only consider those temps that starts or ends their lifetime 
201
 
  %%  within the basic block (that is remove all Unchanged temps).
202
 
 
203
 
  Intervals1 = add_def_point( DefsSet, InstrNo, Intervals),
204
 
 
205
 
  %% Extend the intervals for these temporaries to include InstrNo.
206
 
  Intervals2 = add_use_point(UsesSet, InstrNo, Intervals1),
207
 
 
208
 
  %% Handle the next instruction.
209
 
  traverse_block(Is,InstrNo+1,Intervals2, Target, TempMap);
210
 
 
211
 
 
212
 
traverse_block([], InstrNo, Intervals, _, _) -> 
213
 
  %% Return the new intervals and the number of the next instruction.
214
 
 
215
 
  {Intervals,InstrNo}.
216
 
 
217
 
%%^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
218
 
 
219
 
 
220
 
 
221
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
222
 
%%                                                                    %%
223
 
%%    Step 3. Do a linear scan allocation over the live intervals.    %%
224
 
%%                                                                    %%
225
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
226
 
 
227
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
228
 
%%
229
 
%% allocate(Intervals, PhysicalRegisters,  Target)
230
 
%%
231
 
%% This function performs the linear scan algorithm.
232
 
%%  Intervals contains the start and stop position of each spilled temporary,
233
 
%%            sorted on increasing startpositions
234
 
%%  StackSlots is a list of available Stack slots to use. If they run out a
235
 
%%  new stack slot is allocated from an (in theory) infinite domain.
236
 
%%
237
 
%%-  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -
238
 
allocate(Intervals, StackSlots, SpillIndex,  Target) ->
239
 
  ActiveTemps =[],
240
 
  AllocatedSlots = empty_allocation(),
241
 
  allocate(Intervals, StackSlots, ActiveTemps,
242
 
           AllocatedSlots, SpillIndex,  Target).
243
 
 
244
 
%%-  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -
245
 
%% allocate(Intervals, Free, Active, Allocated, SpillIndex, Target) 
246
 
%%  Iterates on each temporary interval.
247
 
%%   Intervals: The list of temporary intervals.
248
 
%%   Free: Currently available stack slots.
249
 
%%   Active: Currently used stack slots (sorted on increasing 
250
 
%%            interval enpoints)
251
 
%%   Allocated: The mapping of register names to spill positions.
252
 
%%   SpillIndex: The number of spilled registers. 
253
 
%%-  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -
254
 
allocate([TempInt|TIS], Free, Active, Alloc, SpillIndex,  Target) ->
255
 
  %% Remove from the active list those temporaries who's intervals 
256
 
  %% ends before the start of the current interval.
257
 
  {NewActive, NewFree} = 
258
 
    expire_old_intervals(Active, startpoint(TempInt), Free, Target),
259
 
  
260
 
  %% Get the name of the temp in the current interval.
261
 
  Temp = reg(TempInt), 
262
 
 
263
 
  case NewFree of 
264
 
    [] -> 
265
 
      %% There are no free spill slots, so we allocate a new one
266
 
      NewSpillIndex = SpillIndex+1,
267
 
      NewAlloc = spillalloc( Temp, SpillIndex, Alloc ),
268
 
      NewActive2 = add_active(endpoint(TempInt), SpillIndex, 
269
 
                              NewActive),
270
 
 
271
 
      allocate(TIS, NewFree, NewActive2, NewAlloc, NewSpillIndex,
272
 
                Target);
273
 
    
274
 
    [FreeSpillslot | Spillslots] -> 
275
 
      %% The spill slot FreeSpillSlot is available, let's use it.
276
 
      allocate(TIS,Spillslots,
277
 
               add_active(endpoint(TempInt), FreeSpillslot, NewActive),
278
 
               spillalloc(Temp, FreeSpillslot, Alloc),
279
 
               SpillIndex, Target)
280
 
  
281
 
  end;
282
 
allocate([],_,_,Alloc,SpillIndex, _) -> 
283
 
  %% No more register intervals to handle
284
 
  %%  return the result sorted on regnames.
285
 
  {lists:sort(Alloc), SpillIndex}.
286
 
 
287
 
 
288
 
%%^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
289
 
 
290
 
 
291
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
292
 
%%
293
 
%% expire_old_intervals(ActiveTemps, CurrentPos, FreeRegisters) 
294
 
%%   Remove all temporaries that have live-ranges that ends before the
295
 
%%   current position from the active list and put them into the free
296
 
%%   list instead.
297
 
%%
298
 
%% ---------------------------------------------------------------------
299
 
expire_old_intervals([Active|Actives], CurrentPos, Free, Target) ->
300
 
  %% Does the live-range of the first active register end before 
301
 
  %% the current position?
302
 
 
303
 
  %% We expand multimove before regalloc, ignore the next 2 lines.
304
 
  %%  %% We don't free registers that end at the current position,
305
 
  %%  %%  since a multimove can decide to do the moves in another order...
306
 
  case active_endpoint(Active) =< CurrentPos of
307
 
    true -> %% Yes -> Then we can free that register.
308
 
      Spillslot = active_spillslot(Active),
309
 
      %% Add the spillslot to the free pool.
310
 
      NewFree = [Spillslot|Free],
311
 
      %% Here we could try appending the
312
 
      %% register to get a more widespread
313
 
      %% use of registers.
314
 
      %% Free ++ [active_spillslot(Active)]);
315
 
      expire_old_intervals(Actives, CurrentPos, NewFree, Target);
316
 
    false -> 
317
 
      %% No -> Then we cannot free any more temporaries.
318
 
      %%       (Since they are sorted on endpoints...)    
319
 
      {[Active|Actives],Free}
320
 
  end;
321
 
expire_old_intervals([],_,Free,_) ->
322
 
  {[],Free}.
323
 
 
324
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
325
 
%%                                                                    %%
326
 
%%                   D A T A   S T R U C T U R E S                    %%
327
 
%%                                &                                   %%
328
 
%%               A U X I L I A R Y   F U N C T I O N S                %%
329
 
%%                                                                    %%
330
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
331
 
 
332
 
 
333
 
 
334
 
 
335
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
336
 
%%
337
 
%% The "allocation datastructure"
338
 
%%
339
 
%% This is an order list of register names paired with their allocations.
340
 
%%  {Name, Allocation}
341
 
%% Since we are only dealing with spills, the allocation will look like:
342
 
%%  {spill, SpillIndex}
343
 
%%
344
 
%% ---------------------------------------------------------------------
345
 
empty_allocation() -> [].
346
 
spillalloc(Name,N,Allocation) ->
347
 
  [{Name,{spill,N}}|Allocation].
348
 
 
349
 
%spillalloc(Name,N,[{Name,_}|A]) ->
350
 
%  ?debug_msg("Spilled ~w\n",[Name]),
351
 
%  [{Name,{spill,N}}|A];
352
 
%spillalloc(Name,N,[{Name2,Binding}|Bindings]) when Name > Name2 ->
353
 
%  [{Name2,Binding}|spillalloc(Name,N,Bindings)];
354
 
%spillalloc(Name,N,Bindings) ->
355
 
%  [{Name,{spill,N}}|Bindings].
356
 
 
357
 
 
358
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
359
 
%% 
360
 
%%  The active datastructure.
361
 
%%   Keeps tracks of currently active (allocated) spill slots.
362
 
%%   It is sorted on end points in the intervals
363
 
%%
364
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
365
 
add_active(Endpoint, SpillSlot, [A1={P1,_}|Active]) 
366
 
  when P1 < Endpoint ->
367
 
  [A1|add_active(Endpoint, SpillSlot, Active)];
368
 
add_active(Endpoint, SpillSlot, Active) ->
369
 
  [{Endpoint, SpillSlot}|Active].
370
 
 
371
 
active_spillslot({_,SpillSlot}) ->
372
 
  SpillSlot.
373
 
active_endpoint({EndPoint,_}) ->
374
 
  EndPoint.
375
 
 
376
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
377
 
 
378
 
 
379
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
380
 
%% mapmerge( Map1, Map2 )
381
 
%%
382
 
%% Spillalloc will only return the subset of the tempmap that contains 
383
 
%% the spilled temporaries. This function is used to merge the old complete 
384
 
%% tempmap with the new spillinformation. 
385
 
%% Map1 is the old temp map
386
 
%% Map2 is the new "spill" map.
387
 
%% !! Warning, the function does not work with the maps in another order !! 
388
 
%%-  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -
389
 
 
390
 
%% Combines the map with allocated spills with a map from the
391
 
%% register allocator
392
 
 
393
 
mapmerge( Map1, Map2 ) ->
394
 
  mapmerge( Map1, Map2, [] ).
395
 
 
396
 
mapmerge( [], _, Ack ) ->
397
 
  lists:reverse( Ack );
398
 
 
399
 
mapmerge( [{T1, _}|T1s], [{T2, C}|T2s], Ack ) when T1 =:= T2 -> 
400
 
  mapmerge( T1s, T2s, [{T1, C}|Ack] );
401
 
 
402
 
mapmerge( [{_, unknown}|T1s], T2s, Ack) ->
403
 
  mapmerge(T1s, T2s, Ack);
404
 
 
405
 
mapmerge( [T1|T1s], T2s, Ack ) -> 
406
 
  mapmerge( T1s, T2s, [T1|Ack] ).
407
 
 
408
 
 
409
 
mapstrip(Map) ->
410
 
  mapstrip(Map, []).
411
 
 
412
 
mapstrip([], Map) ->
413
 
  lists:reverse(Map);
414
 
 
415
 
mapstrip([{_, unknown}| T], Map) ->
416
 
  mapstrip(T, Map);
417
 
 
418
 
mapstrip([H|T], Map) ->
419
 
  mapstrip(T, [H|Map]).
420
 
 
421
 
 
422
 
 
423
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
424
 
%% The Interval data structure.
425
 
%%
426
 
%%
427
 
%%-  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -
428
 
 
429
 
%mk_interval(Name, Start, End) ->
430
 
%  {Name, Start, End}.
431
 
 
432
 
endpoint({_R,_S,Endpoint}) ->
433
 
  Endpoint.
434
 
startpoint({_R,Startpoint,_E}) ->
435
 
  Startpoint.
436
 
reg({RegName,_S,_E}) ->
437
 
  RegName.
438
 
 
439
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
440
 
%% The Intervals data structure.
441
 
 
442
 
sort_on_start(I)->
443
 
 lists:keysort(2,I).
444
 
 
445
 
 
446
 
-ifdef(gb_intervals).
447
 
empty_interval(_) ->
448
 
  gb_trees:empty().
449
 
 
450
 
interval_to_list(Intervals) ->
451
 
  lists:flatten(
452
 
    lists:map(
453
 
      fun({T, I}) when list(I) ->
454
 
          lists:map(
455
 
            fun ({none, End}) -> 
456
 
                {T,End,End};
457
 
                ({Beg, none}) ->
458
 
                {T,Beg, Beg}
459
 
            end,
460
 
            I);
461
 
         ({T,{B,E}}) -> {T, B, E}
462
 
      end,
463
 
      gb_trees:to_list(Intervals))).
464
 
 
465
 
add_use_point([Temp|Temps],Pos,Intervals) ->
466
 
  %% Extend the old interval...
467
 
  NewInterval =
468
 
    case gb_trees:lookup(Temp, Intervals) of
469
 
      %% This temp has an old interval...
470
 
      {value, Value} ->
471
 
        %% ... extend it.
472
 
        extend_interval(Pos, Value);
473
 
 
474
 
      %% This is the first time we see this temp...
475
 
      none ->
476
 
        %% ... create a new interval
477
 
        {Pos, Pos}
478
 
    end,
479
 
 
480
 
  %% Add or update the extended interval.
481
 
  Intervals2 = gb_trees:enter(Temp, NewInterval, Intervals),
482
 
 
483
 
  %% Add the rest of teh temporaries.
484
 
  add_use_point(Temps, Pos, Intervals2);
485
 
 
486
 
add_use_point([], _, I) ->
487
 
  %% No more to add return the interval.
488
 
  I.
489
 
 
490
 
add_def_point([Temp|Temps],Pos,Intervals) ->
491
 
  %% Extend the old interval...
492
 
  NewInterval =
493
 
    case gb_trees:lookup(Temp, Intervals) of
494
 
      %% This temp has an old interval...
495
 
      {value, Value} ->
496
 
        %% ... extend it.
497
 
        extend_interval(Pos, Value);
498
 
 
499
 
      %% This is the first time we see this temp...
500
 
      none ->
501
 
        %% ... create a new interval
502
 
        {Pos, Pos}
503
 
    end,
504
 
 
505
 
  %% Add or update the extended interval.
506
 
  Intervals2 = gb_trees:enter(Temp, NewInterval, Intervals),
507
 
 
508
 
  %% Add the rest of the temporaries.
509
 
  add_def_point(Temps, Pos, Intervals2);
510
 
 
511
 
add_def_point([], _, I) ->
512
 
  %% No more to add return the interval.
513
 
  I.
514
 
 
515
 
extend_interval(Pos, {Beginning, End}) ->
516
 
  %% If this position occures before the beginning
517
 
  %%  of the interval, then extend the beginning to
518
 
  %%  this position.
519
 
 
520
 
  NewBeginning = 
521
 
    if Pos < Beginning -> Pos;
522
 
       true            -> Beginning
523
 
    end,
524
 
  %% If this position occures after the end
525
 
  %%  of the interval, then extend the end to
526
 
  %%  this position.
527
 
  NewEnd = 
528
 
    if Pos > End -> Pos;
529
 
       true      -> End
530
 
    end,
531
 
 
532
 
  {NewBeginning, NewEnd}.
533
 
 
534
 
extend_def_interval(Pos, {Beginning, End}) ->
535
 
  %% If this position occures before the beginning
536
 
  %%  of the interval, then extend the beginning to
537
 
  %%  this position.
538
 
 
539
 
  NewBeginning = 
540
 
    if Pos < Beginning -> Pos;
541
 
       true            -> Beginning
542
 
    end,
543
 
  %% If this position occures after the end
544
 
  %%  of the interval, then extend the end to
545
 
  %%  this position.
546
 
  NewEnd = 
547
 
    if Pos > End -> Pos;
548
 
       true      -> End
549
 
    end,
550
 
  {NewBeginning, NewEnd}; 
551
 
extend_def_interval(Pos, [{Beginning,none}|More]) ->
552
 
  [{Pos,none}, {Beginning,none}|More];
553
 
extend_def_interval(Pos, Intervals) ->
554
 
  {Pos, Pos}.
555
 
 
556
 
%% ____________________________________________________________________
557
 
-else. %% isdef gb_intervals
558
 
 
559
 
empty_interval(N) ->
560
 
  vector:from_list( lists:duplicate(N,none)).
561
 
 
562
 
interval_to_list(Intervals) ->
563
 
  add_indices(vector:to_list(Intervals),0).
564
 
 
565
 
add_indices([{B,E}|Xs],N) ->
566
 
  [{N,B,E}|add_indices(Xs,N+1)];
567
 
add_indices([List|Xs],N) when list(List) ->
568
 
  flatten(List,N,Xs);
569
 
add_indices([none|Xs],N) ->
570
 
  add_indices(Xs,N+1);
571
 
add_indices([],_N) -> [].
572
 
 
573
 
flatten([{none, End}|Rest], N, More) -> 
574
 
  [{N,End,End} | flatten(Rest, N, More)];
575
 
flatten([{Beg, none}|Rest], N ,More) ->
576
 
  [{N,Beg,Beg} | flatten(Rest, N, More)];
577
 
flatten([],N,More) ->
578
 
  add_indices(More,N+1).
579
 
 
580
 
 
581
 
 
582
 
 
583
 
add_use_point([Temp|Temps],Pos,Intervals) ->
584
 
  %% Extend the old interval...
585
 
  NewInterval =
586
 
    case vector:get(Temp+1, Intervals) of
587
 
      %% This is the first time we see this temp...
588
 
      none ->
589
 
        %% ... create a new interval
590
 
        {Pos, Pos};
591
 
      %% This temp has an old interval...
592
 
      Value ->
593
 
        %% ... extend it.
594
 
        extend_interval(Pos, Value)
595
 
    end,
596
 
 
597
 
  %% Add or update the extended interval.
598
 
  Intervals2 = vector:set(Temp+1, Intervals, NewInterval),
599
 
 
600
 
  %% Add the rest of the temporaries.
601
 
  add_use_point(Temps, Pos, Intervals2);
602
 
 
603
 
add_use_point([], _, I) ->
604
 
  %% No more to add return the interval.
605
 
  I.
606
 
 
607
 
add_def_point([Temp|Temps],Pos,Intervals) ->
608
 
  %% Extend the old interval...
609
 
  NewInterval =
610
 
    case vector:get(Temp+1, Intervals) of
611
 
      %% This is the first time we see this temp...
612
 
      none ->
613
 
        %% ... create a new interval
614
 
        {Pos, Pos};
615
 
      %% This temp has an old interval...
616
 
      Value ->
617
 
        %% ... extend it.
618
 
        extend_interval(Pos, Value)
619
 
    end,
620
 
 
621
 
  %% Add or update the extended interval.
622
 
  Intervals2 = vector:set(Temp+1, Intervals, NewInterval), 
623
 
 
624
 
  %% Add the rest of teh temporaries.
625
 
  add_def_point(Temps, Pos, Intervals2);
626
 
 
627
 
add_def_point([], _, I) ->
628
 
  %% No more to add return the interval.
629
 
  I.
630
 
 
631
 
extend_interval(Pos, {Beginning, End}) ->
632
 
  %% If this position occures before the beginning
633
 
  %%  of the interval, then extend the beginning to
634
 
  %%  this position.
635
 
 
636
 
  NewBeginning = 
637
 
    if Pos < Beginning -> Pos;
638
 
       true            -> Beginning
639
 
    end,
640
 
 
641
 
  %% If this position occures after the end
642
 
  %%  of the interval, then extend the end to
643
 
  %%  this position.
644
 
  NewEnd = 
645
 
    if Pos > End -> Pos;
646
 
       true      -> End
647
 
    end,
648
 
 
649
 
  {NewBeginning, NewEnd}.
650
 
 
651
 
 
652
 
-endif. %% gb_intervals
653
 
 
654
 
 
655
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
656
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
657
 
%%
658
 
%% Interface to external functions.
659
 
%% 
660
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
661
 
 
662
 
succ_map(CFG, Target) ->
663
 
  Target:succ_map(CFG).
664
 
 
665
 
liveness(CFG, Target) ->
666
 
   Target:analyze(CFG).
667
 
 
668
 
bb(CFG, L, Target) ->
669
 
  Target:bb(CFG,L).
670
 
 
671
 
livein(Liveness,L, Target) ->
672
 
  regnames(Target:livein(Liveness,L), Target).
673
 
 
674
 
liveout(Liveness,L, Target)->
675
 
  regnames(Target:liveout(Liveness,L), Target).
676
 
 
677
 
uses(I, Target)->
678
 
  regnames(Target:uses(I), Target).
679
 
 
680
 
defines(I, Target) ->
681
 
  regnames(Target:defines(I), Target).
682
 
 
683
 
regnames(AllRegs, Target) ->
684
 
  Regs = 
685
 
    case Target of
686
 
      hipe_sparc_specific ->
687
 
        hipe_sparc:keep_registers(AllRegs);
688
 
      hipe_sparc_specific_fp->
689
 
        hipe_sparc:keep_fp_registers(AllRegs);
690
 
      _ ->
691
 
        AllRegs
692
 
    end,
693
 
   [Target:reg_nr(X) || X <- Regs]. 
694