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%%
17%% ============================================================================
18%%  Filename :  hipe_icode_ssa_const_prop.erl
19%%  Authors  :  Daniel Luna, Erik Andersson
20%%  Purpose  :  Perform sparse conditional constant propagation on Icode.
21%%  Notes    :  Works on the control-flow graph.
22%%
23%%  History  : * 2003-03-05: Created.
24%%             * 2003-08-11: Passed simple testsuite.
25%%             * 2003-10-01: Passed compiler testsuite.
26%% ============================================================================
27%%
28%% Exports: propagate/1.
29%%
30%% ============================================================================
31%%
32%% TODO:
33%%
34%% Take care of failures in call and replace operation with appropriate
35%% failure.
36%%
37%% Handle ifs with non-binary operators
38%%
39%% We want multisets for easier (and faster) creation of env->ssa_edges
40%%
41%% Maybe do things with begin_handler, begin_try if possible
42%%
43%% Propagation of constant arguments when some of the arguments are bottom
44%%
45%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
46
47-module(hipe_icode_ssa_const_prop).
48-export([propagate/1]).
49
50-include("../main/hipe.hrl").
51-include("hipe_icode.hrl").
52-include("../flow/cfg.hrl").
53-include("hipe_icode_primops.hrl").
54
55-define(CONST_PROP_MSG(Str,L), ok).
56%%-define(CONST_PROP_MSG(Str,L), io:format(Str,L)).
57
58%%-define(DEBUG, 1).
59
60%%-----------------------------------------------------------------------------
61%% Include stuff shared between SCCP on Icode and RTL.
62%% NOTE: Needs to appear after DEBUG is possibly defined.
63%%-----------------------------------------------------------------------------
64
65-define(CODE, hipe_icode).
66-define(CFG,  hipe_icode_cfg).
67
68-include("../ssa/hipe_ssa_const_prop.inc").
69
70%%-----------------------------------------------------------------------------
71
72visit_expression(Instruction, Environment) ->
73  EvaluatedArguments = [lookup_lattice_value(Argument, Environment)
74			|| Argument <- hipe_icode:args(Instruction)],
75  case Instruction of
76    #icode_move{}  ->
77      visit_move              (Instruction, EvaluatedArguments, Environment);
78    #icode_if{} ->
79      visit_if                (Instruction, EvaluatedArguments, Environment);
80    #icode_goto{} ->
81      visit_goto              (Instruction, EvaluatedArguments, Environment);
82    #icode_type{} ->
83      visit_type              (Instruction, EvaluatedArguments, Environment);
84    #icode_call{} ->
85      visit_call              (Instruction, EvaluatedArguments, Environment);
86    #icode_switch_val{} ->
87      visit_switch_val        (Instruction, EvaluatedArguments, Environment);
88    #icode_switch_tuple_arity{} ->
89      visit_switch_tuple_arity(Instruction, EvaluatedArguments, Environment);
90    #icode_begin_handler{} ->
91      visit_begin_handler     (Instruction, EvaluatedArguments, Environment);
92    #icode_begin_try{} ->
93      visit_begin_try         (Instruction, EvaluatedArguments, Environment);
94    #icode_fail{} ->
95      visit_fail              (Instruction, EvaluatedArguments, Environment);
96    #icode_comment{} -> {[], [], Environment};
97    #icode_end_try{} -> {[], [], Environment};
98    #icode_enter{} ->   {[], [], Environment};
99    #icode_label{} ->   {[], [], Environment};
100    #icode_return{} ->  {[], [], Environment}
101  end.
102
103%%-----------------------------------------------------------------------------
104
105visit_begin_try(Instruction, [], Environment) ->
106  Label     = hipe_icode:begin_try_label(Instruction),
107  Successor = hipe_icode:begin_try_successor(Instruction),
108  {[Label, Successor], [], Environment}.
109
110%%-----------------------------------------------------------------------------
111
112visit_begin_handler(Instruction, _Arguments, Environment) ->
113  Destinations = hipe_icode:begin_handler_dstlist(Instruction),
114  {Environment1, SSAWork} =
115    lists:foldl(fun (Dst, {Env0,Work0}) ->
116		    {Env, Work} = update_lattice_value({Dst, bottom}, Env0),
117		    {Env, Work ++ Work0}
118		end,
119		{Environment, []},
120		Destinations),
121  {[], SSAWork, Environment1}.
122
123%%-----------------------------------------------------------------------------
124
125visit_switch_val(Instruction, [Argument], Environment) ->
126  Cases     = hipe_icode:switch_val_cases(Instruction),
127  FailLabel = hipe_icode:switch_val_fail_label(Instruction),
128  case Argument of
129    bottom ->
130      FlowWork  = [Label || {_Value, Label} <- Cases],
131      FlowWork1 = [FailLabel | FlowWork],
132      {FlowWork1, [], Environment};
133    _ ->
134      Target = get_switch_target(Cases, Argument, FailLabel),
135      {[Target], [], Environment}
136  end.
137
138%%-----------------------------------------------------------------------------
139
140visit_switch_tuple_arity(Instruction, [Argument], Environment) ->
141  Cases     = hipe_icode:switch_tuple_arity_cases(Instruction),
142  FailLabel = hipe_icode:switch_tuple_arity_fail_label(Instruction),
143  case Argument of
144    bottom ->
145      FlowWork  = [Label || {_Value, Label} <- Cases],
146      FlowWork1 = [FailLabel | FlowWork],
147      {FlowWork1, [], Environment};
148    Constant ->
149      UnTagged = hipe_icode:const_value(Constant),
150      case is_tuple(UnTagged) of
151	true ->
152	  Target = get_switch_target(Cases, tuple_size(UnTagged), FailLabel),
153	  {[Target], [], Environment};
154	false ->
155	  {[FailLabel], [], Environment}
156      end
157  end.
158
159%%-----------------------------------------------------------------------------
160
161get_switch_target([], _Argument, FailLabel) ->
162  FailLabel;
163get_switch_target([{CaseValue, Target} | CaseList], Argument, FailLabel) ->
164  case CaseValue =:= Argument of
165    true ->
166      Target;
167    false ->
168      get_switch_target(CaseList, Argument, FailLabel)
169  end.
170
171%%-----------------------------------------------------------------------------
172
173visit_move(Instruction, [SourceValue], Environment) ->
174  Destination = hipe_icode:move_dst(Instruction),
175  {Environment1, SSAWork} = update_lattice_value({Destination, SourceValue},
176						 Environment),
177  {[], SSAWork, Environment1}.
178
179%%-----------------------------------------------------------------------------
180
181visit_if(Instruction, Arguments, Environment) ->
182  FlowWork =
183    case evaluate_if(hipe_icode:if_op(Instruction), Arguments) of
184      true ->
185	TrueLabel  = hipe_icode:if_true_label(Instruction),
186	[TrueLabel];
187      false ->
188	FalseLabel = hipe_icode:if_false_label(Instruction),
189	[FalseLabel];
190      bottom ->
191	TrueLabel  = hipe_icode:if_true_label(Instruction),
192	FalseLabel = hipe_icode:if_false_label(Instruction),
193	[TrueLabel, FalseLabel]
194    end,
195  {FlowWork, [], Environment}.
196
197%%-----------------------------------------------------------------------------
198
199visit_goto(Instruction, _Arguments, Environment) ->
200  GotoLabel = hipe_icode:goto_label(Instruction),
201  FlowWork  = [GotoLabel],
202  {FlowWork, [], Environment}.
203
204%%-----------------------------------------------------------------------------
205
206visit_fail(Instruction, _Arguments, Environment) ->
207  FlowWork = hipe_icode:successors(Instruction),
208  {FlowWork, [], Environment}.
209
210%%-----------------------------------------------------------------------------
211
212visit_type(Instruction, Values, Environment) ->
213  FlowWork =
214    case evaluate_type(hipe_icode:type_test(Instruction), Values) of
215      true ->
216	TrueLabel  = hipe_icode:type_true_label(Instruction),
217	[TrueLabel];
218    false ->
219	FalseLabel = hipe_icode:type_false_label(Instruction),
220	[FalseLabel];
221      bottom ->
222	TrueLabel  = hipe_icode:type_true_label(Instruction),
223	FalseLabel = hipe_icode:type_false_label(Instruction),
224	[TrueLabel, FalseLabel]
225    end,
226  {FlowWork, [], Environment}.
227
228%%-----------------------------------------------------------------------------
229
230visit_call(Ins, Args, Environment) ->
231  Dsts = hipe_icode:call_dstlist(Ins),
232  Fun = hipe_icode:call_fun(Ins),
233  Fail = call_fail_labels(Ins),
234  Cont = call_continuation_labels(Ins),
235  visit_call(Dsts, Args, Fun, Cont, Fail, Environment).
236
237visit_call(Dst, Args, Fun, Cont, Fail, Environment) ->
238  {FlowWork, {Environment1, SSAWork}} =
239    case lists:any(fun(X) -> (X =:= bottom) end, Args) of
240      true ->
241	{Fail ++ Cont, update_lattice_value({Dst, bottom}, Environment)};
242      false ->
243	ConstArgs = [hipe_icode:const_value(Argument) || Argument <- Args],
244	try evaluate_call_or_enter(ConstArgs, Fun) of
245	  bottom ->
246	    {Fail ++ Cont, update_lattice_value({Dst, bottom}, Environment)};
247	  Constant ->
248	    {Cont, update_lattice_value({Dst, Constant}, Environment)}
249	catch
250	  _:_ ->
251	    {Fail, update_lattice_value({Dst, bottom}, Environment)}
252	end
253    end,
254  {FlowWork, SSAWork, Environment1}.
255
256%%-----------------------------------------------------------------------------
257
258call_fail_labels(I) ->
259  case hipe_icode:call_fail_label(I) of
260    [] -> [];
261    Label -> [Label]
262  end.
263
264call_continuation_labels(I) ->
265  case hipe_icode:call_continuation(I) of
266    [] -> [];
267    Label -> [Label]
268  end.
269
270%%-----------------------------------------------------------------------------
271
272%% Unary calls
273evaluate_call_or_enter([Argument], Fun) ->
274  case Fun of
275    mktuple ->
276      hipe_icode:mk_const(list_to_tuple([Argument]));
277    unsafe_untag_float ->
278      hipe_icode:mk_const(float(Argument));
279    conv_to_float ->
280      hipe_icode:mk_const(float(Argument));
281    fnegate ->
282      hipe_icode:mk_const(0.0 - Argument);
283    'bnot' ->
284      hipe_icode:mk_const(Argument);
285    #unsafe_element{index=N} ->
286      hipe_icode:mk_const(element(N, Argument));
287    {erlang, hd, 1} ->
288      hipe_icode:mk_const(hd(Argument));
289    {erlang, tl, 1} ->
290      hipe_icode:mk_const(tl(Argument));
291    {erlang, atom_to_list, 1} ->
292      hipe_icode:mk_const(atom_to_list(Argument));
293    {erlang, list_to_atom, 1} ->
294      hipe_icode:mk_const(list_to_atom(Argument));
295    {erlang, tuple_to_list, 1} ->
296      hipe_icode:mk_const(tuple_to_list(Argument));
297    {erlang, list_to_tuple, 1} ->
298      hipe_icode:mk_const(list_to_tuple(Argument));
299    {erlang, length, 1} ->
300      hipe_icode:mk_const(length(Argument));
301    {erlang, size, 1} ->
302      hipe_icode:mk_const(size(Argument));
303    {erlang, bit_size, 1} ->
304      hipe_icode:mk_const(bit_size(Argument));
305    {erlang, byte_size, 1} ->
306      hipe_icode:mk_const(byte_size(Argument));
307    {erlang, tuple_size, 1} ->
308      hipe_icode:mk_const(tuple_size(Argument));
309    {erlang, abs, 1} ->
310      hipe_icode:mk_const(abs(Argument));
311    {erlang, round, 1} ->
312      hipe_icode:mk_const(round(Argument));
313    {erlang, trunc, 1} ->
314      hipe_icode:mk_const(trunc(Argument));
315    _ ->
316      bottom
317  end;
318%% Binary calls
319evaluate_call_or_enter([Argument1,Argument2], Fun) ->
320  case Fun of
321    '+' ->
322      hipe_icode:mk_const(Argument1 + Argument2);
323    '-' ->
324      hipe_icode:mk_const(Argument1 - Argument2);
325    '*' ->
326      hipe_icode:mk_const(Argument1 * Argument2);
327    '/' ->
328      hipe_icode:mk_const(Argument1 / Argument2);
329    'band' ->
330      hipe_icode:mk_const(Argument1 band Argument2);
331    'bor' ->
332      hipe_icode:mk_const(Argument1 bor Argument2);
333    'bsl' ->
334      hipe_icode:mk_const(Argument1 bsl Argument2);
335    'bsr' ->
336      hipe_icode:mk_const(Argument1 bsr Argument2);
337    'bxor' ->
338      hipe_icode:mk_const(Argument1 bxor Argument2);
339    fp_add ->
340      hipe_icode:mk_const(float(Argument1 + Argument2));
341    fp_sub ->
342      hipe_icode:mk_const(float(Argument1 - Argument2));
343    fp_mul ->
344      hipe_icode:mk_const(float(Argument1 * Argument2));
345    fp_div ->
346      hipe_icode:mk_const(Argument1 / Argument2);
347    cons ->
348      hipe_icode:mk_const([Argument1 | Argument2]);
349    mktuple ->
350      hipe_icode:mk_const(list_to_tuple([Argument1,Argument2]));
351    #unsafe_update_element{index=N} ->
352      hipe_icode:mk_const(setelement(N, Argument1, Argument2));
353    {erlang, '++', 2} ->
354      hipe_icode:mk_const(Argument1 ++ Argument2);
355    {erlang, '--', 2} ->
356      hipe_icode:mk_const(Argument1 -- Argument2);
357    {erlang, 'div', 2} ->
358      hipe_icode:mk_const(Argument1 div Argument2);
359    {erlang, 'rem', 2} ->
360      hipe_icode:mk_const(Argument1 rem Argument2);
361    {erlang, append_element, 2} ->
362      hipe_icode:mk_const(erlang:append_element(Argument1, Argument2));
363    {erlang, element, 2} ->
364      hipe_icode:mk_const(element(Argument1, Argument2));
365    _Other ->
366      %% io:format("In ~w(~w,~w)~n", [_Other,Argument1,Argument2]),
367      bottom
368  end;
369
370%% The rest of the calls
371evaluate_call_or_enter(Arguments, Fun) ->
372  case Fun of
373    mktuple ->
374      hipe_icode:mk_const(list_to_tuple(Arguments));
375    {erlang, setelement, 3} ->
376      [Argument1, Argument2, Argument3] = Arguments,
377      hipe_icode:mk_const(setelement(Argument1, Argument2, Argument3));
378    _ ->
379      bottom
380  end.
381
382%%-----------------------------------------------------------------------------
383
384evaluate_if(Conditional, [Argument1, Argument2]) ->
385  case ((Argument1 =:= bottom) or (Argument2 =:= bottom)) of
386    true  -> bottom;
387    false -> evaluate_if_const(Conditional, Argument1, Argument2)
388  end;
389evaluate_if(_Conditional, _Arguments) ->
390  bottom.
391
392%%-----------------------------------------------------------------------------
393
394evaluate_if_const(Conditional, Argument1, Argument2) ->
395  case Conditional of
396    '=:=' -> Argument1 =:= Argument2;
397    '=='  -> Argument1 ==  Argument2;
398    '=/=' -> Argument1 =/= Argument2;
399    '/='  -> Argument1  /= Argument2;
400    '<'   -> Argument1  <  Argument2;
401    '>='  -> Argument1  >= Argument2;
402    '=<'  -> Argument1 =<  Argument2;
403    '>'   -> Argument1  >  Argument2;
404    _     -> bottom
405  end.
406
407%%-----------------------------------------------------------------------------
408
409evaluate_type(Type, Vals) ->
410  case [X || X <- Vals, X =:= bottom] of
411    [] -> evaluate_type_const(Type, Vals);
412    _ -> bottom
413  end.
414
415%%-----------------------------------------------------------------------------
416
417evaluate_type_const(Type, [Arg|Left]) ->
418  Test =
419    case {Type, hipe_icode:const_value(Arg)} of
420      {nil,    []   }  -> true;
421      {nil,    _    }  -> false;
422      {cons,   [_|_]}  -> true;
423      {cons,   _    }  -> false;
424      {{tuple, N}, T} when tuple_size(T) =:= N -> true;
425      {atom,       A} when is_atom(A) -> true;
426      {{atom, A},  A} when is_atom(A) -> true;
427      {{record, A, S}, R} when tuple_size(R) =:= S,
428			       element(1, R) =:= A -> true;
429      {{record, _, _}, _} -> false;
430      _                -> bottom
431    end,
432  case Test of
433    bottom -> bottom;
434    false -> false;
435    true -> evaluate_type_const(Type, Left)
436  end;
437evaluate_type_const(_Type, []) ->
438  true.
439
440%%-----------------------------------------------------------------------------
441%% Icode-specific code below
442%%-----------------------------------------------------------------------------
443
444update_instruction(Instruction, Environment) ->
445  case Instruction of
446    #icode_call{} ->
447      update_call(Instruction, Environment);
448    #icode_enter{} ->
449      update_enter(Instruction, Environment);
450    #icode_if{} ->
451      update_if(Instruction, Environment);
452    #icode_move{} ->
453      update_move(Instruction, Environment);
454    #icode_phi{} ->
455     update_phi(Instruction, Environment);
456    #icode_switch_val{} ->
457      update_switch_val(Instruction, Environment);
458    #icode_type{} ->
459      update_type(Instruction, Environment);
460    #icode_switch_tuple_arity{} ->
461      update_switch_tuple_arity(Instruction, Environment);
462    %% We could but don't handle: catch?, fail?
463    #icode_begin_handler{} -> [Instruction];
464    #icode_begin_try{} ->     [Instruction];
465    #icode_comment{} ->       [Instruction];
466    #icode_end_try{} ->       [Instruction];
467    #icode_fail{} ->          [Instruction];
468    #icode_goto{} ->          [Instruction];
469    #icode_label{} ->         [Instruction];
470    #icode_return{} ->        [Instruction]
471  end.
472
473%%-----------------------------------------------------------------------------
474
475update_call(Instruction, Environment) ->
476  DestList = hipe_icode:call_dstlist(Instruction),
477  case DestList of
478    [Destination] ->
479      case lookup_lattice_value(Destination, Environment) of
480	bottom ->
481	  NewArguments = update_arguments(
482			   hipe_icode:call_args(Instruction),
483			   Environment),
484	  [hipe_icode:call_args_update(Instruction, NewArguments)];
485	X ->
486	  NewInstructions =
487	    case is_call_to_fp_op(Instruction) of
488	      true ->
489		TmpIns =
490		  hipe_icode:call_fun_update(Instruction, unsafe_untag_float),
491		[hipe_icode:call_args_update(TmpIns, [X])];
492	      false ->
493		case hipe_icode:call_continuation(Instruction) of
494		  [] ->
495		    [hipe_icode:mk_move(Destination, X)];
496		  ContinuationLabel ->
497		    [hipe_icode:mk_move(Destination, X),
498		     hipe_icode:mk_goto(ContinuationLabel)]
499		end
500	    end,
501	  ?CONST_PROP_MSG("call: ~w ---> ~w\n",
502			  [Instruction, NewInstructions]),
503	  NewInstructions
504      end;
505    %% [] ->  %% No destination; we don't touch this
506    %% List-> %% Means register allocation; not implemented at this point
507    _ ->
508      NewArguments = update_arguments(hipe_icode:call_args(Instruction),
509                                      Environment),
510      [hipe_icode:call_args_update(Instruction, NewArguments)]
511  end.
512
513%%-----------------------------------------------------------------------------
514
515is_call_to_fp_op(Instruction) ->
516  case hipe_icode:call_fun(Instruction) of
517    fp_add             -> true;
518    fp_sub             -> true;
519    fp_mul             -> true;
520    fp_div             -> true;
521    fnegate            -> true;
522    conv_to_float      -> true;
523    unsafe_untag_float -> true;
524    _                  -> false
525  end.
526
527%%-----------------------------------------------------------------------------
528
529update_enter(Instruction, Environment) ->
530  Args = hipe_icode:enter_args(Instruction),
531  EvalArgs = [lookup_lattice_value(X, Environment) || X <- Args],
532  Fun = hipe_icode:enter_fun(Instruction),
533  case lists:any(fun(X) -> (X =:= bottom) end, EvalArgs) of
534    true ->
535      update_enter_arguments(Instruction, Environment);
536    false ->
537      ConstVals = [hipe_icode:const_value(X) || X <- EvalArgs],
538      try evaluate_call_or_enter(ConstVals, Fun) of
539	bottom ->
540	  update_enter_arguments(Instruction, Environment);
541	Const ->
542	  Dst = hipe_icode:mk_new_var(),
543	  [hipe_icode:mk_move(Dst, Const),
544	   hipe_icode:mk_return([Dst])]
545      catch
546	_:_ ->
547	  update_enter_arguments(Instruction, Environment)
548      end
549  end.
550
551update_enter_arguments(Instruction, Env) ->
552  NewArguments = update_arguments(hipe_icode:enter_args(Instruction), Env),
553  [hipe_icode:enter_args_update(Instruction, NewArguments)].
554
555%%-----------------------------------------------------------------------------
556
557update_if(Instruction, Environment) ->
558  Args = hipe_icode:if_args(Instruction),
559  EvaluatedArguments = [lookup_lattice_value(Argument, Environment)
560                        || Argument <- Args],
561  Op = hipe_icode:if_op(Instruction),
562  case evaluate_if(Op, EvaluatedArguments) of
563    true ->
564      TrueLabel  = hipe_icode:if_true_label(Instruction),
565      ?CONST_PROP_MSG("ifT: ~w ---> goto ~w\n", [Instruction, TrueLabel]),
566      [hipe_icode:mk_goto(TrueLabel)];
567    false ->
568      FalseLabel = hipe_icode:if_false_label(Instruction),
569      ?CONST_PROP_MSG("ifF: ~w ---> goto ~w\n", [Instruction, FalseLabel]),
570      [hipe_icode:mk_goto(FalseLabel)];
571    bottom ->
572      %% Convert the if-test to a type test if possible.
573      Op = hipe_icode:if_op(Instruction),
574      case Op =:= '=:=' orelse Op =:= '=/=' of
575	false ->
576	  [hipe_icode:if_args_update(
577	     Instruction, update_arguments(Args, Environment))];
578	true ->
579	  [Arg1, Arg2] = Args,
580	  case EvaluatedArguments of
581	    [bottom, bottom] ->
582	      [Instruction];
583	    [bottom, X] ->
584	      conv_if_to_type(Instruction, hipe_icode:const_value(X), Arg1);
585	    [X, bottom] ->
586	      conv_if_to_type(Instruction, hipe_icode:const_value(X), Arg2)
587	  end
588      end
589  end.
590
591conv_if_to_type(I, Const, Arg) when is_atom(Const);
592				    is_integer(Const);
593				    Const =:= [] ->
594  Test =
595    if is_atom(Const) -> {atom, Const};
596       is_integer(Const) -> {integer, Const};
597       true -> nil
598    end,
599  {T, F} =
600    case hipe_icode:if_op(I) of
601      '=:=' -> {hipe_icode:if_true_label(I),hipe_icode:if_false_label(I)};
602      '=/=' -> {hipe_icode:if_false_label(I),hipe_icode:if_true_label(I)}
603    end,
604  NewI = hipe_icode:mk_type([Arg], Test, T, F),
605  ?CONST_PROP_MSG("if: ~w ---> type ~w\n", [I, NewI]),
606  [NewI];
607conv_if_to_type(I, Const, Arg) ->
608  %% Note: we are potentially commuting the (equality) comparison here
609  [hipe_icode:if_args_update(I, [Arg, hipe_icode:mk_const(Const)])].
610
611%%-----------------------------------------------------------------------------
612
613update_move(Instruction, Environment) ->
614  Destination = hipe_icode:move_dst(Instruction),
615  case lookup_lattice_value(Destination, Environment) of
616    bottom ->
617      [Instruction];
618    X ->
619      case hipe_icode:move_src(Instruction) of
620	X ->
621	  [Instruction];
622	_ ->
623	  ?CONST_PROP_MSG("move: ~w ---> ~w\n", [Instruction, X]),
624	  [hipe_icode:move_src_update(Instruction, X)]
625      end
626      %% == [hipe_icode:mk_move(Destination, X)]
627  end.
628
629%%-----------------------------------------------------------------------------
630
631update_phi(Instruction, Environment) ->
632  Destination = hipe_icode:phi_dst(Instruction),
633  case lookup_lattice_value(Destination, Environment) of
634    bottom ->
635      [Instruction];
636    X ->
637      ?CONST_PROP_MSG("phi: ~w ---> ~w\n", [Instruction, X]),
638      [hipe_icode:mk_move(Destination, X)]
639  end.
640
641%%-----------------------------------------------------------------------------
642
643update_type(Instruction, Environment) ->
644  EvaluatedArguments = [lookup_lattice_value(Argument, Environment) ||
645                         Argument <- hipe_icode:type_args(Instruction)],
646  case evaluate_type(hipe_icode:type_test(Instruction), EvaluatedArguments) of
647    true ->
648      TrueLabel  = hipe_icode:type_true_label(Instruction),
649      ?CONST_PROP_MSG("typeT: ~w ---> goto ~w\n", [Instruction, TrueLabel]),
650      [hipe_icode:mk_goto(TrueLabel)];
651    false ->
652      FalseLabel = hipe_icode:type_false_label(Instruction),
653      ?CONST_PROP_MSG("typeF: ~w ---> goto ~w\n", [Instruction, FalseLabel]),
654      [hipe_icode:mk_goto(FalseLabel)];
655    bottom ->
656      [Instruction]
657  end.
658
659%%-----------------------------------------------------------------------------
660
661update_switch_val(Instruction, Environment) ->
662  Argument = hipe_icode:switch_val_term(Instruction),
663  Value    = lookup_lattice_value(Argument, Environment),
664  case Value of
665    bottom ->
666      [Instruction];
667    _ ->
668      Cases     = hipe_icode:switch_val_cases(Instruction),
669      FailLabel = hipe_icode:switch_val_fail_label(Instruction),
670      Target    = get_switch_target(Cases, Value, FailLabel),
671      ?CONST_PROP_MSG("sv: ~w ---> goto ~w\n", [Instruction, Target]),
672      [hipe_icode:mk_goto(Target)]
673  end.
674
675%%-----------------------------------------------------------------------------
676
677update_switch_tuple_arity(Instruction, Environment) ->
678  Argument = hipe_icode:switch_tuple_arity_term(Instruction),
679  Value    = lookup_lattice_value(Argument, Environment),
680  case Value of
681    bottom ->
682      [Instruction];
683    Constant ->
684      UnTagged = hipe_icode:const_value(Constant),
685      case is_tuple(UnTagged) of
686	true ->
687	  Cases     = hipe_icode:switch_tuple_arity_cases(Instruction),
688	  FailLabel = hipe_icode:switch_tuple_arity_fail_label(Instruction),
689	  Target = get_switch_target(Cases, tuple_size(UnTagged), FailLabel),
690	  ?CONST_PROP_MSG("sta: ~w ---> goto ~w\n", [Instruction, Target]),
691	  [hipe_icode:mk_goto(Target)];
692	false ->
693	  [Instruction]
694          %% TODO: Can the above be replaced with below??? Perhaps
695	  %% together with some sort of "generate failure".
696	  %% [hipe_icode:mk_goto(FailLabel)]
697      end
698  end.
699
700%%-----------------------------------------------------------------------------
701
702lookup_lattice_value(X, Environment) ->
703  LatticeValues = env__lattice_values(Environment),
704  case hipe_icode:is_const(X) of
705    true ->
706      X;
707    false ->
708      case gb_trees:lookup(X, LatticeValues) of
709	none ->
710	  ?WARNING_MSG("Earlier compiler steps generated erroneous "
711		       "code for X = ~w. We are ignoring this.\n",[X]),
712	  bottom;
713	{value, top} ->
714	  ?EXIT({"lookup_lattice_value, top", X});
715	{value, Y} ->
716	  Y
717      end
718  end.
719
720%%-----------------------------------------------------------------------------
721
722update_arguments(ArgumentList, Environment) ->
723  [case lookup_lattice_value(X, Environment) of
724     bottom ->
725       X;
726     Constant ->
727       Constant
728   end || X <- ArgumentList].
729
730%%----------------------------- End of file -----------------------------------
731