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

« back to all changes in this revision

Viewing changes to lib/hipe/icode/hipe_icode_fp.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:
5
5
%%%               Mapping to fp variables and creation of fp ebbs.
6
6
%%%
7
7
%%% Created : 23 Apr 2003 by Tobias Lindahl <tobiasl@it.uu.se>
 
8
%%%
 
9
%%% CVS      :
 
10
%%%              $Author: kostis $
 
11
%%%              $Date: 2006/07/24 22:12:25 $
 
12
%%%              $Revision: 1.33 $
8
13
%%%-------------------------------------------------------------------
 
14
 
9
15
-module(hipe_icode_fp).
10
16
 
11
 
-export([cfg/1,
12
 
         cfg/2]).
13
 
 
14
 
-export([print_state_info/1]).
15
 
 
16
 
-import(erl_types, [
17
 
                    t_any/0,
18
 
                    t_float/0,
19
 
                    t_from_term/1,
20
 
                    t_inf/2,
21
 
                    t_is_any/1,
22
 
                    t_is_float/1,
23
 
                    t_sup/2,
24
 
                    t_to_string/1,
25
 
                    t_undefined/0]).
 
17
-export([cfg/1]).
 
18
 
 
19
-include("hipe_icode.hrl").
 
20
 
 
21
-record(state, {info, block_map, edge_map, cfg}).
26
22
 
27
23
cfg(Cfg) ->
28
24
  %%hipe_icode_cfg:pp(Cfg),
29
 
  State = analyse(Cfg),
30
 
  %%print_state_info(State),
 
25
  NewCfg = annotate_fclearerror(Cfg),
 
26
  State = new_state(NewCfg),
31
27
  NewState = place_fp_blocks(State),
32
 
  NewCfg = state__cfg(NewState),
33
 
  %%hipe_icode_cfg:pp(NewCfg),
34
 
  NewCfg.
 
28
  %%hipe_icode_cfg:pp(state__cfg(NewState)),
 
29
  NewState2 = finalize(NewState),
 
30
  NewCfg1 = state__cfg(NewState2),
 
31
  %%hipe_icode_cfg:pp(NewCfg1),
 
32
  NewCfg2 = unannotate_fclearerror(NewCfg1),
35
33
 
36
 
cfg(Cfg, InfoMap) ->
37
 
  State = new_state(Cfg, InfoMap),
38
 
  NewState = place_fp_blocks(State),
39
 
  NewCfg = state__cfg(NewState),
40
 
  %%hipe_icode_cfg:pp(NewCfg),
41
 
  NewCfg.
 
34
  NewCfg2.
42
35
 
43
36
%%____________________________________________________________
44
37
%%
45
 
%% Single pass analysis that only focus on floats.
 
38
%% Annotate fclearerror with information of the fail label of the
 
39
%% corresponding fcheckerror.
46
40
%%
47
41
 
48
 
analyse(Cfg)->
49
 
  State = new_state(Cfg),
50
 
  Labels = hipe_icode_cfg:reverse_postorder(Cfg),
51
 
  analyse_blocks(Labels, State).
52
 
 
53
 
analyse_blocks(Labels, State)->
54
 
  analyse_blocks(Labels, Labels, State).
55
 
 
56
 
analyse_blocks(Labels, [Label|Left], State)->
57
 
  Info = state__info_in(State, Label),
58
 
  NewState = analyse_block(Label, Info, State),
59
 
  analyse_blocks(Labels, Left, NewState);
60
 
analyse_blocks(_Labels, [], State) ->
61
 
  State.
62
 
 
63
 
analyse_block(Label, InfoIn, State)->
64
 
  %%io:format("Handling ~w\n", [Label]),
65
 
  BB = state__bb(State, Label),
66
 
  Code = hipe_bb:code(BB),
67
 
  Last = hipe_bb:last(BB),
68
 
  NewInfoIn = analyse_insns(Code, InfoIn),
69
 
  NewState = state__info_out_update(State, Label, NewInfoIn),
70
 
 
71
 
  case hipe_icode:type(Last) of
72
 
    type ->
73
 
      UpdateInfo = do_type(Last, NewInfoIn),
74
 
      %%io:format("Update info for ~w:\n~w", [Label, UpdateInfo]),
75
 
      do_updates(NewState, UpdateInfo);
76
 
    _ ->
77
 
      UpdateInfo = [{X, NewInfoIn}||X<-state__succ(NewState, Label)],
78
 
      %%io:format("Update info for ~w:\n~w", [Label, UpdateInfo]),
79
 
      do_updates(NewState, UpdateInfo)
80
 
  end.
81
 
 
82
 
analyse_insns([I|Insns], Info)->
83
 
  NewInfo = 
84
 
    case hipe_icode:type(I) of
85
 
      mov ->
86
 
        do_mov(I, Info);
87
 
      call ->
88
 
        do_call(I, Info);
89
 
      phi ->
90
 
        Type = join_list(uses(I), Info),
91
 
        enter_defines(I, Type, Info);
92
 
      _ ->
93
 
        enter_defines(I, t_any(), Info)
94
 
    end,
95
 
  analyse_insns(Insns, NewInfo);  
96
 
analyse_insns([], Info) ->
97
 
  Info.
98
 
 
99
 
do_mov(I, Info)->
100
 
  %% Can't use uses/1 since we must keep constants.
101
 
  Src = hipe_icode:mov_src(I), 
102
 
  case const_type(Src) of
103
 
    not_a_constant ->
104
 
      %% Make the destination point to the source.
105
 
      enter_defines(I, Src, Info);
106
 
    ConstType ->
107
 
      enter_defines(I, ConstType, Info)
108
 
  end.
109
 
 
110
 
do_call(I, Info)->
111
 
  case hipe_icode:call_type(I) of
112
 
    remote ->
113
 
      case hipe_icode:call_fun(I) of
114
 
        {M, F, A} ->
115
 
          ArgTypes = lookup_type_list(uses(I), Info),
116
 
          Type = erl_bif_types:type(M, F, A, ArgTypes),
117
 
          enter_defines(I, Type, Info);
118
 
        _ ->
119
 
          Info
120
 
      end;
121
 
    local ->
122
 
      case lists:keysearch(dst_type, 1, hipe_icode:info(I)) of
123
 
        false ->
124
 
          enter_defines(I, t_any(), Info);
125
 
        {value,{_, [Type]}}->
126
 
          enter_defines(I, Type, Info)
127
 
      end;
128
 
    primop ->
129
 
      Fun = hipe_icode:call_fun(I),
130
 
      ArgType = lookup_type_list(uses(I), Info),
131
 
      DstType = hipe_rtl_primops:type(Fun, ArgType),
132
 
      enter_defines(I, DstType, Info)
133
 
  end.
134
 
 
135
 
do_type(I, Info)->
136
 
  [Var] = uses(I),
137
 
  VarInfo = lookup_type(I, Info),
138
 
  TrueLab = hipe_icode:type_true_label(I),
139
 
  FalseLab = hipe_icode:type_false_label(I),
140
 
  
141
 
  case hipe_icode:type_type(I) of
142
 
    float ->
143
 
      TrueType = t_inf(t_float(), VarInfo),
144
 
      TrueInfo = enter(Var, TrueType, Info),
145
 
      FalseInfo = enter(Var, t_any(), Info),
146
 
      [{TrueLab, TrueInfo}, {FalseLab, FalseInfo}];
147
 
    _ ->
148
 
      [{TrueLab, Info}, {FalseLab, Info}]
149
 
  end.
150
 
 
151
 
do_updates(State, [{Label, Info}|Tail])->
152
 
  case state__info_in_update(State, Label, Info) of
153
 
    fixpoint ->
154
 
      do_updates(State, Tail);
155
 
    NewState ->
156
 
      do_updates(NewState, Tail)
157
 
  end;
158
 
do_updates(State, []) ->
159
 
  State.
 
42
annotate_fclearerror(Cfg) ->
 
43
  Labels = hipe_icode_cfg:reverse_postorder(Cfg),
 
44
  annotate_fclearerror(Labels, Cfg).
 
45
 
 
46
annotate_fclearerror([Label|Left], Cfg) ->
 
47
  BB = hipe_icode_cfg:bb(Cfg, Label),
 
48
  Code = hipe_bb:code(BB),
 
49
  NewCode = annotate_fclearerror1(Code, Label, Cfg, []),
 
50
  NewBB = hipe_bb:code_update(BB, NewCode),
 
51
  NewCfg = hipe_icode_cfg:bb_add(Cfg, Label, NewBB),
 
52
  annotate_fclearerror(Left, NewCfg);
 
53
annotate_fclearerror([], Cfg) ->
 
54
  Cfg.
 
55
 
 
56
annotate_fclearerror1([I|Left], Label, Cfg, Acc) ->
 
57
  case I of
 
58
    #call{} ->
 
59
      case hipe_icode:call_fun(I) of
 
60
        fclearerror ->
 
61
          Fail = lookahead_for_fcheckerror(Left, Label, Cfg),
 
62
          NewI = hipe_icode:call_fun_update(I, {fclearerror, Fail}),
 
63
          annotate_fclearerror1(Left, Label, Cfg, [NewI|Acc]);
 
64
        _ ->
 
65
          annotate_fclearerror1(Left, Label, Cfg, [I|Acc])
 
66
      end;
 
67
    _ ->
 
68
      annotate_fclearerror1(Left, Label, Cfg, [I|Acc])
 
69
  end;
 
70
annotate_fclearerror1([], _Label, _Cfg, Acc) ->
 
71
  lists:reverse(Acc).
 
72
 
 
73
lookahead_for_fcheckerror([I|Left], Label, Cfg) ->
 
74
  case I of
 
75
    #call{} ->
 
76
      case hipe_icode:call_fun(I) of
 
77
        fcheckerror ->
 
78
          hipe_icode:call_fail_label(I);
 
79
        _ ->
 
80
          lookahead_for_fcheckerror(Left, Label, Cfg)
 
81
      end;
 
82
    _ ->
 
83
       lookahead_for_fcheckerror(Left, Label, Cfg)
 
84
  end;
 
85
lookahead_for_fcheckerror([], Label, Cfg) ->
 
86
  case hipe_icode_cfg:succ(hipe_icode_cfg:succ_map(Cfg), Label) of
 
87
    [] -> exit("Unterminated fp ebb");
 
88
    SuccList ->
 
89
      Succ = hd(SuccList),
 
90
      Code = hipe_bb:code(hipe_icode_cfg:bb(Cfg, Label)),
 
91
      lookahead_for_fcheckerror(Code, Succ, Cfg)
 
92
  end.
 
93
 
 
94
unannotate_fclearerror(Cfg) ->
 
95
  Labels = hipe_icode_cfg:reverse_postorder(Cfg),
 
96
  unannotate_fclearerror(Labels, Cfg).
 
97
 
 
98
unannotate_fclearerror([Label|Left], Cfg) ->
 
99
  BB = hipe_icode_cfg:bb(Cfg, Label),
 
100
  Code = hipe_bb:code(BB),
 
101
  NewCode = unannotate_fclearerror1(Code, []),
 
102
  NewBB = hipe_bb:code_update(BB, NewCode),
 
103
  NewCfg = hipe_icode_cfg:bb_add(Cfg, Label, NewBB),
 
104
  unannotate_fclearerror(Left, NewCfg);
 
105
unannotate_fclearerror([], Cfg) ->
 
106
  Cfg.
 
107
 
 
108
unannotate_fclearerror1([I|Left], Acc) ->
 
109
  case I of
 
110
    #call{} ->
 
111
      case hipe_icode:call_fun(I) of
 
112
        {fclearerror, _Fail} ->
 
113
          NewI = hipe_icode:call_fun_update(I, fclearerror),
 
114
          unannotate_fclearerror1(Left, [NewI|Acc]);
 
115
        _ ->
 
116
          unannotate_fclearerror1(Left, [I|Acc])
 
117
      end;
 
118
    _ ->
 
119
      unannotate_fclearerror1(Left, [I|Acc])
 
120
  end;
 
121
unannotate_fclearerror1([], Acc) ->
 
122
  lists:reverse(Acc).
 
123
 
160
124
 
161
125
%%____________________________________________________________
162
126
%%
164
128
%%
165
129
 
166
130
place_fp_blocks(State)->
 
131
  WorkList = new_worklist(State),
 
132
  transform_block(WorkList, State).
 
133
 
 
134
transform_block(WorkList, State) ->
 
135
  case get_work(WorkList) of
 
136
    none ->
 
137
      State;
 
138
    {Label, NewWorkList} ->      
 
139
      %%io:format("Handling ~w \n", [Label]),
 
140
      BB = state__bb(State, Label),
 
141
      Code = hipe_bb:code(BB),
 
142
      NofPreds = length(state__pred(State, Label)),
 
143
      Map = state__map(State, Label),
 
144
      FilteredMap = filter_map(Map, NofPreds),
 
145
      %%io:format("Label: ~w\nPhiMap: ~p\nFilteredMap ~p\n", 
 
146
      %%        [Label, gb_trees:to_list(Map), gb_trees:to_list(FilteredMap)]),
 
147
      {Prelude, NewFilteredMap} = do_prelude(FilteredMap),
 
148
      {NewMap, NewCode} = 
 
149
        transform_instrs(Code, Map, NewFilteredMap, []),
 
150
      NewBB = hipe_bb:code_update(BB, Prelude++NewCode),
 
151
      NewState = state__bb_add(State, Label, NewBB),
 
152
      case state__map_update(NewState, Label, NewMap) of
 
153
        fixpoint ->
 
154
          transform_block(NewWorkList, NewState);
 
155
        NewState1 ->
 
156
          Succ = state__succ(NewState1, Label),
 
157
          NewWorkList1 = add_work(NewWorkList, Succ),
 
158
          transform_block(NewWorkList1, NewState1)
 
159
      end
 
160
  end.
 
161
 
 
162
 
 
163
transform_instrs([I|Left], PhiMap, Map, Acc) ->
 
164
  Defines = hipe_icode:defines(I),
 
165
  NewMap = delete_all(Defines, Map),
 
166
  NewPhiMap = delete_all(Defines, PhiMap),
 
167
  
 
168
  case I of
 
169
    #phi{} ->
 
170
      Uses = hipe_icode:uses(I),
 
171
      case [X || X <- Uses, lookup(X, PhiMap) =/= none] of
 
172
        [] ->
 
173
          %% No ordinary variables from the argument has been untagged.
 
174
          transform_instrs(Left, NewPhiMap, NewMap, [I|Acc]);
 
175
        Uses ->
 
176
          %% All arguments are untagged. Let's untag the destination.
 
177
          Dst = hipe_icode:phi_dst(I),
 
178
          NewDst = hipe_icode:mk_new_fvar(),
 
179
          NewMap1 = gb_trees:enter(Dst, NewDst, NewMap),
 
180
          NewI = subst_phi_uncond(I, NewDst, PhiMap),
 
181
          transform_instrs(Left, NewPhiMap, NewMap1, [NewI|Acc]);
 
182
        _ ->
 
183
          %% Some arguments are untagged. Keep the destination.
 
184
          Dst = hipe_icode:phi_dst(I),
 
185
          NewI = subst_phi(I, Dst, PhiMap),
 
186
          transform_instrs(Left, NewPhiMap, NewMap, [NewI|Acc])
 
187
      end;
 
188
    #call{} ->
 
189
      case hipe_icode:call_fun(I) of
 
190
        X when X =:= unsafe_untag_float; X =:= conv_to_float ->
 
191
          [Dst] = hipe_icode:defines(I),
 
192
          case hipe_icode:uses(I) of
 
193
            [] -> %% Constant
 
194
              transform_instrs(Left, NewPhiMap, NewMap, [I|Acc]);
 
195
            [Src] ->
 
196
              case lookup(Src, Map) of
 
197
                none ->
 
198
                  NewMap1 = gb_trees:enter(Src, {assigned, Dst}, NewMap),
 
199
                  transform_instrs(Left, NewPhiMap, NewMap1, [I|Acc]);
 
200
                Dst ->
 
201
                  %% This is the instruction that untagged the variable.
 
202
                  %% Use old maps.
 
203
                  transform_instrs(Left, NewPhiMap, Map, [I|Acc]);
 
204
                FVar -> 
 
205
                  %% The variable was already untagged. 
 
206
                  %% This instruction can be changed to a fmove.
 
207
                  NewI = hipe_icode:mk_fmove(Dst, FVar),
 
208
                  case hipe_icode:call_continuation(I) of
 
209
                    [] ->
 
210
                      transform_instrs(Left,NewPhiMap,NewMap,[NewI|Acc]);
 
211
                    ContLbl ->
 
212
                      Goto = hipe_icode:mk_goto(ContLbl),
 
213
                      transform_instrs(Left, NewPhiMap, NewMap, 
 
214
                                       [Goto, NewI|Acc])
 
215
                  end
 
216
              end
 
217
          end;
 
218
        unsafe_tag_float ->
 
219
          [Dst] = hipe_icode:defines(I),
 
220
          [Src] = hipe_icode:uses(I),
 
221
          NewMap1 = gb_trees:enter(Dst, {assigned, Src}, NewMap),
 
222
          transform_instrs(Left, NewPhiMap, NewMap1,[I|Acc]);
 
223
        _ ->
 
224
          {NewMap1, NewAcc} = check_for_fop_candidates(I, NewMap, Acc),
 
225
          transform_instrs(Left, NewPhiMap, NewMap1, NewAcc)
 
226
      end;
 
227
    _ ->
 
228
      NewIns = handle_untagged_arguments(I, NewMap),
 
229
      transform_instrs(Left, NewPhiMap, NewMap, NewIns ++ Acc)
 
230
  end;
 
231
transform_instrs([], _PhiMap, Map, Acc) ->
 
232
  {Map, lists:reverse(Acc)}.
 
233
 
 
234
check_for_fop_candidates(I, Map, Acc)->
 
235
  case is_fop_cand(I) of
 
236
    false ->
 
237
      NewIs = handle_untagged_arguments(I, Map),
 
238
      {Map, NewIs ++ Acc};
 
239
    true ->
 
240
      Fail = hipe_icode:call_fail_label(I),
 
241
      Cont = hipe_icode:call_continuation(I),
 
242
      Op = fun_to_fop(hipe_icode:call_fun(I)), 
 
243
      case Fail of
 
244
        [] ->
 
245
          Args = hipe_icode:args(I),
 
246
          ConstArgs = [X || X <- Args, hipe_icode:is_const(X)],
 
247
          case catch [float(hipe_icode:const_value(X)) || X <- ConstArgs] of
 
248
            {'EXIT', _} -> 
 
249
              %% This instruction will fail at runtime. The warning
 
250
              %% should already have happened in hipe_icode_type.
 
251
              NewIs = handle_untagged_arguments(I, Map),
 
252
              {Map, NewIs ++ Acc};
 
253
            _ ->
 
254
              %%io:format("Changing ~w to ~w\n", [hipe_icode:call_fun(I), Op]),
 
255
              Uses = hipe_icode:uses(I),
 
256
              Defines = hipe_icode:defines(I),
 
257
              Convs = [X||X <- remove_duplicates(Uses), lookup(X, Map) =:= none],
 
258
              NewMap0 = add_new_bindings_assigned(Convs, Map),
 
259
              NewMap = add_new_bindings_unassigned(Defines, NewMap0),
 
260
              ConvIns = get_conv_instrs(Convs, NewMap),
 
261
              NewI = hipe_icode:mk_primop(lookup_list(Defines, NewMap), Op,
 
262
                                          lookup_list_keep_consts(Args,NewMap),
 
263
                                          Cont, Fail),
 
264
              NewI2 = conv_consts(ConstArgs, NewI),
 
265
              {NewMap, [NewI2|ConvIns]++Acc}
 
266
          end;
 
267
        _ -> %% Bailing out! Can't handle instructions in catches (yet).
 
268
          NewIs = handle_untagged_arguments(I, Map),
 
269
          {Map, NewIs ++ Acc}
 
270
      end
 
271
  end.
 
272
 
 
273
 
 
274
%% If this is an instruction that needs to operate on tagged values,
 
275
%% which currently are untagged, we must tag the values and perhaps
 
276
%% end the fp ebb.
 
277
 
 
278
handle_untagged_arguments(I, Map)->
 
279
  case lists:filter(fun(X)-> must_be_tagged(X, Map) end, hipe_icode:uses(I)) of
 
280
    [] ->
 
281
      [I];
 
282
    Tag ->
 
283
      TagIntrs = 
 
284
        [hipe_icode:mk_primop([Dst], unsafe_tag_float, 
 
285
                              [gb_trees:get(Dst, Map)]) || Dst<-Tag],
 
286
      [I|TagIntrs]
 
287
  end.
 
288
 
 
289
%% Add phi nodes for untagged fp values.
 
290
 
 
291
do_prelude(Map)->  
 
292
  case gb_trees:lookup(phi, Map) of
 
293
    none ->
 
294
      {[], Map};
 
295
    {value, List} ->
 
296
      %%io:format("Adding phi: ~w\n", [List]),
 
297
      Fun = fun({FVar, Bindings}, Acc) -> 
 
298
                [hipe_icode:mk_phi(FVar, Bindings)|Acc]
 
299
            end,
 
300
      {lists:foldl(Fun, [], List), gb_trees:delete(phi, Map)}
 
301
  end.
 
302
 
 
303
split_code(Code) ->
 
304
  split_code(Code, []).
 
305
 
 
306
split_code([I], Acc) ->
 
307
  {lists:reverse(Acc), I};
 
308
split_code([I|Left], Acc)->
 
309
  split_code(Left, [I|Acc]).
 
310
 
 
311
 
 
312
%% When all code is mapped to fp instructions we must make sure that
 
313
%% the fp ebb information goin in to each block is the same as the
 
314
%% information coming out of each predecessor. Otherwise, we must add
 
315
%% a block in between.
 
316
 
 
317
finalize(State) ->
 
318
  Worklist = new_worklist(State),
 
319
  NewState = place_error_handling(Worklist, State),
 
320
  Edges = needs_fcheckerror(NewState),
 
321
  finalize(Edges, NewState).
 
322
 
 
323
finalize([{From, To}|Left], State) ->
 
324
  NewState = add_fp_ebb_fixup(From, To, State),
 
325
  finalize(Left, NewState);
 
326
finalize([], State) ->
 
327
  State.
 
328
 
 
329
needs_fcheckerror(State) ->
167
330
  Cfg = state__cfg(State),
168
 
  Labels = hipe_icode_cfg:reverse_postorder(Cfg),
169
 
  transform_block(Labels, gb_sets:empty(), State).
170
 
 
171
 
transform_block([Label|Left], BackEdgeSucc, State)->
172
 
  BB = state__bb(State, Label),
 
331
  Labels = hipe_icode_cfg:labels(Cfg),
 
332
  needs_fcheckerror(Labels, State, []).
 
333
 
 
334
needs_fcheckerror([Label|Left], State, Acc) ->
 
335
  case state__get_in_block_in(State, Label) of
 
336
    {true, _} ->
 
337
      needs_fcheckerror(Left, State, Acc);
 
338
    false ->
 
339
      Pred = state__pred(State, Label),
 
340
      case [X || X <- Pred, state__get_in_block_out(State, X) =/= false] of
 
341
        [] ->
 
342
          needs_fcheckerror(Left, State, Acc);
 
343
        NeedsFcheck ->    
 
344
          case length(Pred) =:= length(NeedsFcheck) of
 
345
            true ->
 
346
              %% All edges needs fcheckerror. Add this to the
 
347
              %% beginning of the block instead.
 
348
              needs_fcheckerror(Left, State, [{none, Label}|Acc]);
 
349
            false ->
 
350
              Edges = [{X, Label} || X <- NeedsFcheck],
 
351
              needs_fcheckerror(Left, State, Edges ++ Acc)
 
352
          end
 
353
      end
 
354
  end;
 
355
needs_fcheckerror([], _State, Acc) ->
 
356
  Acc.
 
357
 
 
358
add_fp_ebb_fixup('none', To, State) ->
 
359
  %% Add the fcheckerror to the start of the block.
 
360
  BB = state__bb(State, To),
173
361
  Code = hipe_bb:code(BB),
174
 
  Info = state__info_out(State, Label),
175
 
  {Prelude, Map} = do_prelude(State, Label),
176
 
  InBlock = state__in_block(State, Label),
177
 
  {NewMap, NewCode, NewInBlock} = 
178
 
    transform_instrs(Code, Map, Info, InBlock, []),
179
 
  NewBB = hipe_bb:code_update(BB, Prelude++NewCode),
180
 
  NewState0 = state__bb_update(State, Label, NewBB),
181
 
  NewState1 = state__map_update(NewState0, Label, NewMap, NewInBlock),
182
 
  case state__succ(NewState1, Label) of
 
362
  Phis = lists:takewhile(fun(X) -> hipe_icode:is_phi(X) end, Code),
 
363
  TailCode = lists:dropwhile(fun(X) -> hipe_icode:is_phi(X) end, Code),
 
364
  FC = hipe_icode:mk_primop([], fcheckerror, []),
 
365
  NewCode = Phis ++ [FC|TailCode],
 
366
  state__bb_add(State, To, hipe_bb:code_update(BB, NewCode));
 
367
add_fp_ebb_fixup(From, To, State) ->
 
368
  FCCode = [hipe_icode:mk_primop([], fcheckerror, [], To, [])],
 
369
  FCBB = hipe_bb:mk_bb(FCCode),
 
370
  FCLabel = hipe_icode:label_name(hipe_icode:mk_new_label()),
 
371
  NewState = state__bb_add(State, FCLabel, FCBB),
 
372
  NewState1 = state__redirect(NewState, From, To, FCLabel),
 
373
  ToBB = state__bb(NewState, To),
 
374
  ToCode = hipe_bb:code(ToBB),
 
375
  NewToCode = redirect_phis(ToCode, From, FCLabel),
 
376
  NewToBB = hipe_bb:code_update(ToBB, NewToCode),
 
377
  state__bb_add(NewState1, To, NewToBB).
 
378
 
 
379
redirect_phis(Code, OldFrom, NewFrom)->
 
380
  redirect_phis(Code, OldFrom, NewFrom, []).
 
381
 
 
382
redirect_phis([I|Left], OldFrom, NewFrom, Acc)->
 
383
  case I of
 
384
    #phi{} ->
 
385
      NewI = hipe_icode:phi_redirect_pred(I, OldFrom, NewFrom),
 
386
      redirect_phis(Left, OldFrom, NewFrom, [NewI|Acc]);
 
387
    _ ->
 
388
      lists:reverse(Acc)++[I|Left]
 
389
  end;
 
390
redirect_phis([], _OldFrom, _NewFrom, Acc) ->
 
391
  lists:reverse(Acc).
 
392
 
 
393
subst_phi(I, Dst, Map) ->
 
394
  ArgList = subst_phi_uses0(hipe_icode:phi_arglist(I), Map, []),
 
395
  hipe_icode:mk_phi(Dst, ArgList).
 
396
 
 
397
subst_phi_uses0([{Pred, Var}|Left], Map, Acc) ->
 
398
  case gb_trees:lookup(Var, Map) of
 
399
    {value, List} -> 
 
400
      case lists:keysearch(Pred, 1, List) of
 
401
        {value, {Pred, {assigned, _NewVar}}} -> 
 
402
          %% The variable is untagged, but it has been assigned. Keep it!
 
403
          subst_phi_uses0(Left, Map, [{Pred, Var}|Acc]);
 
404
        {value, {Pred, NewVar}}-> 
 
405
          %% The variable is untagged and it has never been assigned as tagged.
 
406
          subst_phi_uses0(Left, Map, [{Pred, NewVar}|Acc]);
 
407
        false ->
 
408
          %% The variable is not untagged.
 
409
          subst_phi_uses0(Left, Map, [{Pred, Var}|Acc])
 
410
      end;
 
411
    none ->
 
412
      %% The variable is not untagged.
 
413
      subst_phi_uses0(Left, Map, [{Pred, Var}|Acc])
 
414
  end;
 
415
subst_phi_uses0([], _Map, Acc) ->
 
416
  Acc.
 
417
 
 
418
subst_phi_uncond(I, Dst, Map) ->
 
419
  ArgList = subst_phi_uses_uncond0(hipe_icode:phi_arglist(I), Map, []),
 
420
  hipe_icode:mk_phi(Dst, ArgList).
 
421
 
 
422
subst_phi_uses_uncond0([{Pred, Var}|Left], Map, Acc) ->
 
423
  case gb_trees:lookup(Var, Map) of
 
424
    {value, List} -> 
 
425
      case lists:keysearch(Pred, 1, List) of
 
426
        {value, {Pred, {assigned, NewVar}}} -> 
 
427
          %% The variable is untagged!
 
428
          subst_phi_uses_uncond0(Left, Map, [{Pred, NewVar}|Acc]);
 
429
        {value, {Pred, NewVar}}-> 
 
430
          %% The variable is untagged!
 
431
          subst_phi_uses_uncond0(Left, Map, [{Pred, NewVar}|Acc]);
 
432
        false ->
 
433
          %% The variable is not untagged.
 
434
          subst_phi_uses_uncond0(Left, Map, [{Pred, Var}|Acc])
 
435
      end;
 
436
    none ->
 
437
      %% The variable is not untagged.
 
438
      subst_phi_uses_uncond0(Left, Map, [{Pred, Var}|Acc])
 
439
  end;
 
440
subst_phi_uses_uncond0([], _Map, Acc) ->
 
441
  Acc.
 
442
 
 
443
 
 
444
place_error_handling(WorkList, State) ->
 
445
  case get_work(WorkList) of
 
446
    none ->
 
447
      State;
 
448
    {Label, NewWorkList} ->      
 
449
      BB = state__bb(State, Label),
 
450
      Code = hipe_bb:code(BB),
 
451
      case state__join_in_block(State, Label) of
 
452
        fixpoint ->
 
453
          place_error_handling(NewWorkList, State);
 
454
        {NewState, NewInBlock} ->
 
455
          {NewCode1, InBlockOut} = place_error(Code, NewInBlock, []),
 
456
          Succ = state__succ(NewState, Label),
 
457
          NewCode2 = handle_unchecked_end(Succ, NewCode1, InBlockOut),
 
458
          NewBB = hipe_bb:code_update(BB, NewCode2),
 
459
          NewState1 = state__bb_add(NewState, Label, NewBB),
 
460
          NewState2 = state__in_block_out_update(NewState1, Label, InBlockOut),
 
461
          NewWorkList1 = add_work(NewWorkList, Succ),
 
462
          place_error_handling(NewWorkList1, NewState2)
 
463
      end
 
464
  end.
 
465
 
 
466
place_error([I|Left], InBlock, Acc) ->
 
467
  case I of
 
468
    #call{} ->
 
469
      case hipe_icode:call_fun(I) of
 
470
        X when X =:= fp_add; X =:= fp_sub; 
 
471
               X =:= fp_mul; X =:= fp_div; X =:= fnegate ->
 
472
          case InBlock of
 
473
            false ->
 
474
              Clear = hipe_icode:mk_primop([], {fclearerror, []}, []),
 
475
              place_error(Left, {true, []}, [I, Clear|Acc]);
 
476
            {true, _} ->
 
477
              place_error(Left, InBlock, [I|Acc])
 
478
          end;
 
479
        unsafe_tag_float ->
 
480
          case InBlock of
 
481
            {true, Fail} ->
 
482
              Check = hipe_icode:mk_primop([], fcheckerror, [], [], Fail),
 
483
              place_error(Left, false, [I, Check|Acc]);
 
484
            false ->
 
485
              place_error(Left, InBlock, [I|Acc])
 
486
          end;
 
487
        {fclearerror, Fail} ->
 
488
          case InBlock of
 
489
            {true, Fail} ->
 
490
              %% We can remove this fclearerror!
 
491
              case hipe_icode:call_continuation(I) of
 
492
                [] ->
 
493
                  place_error(Left, InBlock, Acc);
 
494
                Cont ->
 
495
                  place_error(Left, InBlock, [hipe_icode:mk_goto(Cont)|Acc])
 
496
              end;
 
497
            {true, _OtherFail} ->
 
498
              %% TODO: This can be handled but it requires breaking up
 
499
              %% the BB in two. Currently this should not happen.
 
500
              exit("Starting fp ebb with different fail label");
 
501
            false ->
 
502
              place_error(Left, {true, Fail}, [I|Acc])
 
503
          end;
 
504
        fcheckerror ->
 
505
          case {true, hipe_icode:call_fail_label(I)} of
 
506
            InBlock ->
 
507
              %% No problem
 
508
              place_error(Left, false, [I|Acc]);
 
509
            NewInblock ->
 
510
              exit({"Fcheckerror has the wrong fail label",
 
511
                    InBlock, NewInblock})
 
512
          end;
 
513
        X when X =:= conv_to_float; X =:= unsafe_untag_float ->
 
514
          place_error(Left, InBlock, [I|Acc]);
 
515
        _Other ->
 
516
          case hipe_icode_primops:fails(hipe_icode:call_fun(I)) of
 
517
            false ->
 
518
              place_error(Left, InBlock, [I|Acc]);
 
519
            true ->
 
520
              case InBlock of
 
521
                {true, Fail} ->
 
522
                  Check = hipe_icode:mk_primop([], fcheckerror, [], [], Fail),
 
523
                  place_error(Left, false, [I, Check|Acc]);
 
524
                false ->
 
525
                  place_error(Left, InBlock, [I|Acc])
 
526
              end
 
527
          end
 
528
      end;
 
529
    #fail{} ->
 
530
      place_error_1(I, Left, InBlock, Acc);
 
531
    #return{} ->
 
532
      place_error_1(I, Left, InBlock, Acc);
 
533
    #enter{} ->
 
534
      place_error_1(I, Left, InBlock, Acc);
 
535
    Other ->
 
536
      case instr_allowed_in_fp_ebb(Other) of
 
537
        true ->
 
538
          place_error(Left, InBlock, [I|Acc]);
 
539
        false ->
 
540
          case InBlock of
 
541
            {true, []} ->
 
542
              Check = hipe_icode:mk_primop([], fcheckerror, []),
 
543
              place_error(Left, false, [I, Check|Acc]);
 
544
            {true, _} ->
 
545
              exit({"Illegal instruction in caught fp ebb", I});
 
546
            false ->
 
547
              place_error(Left, InBlock, [I|Acc])
 
548
          end
 
549
      end
 
550
  end;
 
551
place_error([], InBlock, Acc) ->
 
552
  {lists:reverse(Acc), InBlock}.
 
553
 
 
554
place_error_1(I, Left, InBlock, Acc) ->
 
555
  case InBlock of
 
556
    {true, []} ->
 
557
      Check = hipe_icode:mk_primop([], fcheckerror, []),
 
558
      place_error(Left, false, [I,Check|Acc]);
 
559
    {true, _} ->
 
560
      exit({"End of control flow in caught fp ebb", I});
 
561
    false ->
 
562
      place_error(Left, InBlock, [I|Acc])
 
563
  end.
 
564
 
 
565
%% If the block has no successors and we still are in a fp ebb we must
 
566
%% end it to make sure we don't have any unchecked fp exceptions.
 
567
 
 
568
handle_unchecked_end(Succ, Code, InBlock) ->
 
569
  case Succ of
183
570
    [] ->
184
 
      transform_block(Left, BackEdgeSucc, NewState1);
185
 
    Succ ->
186
 
      BackEdge = [X||X<-Succ, not lists:member(X, Left)],
187
 
      NewBackEdgeSucc = lists:foldl(fun(X, Acc)->gb_sets:add(X, Acc)end,
188
 
                                    BackEdgeSucc, BackEdge),
189
 
      transform_block(Left, NewBackEdgeSucc, NewState1)
190
 
  end;
191
 
transform_block([], BackEdgeSucc, State) ->
192
 
  handle_back_edges(gb_sets:to_list(BackEdgeSucc), State).
193
 
 
194
 
transform_instrs([I|Left], Map, Info, InBlock, Acc)->
195
 
  case is_fop_cand(I, Info) of
196
 
    false ->
197
 
      {NewMap, NewAcc, NewInBlock} = end_block(I, Map, Acc, InBlock),
198
 
      transform_instrs(Left, NewMap, Info, NewInBlock, NewAcc);
199
 
    true ->
200
 
      Uses = uses(I),
201
 
      Defines = defines(I),
202
 
      Convs =  [X||X <- remove_duplicates(Uses), lookup(X, Map)==none],
203
 
      NewMap0 = add_new_bindings_assigned(Convs, Map),
204
 
      NewMap = add_new_bindings_unassigned(Defines, NewMap0),
205
 
      ConvIns = get_conv_instrs(Convs, NewMap, Info),
206
 
      {Op, Cont, Fail} = get_info(I),
207
 
      NewI = hipe_icode:mk_primop(lookup_list(Defines, NewMap), Op,
208
 
                                  lookup_list(Uses, NewMap), Cont, Fail),
209
571
      case InBlock of
210
 
        {true, Fail} -> %% We can continue the block
211
 
          transform_instrs(Left, NewMap, Info, InBlock, [NewI|ConvIns]++Acc);
212
 
        {true, _NewFail} -> %% Must end previous block and start a new one.
213
 
          %% TODO: Find out if this ever happens. If so, handle it!
214
 
          exit('Different catches');
 
572
        {true, []} ->
 
573
          {TopCode, Last} = split_code(Code),
 
574
          NewI = hipe_icode:mk_primop([], fcheckerror, []),
 
575
          TopCode++[NewI, Last];
215
576
        false ->
216
 
          BlockStart = hipe_icode:mk_primop([], fclearerror, []),
217
 
          transform_instrs(Left, NewMap, Info, {true, Fail}, 
218
 
                           [NewI, BlockStart|ConvIns]++Acc)
219
 
      end
220
 
  end;
221
 
transform_instrs([], Map, _Info, InBlock, Acc) ->
222
 
  {Map, lists:reverse(Acc), InBlock}.
223
 
 
224
 
end_block(I, Map, Code, InBlock)->
225
 
  %% If there is instructions that need to operate on tagged values
226
 
  %% that currently are untagged, we must end the block (if necessary)
227
 
  %% and tag the values .
228
 
  case hipe_icode:type(I) of
229
 
    phi ->
230
 
      Uses = uses(I),
231
 
      case [{X, Y}||X<-Uses, (Y=lookup(X, Map))/=none] of
232
 
        [] ->
233
 
          {Map, [I|Code], InBlock};
234
 
        Subst0 ->
235
 
          Defines = defines(I),
236
 
          NewMap = add_new_bindings_assigned(Defines, Map),
237
 
          Dst = hd(Defines),
238
 
          Subst = [{Dst, lookup(Dst, NewMap)}|Subst0],
239
 
          NewI = hipe_icode:subst(Subst, I),
240
 
          {NewMap, [NewI|Code], InBlock}
241
 
      end;
242
 
    Other ->
243
 
      LocalCallEndsBlock =
244
 
        case Other of
245
 
          call ->
246
 
            case hipe_icode:call_type(I) of
247
 
              local -> InBlock;
248
 
              _ ->false
249
 
            end;
250
 
          _ ->
251
 
            false
252
 
        end,
253
 
      case lists:filter(fun(X)->must_be_tagged(X, Map)end, uses(I)) of
254
 
        [] ->
255
 
          case LocalCallEndsBlock of
256
 
            {true, FailLab}->
257
 
              Fcheck = hipe_icode:mk_primop([], fcheckerror, [],
258
 
                                            [], FailLab),      
259
 
              {Map, [I, Fcheck|Code], false};
260
 
            false ->
261
 
              {Map, [I|Code], InBlock}
262
 
          end;
263
 
        Tag ->
264
 
          TagIntrs = mk_tags(Tag, Map),
265
 
          NewMap = lists:foldl(fun(X,Tree)->gb_trees:delete(X, Tree)end,
266
 
                               Map, Tag),
267
 
          case InBlock of
268
 
            {true, FailLab} ->
269
 
              Fcheck = hipe_icode:mk_primop([], fcheckerror, [],
270
 
                                            [], FailLab),      
271
 
              {NewMap, [I|TagIntrs]++[Fcheck|Code], false};
272
 
            _ ->
273
 
              {NewMap, [I|TagIntrs]++Code, InBlock}
274
 
          end
275
 
      end
276
 
  end.
277
 
 
278
 
mk_tags(Tag, Map)->
279
 
  [hipe_icode:mk_primop([Dst], unsafe_tag_float, [gb_trees:get(Dst, Map)])||
280
 
    Dst<-Tag].
281
 
 
282
 
%% We make a difference between values that has been assigned as
283
 
%% tagged variables and those that has got a 'virtual' binding.
284
 
 
285
 
add_new_bindings_unassigned([Var|Left], Map)->
286
 
  FVar = hipe_icode:mk_new_fvar(),
287
 
  add_new_bindings_unassigned(Left, gb_trees:insert(Var, FVar, Map));
288
 
add_new_bindings_unassigned([], Map) ->
289
 
  Map.
290
 
 
291
 
add_new_bindings_assigned([Var|Left], Map)->
292
 
  case lookup(Var, Map) of
293
 
    none ->
294
 
      FVar = hipe_icode:mk_new_fvar(),
295
 
      NewMap = gb_trees:insert(Var, {assigned, FVar}, Map),
296
 
      add_new_bindings_assigned(Left, NewMap);
297
 
    _ ->
298
 
      add_new_bindings_assigned(Left, Map)
299
 
  end;
300
 
add_new_bindings_assigned([], Map) ->
301
 
  Map.
302
 
 
303
 
 
304
 
get_conv_instrs(Vars, Map, Info)->
305
 
  get_conv_instrs(Vars, Map, Info, []).
306
 
 
307
 
get_conv_instrs([Var|Left], Map, Info, Acc)->
308
 
  {_, Dst} = gb_trees:get(Var, Map),
309
 
  NewI = 
310
 
    case t_is_float(lookup_type(Var, Info)) of
311
 
      true ->
312
 
        hipe_icode:mk_primop([Dst],unsafe_untag_float,[Var]);
313
 
      _ ->
314
 
        hipe_icode:mk_primop([Dst],conv_to_float,[Var]) 
315
 
    end,
316
 
  get_conv_instrs(Left, Map, Info, [NewI|Acc]);
317
 
get_conv_instrs([], _, _, Acc) ->
318
 
  Acc.
319
 
 
320
 
do_prelude(State, Label)->  
321
 
  %% Add phi nodes for untagged fp values.
322
 
  Map = state__map(State, Label),
323
 
  case state__pred(State, Label) of
324
 
    List when length(List)>1 ->
325
 
      {Ins, NewMap} = lists:foldl(fun(X, Acc)->get_phi(X, List, Acc)end,
326
 
                                  {[], Map}, gb_trees:to_list(Map)),
327
 
      {Ins, init_map(NewMap)};
328
 
    _ -> {[], init_map(Map)}
329
 
  end.
330
 
 
331
 
get_phi({Var, PredList}, Preds, {InsAcc, Map})->
332
 
  case all_args_equal(PredList) of
333
 
    true ->
334
 
      {InsAcc, Map};
335
 
    false ->
336
 
      FVar = hipe_icode:mk_new_fvar(),
337
 
      NewMap = gb_trees:enter(Var, FVar, Map),
338
 
      Phi0 = hipe_icode:mk_phi(FVar, Preds),
339
 
      Phi1 = lists:foldl(fun(X, Ins)->
340
 
                             case X of
341
 
                               {Pred, {assigned, Val}}->
342
 
                                 hipe_icode:subst_phi_arg(Ins, Pred, Val);
343
 
                               {Pred, Val} ->
344
 
                                 hipe_icode:subst_phi_arg(Ins, Pred, Val)
345
 
                             end
346
 
                         end,
347
 
                         Phi0, PredList),
348
 
      {[Phi1|InsAcc], NewMap}
349
 
  end.
350
 
 
351
 
all_args_equal([{_, FVar}|Left])->
352
 
  all_args_equal(Left, FVar).
353
 
 
354
 
all_args_equal([{_, FVar1}|Left], FVar2) when FVar1 == FVar2 ->
355
 
  all_args_equal(Left, FVar2);
356
 
all_args_equal([], _) ->
357
 
  true;
358
 
all_args_equal(_, _) ->
359
 
  false.
360
 
  
361
 
handle_back_edges([Label|Left], State)->
362
 
  %% When there is a back edge we must make sure that any phi nodes
363
 
  %% has the rigth arguments since untagging might have occured after
364
 
  %% the block was processed.
365
 
  BB = state__bb(State, Label),
366
 
  Code = hipe_bb:code(BB),
367
 
  Map = init_map(state__map(State, Label)),
368
 
  NewCode = lists:map(fun(X)->subst_phi_uses(X, Map)end, Code),
369
 
  NewBB = hipe_bb:code_update(BB, NewCode),
370
 
  NewState = state__bb_update(State, Label, NewBB),
371
 
  handle_back_edges(Left, NewState);
372
 
handle_back_edges([], State) ->
373
 
  State.
374
 
 
375
 
subst_phi_uses(I, Map)->
376
 
  case hipe_icode:type(I) of
377
 
    phi ->
378
 
      Uses = uses(I),
379
 
      case [{X, Y}||X<-Uses, (Y=lookup(X, Map))/=none] of
380
 
        [] ->
381
 
          I;
382
 
        Subst ->
383
 
          hipe_icode:subst(Subst, I)
384
 
      end;
385
 
    _ ->
386
 
      I
 
577
          Code
 
578
      end;
 
579
    _ ->
 
580
      Code
 
581
  end.      
 
582
 
 
583
instr_allowed_in_fp_ebb(Instr) ->
 
584
  case Instr of
 
585
    #comment{} -> true;
 
586
    #fmove{} -> true;
 
587
    #goto{} -> true;
 
588
    #'if'{} -> true;
 
589
    #move{} -> true;
 
590
    #phi{} -> true;
 
591
    #begin_handler{} -> true;
 
592
    #switch_tuple_arity{} -> true;
 
593
    #switch_val{} -> true;
 
594
    #type{} -> true;
 
595
    _ -> false
387
596
  end.
388
597
 
389
598
 
390
599
%%____________________________________________________________
391
600
%%
392
 
%% Information handling help functions
 
601
%% Help functions
393
602
%%
394
603
 
395
 
lookup(Key, Tree)->
396
 
  case gb_trees:lookup(Key, Tree) of
397
 
    none -> none;
398
 
    {value, {assigned, Val}} -> Val;
399
 
    {value, Val} -> Val
400
 
  end.
401
 
 
402
 
lookup_type(Var, Tree)->
403
 
  case gb_trees:lookup(Var, Tree) of
404
 
    none ->
405
 
      t_any();
406
 
    {value, Val} ->
407
 
      case hipe_icode:is_var(Val) of
408
 
        true ->
409
 
          lookup(Val, Tree);
410
 
        _ ->
411
 
          Val
412
 
      end
413
 
  end.
414
 
 
415
 
lookup_type_list(List, Info)->
416
 
  lookup_list(List, fun lookup_type/2, Info, []).
417
 
 
418
 
lookup_list(List, Info)->
 
604
%% ------------------------------------------------------------ 
 
605
%% Handling the gb_tree
 
606
 
 
607
empty() ->
 
608
  gb_trees:empty().
 
609
 
 
610
delete_all([Key|Left], Tree) ->
 
611
  delete_all(Left, gb_trees:delete_any(Key, Tree));
 
612
delete_all([], Tree) ->
 
613
  Tree.
 
614
 
 
615
lookup_list(List, Info) ->
419
616
  lookup_list(List, fun lookup/2, Info, []).
420
617
 
421
 
lookup_list([H|T], Fun, Info, Acc)->
 
618
lookup_list([H|T], Fun, Info, Acc) ->
422
619
  lookup_list(T, Fun, Info, [Fun(H, Info)|Acc]);
423
620
lookup_list([], _,  _, Acc) ->
424
621
  lists:reverse(Acc).
425
622
 
426
 
enter([Key], Value, Tree)->
427
 
  enter(Key, Value, Tree);
428
 
enter(Key, Value, Tree)->
429
 
  case t_is_any(Value) of
430
 
    true ->
431
 
      Tree;
432
 
    _ ->
433
 
      enter_to_leaf(Key, Value, Tree)
434
 
  end.
435
 
 
436
 
enter_to_leaf(Key, Value, Tree)->
437
 
  case gb_trees:lookup(Key, Tree) of
438
 
    {value, Value} ->
439
 
      Tree;
440
 
    {value, Val} ->
441
 
      case hipe_icode:is_var(Val) of
442
 
        true->
443
 
          enter_to_leaf(Val, Value, Tree);
444
 
        _ ->
445
 
          gb_trees:enter(Key, Value, Tree)
446
 
      end;
447
 
    _ ->
448
 
      gb_trees:insert(Key, Value, Tree)
449
 
  end.
450
 
 
451
 
enter_defines(I, Types, Info)when is_list(Types)->
452
 
  case defines(I) of
453
 
    []-> Info;
454
 
    Def->
455
 
      {NewInfo, _} =
456
 
        lists:foldl(fun(X, {Info, [Type|Tail]})->
457
 
                        {enter(X,Type,Info), Tail}end,
458
 
                    {Info, Types}, Def),
459
 
      NewInfo
460
 
  end;
461
 
enter_defines(I, Type, Info)->
462
 
  case defines(I) of
463
 
    []-> Info;
464
 
    Def->
465
 
      lists:foldl(fun(X, Acc)->enter(X, Type, Acc)end, Info, Def)
466
 
  end.
467
 
 
468
 
join_list(List, Info)->
469
 
  join_list(List, Info, t_undefined()).
470
 
 
471
 
join_list([H|T], Info, Acc)->
472
 
  Type = t_sup(lookup_type(H, Info), Acc),
473
 
  join_list(T, Info, Type);
474
 
join_list([], _, Acc) ->
475
 
  Acc.
476
 
 
477
 
join_info_in([{Var, Type}|Tail], InfoIn)->
478
 
  case gb_trees:lookup(Var, InfoIn) of
479
 
    none ->
480
 
      join_info_in(Tail, enter(Var, Type, InfoIn));
481
 
    {value, Type} ->
482
 
      join_info_in(Tail, InfoIn);
483
 
    {value, OldType}->
484
 
      join_info_in(Tail, enter(Var, t_sup(OldType, Type), InfoIn))
485
 
  end;
486
 
join_info_in([], InfoIn) ->
487
 
  InfoIn.
488
 
 
489
 
join_maps(Pred, BlockMap)->
490
 
  join_maps(Pred, BlockMap, empty()).
491
 
 
492
 
join_maps([Pred|Left], BlockMap, Map)->
 
623
lookup(Key, Tree) ->
 
624
  case hipe_icode:is_const(Key) of
 
625
    %% This can be true if the same constant has been
 
626
    %% untagged more than once
 
627
    true -> none;
 
628
    false ->
 
629
      case gb_trees:lookup(Key, Tree) of
 
630
        none -> none;
 
631
        {value, {assigned, Val}} -> Val;
 
632
        {value, Val} -> Val
 
633
      end
 
634
  end.
 
635
 
 
636
lookup_list_keep_consts(List, Info) ->
 
637
  lookup_list(List, fun lookup_keep_consts/2, Info, []).
 
638
 
 
639
lookup_keep_consts(Key, Tree) ->
 
640
  case hipe_icode:is_const(Key) of
 
641
    true -> Key;
 
642
    false ->
 
643
      case gb_trees:lookup(Key, Tree) of
 
644
        none -> none;
 
645
        {value, {assigned, Val}} -> Val;
 
646
        {value, Val} -> Val
 
647
      end
 
648
  end.
 
649
 
 
650
get_type(Var) ->
 
651
  case hipe_icode:is_const(Var) of
 
652
    true -> erl_types:t_from_term(hipe_icode:const_value(Var));
 
653
    false ->
 
654
      case hipe_icode:is_annotated_var(Var) of
 
655
        true -> hipe_icode:var_annotation(Var)
 
656
%%%     false -> erl_types:t_any()
 
657
      end
 
658
  end.
 
659
 
 
660
%% ------------------------------------------------------------ 
 
661
%% Handling the map from variables to fp-variables
 
662
 
 
663
join_maps(Preds, BlockMap) ->
 
664
  join_maps(Preds, BlockMap, empty()).
 
665
 
 
666
join_maps([Pred|Left], BlockMap, Map) ->
493
667
  case gb_trees:lookup(Pred, BlockMap) of
494
668
    none ->
495
 
      join_maps(Left, BlockMap, Map);
 
669
      %%join_maps(Left, BlockMap, Map);
 
670
      %% All predecessors have not been handled. Use empty map.
 
671
      empty();
496
672
    {value, OldMap} ->
497
673
      NewMap = join_maps0(gb_trees:to_list(OldMap), Pred, Map),
498
674
      join_maps(Left, BlockMap, NewMap)
500
676
join_maps([], _, Map) ->
501
677
  Map.
502
678
 
503
 
join_maps0([{Var, FVar}|Tail], Pred,  Map)->
504
 
  case lookup(Var, Map) of
 
679
join_maps0([{phi, _}|Tail], Pred,  Map) ->
 
680
  join_maps0(Tail, Pred, Map);
 
681
join_maps0([{Var, FVar}|Tail], Pred,  Map) ->
 
682
  case gb_trees:lookup(Var, Map) of
505
683
    none ->
506
684
      join_maps0(Tail, Pred, gb_trees:enter(Var, [{Pred, FVar}], Map));
507
 
    Val ->
508
 
      join_maps0(Tail, Pred, gb_trees:enter(Var, [{Pred, FVar}|Val], Map))
 
685
    {value, List} ->
 
686
      case lists:keysearch(Pred, 1, List) of
 
687
        {value, {Pred, FVar}} ->
 
688
          %% No problem.
 
689
          join_maps0(Tail, Pred, Map);
 
690
        {value, _}->
 
691
          exit('New binding to same variable');
 
692
        false ->
 
693
          join_maps0(Tail, Pred, gb_trees:update(Var, [{Pred, FVar}|List], Map))
 
694
      end
509
695
  end;
510
696
join_maps0([], _, Map) ->
511
697
  Map.
512
698
 
513
 
%% The map has information about from which predecessor a particular
514
 
%% binding comes from. When this information has been used we strip
515
 
%% the map of it.
516
 
init_map(Map)->
517
 
  init_map(gb_trees:to_list(Map), empty()).
518
 
 
519
 
init_map([{Var, [{_, FVar}|_]}|Left], Acc)->
520
 
  init_map(Left, gb_trees:insert(Var, FVar, Acc));
521
 
init_map([{Var, FVar}|Left], Acc)->
522
 
  init_map(Left, gb_trees:insert(Var, FVar, Acc));
523
 
init_map([], Acc) ->
 
699
filter_map(Map, NofPreds) ->
 
700
  filter_map(gb_trees:to_list(Map), NofPreds, Map).
 
701
 
 
702
filter_map([{Var, Bindings}|Left], NofPreds, Map) ->
 
703
  case length(Bindings) =:= NofPreds of
 
704
    true ->
 
705
      case all_args_equal(Bindings) of
 
706
        true ->
 
707
          {_, FVar} = hd(Bindings),
 
708
          filter_map(Left, NofPreds, gb_trees:update(Var, FVar, Map));
 
709
        false ->
 
710
          PhiDst = hipe_icode:mk_new_fvar(),
 
711
          PhiArgs = strip_of_assigned(Bindings),
 
712
          NewMap =
 
713
            case gb_trees:lookup(phi, Map) of
 
714
              none ->
 
715
                gb_trees:insert(phi, [{PhiDst, PhiArgs}], Map);
 
716
              {value, Val} ->
 
717
                gb_trees:update(phi, [{PhiDst, PhiArgs}|Val], Map)
 
718
            end,
 
719
          filter_map(Left, NofPreds, gb_trees:update(Var, PhiDst, NewMap))
 
720
      end;
 
721
    false ->
 
722
      filter_map(Left, NofPreds, gb_trees:delete(Var, Map))
 
723
  end;
 
724
filter_map([], _NofPreds, Map) ->
 
725
  Map.
 
726
 
 
727
%% all_args_equal returns true if the mapping for a variable is the
 
728
%% same from all predecessors, i.e., we do not need a phi-node.
 
729
 
 
730
all_args_equal([{_, FVar}|Left]) ->
 
731
  all_args_equal(Left, FVar).
 
732
 
 
733
all_args_equal([{_, FVar1}|Left], FVar1) ->
 
734
  all_args_equal(Left, FVar1);
 
735
all_args_equal([], _) ->
 
736
  true;
 
737
all_args_equal(_, _) ->
 
738
  false.
 
739
 
 
740
 
 
741
%% We differentiate between values that have been assigned as
 
742
%% tagged variables and those that got a 'virtual' binding.
 
743
 
 
744
add_new_bindings_unassigned([Var|Left], Map) ->
 
745
  FVar = hipe_icode:mk_new_fvar(),
 
746
  add_new_bindings_unassigned(Left, gb_trees:insert(Var, FVar, Map));
 
747
add_new_bindings_unassigned([], Map) ->
 
748
  Map.
 
749
 
 
750
add_new_bindings_assigned([Var|Left], Map) ->
 
751
  case lookup(Var, Map) of
 
752
    none ->
 
753
      FVar = hipe_icode:mk_new_fvar(),
 
754
      NewMap = gb_trees:insert(Var, {assigned, FVar}, Map),
 
755
      add_new_bindings_assigned(Left, NewMap);
 
756
    _ ->
 
757
      add_new_bindings_assigned(Left, Map)
 
758
  end;
 
759
add_new_bindings_assigned([], Map) ->
 
760
  Map.
 
761
 
 
762
strip_of_assigned(List) ->
 
763
  strip_of_assigned(List, []).
 
764
 
 
765
strip_of_assigned([{Pred, {assigned, Val}}|Left], Acc) ->
 
766
  strip_of_assigned(Left, [{Pred, Val}|Acc]);
 
767
strip_of_assigned([Tuple|Left], Acc) ->
 
768
  strip_of_assigned(Left, [Tuple|Acc]);
 
769
strip_of_assigned([], Acc) ->
524
770
  Acc.
525
771
 
526
 
defines(I)->
527
 
  hipe_icode:defines(I).
528
 
 
529
 
uses(I)->
530
 
  hipe_icode:uses(I).
531
 
 
532
 
remove_duplicates(List)->
 
772
%% ------------------------------------------------------------ 
 
773
%% Help functions for the transformation from ordinary instruction to
 
774
%% fp-instruction
 
775
 
 
776
is_fop_cand(I) ->
 
777
  case hipe_icode:call_fun(I) of
 
778
    '/' -> true;
 
779
    Fun ->
 
780
      case fun_to_fop(Fun) of
 
781
        false -> false;
 
782
        _ -> any_is_float(hipe_icode:args(I))
 
783
      end
 
784
  end.
 
785
 
 
786
any_is_float([Var|Left]) ->
 
787
  case erl_types:t_is_float(get_type(Var)) of
 
788
    true -> true;
 
789
    false -> any_is_float(Left)
 
790
  end;
 
791
any_is_float([]) ->
 
792
  false.
 
793
 
 
794
remove_duplicates(List) ->
533
795
  remove_duplicates(List, []).
534
 
remove_duplicates([X|Left], Acc)->
 
796
remove_duplicates([X|Left], Acc) ->
535
797
  case lists:member(X, Acc) of
536
798
    true ->
537
799
      remove_duplicates(Left, Acc);
541
803
remove_duplicates([], Acc) ->
542
804
  Acc.
543
805
 
544
 
print_state_info(State)->
545
 
  Labels = hipe_icode_cfg:reverse_postorder(state__cfg(State)),
546
 
  lists:foreach(
547
 
    fun(X)-> 
548
 
        io:format("Label ~w:\n", [X]),
549
 
        lists:foreach(
550
 
          fun({Y, Z})->
551
 
              io:format("\t~w: ~s\n", [Y, t_to_string(Z)])
552
 
          end,
553
 
          gb_trees:to_list(state__info_out(State, X)))
554
 
    end,
555
 
    Labels),
556
 
  io:format("=========================\n", []),
557
 
  ok.
558
 
 
559
 
const_type(Var)->
560
 
  case hipe_icode:is_const(Var) of
561
 
    false ->
562
 
      not_a_constant;
563
 
    true ->
564
 
      t_from_term(hipe_icode:const_value(Var))
565
 
  end.
566
 
 
567
 
is_fop_cand(I, Info)->
568
 
  case get_info(I) of
569
 
    false -> false;
570
 
    {false, _, _} -> false;
571
 
    _ ->
572
 
      case [X||X<-uses(I), t_is_float(lookup_type(X, Info))] of
573
 
        [] -> false;
574
 
        _ -> true
575
 
      end
576
 
  end.
577
 
 
578
 
get_info(I)->
579
 
  case hipe_icode:type(I) of
580
 
    call ->
581
 
      Fail = hipe_icode:call_fail(I),
582
 
      Cont = hipe_icode:call_continuation(I),
583
 
      Op = fun_to_fop(hipe_icode:call_fun(I)), 
584
 
      {Op, Cont, Fail};
585
 
    enter ->
586
 
      {fun_to_fop(hipe_icode:enter_fun(I)), [], []};
587
 
    _ ->
588
 
      false
589
 
  end.
590
 
 
591
 
fun_to_fop(Fun)->
 
806
fun_to_fop(Fun) ->
592
807
  case Fun of
593
808
    '+' -> fp_add;
594
809
    '-' -> fp_sub;
595
 
    {erlang, '/', 2} -> fp_div;
596
 
    {erlang, '*', 2} -> fp_mul;
597
 
    _ ->false
 
810
    '*' -> fp_mul;
 
811
    '/' -> fp_div;
 
812
    _ -> false
598
813
  end.
599
814
 
600
 
must_be_tagged(Var, Map)->
601
 
  %% If there is a tagged version of this variable available we don't
602
 
  %% have to tag the untagged version.
 
815
 
 
816
%% If there is a tagged version of this variable available we don't
 
817
%% have to tag the untagged version.
 
818
 
 
819
must_be_tagged(Var, Map) ->
603
820
  case gb_trees:lookup(Var, Map) of
604
821
    none -> false;
605
822
    {value, {assigned, _}} -> false; 
606
 
    _ ->true
 
823
    {value, Val} -> hipe_icode:is_fvar(Val)
607
824
  end.
608
825
 
 
826
 
 
827
%% Converting to floating point variables
 
828
 
 
829
get_conv_instrs(Vars, Map) ->
 
830
  get_conv_instrs(Vars, Map, []).
 
831
 
 
832
get_conv_instrs([Var|Left], Map, Acc) ->
 
833
  {_, Dst} = gb_trees:get(Var, Map),
 
834
  NewI = 
 
835
    case erl_types:t_is_float(get_type(Var)) of
 
836
      true ->
 
837
        [hipe_icode:mk_primop([Dst],unsafe_untag_float,[Var])];
 
838
      false ->
 
839
        [hipe_icode:mk_primop([Dst],conv_to_float,[Var])] 
 
840
    end,
 
841
  get_conv_instrs(Left, Map, NewI++Acc);
 
842
get_conv_instrs([], _, Acc) ->
 
843
  Acc.
 
844
 
 
845
 
 
846
conv_consts(ConstArgs, I) ->
 
847
  conv_consts(ConstArgs, I, []).
 
848
 
 
849
conv_consts([Const|Left], I, Subst) ->
 
850
  NewConst = hipe_icode:mk_const(float(hipe_icode:const_value(Const))),
 
851
  conv_consts(Left, I, [{Const, NewConst}|Subst]);
 
852
conv_consts([], I, Subst) ->
 
853
  hipe_icode:subst_uses(Subst, I).
 
854
  
 
855
 
609
856
%% _________________________________________________________________
610
857
%%
611
858
%% Handling the state
612
859
%%
613
860
 
614
 
-record(state, {info, info_map, block_map, cfg}).
615
 
 
616
 
new_state(Cfg)->
617
 
  Start = hipe_icode_cfg:start(Cfg),  
618
 
  Info = case lists:keysearch(arg_type, 1, hipe_icode_cfg:info(Cfg)) of
619
 
           false ->
620
 
             Any = t_any(),
621
 
             lists:foldl(fun(X, Tree)->gb_trees:insert(X, Any, Tree)end,
622
 
                         empty(), hipe_icode_cfg:params(Cfg));
623
 
           {value,{_, ArgType}}->
624
 
             add_arg_types(hipe_icode_cfg:params(Cfg), ArgType)
625
 
         end,
626
 
  InfoMap = gb_trees:insert({Start, in}, Info, empty()),
627
 
  new_state(Cfg, InfoMap).
628
 
 
629
 
new_state(Cfg, InfoMap)->
630
 
  Start = hipe_icode_cfg:start(Cfg),  
631
 
  Block_map = gb_trees:insert({Start, inblock}, false, empty()),
632
 
  #state{info_map=InfoMap, cfg=Cfg, block_map=Block_map}.
633
 
 
634
 
add_arg_types(Args,Types)->
635
 
  add_arg_types(Args, Types, empty()).
636
 
 
637
 
add_arg_types([Arg|Args],[Type|Types], Acc)->
638
 
  add_arg_types(Args,Types, enter(Arg, Type, Acc));
639
 
add_arg_types([],[],Acc) ->
640
 
  Acc;
641
 
add_arg_types(A,B,_) ->
642
 
  exit({wrong_number_of_arguments, {A, B}}).
643
 
 
644
 
empty()->
645
 
  gb_trees:empty().
 
861
new_state(Cfg) ->
 
862
  Start = hipe_icode_cfg:start_label(Cfg),  
 
863
  BlockMap = gb_trees:insert({inblock, Start}, false, empty()),
 
864
  EdgeMap = gb_trees:empty(),
 
865
  #state{cfg=Cfg, block_map=BlockMap, edge_map=EdgeMap}.
646
866
 
647
867
state__cfg(#state{cfg=Cfg})->
648
868
  Cfg.
653
873
state__pred(#state{cfg=Cfg}, Label)->
654
874
  hipe_icode_cfg:pred(hipe_icode_cfg:pred_map(Cfg), Label).
655
875
 
 
876
state__redirect(S=#state{cfg=Cfg}, From, ToOld, ToNew)->
 
877
  NewCfg = hipe_icode_cfg:redirect(Cfg, From, ToOld, ToNew),
 
878
  S#state{cfg=NewCfg}.
 
879
 
656
880
state__bb(#state{cfg=Cfg}, Label)->
657
881
  hipe_icode_cfg:bb(Cfg, Label).
658
882
  
659
 
state__bb_update(S=#state{cfg=Cfg}, Label, BB)->
660
 
  NewCfg = hipe_icode_cfg:bb_update(Cfg, Label, BB),
 
883
state__bb_add(S=#state{cfg=Cfg}, Label, BB)->
 
884
  NewCfg = hipe_icode_cfg:bb_add(Cfg, Label, BB),
661
885
  S#state{cfg=NewCfg}.
662
886
 
663
 
state__info_in(S, Label)->
664
 
  state__info(S, {Label, in}).
665
 
 
666
 
state__info_out(S, Label)->
667
 
  state__info(S, {Label, out}).
668
 
 
669
 
state__info(#state{info_map=IM}, Label)->
670
 
  case gb_trees:lookup(Label, IM) of
671
 
    {value, Info}-> Info;
672
 
    _ -> empty()
673
 
  end.
674
 
 
675
 
state__info_in_update(S=#state{info_map=IM}, Label, Info)->
676
 
  case gb_trees:lookup({Label, in}, IM) of
677
 
    none ->
678
 
      S#state{info_map=gb_trees:enter({Label, in}, Info, IM)};
679
 
    {value, Info} ->
680
 
      fixpoint;
681
 
    {value, OldInfo} ->
682
 
      NewInfo = join_info_in(gb_trees:to_list(OldInfo), Info),
683
 
      S#state{info_map=gb_trees:enter({Label, in}, NewInfo, IM)}
684
 
  end.
685
 
 
686
 
state__info_out_update(S=#state{info_map=IM}, Label, Info)->
687
 
  S#state{info_map=gb_trees:enter({Label, out}, Info, IM)}.
688
 
 
689
887
state__map(S=#state{block_map=BM}, Label)->
690
888
  join_maps(state__pred(S, Label), BM).
691
889
 
692
 
state__map_update(S=#state{block_map=BM}, Label, Map, InBlock)->
693
 
  NewBM0 = gb_trees:enter(Label, Map, BM),
 
890
state__map_update(S=#state{block_map=BM}, Label, Map)->
 
891
  MapChanged = 
 
892
    case gb_trees:lookup(Label, BM) of
 
893
      {value, Map1} -> not match(Map1, Map);
 
894
      none -> true
 
895
    end,
 
896
  case MapChanged of
 
897
    true ->
 
898
      NewBM = gb_trees:enter(Label, Map, BM),
 
899
      S#state{block_map = NewBM};
 
900
    false ->
 
901
      fixpoint
 
902
  end.
 
903
 
 
904
state__join_in_block(S=#state{edge_map = Map}, Label)->
 
905
  Pred = state__pred(S, Label),
 
906
  Edges = [{X, Label} || X <- Pred],
 
907
  NewInBlock = join_in_block([gb_trees:lookup(X, Map) || X <- Edges]),
 
908
  case gb_trees:lookup({inblock_in, Label}, Map) of
 
909
    none ->
 
910
      NewMap = gb_trees:insert({inblock_in, Label}, NewInBlock, Map),
 
911
      {S#state{edge_map = NewMap}, NewInBlock};
 
912
    {value, NewInBlock} ->
 
913
      fixpoint;
 
914
    _Other ->
 
915
      NewMap = gb_trees:update({inblock_in, Label}, NewInBlock, Map),
 
916
      {S#state{edge_map = NewMap}, NewInBlock}
 
917
  end.
 
918
 
 
919
state__in_block_out_update(S=#state{edge_map = Map}, Label, NewInBlock)->
694
920
  Succ = state__succ(S, Label),
695
 
  Fun = fun(X, Acc)->gb_trees:enter({X, inblock}, InBlock, Acc)end,
696
 
  NewBM = lists:foldl(Fun, NewBM0, Succ),
697
 
  S#state{block_map=NewBM}.  
698
 
 
699
 
state__in_block(#state{block_map=BM}, Label)->
700
 
  case gb_trees:lookup({Label, inblock}, BM) of
701
 
    {value, Ans}->
702
 
      Ans
703
 
  end.
 
921
  Edges = [{Label, X} || X <- Succ],
 
922
  NewMap = update_edges(Edges, NewInBlock, Map),
 
923
  NewMap1 = gb_trees:enter({inblock_out, Label}, NewInBlock, NewMap),
 
924
  S#state{edge_map = NewMap1}.
 
925
 
 
926
update_edges([Edge|Left], NewInBlock, Map)->
 
927
  NewMap = gb_trees:enter(Edge, NewInBlock, Map),
 
928
  update_edges(Left, NewInBlock, NewMap);
 
929
update_edges([], _NewInBlock, NewMap) ->
 
930
  NewMap.
 
931
 
 
932
join_in_block([])->
 
933
  false;
 
934
join_in_block([none|_])->
 
935
  false;
 
936
join_in_block([{value, InBlock}|Left]) ->
 
937
  join_in_block(Left, InBlock).
 
938
 
 
939
join_in_block([none|_], _Current)->
 
940
  false;
 
941
join_in_block([{value, InBlock}|Left], Current) ->
 
942
  if Current =:= InBlock -> join_in_block(Left, Current);
 
943
     Current =:= false -> false;
 
944
     InBlock =:= false -> false;
 
945
     true -> exit("Basic block is in two different fp ebb:s")
 
946
  end;
 
947
join_in_block([], Current) ->
 
948
  Current.
 
949
        
 
950
 
 
951
state__get_in_block_in(#state{edge_map=Map}, Label)->
 
952
  gb_trees:get({inblock_in, Label}, Map).
 
953
 
 
954
state__get_in_block_out(#state{edge_map=Map}, Label)->
 
955
  gb_trees:get({inblock_out, Label}, Map).
 
956
 
 
957
 
 
958
new_worklist(#state{cfg=Cfg})->
 
959
  Start = hipe_icode_cfg:start_label(Cfg),
 
960
  {[Start], [], gb_sets:insert(Start, gb_sets:empty())}.
 
961
 
 
962
get_work({[Label|Left], List, Set})->
 
963
  {Label, {Left, List, gb_sets:delete(Label, Set)}};
 
964
get_work({[], [], _Set}) ->
 
965
  none;
 
966
get_work({[], List, Set}) ->
 
967
  get_work({lists:reverse(List), [], Set}).
 
968
 
 
969
add_work({List1, List2, Set}, [Label|Left])->
 
970
  case gb_sets:is_member(Label, Set) of
 
971
    true -> 
 
972
      add_work({List1, List2, Set}, Left);
 
973
    false -> 
 
974
      %%io:format("Added work: ~w\n", [Label]),
 
975
      NewSet = gb_sets:insert(Label, Set),
 
976
      add_work({List1, [Label|List2], NewSet}, Left)
 
977
  end;
 
978
add_work(WorkList, []) ->
 
979
  WorkList.
 
980
 
 
981
 
 
982
match(Tree1, Tree2)->
 
983
  match_1(gb_trees:to_list(Tree1), Tree2) andalso 
 
984
    match_1(gb_trees:to_list(Tree2), Tree1).
 
985
 
 
986
match_1([{Key, Val}|Left], Tree2)->
 
987
  case gb_trees:lookup(Key, Tree2) of
 
988
    {value, Val} ->
 
989
      match_1(Left, Tree2);
 
990
    _ -> false
 
991
  end;
 
992
match_1([], _) ->
 
993
  true.