← Back to branch summary

~rdoering/ubuntu/karmic/erlang/fix-535090

« back to all changes in this revision

Viewing changes to lib/compiler/src/v3_kernel.erl

  • Committer: Bazaar Package Importer
  • Author(s): Sergei Golovan
  • Date: 2009-02-15 16:42:52 UTC
  • mfrom: (3.1.2 squeeze)
  • Revision ID: james.westby@ubuntu.com-20090215164252-q5x4rcf8a5pbesb1
Tags: 1:12.b.5-dfsg-2
Upload to unstable after lenny is released.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/compiler/src/v3_kernel.erl
79
79
 
80
80
-export([module/2,format_error/1]).
81
81
 
82
 
-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,
83
 
                member/2,reverse/1,reverse/2]).
 
82
-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2]).
84
83
-import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]).
85
84
 
86
85
-compile({nowarn_deprecated_function, {erlang,hash,2}}).
563
562
validate_bin_element_size(#k_var{}) -> ok;
564
563
validate_bin_element_size(#k_int{val=V}) when V >= 0 -> ok;
565
564
validate_bin_element_size(#k_atom{val=all}) -> ok;
 
565
validate_bin_element_size(#k_atom{val=undefined}) -> ok;
566
566
validate_bin_element_size(_) -> throw(bad_element_size).
567
567
    
568
568
%% atomic_list([Cexpr], Sub, State) -> {[Kexpr],[PreKexpr],State}.
763
763
    case erl_internal:guard_bif(N, A) of
764
764
        true -> true;
765
765
        false ->
766
 
            case catch erl_internal:op_type(N, A) of
 
766
            try erl_internal:op_type(N, A) of
767
767
                arith -> true;
768
768
                bool -> true;
769
769
                comp -> true;
770
 
                _Other -> false         %List, send or not an op
 
770
                list -> false;
 
771
                send -> false
 
772
            catch
 
773
                _:_ -> false            % not an op
771
774
            end
772
775
    end;
773
776
is_remote_bif(_, _, _) -> false.
1058
1061
    [{Con,[C1|More]}|select_bin_con_2(Rest)];
1059
1062
select_bin_con_2([]) -> [].
1060
1063
 
 
1064
%% select_bin_int([Clause]) -> {k_bin_int,[Clause]}
 
1065
%%  If the first pattern in each clause selects the same integer,
 
1066
%%  rewrite all clauses to use #k_bin_int{} (which will later to
 
1067
%%  translated to a bs_match_string/4 instruction).
 
1068
%%
 
1069
%%  If it is not possible to do this rewrite, a 'not_possible'
 
1070
%%  exception is thrown.
 
1071
 
1061
1072
select_bin_int([#iclause{pats=[#k_bin_seg{anno=A,type=integer,
1062
1073
                                          size=#k_int{val=Bits0}=Sz,unit=U,
1063
1074
                                          flags=Fl,seg=#k_int{val=Val},
1064
1075
                                          next=N}|Ps]}=C|Cs0]) ->
1065
1076
    Bits = U * Bits0,
 
1077
    if
 
1078
        Bits > 1024 -> throw(not_possible); %Expands the code too much.
 
1079
        true -> ok
 
1080
    end,
 
1081
    select_assert_match_possible(Bits, Val, Fl),
1066
1082
    P = #k_bin_int{anno=A,size=Sz,unit=U,flags=Fl,val=Val,next=N},
1067
 
    select_assert_not_expensive(Bits, Val, Fl),
 
1083
    select_assert_match_possible(Bits, Val, Fl),
 
1084
    case member(native, Fl) of
 
1085
        true -> throw(not_possible);
 
1086
        false -> ok
 
1087
    end,
 
1088
    Cs = select_bin_int_1(Cs0, Bits, Fl, Val),
 
1089
    [{k_bin_int,[C#iclause{pats=[P|Ps]}|Cs]}];
 
1090
select_bin_int([#iclause{pats=[#k_bin_seg{anno=A,type=utf8,
 
1091
                                          flags=[unsigned,big]=Fl,
 
1092
                                          seg=#k_int{val=Val0},
 
1093
                                          next=N}|Ps]}=C|Cs0]) ->
 
1094
    {Val,Bits} = select_utf8(Val0),
 
1095
    P = #k_bin_int{anno=A,size=#k_int{val=Bits},unit=1,
 
1096
                   flags=Fl,val=Val,next=N},
1068
1097
    Cs = select_bin_int_1(Cs0, Bits, Fl, Val),
1069
1098
    [{k_bin_int,[C#iclause{pats=[P|Ps]}|Cs]}];
1070
1099
select_bin_int(_) -> throw(not_possible).
1078
1107
        Bits0*U =:= Bits -> ok;
1079
1108
        true -> throw(not_possible)
1080
1109
    end,
1081
 
    select_assert_not_expensive(Bits, Val, Fl),
1082
1110
    P = #k_bin_int{anno=A,size=Sz,unit=U,flags=Fl,val=Val,next=N},
1083
1111
    [C#iclause{pats=[P|Ps]}|select_bin_int_1(Cs, Bits, Fl, Val)];
 
1112
select_bin_int_1([#iclause{pats=[#k_bin_seg{anno=A,type=utf8,
 
1113
                                            flags=Fl,seg=#k_int{val=Val0},
 
1114
                                            next=N}|Ps]}=C|Cs],
 
1115
                 Bits, Fl, Val) ->
 
1116
    case select_utf8(Val0) of
 
1117
        {Val,Bits} -> ok;
 
1118
        {_,_} -> throw(not_possible)
 
1119
    end,
 
1120
    P = #k_bin_int{anno=A,size=#k_int{val=Bits},unit=1,
 
1121
                   flags=[unsigned,big],val=Val,next=N},
 
1122
    [C#iclause{pats=[P|Ps]}|select_bin_int_1(Cs, Bits, Fl, Val)];
1084
1123
select_bin_int_1([], _, _, _) -> [];
1085
1124
select_bin_int_1(_, _, _, _) -> throw(not_possible).
1086
1125
 
1087
 
select_assert_not_expensive(Sz, Val, Fs) ->
 
1126
select_assert_match_possible(Sz, Val, Fs) ->
1088
1127
    EmptyBindings = erl_eval:new_bindings(),
 
1128
    MatchFun = fun({integer,_,_}, NewV, Bs) when NewV =:= Val ->
 
1129
                       {match,Bs}
 
1130
               end,
1089
1131
    EvalFun = fun({integer,_,S}, B) -> {value,S,B} end,
1090
1132
    Expr = [{bin_element,0,{integer,0,Val},{integer,0,Sz},[{unit,1}|Fs]}],
1091
1133
    {value,Bin,EmptyBindings} = eval_bits:expr_grp(Expr, EmptyBindings, EvalFun),
 
1134
    try
 
1135
        {match,_} = eval_bits:match_bits(Expr, Bin,
 
1136
                                         EmptyBindings,
 
1137
                                         EmptyBindings,
 
1138
                                         MatchFun, EvalFun)
 
1139
    catch
 
1140
        throw:nomatch ->
 
1141
            throw(not_possible)
 
1142
    end.
 
1143
 
 
1144
select_utf8(Val0) ->
 
1145
    Bin = int_to_utf8(Val0),
 
1146
    Size = bit_size(Bin),
 
1147
    <<Val:Size>> = Bin,
 
1148
    {Val,Size}.
 
1149
 
 
1150
%% XXX Get rid of this function in the release following R12B-5.
 
1151
int_to_utf8(I) when 0 =< I, I =< 16#7F ->
 
1152
    <<I>>;
 
1153
int_to_utf8(I) when 0 =< I, I =< 16#7FF ->
 
1154
    B2 = I,
 
1155
    B1 = (I bsr 6),
 
1156
    <<1:1,1:1,0:1,B1:5,1:1,0:1,B2:6>>;
 
1157
int_to_utf8(I) when 0 =< I, I =< 16#FFFF ->
1092
1158
    if
1093
 
        bit_size(Bin) > 1024 ->
1094
 
            throw(not_possible);
1095
 
        true ->
1096
 
            ok
1097
 
    end.
 
1159
        16#D800 =< I, I =< 16#DFFF -> throw(not_possible);
 
1160
        true -> ok
 
1161
    end,
 
1162
    B3 = I,
 
1163
    B2 = (I bsr 6),
 
1164
    B1 = (I bsr 12),
 
1165
    <<1:1,1:1,1:1,0:1,B1:4,1:1,0:1,B2:6,1:1,0:1,B3:6>>;
 
1166
int_to_utf8(I) when 0 =< I, I =< 16#10FFFF ->
 
1167
    B4 = I,
 
1168
    B3 = (I bsr 6),
 
1169
    B2 = (I bsr 12),
 
1170
    B1 = (I bsr 18),
 
1171
    <<1:1,1:1,1:1,1:1,0:1,B1:3,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6>>;
 
1172
int_to_utf8(_) ->
 
1173
    throw(not_possible).
1098
1174
 
1099
1175
%% select(Con, [Clause]) -> [Clause].
1100
1176