diff options
Diffstat (limited to 'lib')
98 files changed, 8994 insertions, 1975 deletions
diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile index 0f9e044f9e..9d751996ad 100644 --- a/lib/common_test/src/Makefile +++ b/lib/common_test/src/Makefile @@ -80,6 +80,7 @@ MODULES= \ ct_groups \ ct_property_test \ ct_release_test \ + ct_default_gl \ erl2html2 \ test_server_ctrl \ test_server_gl \ diff --git a/lib/common_test/src/ct_default_gl.erl b/lib/common_test/src/ct_default_gl.erl new file mode 100644 index 0000000000..d1b52e5f4f --- /dev/null +++ b/lib/common_test/src/ct_default_gl.erl @@ -0,0 +1,83 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(ct_default_gl). +-export([start_link/1, stop/0]). + +-export([init/1,handle_call/3,handle_cast/2,handle_info/2,terminate/2]). + +%% start_link() +%% Start a new group leader process. +start_link(ParentGL) -> + do_start(ParentGL, 3). + +do_start(_ParentGL, 0) -> + exit({?MODULE,startup}); +do_start(ParentGL, Retries) -> + case whereis(?MODULE) of + undefined -> + case gen_server:start_link(?MODULE, [ParentGL], []) of + {ok,Pid} -> + {ok,Pid}; + Other -> + Other + end; + Pid -> + exit(Pid, kill), + timer:sleep(1000), + do_start(ParentGL, Retries-1) + end. + +%% stop(Pid) +%% Stop a group leader process. +stop() -> + gen_server:cast(whereis(?MODULE), stop). + + +%%% Internal functions. + +init([ParentGL]) -> + register(?MODULE, self()), + {ok,#{parent_gl_pid => ParentGL, + parent_gl_monitor => erlang:monitor(process,ParentGL)}}. + +handle_cast(stop, St) -> + {stop,normal,St}. + +%% If the parent group leader dies, fall back on using the local user process +handle_info({'DOWN',Ref,process,_,_Reason}, #{parent_gl_monitor := Ref} = St) -> + User = whereis(user), + {noreply,St#{parent_gl_pid => User, + parent_gl_monitor => erlang:monitor(process,User)}}; + +handle_info({io_request,_From,_ReplyAs,_Req} = IoReq, + #{parent_gl_pid := ParentGL} = St) -> + ParentGL ! IoReq, + {noreply,St}; + +handle_info(Msg, St) -> + io:format(user, "Common Test Group Leader process got: ~tp~n", [Msg]), + {noreply,St}. + +handle_call(_Req, _From, St) -> + {reply,ok,St}. + +terminate(_, _) -> + ok. diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index 104515e57e..291a4d716c 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -307,7 +307,7 @@ add_defaults(Mod,Func, GroupPath) -> "~w:suite/0 failed: ~p~n", [Suite,Reason]), io:format(ErrStr, []), - io:format(user, ErrStr, []), + io:format(?def_gl, ErrStr, []), {suite0_failed,{exited,Reason}}; SuiteInfo when is_list(SuiteInfo) -> case lists:all(fun(E) when is_tuple(E) -> true; @@ -330,7 +330,7 @@ add_defaults(Mod,Func, GroupPath) -> "~w:suite/0: ~p~n", [Suite,SuiteInfo]), io:format(ErrStr, []), - io:format(user, ErrStr, []), + io:format(?def_gl, ErrStr, []), {suite0_failed,bad_return_value} end; SuiteInfo -> @@ -338,7 +338,7 @@ add_defaults(Mod,Func, GroupPath) -> "Invalid return value from " "~w:suite/0: ~p~n", [Suite,SuiteInfo]), io:format(ErrStr, []), - io:format(user, ErrStr, []), + io:format(?def_gl, ErrStr, []), {suite0_failed,bad_return_value} end. @@ -366,7 +366,7 @@ add_defaults1(Mod,Func, GroupPath, SuiteInfo) -> "~w:group(~w): ~p~n", [Mod,GrName,BadGr0Val]), io:format(Gr0ErrStr, []), - io:format(user, Gr0ErrStr, []), + io:format(?def_gl, Gr0ErrStr, []), {group0_failed,bad_return_value}; _ -> Args = if Func == init_per_group ; Func == end_per_group -> @@ -388,7 +388,7 @@ add_defaults1(Mod,Func, GroupPath, SuiteInfo) -> "~w:~w/0: ~p~n", [Mod,Func,BadTC0Val]), io:format(TC0ErrStr, []), - io:format(user, TC0ErrStr, []), + io:format(?def_gl, TC0ErrStr, []), {testcase0_failed,bad_return_value}; _ -> %% let test case info (also for all config funcs) override @@ -927,7 +927,7 @@ error_notification(Mod,Func,_Args,{Error,Loc}) -> Div = "~n- - - - - - - - - - - - - - - - - - - " "- - - - - - - - - - - - - - - - - - - - -~n", ErrorStr2 = io_lib:format(ErrorFormat, ErrorArgs), - io:format(user, lists:concat([Div,ErrorStr2,Div,"~n"]), + io:format(?def_gl, lists:concat([Div,ErrorStr2,Div,"~n"]), []), Link = "\n\n<a href=\"#end\">" @@ -1133,7 +1133,7 @@ get_all(Mod, ConfTests) -> ErrStr = io_lib:format("~n*** ERROR *** " "~w:all/0 failed: ~p~n", [Mod,ExitReason]), - io:format(user, ErrStr, []), + io:format(?def_gl, ErrStr, []), %% save the error info so it doesn't get printed twice ct_util:set_testdata_async({{error_in_suite,Mod}, ExitReason}); diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index 9282a9f81d..0daed60dba 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -531,8 +531,13 @@ tc_print(Category,Importance,Format,Args) -> Val end, if Importance >= (100-VLvl) -> - Head = get_heading(Category), - io:format(user, lists:concat([Head,Format,"\n\n"]), Args), + Str = lists:concat([get_heading(Category),Format,"\n\n"]), + try + io:format(?def_gl, Str, Args) + catch + %% default group leader probably not started, or has stopped + _:_ -> io:format(user, Str, Args) + end, ok; true -> ok @@ -679,7 +684,7 @@ logger(Parent, Mode, Verbosity) -> PrivFilesDestRun = [filename:join(AbsDir, F) || F <- PrivFiles], case copy_priv_files(PrivFilesSrc, PrivFilesDestTop) of {error,Src1,Dest1,Reason1} -> - io:format(user, "ERROR! "++ + io:format(?def_gl, "ERROR! "++ "Priv file ~p could not be copied to ~p. "++ "Reason: ~p~n", [Src1,Dest1,Reason1]), @@ -687,7 +692,7 @@ logger(Parent, Mode, Verbosity) -> ok -> case copy_priv_files(PrivFilesSrc, PrivFilesDestRun) of {error,Src2,Dest2,Reason2} -> - io:format(user, + io:format(?def_gl, "ERROR! "++ "Priv file ~p could not be copied to ~p. " ++"Reason: ~p~n", diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index fbb9c7ab60..a049ef5695 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -2155,8 +2155,8 @@ continue(_MakeErrors, true) -> false; continue(_MakeErrors, _AbortIfMissingSuites) -> io:nl(), - OldGl = group_leader(), - case set_group_leader_same_as_shell() of + OldGL = group_leader(), + case set_group_leader_same_as_shell(OldGL) of true -> S = self(), io:format("Failed to compile or locate one " @@ -2172,7 +2172,7 @@ continue(_MakeErrors, _AbortIfMissingSuites) -> S ! false end end), - group_leader(OldGl, self()), + group_leader(OldGL, self()), receive R when R==true; R==false -> R after 15000 -> @@ -2184,7 +2184,9 @@ continue(_MakeErrors, _AbortIfMissingSuites) -> true end. -set_group_leader_same_as_shell() -> +set_group_leader_same_as_shell(OldGL) -> + %% find the group leader process on the node in a dirty fashion + %% (check initial function call and look in the process dictionary) GS2or3 = fun(P) -> case process_info(P,initial_call) of {initial_call,{group,server,X}} when X == 2 ; X == 3 -> @@ -2197,7 +2199,10 @@ set_group_leader_same_as_shell() -> true == lists:keymember(shell,1, element(2,process_info(P,dictionary)))] of [GL|_] -> - group_leader(GL, self()); + %% check if started from remote node (skip interaction) + if node(OldGL) /= node(GL) -> false; + true -> group_leader(GL, self()) + end; [] -> false end. diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index 82a8743cf0..4d3a2ae7e3 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -188,6 +188,8 @@ do_start(Parent, Mode, LogDir, Verbosity) -> ok end, + ct_default_gl:start_link(group_leader()), + {StartTime,TestLogDir} = ct_logs:init(Mode, Verbosity), ct_event:notify(#event{name=test_start, @@ -474,6 +476,7 @@ loop(Mode,TestData,StartDir) -> ct_logs:close(Info, StartDir), ct_event:stop(), ct_config:stop(), + ct_default_gl:stop(), ok = file:set_cwd(StartDir), return(From, Info); {Ref, _Msg} when is_reference(Ref) -> @@ -926,7 +929,8 @@ warn_duplicates(Suites) -> [] -> ok; _ -> - io:format(user,"~nWARNING! Deprecated function: ~w:sequences/0.~n" + io:format(?def_gl, + "~nWARNING! Deprecated function: ~w:sequences/0.~n" " Use group with sequence property instead.~n",[Mod]) end end, @@ -980,12 +984,12 @@ get_profile_data(Profile, Key, StartDir) -> end, case Result of {error,enoent} when Profile /= default -> - io:format(user, "~nERROR! Missing profile file ~p~n", [File]), + io:format(?def_gl, "~nERROR! Missing profile file ~p~n", [File]), undefined; {error,enoent} when Profile == default -> undefined; {error,Reason} -> - io:format(user,"~nERROR! Error in profile file ~p: ~p~n", + io:format(?def_gl,"~nERROR! Error in profile file ~p: ~p~n", [WhichFile,Reason]), undefined; {ok,Data} -> @@ -995,7 +999,7 @@ get_profile_data(Profile, Key, StartDir) -> _ when is_list(Data) -> Data; _ -> - io:format(user, + io:format(?def_gl, "~nERROR! Invalid profile data in ~p~n", [WhichFile]), [] @@ -1082,10 +1086,10 @@ open_url(iexplore, Args, URL) -> Path = proplists:get_value(default, Paths), [Cmd | _] = string:tokens(Path, "%"), Cmd1 = Cmd ++ " " ++ Args ++ " " ++ URL, - io:format(user, "~nOpening ~ts with command:~n ~ts~n", [URL,Cmd1]), + io:format(?def_gl, "~nOpening ~ts with command:~n ~ts~n", [URL,Cmd1]), open_port({spawn,Cmd1}, []); _ -> - io:format("~nNo path to iexplore.exe~n",[]) + io:format(?def_gl, "~nNo path to iexplore.exe~n",[]) end, win32reg:close(R), ok; @@ -1095,6 +1099,6 @@ open_url(Prog, Args, URL) -> is_list(Prog) -> Prog end, Cmd = ProgStr ++ " " ++ Args ++ " " ++ URL, - io:format(user, "~nOpening ~ts with command:~n ~ts~n", [URL,Cmd]), + io:format(?def_gl, "~nOpening ~ts with command:~n ~ts~n", [URL,Cmd]), open_port({spawn,Cmd},[]), ok. diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl index d7efa26863..039c8168ec 100644 --- a/lib/common_test/src/ct_util.hrl +++ b/lib/common_test/src/ct_util.hrl @@ -23,6 +23,7 @@ -define(board_table,ct_boards). -define(suite_table,ct_suite_data). -define(verbosity_table,ct_verbosity_table). +-define(def_gl, ct_default_gl). -record(conn, {handle, targetref, diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index b5ca6c3c49..c37f731d8c 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -49,7 +49,6 @@ MODULES = \ beam_a \ beam_asm \ beam_block \ - beam_bool \ beam_bs \ beam_bsm \ beam_clean \ diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl deleted file mode 100644 index 99e4ccb1e9..0000000000 --- a/lib/compiler/src/beam_bool.erl +++ /dev/null @@ -1,765 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% Purpose: Optimizes booleans in guards. - --module(beam_bool). - --export([module/2]). - --import(lists, [reverse/1,reverse/2,foldl/3,mapfoldl/3,map/2]). - --record(st, - {next, %Next label number. - ll %Live regs at labels. - }). - -module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> - %%io:format("~p:\n", [Mod]), - {Fs,_} = mapfoldl(fun(Fn, Lbl) -> function(Fn, Lbl) end, 100000000, Fs0), - {ok,{Mod,Exp,Attr,Fs,Lc}}. - -function({function,Name,Arity,CLabel,Is0}, Lbl0) -> - try - {Is,#st{next=Lbl}} = bool_opt(Is0, Lbl0), - {{function,Name,Arity,CLabel,Is},Lbl} - catch - Class:Error -> - Stack = erlang:get_stacktrace(), - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) - end. - -%% -%% Optimize boolean expressions that use guard bifs. Rewrite to -%% use test instructions if possible. -%% - -bool_opt(Asm, Lbl) -> - LiveInfo = beam_utils:index_labels(Asm), - bopt(Asm, [], #st{next=Lbl,ll=LiveInfo}). - -bopt([{block,Bl0}=Block| - [{jump,{f,Succ}}, - {label,Fail}, - {block,[{set,[Dst],[{atom,false}],move}]}, - {label,Succ}|Is]=Is0], Acc0, St) -> - case split_block(Bl0, Dst, Fail, Acc0, true) of - failed -> - bopt(Is0, [Block|Acc0], St); - {Bl,PreBlock} -> - Acc1 = case PreBlock of - [] -> Acc0; - _ -> [{block,PreBlock}|Acc0] - end, - Acc = [{protected,[Dst],Bl,{Fail,Succ}}|Acc1], - bopt(Is, Acc, St) - end; -bopt([{test,is_eq_exact,{f,Fail},[Reg,{atom,true}]}=I|Is], [{block,_}|_]=Acc0, St0) -> - case bopt_block(Reg, Fail, Is, Acc0, St0) of - failed -> bopt(Is, [I|Acc0], St0); - {Acc,St} -> bopt(Is, Acc, St) - end; -bopt([I|Is], Acc, St) -> - bopt(Is, [I|Acc], St); -bopt([], Acc, St) -> - {bopt_reverse(Acc, []),St}. - -bopt_reverse([{protected,[Dst],Block,{Fail,Succ}}|Is], Acc0) -> - Acc = [{block,Block},{jump,{f,Succ}}, - {label,Fail}, - {block,[{set,[Dst],[{atom,false}],move}]}, - {label,Succ}|Acc0], - bopt_reverse(Is, Acc); -bopt_reverse([I|Is], Acc) -> - bopt_reverse(Is, [I|Acc]); -bopt_reverse([], Acc) -> Acc. - -%% bopt_block(Reg, Fail, OldIs, Accumulator, St) -> failed | {NewAcc,St} -%% Attempt to optimized a block of guard BIFs followed by a test -%% instruction. -bopt_block(Reg, Fail, OldIs, [{block,Bl0}|Acc0], St0) -> - case split_block(Bl0, Reg, Fail, Acc0, false) of - failed -> - %% Reason for failure: The block either contained no - %% guard BIFs with the failure label Fail, or the final - %% instruction in the block did not assign the Reg register. - - %%io:format("split ~p: ~P\n", [Reg,Bl0,20]), - failed; - {Bl1,BlPre} -> - %% The block has been splitted. Bl1 is a non-empty list - %% of guard BIF instructions having the failure label Fail. - %% BlPre is a (possibly empty list) of instructions preceeding - %% Bl1. - Acc1 = make_block(BlPre, Acc0), - {Bl,Acc} = extend_block(Bl1, Fail, Acc1), - try - {NewCode,St} = bopt_tree_cg(Bl, Fail, St0), - ensure_opt_safe(Bl, NewCode, OldIs, Fail, Acc, St), - {NewCode++Acc,St} - catch - %% Not possible to rewrite because a boolean value is - %% passed to another guard bif, e.g. 'abs(A > B)' - %% (in this case, obviously nonsense code). Rare in - %% practice. - throw:mixed -> - failed; - - %% There was a reference to a boolean expression - %% from inside a protected block (try/catch), to - %% a boolean expression outside. - throw:protected_barrier -> - failed; - - %% The 'xor' operator was used. We currently don't - %% find it worthwile to translate 'xor' operators - %% (the code would be clumsy). - throw:'xor' -> - failed; - - %% The block does not contain a boolean expression, - %% but only a call to a guard BIF. - %% For instance: ... when element(1, T) -> - throw:not_boolean_expr -> - failed; - - %% The optimization is not safe. (A register - %% used by the instructions following the - %% optimized code is either not assigned a - %% value at all or assigned a different value.) - throw:all_registers_not_killed -> - failed; - throw:registers_used -> - failed; - - %% A protected block refered to the value - %% returned by another protected block, - %% probably because the Core Erlang code - %% used nested try/catches in the guard. - %% (v3_core never produces nested try/catches - %% in guards, so it must have been another - %% Core Erlang translator.) - throw:protected_violation -> - failed; - - %% Failed to work out the live registers for a GC - %% BIF. For example, if the number of live registers - %% needed to be 4 because {x,3} was a source register, - %% but {x,2} was not known to be initialized, this - %% exception would be thrown. - throw:gc_bif_alloc_failure -> - failed - - end - end. - -%% ensure_opt_safe(OriginalCode, OptCode, FollowingCode, Fail, -%% ReversedPrecedingCode, State) -> ok -%% Comparing the original code to the optimized code, determine -%% whether the optimized code is guaranteed to work in the same -%% way as the original code. -%% -%% Throw an exception if the optimization is not safe. -%% -ensure_opt_safe(Bl, NewCode, OldIs, Fail, PrecedingCode, St) -> - %% Here are the conditions that must be true for the - %% optimization to be safe. - %% - %% 1. If a register is INITIALIZED by PrecedingCode, - %% then if that register assigned a value in the original - %% code, but not in the optimized code, it must be UNUSED or KILLED - %% in the code that follows. - %% - %% 2. If a register is not known to be INITIALIZED by PreccedingCode, - %% then if that register assigned a value in the original - %% code, but not in the optimized code, it must be KILLED - %% by the code that follows. - %% - %% 3. Any register that is assigned a value in the optimized - %% code must be UNUSED or KILLED in the following code, - %% unless we can be sure that it is always assigned the same - %% value. - - InitInPreceding = initialized_regs(PrecedingCode), - - PrevDst = dst_regs(Bl), - NewDst = dst_regs(NewCode), - NotSet = ordsets:subtract(PrevDst, NewDst), - MustBeKilled = ordsets:subtract(NotSet, InitInPreceding), - - case all_killed(MustBeKilled, OldIs, Fail, St) of - false -> throw(all_registers_not_killed); - true -> ok - end, - MustBeUnused = ordsets:subtract(ordsets:union(NotSet, NewDst), - MustBeKilled), - case none_used(MustBeUnused, OldIs, Fail, St) of - false -> throw(registers_used); - true -> ok - end, - ok. - -update_fail_label([{set,Ds,As,{bif,N,{f,_}}}|Is], Fail, Acc) -> - update_fail_label(Is, Fail, [{set,Ds,As,{bif,N,{f,Fail}}}|Acc]); -update_fail_label([{set,Ds,As,{alloc,Regs,{gc_bif,N,{f,_}}}}|Is], Fail, Acc) -> - update_fail_label(Is, Fail, - [{set,Ds,As,{alloc,Regs,{gc_bif,N,{f,Fail}}}}|Acc]); -update_fail_label([], _, Acc) -> reverse(Acc). - -make_block(Bl) -> - make_block(Bl, []). - -make_block([], Acc) -> Acc; -make_block(Bl, Acc) -> [{block,Bl}|Acc]. - -extend_block(BlAcc, Fail, [{protected,_,_,_}=Prot|OldAcc]) -> - extend_block([Prot|BlAcc], Fail, OldAcc); -extend_block(BlAcc0, Fail, [{block,Is0}|OldAcc]) -> - case extend_block_1(reverse(Is0), Fail, BlAcc0) of - {BlAcc,[]} -> extend_block(BlAcc, Fail, OldAcc); - {BlAcc,Is} -> {BlAcc,[{block,Is}|OldAcc]} - end; -extend_block(BlAcc, _, OldAcc) -> {BlAcc,OldAcc}. - -extend_block_1([{set,[{x,_}],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) -> - extend_block_1(Is, Fail, [I|Acc]); -extend_block_1([{set,[{x,_}],As,{bif,Bif,_}}=I|Is]=Is0, Fail, Acc) -> - case safe_bool_op(Bif, length(As)) of - false -> {Acc,reverse(Is0)}; - true -> extend_block_1(Is, Fail, [I|Acc]) - end; -extend_block_1([_|_]=Is, _, Acc) -> {Acc,reverse(Is)}; -extend_block_1([], _, Acc) -> {Acc,[]}. - -%% split_block([Instruction], Destination, FailLabel, [PreInstruction], -%% ProhibitFailLabelInPreBlock) -> failed | {Block,PreBlock} -%% Split a sequence of instructions into two blocks - one containing -%% all guard bif instructions and a pre-block all instructions before -%% the guard BIFs. - -split_block(Is0, Dst, Fail, PreIs, ProhibitFailLabel) -> - case ProhibitFailLabel andalso beam_jump:is_label_used_in(Fail, PreIs) of - true -> - %% The failure label was used in one of the instructions (most - %% probably bit syntax construction) preceeding the block, - %% the caller might eliminate the label. - failed; - false -> - case reverse(Is0) of - [{set,[Dst],_,_}|_]=Is -> - split_block_1(Is, Fail, ProhibitFailLabel); - _ -> failed - end - end. - -split_block_1(Is, Fail, ProhibitFailLabel) -> - case split_block_2(Is, Fail, []) of - {[],_} -> failed; - {_,PreBlock}=Res -> - case ProhibitFailLabel andalso - split_block_label_used(PreBlock, Fail) of - true -> - %% The failure label was used in the pre-block; - %% not allowed, because the label may be removed. - failed; - false -> - Res - end - end. - -split_block_2([{set,[_],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) -> - split_block_2(Is, Fail, [I|Acc]); -split_block_2([{set,[_],_,{alloc,_,{gc_bif,_,{f,Fail}}}}=I|Is], Fail, Acc) -> - split_block_2(Is, Fail, [I|Acc]); -split_block_2(Is0, _, Acc) -> - Is = reverse(Is0), - {Acc,Is}. - -split_block_label_used([{set,[_],_,{bif,_,{f,Fail}}}|_], Fail) -> - true; -split_block_label_used([{set,[_],_,{alloc,_,{gc_bif,_,{f,Fail}}}}|_], Fail) -> - true; -split_block_label_used([{set,[_],_,{alloc,_,{put_map,_,{f,Fail}}}}|_], Fail) -> - true; -split_block_label_used([_|Is], Fail) -> - split_block_label_used(Is, Fail); -split_block_label_used([], _) -> false. - -dst_regs(Is) -> - dst_regs(Is, []). - -dst_regs([{block,Bl}|Is], Acc) -> - dst_regs(Bl, dst_regs(Is, Acc)); -dst_regs([{set,[D],_,{bif,_,{f,_}}}|Is], Acc) -> - dst_regs(Is, [D|Acc]); -dst_regs([{set,[D],_,{alloc,_,{gc_bif,_,{f,_}}}}|Is], Acc) -> - dst_regs(Is, [D|Acc]); -dst_regs([{protected,_,Bl,_}|Is], Acc) -> - dst_regs(Bl, dst_regs(Is, Acc)); -dst_regs([_|Is], Acc) -> - dst_regs(Is, Acc); -dst_regs([], Acc) -> ordsets:from_list(Acc). - -all_killed([R|Rs], OldIs, Fail, St) -> - case is_killed(R, OldIs, Fail, St) of - false -> false; - true -> all_killed(Rs, OldIs, Fail, St) - end; -all_killed([], _, _, _) -> true. - -none_used([R|Rs], OldIs, Fail, St) -> - case is_not_used(R, OldIs, Fail, St) of - false -> false; - true -> none_used(Rs, OldIs, Fail, St) - end; -none_used([], _, _, _) -> true. - -bopt_tree_cg(Block0, Fail, St) -> - Free = free_variables(Block0), - Block = ssa_block(Block0), -%% io:format("~p\n", [Block0]), -%% io:format("~p\n", [Block]), -%% io:format("~p\n", [gb_trees:to_list(Free)]), - case bopt_tree(Block, Free, []) of - {Pre0,[{_,Tree}]} -> - Pre1 = update_fail_label(Pre0, Fail, []), - Regs0 = init_regs(gb_trees:keys(Free)), -%% io:format("~p\n", [dst_regs(Block0)]), -%% io:format("~p\n", [Pre1]), -%% io:format("~p\n", [Tree]), -%% io:nl(), - {Pre,Regs} = rename_regs(Pre1, Regs0), -%% io:format("~p\n", [Regs0]), -%% io:format("~p\n", [Pre]), - bopt_cg(Tree, Fail, Regs, make_block(Pre), St); - _Res -> - throw(not_boolean_expr) - end. - -bopt_tree([{set,[Dst],As0,{bif,'not',_}}|Is], Forest0, Pre) -> - {[Arg],Forest1} = bopt_bool_args(As0, Forest0), - Forest = gb_trees:enter(Dst, {'not',Arg}, Forest1), - bopt_tree(Is, Forest, Pre); -bopt_tree([{set,[Dst],As0,{bif,'and',_}}|Is], Forest0, Pre) -> - {As,Forest1} = bopt_bool_args(As0, Forest0), - Node = make_and_node(As), - Forest = gb_trees:enter(Dst, Node, Forest1), - bopt_tree(Is, Forest, Pre); -bopt_tree([{set,[Dst],As0,{bif,'or',_}}|Is], Forest0, Pre) -> - {As,Forest1} = bopt_bool_args(As0, Forest0), - Node = make_or_node(As), - Forest = gb_trees:enter(Dst, Node, Forest1), - bopt_tree(Is, Forest, Pre); -bopt_tree([{set,_,_,{bif,'xor',_}}|_], _, _) -> - throw('xor'); -bopt_tree([{protected,[Dst],Code,_}|Is], Forest0, Pre) -> - ProtForest0 = gb_trees:from_orddict([P || {_,any}=P <- gb_trees:to_list(Forest0)]), - case bopt_tree(Code, ProtForest0, []) of - {ProtPre,[{_,ProtTree}]} -> - Prot = {prot,ProtPre,ProtTree}, - Forest = gb_trees:enter(Dst, Prot, Forest0), - bopt_tree(Is, Forest, Pre); - _Res -> - throw(not_boolean_expr) - end; -bopt_tree([{set,[Dst],As,{bif,N,_}}=Bif|Is], Forest0, Pre) -> - Ar = length(As), - case safe_bool_op(N, Ar) of - false -> - bopt_good_args(As, Forest0), - Forest = gb_trees:enter(Dst, any, Forest0), - bopt_tree(Is, Forest, [Bif|Pre]); - true -> - bopt_good_args(As, Forest0), - Test = bif_to_test(Dst, N, As), - Forest = gb_trees:enter(Dst, Test, Forest0), - bopt_tree(Is, Forest, Pre) - end; -bopt_tree([{set,[Dst],As,{alloc,_,{gc_bif,_,_}}}=Bif|Is], Forest0, Pre) -> - bopt_good_args(As, Forest0), - Forest = gb_trees:enter(Dst, any, Forest0), - bopt_tree(Is, Forest, [Bif|Pre]); -bopt_tree([], Forest, Pre) -> - {reverse(Pre),[R || {_,V}=R <- gb_trees:to_list(Forest), V =/= any]}. - -safe_bool_op(N, Ar) -> - erl_internal:new_type_test(N, Ar) orelse erl_internal:comp_op(N, Ar). - -bopt_bool_args([V0,V0], Forest0) -> - {V,Forest} = bopt_bool_arg(V0, Forest0), - {[V,V],Forest}; -bopt_bool_args(As, Forest) -> - mapfoldl(fun bopt_bool_arg/2, Forest, As). - -bopt_bool_arg({T,_}=R, Forest) when T =:= x; T =:= y; T =:= tmp -> - Val = case gb_trees:lookup(R, Forest) of - {value,any} -> {test,is_eq_exact,fail,[R,{atom,true}]}; - {value,Val0} -> Val0; - none -> throw(mixed) - end, - {Val,gb_trees:delete(R, Forest)}; -bopt_bool_arg(Term, Forest) -> - {Term,Forest}. - -bopt_good_args([A|As], Regs) -> - bopt_good_arg(A, Regs), - bopt_good_args(As, Regs); -bopt_good_args([], _) -> ok. - -bopt_good_arg({Tag,_}=X, Regs) when Tag =:= x; Tag =:= tmp -> - case gb_trees:lookup(X, Regs) of - {value,any} -> ok; - {value,_} -> throw(mixed); - none -> throw(protected_barrier) - end; -bopt_good_arg(_, _) -> ok. - -bif_to_test(_, N, As) -> - beam_utils:bif_to_test(N, As, fail). - -make_and_node(Is) -> - AndList0 = make_and_list(Is), - case simplify_and_list(AndList0) of - [] -> {atom,true}; - [Op] -> Op; - AndList -> {'and',AndList} - end. - -make_and_list([{'and',As}|Is]) -> - make_and_list(As++Is); -make_and_list([I|Is]) -> - [I|make_and_list(Is)]; -make_and_list([]) -> []. - -simplify_and_list([{atom,true}|T]) -> - simplify_and_list(T); -simplify_and_list([{atom,false}=False|_]) -> - [False]; -simplify_and_list([H|T]) -> - [H|simplify_and_list(T)]; -simplify_and_list([]) -> []. - -make_or_node(Is) -> - OrList0 = make_or_list(Is), - case simplify_or_list(OrList0) of - [] -> {atom,false}; - [Op] -> Op; - OrList -> {'or',OrList} - end. - -make_or_list([{'or',As}|Is]) -> - make_or_list(As++Is); -make_or_list([I|Is]) -> - [I|make_or_list(Is)]; -make_or_list([]) -> []. - -simplify_or_list([{atom,false}|T]) -> - simplify_or_list(T); -simplify_or_list([{atom,true}=True|_]) -> - [True]; -simplify_or_list([H|T]) -> - [H|simplify_or_list(T)]; -simplify_or_list([]) -> []. - -%% Code generation for a boolean tree. - -bopt_cg({'not',Arg}, Fail, Rs, Acc, St) -> - I = bopt_cg_not(Arg), - bopt_cg(I, Fail, Rs, Acc, St); -bopt_cg({'and',As}, Fail, Rs, Acc, St) -> - bopt_cg_and(As, Fail, Rs, Acc, St); -bopt_cg({'or',As}, Fail, Rs, Acc, St0) -> - {Succ,St} = new_label(St0), - bopt_cg_or(As, Succ, Fail, Rs, Acc, St); -bopt_cg({test,N,fail,As0}, Fail, Rs, Acc, St) -> - As = rename_sources(As0, Rs), - Test = {test,N,{f,Fail},As}, - {[Test|Acc],St}; -bopt_cg({inverted_test,N,fail,As0}, Fail, Rs, Acc, St0) -> - As = rename_sources(As0, Rs), - {Lbl,St} = new_label(St0), - {[{label,Lbl},{jump,{f,Fail}},{test,N,{f,Lbl},As}|Acc],St}; -bopt_cg({prot,Pre0,Tree}, Fail, Rs0, Acc, St0) -> - Pre1 = update_fail_label(Pre0, Fail, []), - {Pre,Rs} = rename_regs(Pre1, Rs0), - bopt_cg(Tree, Fail, Rs, make_block(Pre, Acc), St0); -bopt_cg({atom,true}, _Fail, _Rs, Acc, St) -> - {Acc,St}; -bopt_cg({atom,false}, Fail, _Rs, Acc, St) -> - {[{jump,{f,Fail}}|Acc],St}; -bopt_cg(_, _, _, _, _) -> - throw(not_boolean_expr). - -bopt_cg_not({'and',As0}) -> - As = [bopt_cg_not(A) || A <- As0], - {'or',As}; -bopt_cg_not({'or',As0}) -> - As = [bopt_cg_not(A) || A <- As0], - {'and',As}; -bopt_cg_not({'not',Arg}) -> - bopt_cg_not_not(Arg); -bopt_cg_not({test,Test,Fail,As}) -> - {inverted_test,Test,Fail,As}; -bopt_cg_not({atom,Bool}) when is_boolean(Bool) -> - {atom,not Bool}; -bopt_cg_not(_) -> - throw(not_boolean_expr). - -bopt_cg_not_not({'and',As}) -> - {'and',[bopt_cg_not_not(A) || A <- As]}; -bopt_cg_not_not({'or',As}) -> - {'or',[bopt_cg_not_not(A) || A <- As]}; -bopt_cg_not_not({'not',Arg}) -> - bopt_cg_not(Arg); -bopt_cg_not_not(Leaf) -> Leaf. - -bopt_cg_and([I|Is], Fail, Rs, Acc0, St0) -> - {Acc,St} = bopt_cg(I, Fail, Rs, Acc0, St0), - bopt_cg_and(Is, Fail, Rs, Acc, St); -bopt_cg_and([], _, _, Acc, St) -> {Acc,St}. - -bopt_cg_or([I], Succ, Fail, Rs, Acc0, St0) -> - {Acc,St} = bopt_cg(I, Fail, Rs, Acc0, St0), - {[{label,Succ}|Acc],St}; -bopt_cg_or([I|Is], Succ, Fail, Rs, Acc0, St0) -> - {Lbl,St1} = new_label(St0), - {Acc,St} = bopt_cg(I, Lbl, Rs, Acc0, St1), - bopt_cg_or(Is, Succ, Fail, Rs, [{label,Lbl},{jump,{f,Succ}}|Acc], St). - -new_label(#st{next=LabelNum}=St) when is_integer(LabelNum) -> - {LabelNum,St#st{next=LabelNum+1}}. - -free_variables(Is) -> - E = gb_sets:empty(), - free_vars_1(Is, E, E, E). - -free_vars_1([{set,Ds,As,{bif,_,_}}|Is], F0, N0, A) -> - F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)), - N = gb_sets:union(N0, var_list(Ds)), - free_vars_1(Is, F, N, A); -free_vars_1([{set,Ds,As,{alloc,Regs,{gc_bif,_,_}}}|Is], F0, N0, A0) -> - A = gb_sets:union(A0, gb_sets:from_list(free_vars_regs(Regs))), - F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)), - N = gb_sets:union(N0, var_list(Ds)), - free_vars_1(Is, F, N, A); -free_vars_1([{protected,_,Pa,_}|Is], F, N, A) -> - free_vars_1(Pa++Is, F, N, A); -free_vars_1([], F0, N, A) -> - F = case gb_sets:is_empty(A) of - true -> - %% No GC BIFs. - {x,X} = gb_sets:smallest(N), - P = ordsets:from_list(free_vars_regs(X)), - ordsets:union(gb_sets:to_list(F0), P); - false -> - %% At least one GC BIF. - gb_sets:to_list(gb_sets:union(F0, gb_sets:difference(A, N))) - end, - gb_trees:from_orddict([{K,any} || K <- F]). - -var_list(Is) -> - var_list_1(Is, gb_sets:empty()). - -var_list_1([{Tag,_}=X|Is], D) when Tag =:= x; Tag =:= y -> - var_list_1(Is, gb_sets:add(X, D)); -var_list_1([_|Is], D) -> - var_list_1(Is, D); -var_list_1([], D) -> D. - -free_vars_regs(0) -> []; -free_vars_regs(X) -> [{x,X-1}|free_vars_regs(X-1)]. - -rename_regs(Is, Regs) -> - rename_regs(Is, Regs, []). - -rename_regs([{set,[Dst0],Ss0,{alloc,_,Info}}|Is], Regs0, Acc) -> - Live = live_regs(Regs0), - Ss = rename_sources(Ss0, Regs0), - Regs = put_reg(Dst0, Regs0), - Dst = fetch_reg(Dst0, Regs), - rename_regs(Is, Regs, [{set,[Dst],Ss,{alloc,Live,Info}}|Acc]); -rename_regs([{set,[Dst0],Ss0,Info}|Is], Regs0, Acc) -> - Ss = rename_sources(Ss0, Regs0), - Regs = put_reg(Dst0, Regs0), - Dst = fetch_reg(Dst0, Regs), - rename_regs(Is, Regs, [{set,[Dst],Ss,Info}|Acc]); -rename_regs([], Regs, Acc) -> {reverse(Acc),Regs}. - -rename_sources(Ss, Regs) -> - map(fun({x,_}=R) -> fetch_reg(R, Regs); - ({tmp,_}=R) -> fetch_reg(R, Regs); - (E) -> E - end, Ss). - -%%% -%%% Keeping track of register assignments. -%%% - -init_regs(Free) -> - init_regs_1(Free, 0). - -init_regs_1([{x,I}=V|T], I) -> - [{I,V}|init_regs_1(T, I+1)]; -init_regs_1([{x,X}|_]=T, I) when I < X -> - [{I,reserved}|init_regs_1(T, I+1)]; -init_regs_1([{y,_}|_], _) -> []; -init_regs_1([], _) -> []. - -put_reg(V, Rs) -> put_reg_1(V, Rs, 0). - -put_reg_1(V, [R|Rs], I) -> [R|put_reg_1(V, Rs, I+1)]; -put_reg_1(V, [], I) -> [{I,V}]. - -fetch_reg(V, [{I,V}|_]) -> {x,I}; -fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs). - -live_regs([{_,reserved}|_]) -> - %% We are not sure that this register is initialized, so we must - %% abort the optimization. - throw(gc_bif_alloc_failure); -live_regs([{I,_}]) -> - I+1; -live_regs([{_,_}|Regs]) -> - live_regs(Regs); -live_regs([]) -> - 0. - - -%%% -%%% Convert a block to Static Single Assignment (SSA) form. -%%% - --record(ssa, - {live=0, %Variable counter. - sub=gb_trees:empty(), %Substitution table. - prot=gb_sets:empty(), %Targets assigned by protecteds. - in_prot=false %Inside a protected. - }). - -ssa_block(Is0) -> - {Is,_} = ssa_block_1(Is0, #ssa{}, []), - Is. - -ssa_block_1([{protected,[_],Pa0,Pb}|Is], Sub0, Acc) -> - {Pa,Sub1} = ssa_block_1(Pa0, Sub0#ssa{in_prot=true}, []), - Dst = ssa_last_target(Pa), - Sub = Sub1#ssa{prot=gb_sets:insert(Dst, Sub1#ssa.prot), - in_prot=Sub0#ssa.in_prot}, - ssa_block_1(Is, Sub, [{protected,[Dst],Pa,Pb}|Acc]); -ssa_block_1([{set,[Dst],As,Bif}|Is], Sub0, Acc0) -> - Sub1 = ssa_in_use_list(As, Sub0), - Sub = ssa_assign(Dst, Sub1), - Acc = [{set,[ssa_sub(Dst, Sub)],ssa_sub_list(As, Sub0),Bif}|Acc0], - ssa_block_1(Is, Sub, Acc); -ssa_block_1([], Sub, Acc) -> {reverse(Acc),Sub}. - -ssa_in_use_list(As, Sub) -> - foldl(fun ssa_in_use/2, Sub, As). - -ssa_in_use({x,_}=R, #ssa{sub=Sub0}=Ssa) -> - case gb_trees:is_defined(R, Sub0) of - true -> Ssa; - false -> - Sub = gb_trees:insert(R, R, Sub0), - Ssa#ssa{sub=Sub} - end; -ssa_in_use(_, Ssa) -> Ssa. - -ssa_assign({x,_}=R, #ssa{sub=Sub0}=Ssa0) -> - {NewReg,Ssa} = ssa_new_reg(Ssa0), - case gb_trees:is_defined(R, Sub0) of - false -> - Sub = gb_trees:insert(R, NewReg, Sub0), - Ssa#ssa{sub=Sub}; - true -> - Sub1 = gb_trees:update(R, NewReg, Sub0), - Sub = gb_trees:insert(NewReg, NewReg, Sub1), - Ssa#ssa{sub=Sub} - end. - -ssa_sub_list(List, Sub) -> - [ssa_sub(E, Sub) || E <- List]. - -ssa_sub(R0, #ssa{sub=Sub,prot=Prot,in_prot=InProt}) -> - case gb_trees:lookup(R0, Sub) of - none -> R0; - {value,R} -> - case InProt andalso gb_sets:is_element(R, Prot) of - true -> - throw(protected_violation); - false -> - R - end - end. - -ssa_new_reg(#ssa{live=Reg}=Ssa) -> - {{tmp,Reg},Ssa#ssa{live=Reg+1}}. - -ssa_last_target([{set,[Dst],_,_}]) -> Dst; -ssa_last_target([_|Is]) -> ssa_last_target(Is). - -%% is_killed(Register, [Instruction], FailLabel, State) -> true|false -%% Determine whether a register is killed in the instruction sequence. -%% The state is used to allow us to determine the kill state -%% across branches. - -is_killed(R, Is, Label, #st{ll=Ll}) -> - beam_utils:is_killed(R, Is, Ll) andalso - beam_utils:is_killed_at(R, Label, Ll). - -%% is_not_used(Register, [Instruction], FailLabel, State) -> true|false -%% Determine whether a register is never used in the instruction sequence -%% (it could still referenced by an allocate instruction, meaning that -%% it MUST be initialized). -%% The state is used to allow us to determine the usage state -%% across branches. - -is_not_used(R, Is, Label, #st{ll=Ll}) -> - beam_utils:is_not_used(R, Is, Ll) andalso - beam_utils:is_not_used_at(R, Label, Ll). - -%% initialized_regs([Instruction]) -> [Register]) -%% Given a REVERSED instruction sequence, return a list of the registers -%% that are guaranteed to be initialized (not contain garbage). - -initialized_regs(Is) -> - initialized_regs(Is, ordsets:new()). - -initialized_regs([{set,Dst,_Src,{alloc,Live,_}}|_], Regs0) -> - Regs = add_init_regs(free_vars_regs(Live), Regs0), - add_init_regs(Dst, Regs); -initialized_regs([{set,Dst,Src,_}|Is], Regs) -> - initialized_regs(Is, add_init_regs(Dst, add_init_regs(Src, Regs))); -initialized_regs([{test,_,_,Src}|Is], Regs) -> - initialized_regs(Is, add_init_regs(Src, Regs)); -initialized_regs([{block,Bl}|Is], Regs) -> - initialized_regs(reverse(Bl, Is), Regs); -initialized_regs([{bs_context_to_binary,Src}|Is], Regs) -> - initialized_regs(Is, add_init_regs([Src], Regs)); -initialized_regs([{label,_},{func_info,_,_,Arity}|_], Regs) -> - InitRegs = free_vars_regs(Arity), - add_init_regs(InitRegs, Regs); -initialized_regs([_|_], Regs) -> Regs. - -add_init_regs([{x,_}=X|T], Regs) -> - add_init_regs(T, ordsets:add_element(X, Regs)); -add_init_regs([_|T], Regs) -> - add_init_regs(T, Regs); -add_init_regs([], Regs) -> Regs. diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index 3606af9d75..9087586b58 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -266,12 +266,30 @@ backward([{jump,{f,To0}},{move,Src,Reg}=Move|Is], D, Acc) -> false -> backward([Move|Is], D, [Jump|Acc]); true -> backward([Jump|Is], D, Acc) end; -backward([{jump,{f,To}}=J|[{bif,Op,_,Ops,Reg}|Is]=Is0], D, Acc) -> +backward([{jump,{f,To}}=J|[{bif,Op,{f,BifFail},Ops,Reg}|Is]=Is0], D, Acc) -> try replace_comp_op(To, Reg, Op, Ops, D) of I -> backward(Is, D, I++Acc) catch - throw:not_possible -> backward(Is0, D, [J|Acc]) + throw:not_possible -> + case To =:= BifFail of + true -> + %% The bif instruction is redundant. See the comment + %% in the next clause for why there is no need to + %% test for liveness of Reg at label To. + backward([J|Is], D, Acc); + false -> + backward(Is0, D, [J|Acc]) + end end; +backward([{jump,{f,To}}=J|[{gc_bif,_,{f,To},_,_,_Dst}|Is]], D, Acc) -> + %% The gc_bif instruction is redundant, since either the gc_bif + %% instruction itself or the jump instruction will transfer control + %% to label To. Note that a gc_bif instruction does not assign its + %% destination register if the failure branch is taken; therefore, + %% the code at label To is not allowed to assume that the destination + %% register is initialized, and it is therefore no need to test + %% for liveness of the destination register at label To. + backward([J|Is], D, Acc); backward([{test,bs_start_match2,F,Live,[R,_]=Args,Ctxt}|Is], D, [{test,bs_match_string,F,[Ctxt,Bs]}, {test,bs_test_tail2,F,[Ctxt,0]}|Acc0]=Acc) -> @@ -361,6 +379,14 @@ backward([{kill,_}=I|Is], D, [{line,_},Exit|_]=Acc) -> false -> backward(Is, D, [I|Acc]); true -> backward(Is, D, Acc) end; +backward([{bif,'or',{f,To0},[Dst,{atom,false}],Dst}=I|Is], D, + [{test,is_eq_exact,{f,To},[Dst,{atom,true}]}|_]=Acc) -> + case shortcut_label(To0, D) of + To -> + backward(Is, D, Acc); + _ -> + backward(Is, D, [I|Acc]) + end; backward([I|Is], D, Acc) -> backward(Is, D, [I|Acc]); backward([], _D, Acc) -> Acc. @@ -379,6 +405,8 @@ shortcut_select_list([Lit,{f,To0}|T], Reg, D, Acc) -> shortcut_select_list(T, Reg, D, [{f,To},Lit|Acc]); shortcut_select_list([], _, _, Acc) -> reverse(Acc). +shortcut_label(0, _) -> + 0; shortcut_label(To0, D) -> case beam_utils:code_at(To0, D) of [{jump,{f,To}}|_] -> shortcut_label(To, D); diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 5311ce7379..e096270d8c 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -23,7 +23,7 @@ -export([module/2, is_unreachable_after/1,is_exit_instruction/1, - remove_unused_labels/1,is_label_used_in/2]). + remove_unused_labels/1]). %%% The following optimisations are done: %%% @@ -473,36 +473,6 @@ is_exit_instruction({try_case_end,_}) -> true; is_exit_instruction({badmatch,_}) -> true; is_exit_instruction(_) -> false. -%% is_label_used_in(LabelNumber, [Instruction]) -> boolean() -%% Check whether the label is used in the instruction sequence -%% (including inside blocks). - -is_label_used_in(Lbl, Is) -> - is_label_used_in_1(Is, Lbl, cerl_sets:new()). - -is_label_used_in_1([{block,Block}|Is], Lbl, Empty) -> - lists:any(fun(I) -> is_label_used_in_block(I, Lbl) end, Block) - orelse is_label_used_in_1(Is, Lbl, Empty); -is_label_used_in_1([I|Is], Lbl, Empty) -> - Used = ulbl(I, Empty), - cerl_sets:is_element(Lbl, Used) orelse is_label_used_in_1(Is, Lbl, Empty); -is_label_used_in_1([], _, _) -> false. - -is_label_used_in_block({set,_,_,Info}, Lbl) -> - case Info of - {bif,_,{f,F}} -> F =:= Lbl; - {alloc,_,{gc_bif,_,{f,F}}} -> F =:= Lbl; - {alloc,_,{put_map,_,{f,F}}} -> F =:= Lbl; - {get_map_elements,{f,F}} -> F =:= Lbl; - {try_catch,_,{f,F}} -> F =:= Lbl; - {alloc,_,_} -> false; - {put_tuple,_} -> false; - {get_tuple_element,_} -> false; - {set_tuple_element,_} -> false; - {line,_} -> false; - _ when is_atom(Info) -> false - end. - %% remove_unused_labels(Instructions0) -> Instructions %% Remove all unused labels. Also remove unreachable %% instructions following labels that are removed. diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 564a62a7f2..74e3d7e38a 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -22,7 +22,7 @@ -module(beam_utils). -export([is_killed_block/2,is_killed/3,is_killed_at/3, - is_not_used/3,is_not_used_at/3, + is_not_used/3, empty_label_index/0,index_label/3,index_labels/1, code_at/2,bif_to_test/3,is_pure_test/1, live_opt/1,delete_live_annos/1,combine_heap_needs/2, @@ -96,20 +96,6 @@ is_not_used(R, Is, D) -> {_,_} -> true end. -%% is_not_used(Register, [Instruction], State) -> true|false -%% Determine whether a register is never used in the instruction sequence -%% (it could still be referenced by an allocate instruction, meaning that -%% it MUST be initialized, but that its value does not matter). -%% The state is used to allow us to determine the usage state -%% across branches. - -is_not_used_at(R, Lbl, D) -> - St = #live{lbl=D,res=gb_trees:empty()}, - case check_liveness_at(R, Lbl, St) of - {used,_} -> false; - {_,_} -> true - end. - %% index_labels(FunctionIs) -> State %% Index the instruction sequence so that we can quickly %% look up the instruction following a specific label. diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index e4fb703939..37da045d25 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -707,8 +707,6 @@ asm_passes() -> {iff,dexcept,{listing,"except"}}, {unless,no_bs_opt,{pass,beam_bs}}, {iff,dbs,{listing,"bs"}}, - {unless,no_bopt,{pass,beam_bool}}, - {iff,dbool,{listing,"bool"}}, {unless,no_topt,{pass,beam_type}}, {iff,dtype,{listing,"type"}}, {pass,beam_split}, @@ -1780,7 +1778,6 @@ pre_load() -> L = [beam_a, beam_asm, beam_block, - beam_bool, beam_bs, beam_bsm, beam_clean, diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index 20195ac36f..3cb991687b 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -24,7 +24,6 @@ beam_a, beam_asm, beam_block, - beam_bool, beam_bs, beam_bsm, beam_clean, diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 5d7fd37270..50d28c0a5f 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -373,7 +373,7 @@ expr(#c_case{}=Case0, Ctxt, Sub) -> %% (in addition to any warnings that may have been emitted %% according to the rules above). %% - case opt_bool_case(Case0) of + case opt_bool_case(Case0, Sub) of #c_case{arg=Arg0,clauses=Cs0}=Case1 -> Arg1 = body(Arg0, value, Sub), LitExpr = cerl:is_literal(Arg1), @@ -1554,9 +1554,11 @@ will_match(E, [P]) -> will_match_1({false,_}) -> maybe; will_match_1({true,_}) -> yes. -%% opt_bool_case(CoreExpr) - CoreExpr'. -%% Do various optimizations to case statement that has a -%% boolean case expression. +%% opt_bool_case(CoreExpr, Sub) - CoreExpr'. +%% +%% In bodies, do various optimizations to case statements that have +%% boolean case expressions. We don't do the optimizations in guards, +%% because they would thwart the optimization in v3_kernel. %% %% We start with some simple optimizations and normalization %% to facilitate later optimizations. @@ -1565,7 +1567,7 @@ will_match_1({true,_}) -> yes. %% (or fail), we can remove any clause that cannot %% possibly match 'true' or 'false'. Also, any clause %% following both 'true' and 'false' clause can -%% be removed. If successful, we will end up this: +%% be removed. If successful, we will end up like this: %% %% case BoolExpr of case BoolExpr of %% true -> false -> @@ -1576,8 +1578,11 @@ will_match_1({true,_}) -> yes. %% %% We give up if there are clauses with guards, or if there %% is a variable clause that matches anything. -%% -opt_bool_case(#c_case{arg=Arg}=Case0) -> + +opt_bool_case(#c_case{}=Case, #sub{in_guard=true}) -> + %% v3_kernel does a better job without "help". + Case; +opt_bool_case(#c_case{arg=Arg}=Case0, #sub{in_guard=false}) -> case is_bool_expr(Arg) of false -> Case0; @@ -1589,8 +1594,7 @@ opt_bool_case(#c_case{arg=Arg}=Case0) -> impossible -> Case0 end - end; -opt_bool_case(Core) -> Core. + end. opt_bool_clauses(#c_case{clauses=Cs}=Case) -> Case#c_case{clauses=opt_bool_clauses(Cs, false, false)}. @@ -1606,16 +1610,14 @@ opt_bool_clauses(Cs, true, true) -> [] end; opt_bool_clauses([#c_clause{pats=[#c_literal{val=Lit}], - guard=#c_literal{val=true}, - body=B}=C0|Cs], SeenT, SeenF) -> + guard=#c_literal{val=true}}=C|Cs], SeenT, SeenF) -> case is_boolean(Lit) of false -> %% Not a boolean - this clause can't match. - add_warning(C0, nomatch_clause_type), + add_warning(C, nomatch_clause_type), opt_bool_clauses(Cs, SeenT, SeenF); true -> %% This clause will match. - C = C0#c_clause{body=opt_bool_case(B)}, case {Lit,SeenT,SeenF} of {false,_,false} -> [C|opt_bool_clauses(Cs, SeenT, true)]; @@ -2238,14 +2240,14 @@ inverse_rel_op(_) -> no. %% opt_bool_case_in_let(LetExpr) -> Core -opt_bool_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let) -> - opt_bool_case_in_let_1(Vs, Arg, B, Let). +opt_bool_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) -> + opt_bool_case_in_let_1(Vs, Arg, B, Let, Sub). opt_bool_case_in_let_1([#c_var{name=V}], Arg, - #c_case{arg=#c_var{name=V}}=Case0, Let) -> + #c_case{arg=#c_var{name=V}}=Case0, Let, Sub) -> case is_simple_case_arg(Arg) of true -> - Case = opt_bool_case(Case0#c_case{arg=Arg}), + Case = opt_bool_case(Case0#c_case{arg=Arg}, Sub), case core_lib:is_var_used(V, Case) of false -> Case; true -> Let @@ -2253,7 +2255,7 @@ opt_bool_case_in_let_1([#c_var{name=V}], Arg, false -> Let end; -opt_bool_case_in_let_1(_, _, _, Let) -> Let. +opt_bool_case_in_let_1(_, _, _, Let, _) -> Let. %% is_simple_case_arg(Expr) -> true|false %% Determine whether the Expr is simple enough to be worth @@ -2386,9 +2388,7 @@ is_safe_bool_expr_list([], _, _) -> true. %% as a let or a sequence, move the original let body into the complex %% expression. -simplify_let(#c_let{arg=Arg0}=Let0, Sub) -> - Arg = opt_bool_case(Arg0), - Let = Let0#c_let{arg=Arg}, +simplify_let(#c_let{arg=Arg}=Let, Sub) -> move_let_into_expr(Let, Arg, Sub). move_let_into_expr(#c_let{vars=InnerVs0,body=InnerBody0}=Inner, @@ -2688,8 +2688,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> #c_seq{arg=Arg,body=Body}; true -> Let1 = Let0#c_let{vars=Vs,arg=Arg1,body=Body}, - Let2 = opt_bool_case_in_let(Let1), - opt_case_in_let_arg(Let2, Ctxt, Sub) + opt_bool_case_in_let(Let1, Sub) end end. @@ -2817,48 +2816,6 @@ move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer, move_case_into_arg(_, _) -> impossible. -%% In guards only, rewrite a case in a let argument like -%% -%% let <Var> = case <> of -%% <> when AnyGuard -> Literal1; -%% <> when AnyGuard -> Literal2 -%% end -%% in LetBody -%% -%% to -%% -%% case <> of -%% <> when AnyGuard -> -%% let <Var> = Literal1 in LetBody -%% <> when 'true' -> -%% let <Var> = Literal2 in LetBody -%% end -%% -%% In the worst case, the size of the code could increase. -%% In practice, though, substituting the literals into -%% LetBody and doing constant folding will decrease the code -%% size. (Doing this transformation outside of guards could -%% lead to a substantational increase in code size.) -%% -opt_case_in_let_arg(#c_let{arg=#c_case{}=Case}=Let, Ctxt, - #sub{in_guard=true}=Sub) -> - opt_case_in_let_arg_1(Let, Case, Ctxt, Sub); -opt_case_in_let_arg(Let, _, _) -> Let. - -opt_case_in_let_arg_1(Let0, #c_case{arg=#c_values{es=[]}, - clauses=Cs}=Case0, _Ctxt, _Sub) -> - Let = mark_compiler_generated(Let0), - case Cs of - [#c_clause{body=#c_literal{}=BodyA}=Ca0, - #c_clause{body=#c_literal{}=BodyB}=Cb0] -> - Ca = Ca0#c_clause{body=Let#c_let{arg=BodyA}}, - Cb = Cb0#c_clause{body=Let#c_let{arg=BodyB}}, - Case0#c_case{clauses=[Ca,Cb]}; - _ -> - Let - end; -opt_case_in_let_arg_1(Let, _, _, _) -> Let. - is_any_var_used([#c_var{name=V}|Vs], Expr) -> case core_lib:is_var_used(V, Expr) of false -> is_any_var_used(Vs, Expr); @@ -3289,13 +3246,6 @@ bsm_problem(Where, What) -> %%% Handling of warnings. %%% -mark_compiler_generated(Term) -> - cerl_trees:map(fun mark_compiler_generated_1/1, Term). - -mark_compiler_generated_1(#c_call{anno=Anno}=Term) -> - Term#c_call{anno=[compiler_generated|Anno--[compiler_generated]]}; -mark_compiler_generated_1(Term) -> Term. - init_warnings() -> put({?MODULE,warnings}, []). diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index c2e0c2bd1a..3627cdb7cd 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -363,7 +363,7 @@ bsm_rename_ctx(#l{ke={match,Ms0,Rs}}=L, Old, New, InProt) -> bsm_rename_ctx(#l{ke={guard_match,Ms0,Rs}}=L, Old, New, InProt) -> Ms = bsm_rename_ctx(Ms0, Old, New, InProt), L#l{ke={guard_match,Ms,Rs}}; -bsm_rename_ctx(#l{ke={test,_,_}}=L, _, _, _) -> L; +bsm_rename_ctx(#l{ke={test,_,_,_}}=L, _, _, _) -> L; bsm_rename_ctx(#l{ke={bif,_,_,_}}=L, _, _, _) -> L; bsm_rename_ctx(#l{ke={gc_bif,_,_,_}}=L, _, _, _) -> L; bsm_rename_ctx(#l{ke={set,_,_}}=L, _, _, _) -> L; @@ -1051,8 +1051,15 @@ guard_cg(#l{ke={protected,Ts,Rs},i=I,vdb=Pdb}, Fail, _Vdb, Bef, St) -> protected_cg(Ts, Rs, Fail, I, Pdb, Bef, St); guard_cg(#l{ke={block,Ts},i=I,vdb=Bdb}, Fail, _Vdb, Bef, St) -> guard_cg_list(Ts, Fail, I, Bdb, Bef, St); -guard_cg(#l{ke={test,Test,As},i=I,vdb=_Tdb}, Fail, Vdb, Bef, St) -> - test_cg(Test, As, Fail, I, Vdb, Bef, St); +guard_cg(#l{ke={test,Test,As,Inverted},i=I,vdb=_Tdb}, Fail, Vdb, Bef, St0) -> + case Inverted of + false -> + test_cg(Test, As, Fail, I, Vdb, Bef, St0); + true -> + {Psucc,St1} = new_label(St0), + {Is,Aft,St2} = test_cg(Test, As, Psucc, I, Vdb, Bef, St1), + {Is++[{jump,{f,Fail}},{label,Psucc}],Aft,St2} + end; guard_cg(G, _Fail, Vdb, Bef, St) -> %%ok = io:fwrite("cg ~w: ~p~n", [?LINE,{G,Fail,Vdb,Bef}]), {Gis,Aft,St1} = cg(G, Vdb, Bef, St), @@ -1103,6 +1110,13 @@ test_cg(is_map, [A], Fail, I, Vdb, Bef, St) -> Arg = cg_reg_arg_prefer_y(A, Bef), Aft = clear_dead(Bef, I, Vdb), {[{test,is_map,{f,Fail},[Arg]}],Aft,St}; +test_cg(is_boolean, [{atom,Val}], Fail, I, Vdb, Bef, St) -> + Aft = clear_dead(Bef, I, Vdb), + Is = case is_boolean(Val) of + true -> []; + false -> [{jump,{f,Fail}}] + end, + {Is,Aft,St}; test_cg(Test, As, Fail, I, Vdb, Bef, St) -> Args = cg_reg_args(As, Bef), Aft = clear_dead(Bef, I, Vdb), diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index f8e99905b5..2bfa610628 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -82,7 +82,7 @@ -export([module/2,format_error/1]). -import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2, - keymember/3,keyfind/3,partition/2,droplast/1,last/1]). + keymember/3,keyfind/3,partition/2,droplast/1,last/1,sort/1]). -import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]). -import(cerl, [c_tuple/1]). @@ -190,9 +190,479 @@ body(Ce, Sub, St0) -> guard(G0, Sub, St0) -> {G1,St1} = wrap_guard(G0, St0), {Ge0,Pre,St2} = expr(G1, Sub, St1), - {Ge,St} = gexpr_test(Ge0, St2), + {Ge1,St3} = gexpr_test(Ge0, St2), + {Ge,St} = guard_opt(Ge1, St3), {pre_seq(Pre, Ge),St}. +%% guard_opt(Kexpr, State) -> {Kexpr,State}. +%% Optimize the Kexpr for the guard. Instead of evaluating a boolean +%% expression comparing it to 'true' in a final #k_test{}, +%% replace BIF calls with #k_test{} in the expression. +%% +%% As an example, take the guard: +%% +%% when is_integer(V0), is_atom(V1) -> +%% +%% The unoptimized Kexpr translated to pseudo BEAM assembly +%% code would look like: +%% +%% bif is_integer V0 => Bool0 +%% bif is_atom V1 => Bool1 +%% bif and Bool0 Bool1 => Bool +%% test Bool =:= true else goto Fail +%% ... +%% Fail: +%% ... +%% +%% The optimized code would look like: +%% +%% test is_integer V0 else goto Fail +%% test is_atom V1 else goto Fail +%% ... +%% Fail: +%% ... +%% +%% An 'or' operation is only slightly more complicated: +%% +%% test is_integer V0 else goto NotFailedYet +%% goto Success +%% +%% NotFailedYet: +%% test is_atom V1 else goto Fail +%% +%% Success: +%% ... +%% Fail: +%% ... + +guard_opt(G, St0) -> + {Root,Forest0,St1} = make_forest(G, St0), + {Exprs,Forest,St} = rewrite_bool(Root, Forest0, false, St1), + E = forest_pre_seq(Exprs, Forest), + {G#k_try{arg=E},St}. + +%% rewrite_bool(Kexpr, Forest, Inv, St) -> {[Kexpr],Forest,St}. +%% Rewrite Kexpr to use #k_test{} operations instead of comparison +%% and type test BIFs. +%% +%% If Kexpr is a #k_test{} operation, the call will always +%% succeed. Otherwise, a 'not_possible' exception will be +%% thrown if Kexpr cannot be rewritten. + +rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}}, + args=[#k_var{}=V,#k_atom{val=true}]}=Test, Forest0, Inv, St0) -> + try rewrite_bool_var(V, Forest0, Inv, St0) of + {_,_,_}=Res -> + Res + catch + throw:not_possible -> + {[Test],Forest0,St0} + end; +rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}}, + args=[#k_var{}=V,#k_atom{val=false}]}=Test, Forest0, Inv, St0) -> + try rewrite_bool_var(V, Forest0, not Inv, St0) of + {_,_,_}=Res -> + Res + catch + throw:not_possible -> + {[Test],Forest0,St0} + end; +rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}}, + args=[#k_atom{val=V1},#k_atom{val=V2}]}, Forest0, false, St0) -> + case V1 =:= V2 of + true -> + {[make_test(is_boolean, [#k_atom{val=true}])],Forest0,St0}; + false -> + {[make_failing_test()],Forest0,St0} + end; +rewrite_bool(#k_test{}=Test, Forest, false, St) -> + {[Test],Forest,St}; +rewrite_bool(#k_try{vars=[#k_var{name=X}],body=#k_var{name=X}, + handler=#k_atom{val=false},ret=[]}=Prot, + Forest0, Inv, St0) -> + {Root,Forest1,St1} = make_forest(Prot, Forest0, St0), + {Exprs,Forest2,St} = rewrite_bool(Root, Forest1, Inv, St1), + InnerForest = maps:without(maps:keys(Forest0), Forest2), + Forest = maps:without(maps:keys(InnerForest), Forest2), + E = forest_pre_seq(Exprs, InnerForest), + {[Prot#k_try{arg=E}],Forest,St}; +rewrite_bool(#k_match{body=Body,ret=[]}, Forest, Inv, St) -> + rewrite_match(Body, Forest, Inv, St); +rewrite_bool(Other, Forest, Inv, St) -> + case extract_bif(Other) of + {Name,Args} -> + rewrite_bif(Name, Args, Forest, Inv, St); + error -> + throw(not_possible) + end. + +%% rewrite_bool_var(Var, Forest, Inv, St) -> {[Kexpr],Forest,St}. +%% Rewrite the boolean expression whose key in Forest is +%% given by Var. Throw a 'not_possible' expression if something +%% prevents the rewriting. + +rewrite_bool_var(Arg, Forest0, Inv, St) -> + {Expr,Forest} = forest_take_expr(Arg, Forest0), + rewrite_bool(Expr, Forest, Inv, St). + +%% rewrite_bool_args([Kexpr], Forest, Inv, St) -> {[[Kexpr]],Forest,St}. +%% Rewrite each Kexpr in the list. The input Kexpr should be variables +%% or boolean values. Throw a 'not_possible' expression if something +%% prevents the rewriting. +%% +%% This function is suitable for handling the arguments for both +%% 'and' and 'or'. + +rewrite_bool_args([#k_atom{val=B}=A|Vs], Forest0, false=Inv, St0) when is_boolean(B) -> + {Tail,Forest1,St1} = rewrite_bool_args(Vs, Forest0, Inv, St0), + Bif = make_bif('=:=', [A,#k_atom{val=true}]), + {Exprs,Forest,St} = rewrite_bool(Bif, Forest1, Inv, St1), + {[Exprs|Tail],Forest,St}; +rewrite_bool_args([#k_var{}=Var|Vs], Forest0, false=Inv, St0) -> + {Tail,Forest1,St1} = rewrite_bool_args(Vs, Forest0, Inv, St0), + {Exprs,Forest,St} = + case is_bool_expr(Var, Forest0) of + true -> + rewrite_bool_var(Var, Forest1, Inv, St1); + false -> + Bif = make_bif('=:=', [Var,#k_atom{val=true}]), + rewrite_bool(Bif, Forest1, Inv, St1) + end, + {[Exprs|Tail],Forest,St}; +rewrite_bool_args([_|_], _Forest, _Inv, _St) -> + throw(not_possible); +rewrite_bool_args([], Forest, _Inv, St) -> + {[],Forest,St}. + +%% rewrite_bif(Name, [Kexpr], Forest, Inv, St) -> {[Kexpr],Forest,St}. +%% Rewrite a BIF. Throw a 'not_possible' expression if something +%% prevents the rewriting. + +rewrite_bif('or', Args, Forest, true, St) -> + rewrite_not_args('and', Args, Forest, St); +rewrite_bif('and', Args, Forest, true, St) -> + rewrite_not_args('or', Args, Forest, St); +rewrite_bif('and', [#k_atom{val=Val},Arg], Forest0, Inv, St0) -> + false = Inv, %Assertion. + case Val of + true -> + %% The result only depends on Arg. + rewrite_bool_var(Arg, Forest0, Inv, St0); + _ -> + %% Will fail. There is no need to evalute the expression + %% represented by Arg. Take it out from the forest and + %% discard the expression. + Failing = make_failing_test(), + try rewrite_bool_var(Arg, Forest0, Inv, St0) of + {_,Forest,St} -> + {[Failing],Forest,St} + catch + throw:not_possible -> + try forest_take_expr(Arg, Forest0) of + {_,Forest} -> + {[Failing],Forest,St0} + catch + throw:not_possible -> + %% Arg is probably a variable bound in an + %% outer scope. + {[Failing],Forest0,St0} + end + end + end; +rewrite_bif('and', [Arg,#k_atom{}=Atom], Forest, Inv, St) -> + false = Inv, %Assertion. + rewrite_bif('and', [Atom,Arg], Forest, Inv, St); +rewrite_bif('and', Args, Forest0, Inv, St0) -> + false = Inv, %Assertion. + {[Es1,Es2],Forest,St} = rewrite_bool_args(Args, Forest0, Inv, St0), + {Es1 ++ Es2,Forest,St}; +rewrite_bif('or', Args, Forest0, Inv, St0) -> + false = Inv, %Assertion. + {[First,Then],Forest,St} = rewrite_bool_args(Args, Forest0, Inv, St0), + Alt = make_alt(First, Then), + {[Alt],Forest,St}; +rewrite_bif('xor', [_,_], _Forest, _Inv, _St) -> + %% Rewriting 'xor' is not practical. Fortunately, 'xor' is + %% almost never used in practice. + throw(not_possible); +rewrite_bif('not', [Arg], Forest0, Inv, St) -> + {Expr,Forest} = forest_take_expr(Arg, Forest0), + rewrite_bool(Expr, Forest, not Inv, St); +rewrite_bif(Op, Args, Forest, Inv, St) -> + case is_test(Op, Args) of + true -> + rewrite_bool(make_test(Op, Args, Inv), Forest, false, St); + false -> + throw(not_possible) + end. + +rewrite_not_args(Op, [A0,B0], Forest0, St0) -> + {A,Forest1,St1} = rewrite_not_args_1(A0, Forest0, St0), + {B,Forest2,St2} = rewrite_not_args_1(B0, Forest1, St1), + rewrite_bif(Op, [A,B], Forest2, false, St2). + +rewrite_not_args_1(Arg, Forest, St) -> + Not = make_bif('not', [Arg]), + forest_add_expr(Not, Forest, St). + +%% rewrite_match(Kvar, TypeClause, Forest, Inv, St) -> +%% {[Kexpr],Forest,St}. +%% Try to rewrite a #k_match{} originating from an 'andalso' or an 'orelse'. + +rewrite_match(#k_alt{first=First,then=Then}, Forest, Inv, St) -> + case {First,Then} of + {#k_select{var=#k_var{name=V}=Var,types=[TypeClause]},#k_var{name=V}} -> + rewrite_match_1(Var, TypeClause, Forest, Inv, St); + {_,_} -> + throw(not_possible) + end. + +rewrite_match_1(Var, #k_type_clause{values=Cs0}, Forest0, Inv, St0) -> + Cs = sort([{Val,B} || #k_val_clause{val=#k_atom{val=Val},body=B} <- Cs0]), + case Cs of + [{false,False},{true,True}] -> + rewrite_match_2(Var, False, True, Forest0, Inv, St0); + _ -> + throw(not_possible) + end. + +rewrite_match_2(Var, False, #k_atom{val=true}, Forest0, Inv, St0) -> + %% Originates from an 'orelse'. + case False of + #k_atom{val=NotBool} when not is_boolean(NotBool) -> + rewrite_bool(Var, Forest0, Inv, St0); + _ -> + {CodeVar,Forest1,St1} = add_protected_expr(False, Forest0, St0), + rewrite_bif('or', [Var,CodeVar], Forest1, Inv, St1) + end; +rewrite_match_2(Var, #k_atom{val=false}, True, Forest0, Inv, St0) -> + %% Originates from an 'andalso'. + {CodeVar,Forest1,St1} = add_protected_expr(True, Forest0, St0), + rewrite_bif('and', [Var,CodeVar], Forest1, Inv, St1); +rewrite_match_2(_V, _, _, _Forest, _Inv, _St) -> + throw(not_possible). + +%% is_bool_expr(#k_var{}, Forest) -> true|false. +%% Return true if the variable refers to a boolean expression +%% that does not need an explicit '=:= true' test. + +is_bool_expr(V, Forest) -> + case forest_peek_expr(V, Forest) of + error -> + %% Defined outside of the guard. We can't know. + false; + Expr -> + case extract_bif(Expr) of + {Name,Args} -> + is_test(Name, Args) orelse + erl_internal:bool_op(Name, length(Args)); + error -> + %% Not a BIF. Should be possible to rewrite + %% to a boolean. Definitely does not need + %% a '=:= true' test. + true + end + end. + +make_bif(Op, Args) -> + #k_bif{op=#k_remote{mod=#k_atom{val=erlang}, + name=#k_atom{val=Op}, + arity=length(Args)}, + args=Args}. + +extract_bif(#k_bif{op=#k_remote{mod=#k_atom{val=erlang}, + name=#k_atom{val=Name}}, + args=Args}) -> + {Name,Args}; +extract_bif(_) -> + error. + +%% make_alt(First, Then) -> KMatch. +%% Make a #k_alt{} within a #k_match{} to implement +%% 'or' or 'orelse'. + +make_alt(First0, Then0) -> + First1 = pre_seq(droplast(First0), last(First0)), + Then1 = pre_seq(droplast(Then0), last(Then0)), + First2 = make_protected(First1), + Then2 = make_protected(Then1), + Body = #k_atom{val=ignored}, + First3 = #k_guard_clause{guard=First2,body=Body}, + Then3 = #k_guard_clause{guard=Then2,body=Body}, + First = #k_guard{clauses=[First3]}, + Then = #k_guard{clauses=[Then3]}, + Alt = #k_alt{first=First,then=Then}, + #k_match{vars=[],body=Alt}. + +add_protected_expr(#k_atom{}=Atom, Forest, St) -> + {Atom,Forest,St}; +add_protected_expr(#k_var{}=Var, Forest, St) -> + {Var,Forest,St}; +add_protected_expr(E0, Forest, St) -> + E = make_protected(E0), + forest_add_expr(E, Forest, St). + +make_protected(#k_try{}=Try) -> + Try; +make_protected(B) -> + #k_try{arg=B,vars=[#k_var{name=''}],body=#k_var{name=''}, + handler=#k_atom{val=false}}. + +make_failing_test() -> + make_test(is_boolean, [#k_atom{val=fail}]). + +make_test(Op, Args) -> + make_test(Op, Args, false). + +make_test(Op, Args, Inv) -> + Remote = #k_remote{mod=#k_atom{val=erlang}, + name=#k_atom{val=Op}, + arity=length(Args)}, + #k_test{op=Remote,args=Args,inverted=Inv}. + +is_test(Op, Args) -> + A = length(Args), + erl_internal:new_type_test(Op, A) orelse erl_internal:comp_op(Op, A). + +%% make_forest(Kexpr, St) -> {RootKexpr,Forest,St}. +%% Build a forest out of Kexpr. RootKexpr is the final expression +%% nested inside Kexpr. + +make_forest(G, St) -> + make_forest_1(G, #{}, 0, St). + +%% make_forest(Kexpr, St) -> {RootKexpr,Forest,St}. +%% Add to Forest from Kexpr. RootKexpr is the final expression +%% nested inside Kexpr. + +make_forest(G, Forest0, St) -> + N = forest_next_index(Forest0), + make_forest_1(G, Forest0, N, St). + +make_forest_1(#k_try{arg=B}, Forest, I, St) -> + make_forest_1(B, Forest, I, St); +make_forest_1(#iset{vars=[]}=Iset0, Forest, I, St0) -> + {UnrefVar,St} = new_var(St0), + Iset = Iset0#iset{vars=[UnrefVar]}, + make_forest_1(Iset, Forest, I, St); +make_forest_1(#iset{vars=[#k_var{name=V}],arg=Arg,body=B}, Forest0, I, St) -> + Forest = Forest0#{V => {I,Arg}, {untaken,V} => true}, + make_forest_1(B, Forest, I+1, St); +make_forest_1(Innermost, Forest, _I, St) -> + {Innermost,Forest,St}. + +%% forest_take_expr(Kexpr, Forest) -> {Expr,Forest}. +%% If Kexpr is a variable, take out the expression corresponding +%% to variable in Forest. Expressions that have been taken out +%% of the forest will not be included the Kexpr returned +%% by forest_pre_seq/2. +%% +%% Throw a 'not_possible' exception if Kexpr is not a variable or +%% if the name of the variable is not a key in Forest. + +forest_take_expr(#k_var{name=V}, Forest0) -> + %% v3_core currently always generates guard expressions that can + %% be represented as a tree. Other code generators (such as LFE) + %% could generate guard expressions that can only be represented + %% as a DAG (i.e. some nodes are referenced more than once). To + %% handle DAGs, we must never remove a node from the forest, but + %% just remove the {untaken,V} marker. That will effectively convert + %% the DAG to a tree by duplicating the shared nodes and their + %% descendants. + + case maps:find(V, Forest0) of + {ok,{_,Expr}} -> + Forest = maps:remove({untaken,V}, Forest0), + {Expr,Forest}; + error -> + throw(not_possible) + end; +forest_take_expr(_, _) -> + throw(not_possible). + +%% forest_peek_expr(Kvar, Forest) -> Kexpr | error. +%% Return the expression corresponding to Kvar in Forest or +%% return 'error' if there is a corresponding expression. + +forest_peek_expr(#k_var{name=V}, Forest0) -> + case maps:find(V, Forest0) of + {ok,{_,Expr}} -> Expr; + error -> error + end. + +%% forest_add_expr(Kexpr, Forest, St) -> {Kvar,Forest,St}. +%% Add a new expression to Forest. + +forest_add_expr(Expr, Forest0, St0) -> + {#k_var{name=V}=Var,St} = new_var(St0), + N = forest_next_index(Forest0), + Forest = Forest0#{V => {N,Expr}}, + {Var,Forest,St}. + +forest_next_index(Forest) -> + 1 + lists:max([N || {N,_} <- maps:values(Forest), + is_integer(N)] ++ [0]). + +%% forest_pre_seq([Kexpr], Forest) -> Kexpr. +%% Package the list of Kexprs into a nested Kexpr, prepending all +%% expressions in Forest that have not been taken out using +%% forest_take_expr/2. + +forest_pre_seq(Exprs, Forest) -> + Es0 = [#k_var{name=V} || {untaken,V} <- maps:keys(Forest)], + Es = Es0 ++ Exprs, + Vs = extract_all_vars(Es, Forest, []), + Pre0 = sort([{maps:get(V, Forest),V} || V <- Vs]), + Pre = [#iset{vars=[#k_var{name=V}],arg=A} || + {{_,A},V} <- Pre0], + pre_seq(Pre++droplast(Exprs), last(Exprs)). + +extract_all_vars(Es, Forest, Acc0) -> + case extract_var_list(Es) of + [] -> + Acc0; + [_|_]=Vs0 -> + Vs = [V || V <- Vs0, maps:is_key(V, Forest)], + NewVs = ordsets:subtract(Vs, Acc0), + NewEs = [begin + {_,E} = maps:get(V, Forest), + E + end || V <- NewVs], + Acc = union(NewVs, Acc0), + extract_all_vars(NewEs, Forest, Acc) + end. + +extract_vars(#iset{arg=A,body=B}) -> + union(extract_vars(A), extract_vars(B)); +extract_vars(#k_bif{args=Args}) -> + ordsets:from_list(lit_list_vars(Args)); +extract_vars(#k_call{}) -> + []; +extract_vars(#k_test{args=Args}) -> + ordsets:from_list(lit_list_vars(Args)); +extract_vars(#k_match{body=Body}) -> + extract_vars(Body); +extract_vars(#k_alt{first=First,then=Then}) -> + union(extract_vars(First), extract_vars(Then)); +extract_vars(#k_guard{clauses=Cs}) -> + extract_var_list(Cs); +extract_vars(#k_guard_clause{guard=G}) -> + extract_vars(G); +extract_vars(#k_select{var=Var,types=Types}) -> + union(ordsets:from_list(lit_vars(Var)), + extract_var_list(Types)); +extract_vars(#k_type_clause{values=Values}) -> + extract_var_list(Values); +extract_vars(#k_val_clause{body=Body}) -> + extract_vars(Body); +extract_vars(#k_try{arg=Arg}) -> + extract_vars(Arg); +extract_vars(Lit) -> + ordsets:from_list(lit_vars(Lit)). + +extract_var_list(L) -> + union([extract_vars(E) || E <- L]). + %% Wrap the entire guard in a try/catch if needed. wrap_guard(#c_try{}=Try, St) -> {Try,St}; diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl index 1169a69117..7cd30b25a8 100644 --- a/lib/compiler/src/v3_kernel.hrl +++ b/lib/compiler/src/v3_kernel.hrl @@ -58,7 +58,7 @@ -record(k_seq, {anno=[],arg,body}). -record(k_put, {anno=[],arg,ret=[]}). -record(k_bif, {anno=[],op,args,ret=[]}). --record(k_test, {anno=[],op,args}). +-record(k_test, {anno=[],op,args,inverted=false}). -record(k_call, {anno=[],op,args,ret=[]}). -record(k_enter, {anno=[],op,args}). -record(k_receive, {anno=[],var,body,timeout,action,ret=[]}). diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl index 45065b7e11..d5f6ee19c9 100644 --- a/lib/compiler/src/v3_kernel_pp.erl +++ b/lib/compiler/src/v3_kernel_pp.erl @@ -235,8 +235,13 @@ format_1(#k_bif{op=Op,args=As,ret=Rs}, Ctxt) -> [Txt,format_args(As, Ctxt1), format_ret(Rs, Ctxt1) ]; -format_1(#k_test{op=Op,args=As}, Ctxt) -> - Txt = ["test (",format(Op, ctxt_bump_indent(Ctxt, 6)),$)], +format_1(#k_test{op=Op,args=As,inverted=Inverted}, Ctxt) -> + Txt = case Inverted of + false -> + ["test (",format(Op, ctxt_bump_indent(Ctxt, 6)),$)]; + true -> + ["inverted_test (",format(Op, ctxt_bump_indent(Ctxt, 6)),$)] + end, Ctxt1 = ctxt_bump_indent(Ctxt, 2), [Txt,format_args(As, Ctxt1)]; format_1(#k_put{arg=A,ret=Rs}, Ctxt) -> diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index 4337ec732c..0f2aeda87f 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -118,8 +118,8 @@ protected(#k_protected{anno=A,arg=Ts,ret=Rs}, I, Vdb) -> %% expr(Kexpr, I, Vdb) -> Expr. -expr(#k_test{anno=A,op=Op,args=As}, I, _Vdb) -> - #l{ke={test,test_op(Op),atomic_list(As)},i=I,a=A#k.a}; +expr(#k_test{anno=A,op=Op,args=As,inverted=Inverted}, I, _Vdb) -> + #l{ke={test,test_op(Op),atomic_list(As),Inverted},i=I,a=A#k.a}; expr(#k_call{anno=A,op=Op,args=As,ret=Rs}, I, _Vdb) -> #l{ke={call,call_op(Op),atomic_list(As),var_list(Rs)},i=I,a=A#k.a}; expr(#k_enter{anno=A,op=Op,args=As}, I, _Vdb) -> diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index de06e8760f..e338dbb4e3 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -9,7 +9,6 @@ MODULES= \ andor_SUITE \ apply_SUITE \ beam_block_SUITE \ - beam_bool_SUITE \ beam_validator_SUITE \ beam_disasm_SUITE \ beam_except_SUITE \ @@ -49,7 +48,6 @@ NO_OPT= \ andor \ apply \ beam_block \ - beam_bool \ beam_except \ beam_jump \ beam_reorder \ @@ -76,7 +74,6 @@ INLINE= \ andor \ apply \ beam_block \ - beam_bool \ beam_utils \ bif \ bs_bincomp \ @@ -96,6 +93,10 @@ INLINE= \ receive \ record +CORE_MODULES = \ + lfe_andor_SUITE \ + lfe_guard_SUITE + NO_OPT_MODULES= $(NO_OPT:%=%_no_opt_SUITE) NO_OPT_ERL_FILES= $(NO_OPT_MODULES:%=%.erl) POST_OPT_MODULES= $(NO_OPT:%=%_post_opt_SUITE) @@ -104,6 +105,8 @@ INLINE_MODULES= $(INLINE:%=%_inline_SUITE) INLINE_ERL_FILES= $(INLINE_MODULES:%=%.erl) ERL_FILES= $(MODULES:%=%.erl) +CORE_FILES= $(CORE_MODULES:%=%.core) +ERL_DUMMY_FILES= $(CORE_MODULES:%=%.erl) ##TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) ##INSTALL_PROGS= $(TARGET_FILES) @@ -137,6 +140,8 @@ make_emakefile: $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) $(INLINE_ERL_FILES) -o$(EBIN) $(POST_OPT_MODULES) >> $(EMAKEFILE) $(ERL_TOP)/make/make_emakefile +inline $(ERL_COMPILE_FLAGS) \ -o$(EBIN) $(INLINE_MODULES) >> $(EMAKEFILE) + $(ERL_TOP)/make/make_emakefile +from_core $(ERL_COMPILE_FLAGS) \ + -o$(EBIN) $(CORE_MODULES) >> $(EMAKEFILE) tests debug opt: make_emakefile erl $(ERL_MAKE_FLAGS) -make @@ -174,6 +179,12 @@ release_tests_spec: make_emakefile $(EMAKEFILE) $(ERL_FILES) "$(RELSYSDIR)" $(INSTALL_DATA) $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) \ $(INLINE_ERL_FILES) "$(RELSYSDIR)" + $(INSTALL_DATA) $(CORE_FILES) "$(RELSYSDIR)" + for file in $(ERL_DUMMY_FILES); do \ + module=`basename $$file .erl`; \ + echo "-module($$module). %% dummy .erl file" >$$file; \ + done + $(INSTALL_DATA) $(ERL_DUMMY_FILES) "$(RELSYSDIR)" chmod -R u+w "$(RELSYSDIR)" @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) diff --git a/lib/compiler/test/beam_bool_SUITE.erl b/lib/compiler/test/beam_bool_SUITE.erl deleted file mode 100644 index e585eaedb5..0000000000 --- a/lib/compiler/test/beam_bool_SUITE.erl +++ /dev/null @@ -1,197 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2015-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(beam_bool_SUITE). - --export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, - init_per_group/2,end_per_group/2, - before_and_inside_if/1, - scotland/1,y_registers/1,protected/1, - maps/1]). - -suite() -> - [{ct_hooks,[ts_install_cth]}]. - -all() -> - test_lib:recompile(?MODULE), - [{group,p}]. - -groups() -> - [{p,[parallel], - [before_and_inside_if, - scotland, - y_registers, - protected, - maps - ]}]. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -before_and_inside_if(_Config) -> - no = before_and_inside_if([a], [b], delete), - no = before_and_inside_if([a], [b], x), - no = before_and_inside_if([a], [], delete), - no = before_and_inside_if([a], [], x), - no = before_and_inside_if([], [], delete), - yes = before_and_inside_if([], [], x), - yes = before_and_inside_if([], [b], delete), - yes = before_and_inside_if([], [b], x), - - {ch1,ch2} = before_and_inside_if_2([a], [b], blah), - {ch1,ch2} = before_and_inside_if_2([a], [b], xx), - {ch1,ch2} = before_and_inside_if_2([a], [], blah), - {ch1,ch2} = before_and_inside_if_2([a], [], xx), - {no,no} = before_and_inside_if_2([], [b], blah), - {no,no} = before_and_inside_if_2([], [b], xx), - {ch1,no} = before_and_inside_if_2([], [], blah), - {no,ch2} = before_and_inside_if_2([], [], xx), - ok. - -%% Thanks to Simon Cornish and Kostis Sagonas. -%% Used to crash beam_bool. -before_and_inside_if(XDo1, XDo2, Do3) -> - Do1 = (XDo1 =/= []), - Do2 = (XDo2 =/= []), - if - %% This expression occurs in a try/catch (protected) - %% block, which cannot refer to variables outside of - %% the block that are boolean expressions. - Do1 =:= true; - Do1 =:= false, Do2 =:= false, Do3 =:= delete -> - no; - true -> - yes - end. - -%% Thanks to Simon Cornish. -%% Used to generate code that would not set {y,0} on -%% all paths before its use (and therefore fail -%% validation by the beam_validator). -before_and_inside_if_2(XDo1, XDo2, Do3) -> - Do1 = (XDo1 =/= []), - Do2 = (XDo2 =/= []), - CH1 = if Do1 == true; - Do1 == false,Do2==false,Do3 == blah -> - ch1; - true -> - no - end, - CH2 = if Do1 == true; - Do1 == false,Do2==false,Do3 == xx -> - ch2; - true -> - no - end, - {CH1,CH2}. - - -%% beam_bool would remove the initialization of {y,0}. -%% (Thanks to Thomas Arts and QuickCheck.) - -scotland(_Config) -> - million = do_scotland(placed), - {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(false)), - {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(true)), - {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(echo)), - ok. - -do_scotland(Echo) -> - found(case Echo of - Echo when true; Echo, Echo, Echo -> - Echo; - echo -> - [] - end, - Echo = placed). - -found(_, _) -> million. - - -%% ERL-143: beam_bool could not handle Y registers as a destination. -y_registers(_Config) -> - {'EXIT',{badarith,[_|_]}} = (catch baker(valentine)), - {'EXIT',{badarith,[_|_]}} = (catch baker(clementine)), - - {not_ok,true} = potter([]), - {ok,false} = potter([{encoding,any}]), - - ok. - -%% Thanks to Quickcheck. -baker(Baker) -> - (valentine == Baker) + - case Baker of - Baker when Baker; Baker -> - Baker; - Baker -> - [] - end. - -%% Thanks to Jose Valim. -potter(Modes) -> - Raw = lists:keyfind(encoding, 1, Modes) == false, - Final = case Raw of - X when X == false; X == nil -> ok; - _ -> not_ok - end, - {Final,Raw}. - -protected(_Config) -> - {'EXIT',{if_clause,_}} = (catch photographs({1, surprise, true}, opinions)), - - {{true}} = welcome({perfect, true}), - {'EXIT',{if_clause,_}} = (catch welcome({perfect, false})), - ok. - -photographs({_Violation, surprise, Deep}, opinions) -> - {if - 0; "here", Deep -> - Deep = Deep - end}. - -welcome({perfect, Profit}) -> - if - Profit, Profit, Profit; 0 -> - {id({Profit})} - end. - -maps(_Config) -> - ok = evidence(#{0 => 42}). - -%% Cover handling of put_map in in split_block_label_used/2. -evidence(#{0 := Charge}) when 0; #{[] => Charge} == #{[] => 42} -> - ok. - - -%%% -%%% Common utilities. -%%% - -id(I) -> - I. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 6742571b86..89f851ac3b 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -887,28 +887,41 @@ matching_and_andalso(Config) when is_list(Config) -> {'EXIT',{function_clause,_}} = (catch matching_and_andalso_1(<<1,2,3>>, blurf)), {'EXIT',{function_clause,_}} = (catch matching_and_andalso_1(<<1,2,3>>, 19)), - {"abc",<<"xyz">>} = matching_and_andalso_2("abc", <<"-xyz">>), - {"abc",<<"">>} = matching_and_andalso_2("abc", <<($a-1)>>), - {"abc",<<"">>} = matching_and_andalso_2("abc", <<($z+1)>>), - {"abc",<<"">>} = matching_and_andalso_2("abc", <<($A-1)>>), - {"abc",<<"">>} = matching_and_andalso_2("abc", <<($Z+1)>>), - error = matching_and_andalso_2([], <<>>), - error = matching_and_andalso_2([], <<$A>>), - error = matching_and_andalso_2([], <<$Z>>), - error = matching_and_andalso_2([], <<$a>>), - error = matching_and_andalso_2([], <<$z>>), + {"abc",<<"xyz">>} = matching_and_andalso_23("abc", <<"-xyz">>), + {"abc",<<"">>} = matching_and_andalso_23("abc", <<($a-1)>>), + {"abc",<<"">>} = matching_and_andalso_23("abc", <<($z+1)>>), + {"abc",<<"">>} = matching_and_andalso_23("abc", <<($A-1)>>), + {"abc",<<"">>} = matching_and_andalso_23("abc", <<($Z+1)>>), + error = matching_and_andalso_23([], <<>>), + error = matching_and_andalso_23([], <<$A>>), + error = matching_and_andalso_23([], <<$Z>>), + error = matching_and_andalso_23([], <<$a>>), + error = matching_and_andalso_23([], <<$z>>), ok. matching_and_andalso_1(<<Bitmap/binary>>, K) when is_integer(K) andalso size(Bitmap) >= K andalso 0 < K -> ok. +matching_and_andalso_23(Datetime, Bin) -> + Res = matching_and_andalso_2(Datetime, Bin), + Res = matching_and_andalso_3(Datetime, Bin), + Res. + matching_and_andalso_2(Datetime, <<H,T/binary>>) when not ((H >= $a) andalso (H =< $z)) andalso not ((H >= $A) andalso (H =< $Z)) -> {Datetime,T}; matching_and_andalso_2(_, _) -> error. +%% Contrived example to ensure we cover the handling of 'call' instructions +%% in v3_codegen:bsm_rename_ctx/4. +matching_and_andalso_3(Datetime, <<H,T/binary>>) + when not ((abs(H) >= $a) andalso (abs(H) =< $z)) andalso + not ((abs(H) >= $A) andalso (abs(H) =< $Z)) -> + {Datetime,T}; +matching_and_andalso_3(_, _) -> error. + %% Thanks to Tomas Stejskal. otp_7188(Config) when is_list(Config) -> MP3 = <<84,65,71,68,117,154,105,232,107,121,0,0,0,0,0,0,0,0,0,0, diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 28a353d27b..e2988b18dc 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -29,10 +29,10 @@ app_test/1,appup_test/1, file_1/1, forms_2/1, module_mismatch/1, big_file/1, outdir/1, binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1, - other_output/1, encrypted_abstr/1, + other_output/1, kernel_listing/1, encrypted_abstr/1, strict_record/1, cover/1, env/1, core/1, - core_roundtrip/1, asm/1, + core_roundtrip/1, asm/1, optimized_guards/1, sys_pre_attributes/1, dialyzer/1, warnings/1, pre_load_check/1, env_compiler_options/1 ]). @@ -47,9 +47,9 @@ all() -> test_lib:recompile(?MODULE), [app_test, appup_test, file_1, forms_2, module_mismatch, big_file, outdir, binary, makedep, cond_and_ifdef, listings, listings_big, - other_output, encrypted_abstr, + other_output, kernel_listing, encrypted_abstr, strict_record, - cover, env, core, core_roundtrip, asm, + cover, env, core, core_roundtrip, asm, optimized_guards, sys_pre_attributes, dialyzer, warnings, pre_load_check, env_compiler_options]. @@ -342,7 +342,6 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> do_listing(Simple, TargetDir, dblk, ".block"), do_listing(Simple, TargetDir, dexcept, ".except"), do_listing(Simple, TargetDir, dbs, ".bs"), - do_listing(Simple, TargetDir, dbool, ".bool"), do_listing(Simple, TargetDir, dtype, ".type"), do_listing(Simple, TargetDir, ddead, ".dead"), do_listing(Simple, TargetDir, djmp, ".jump"), @@ -430,6 +429,32 @@ other_output(Config) when is_list(Config) -> ok. +%% Smoke test and cover of pretty-printing of Kernel code. +kernel_listing(_Config) -> + TestBeams = get_unique_beam_files(), + Abstr = [begin {ok,{Mod,[{abstract_code, + {raw_abstract_v1,Abstr}}]}} = + beam_lib:chunks(Beam, [abstract_code]), + {Mod,Abstr} end || Beam <- TestBeams], + test_lib:p_run(fun(F) -> do_kernel_listing(F) end, Abstr). + +do_kernel_listing({M,A}) -> + try + {ok,M,Kern} = compile:forms(A, [to_kernel]), + IoList = v3_kernel_pp:format(Kern), + _ = iolist_size(IoList), + ok + catch + throw:{error,Error} -> + io:format("*** compilation failure '~p' for module ~s\n", + [Error,M]), + error; + Class:Error -> + io:format("~p: ~p ~p\n~p\n", + [M,Class,Error,erlang:get_stacktrace()]), + error + end. + encrypted_abstr(Config) when is_list(Config) -> {Simple,Target} = get_files(Config, simple, "encrypted_abstr"), @@ -901,6 +926,96 @@ do_asm(Beam, Outdir) -> error end. +%% Make sure that guards are fully optimized. Guards should +%% should use 'test' instructions, not 'bif' instructions. + +optimized_guards(_Config) -> + TestBeams = get_unique_beam_files(), + test_lib:p_run(fun(F) -> do_opt_guards(F) end, TestBeams). + +do_opt_guards(Beam) -> + {ok,{M,[{abstract_code,{raw_abstract_v1,A}}]}} = + beam_lib:chunks(Beam, [abstract_code]), + try + {ok,M,Asm} = compile:forms(A, ['S']), + do_opt_guards_mod(Asm) + catch Class:Error -> + io:format("~p: ~p ~p\n~p\n", + [M,Class,Error,erlang:get_stacktrace()]), + error + end. + +do_opt_guards_mod({Mod,_Exp,_Attr,Asm,_NumLabels}) -> + case do_opt_guards_fs(Mod, Asm) of + [] -> + ok; + [_|_]=Bifs -> + io:format("ERRORS FOR ~p:\n~p\n", [Mod,Bifs]), + error + end. + +do_opt_guards_fs(Mod, [{function,Name,Arity,_,Is}|Fs]) -> + Bifs0 = do_opt_guards_fun(Is), + + %% The compiler does not attempt to optimize 'xor'. + %% Therefore, ignore all functions that use 'xor' in + %% a guard. + Bifs = case lists:any(fun({bif,'xor',_,_,_}) -> true; + (_) -> false + end, Bifs0) of + true -> []; + false -> Bifs0 + end, + + %% Filter out the allowed exceptions. + FA = {Name,Arity}, + case {Bifs,is_exception(Mod, FA)} of + {[_|_],true} -> + io:format("~p:~p/~p IGNORED:\n~p\n", + [Mod,Name,Arity,Bifs]), + do_opt_guards_fs(Mod, Fs); + {[_|_],false} -> + [{FA,Bifs}|do_opt_guards_fs(Mod, Fs)]; + {[],false} -> + do_opt_guards_fs(Mod, Fs); + {[],true} -> + io:format("Redundant exception for ~p:~p/~p\n", + [Mod,Name,Arity]), + error(redundant) + end; +do_opt_guards_fs(_, []) -> []. + +do_opt_guards_fun([{bif,Name,{f,F},As,_}=I|Is]) when F =/= 0 -> + Arity = length(As), + case erl_internal:comp_op(Name, Arity) orelse + erl_internal:bool_op(Name, Arity) orelse + erl_internal:new_type_test(Name, Arity) of + true -> + [I|do_opt_guards_fun(Is)]; + false -> + do_opt_guards_fun(Is) + end; +do_opt_guards_fun([_|Is]) -> + do_opt_guards_fun(Is); +do_opt_guards_fun([]) -> []. + +is_exception(bs_match_SUITE, {matching_and_andalso_2,2}) -> true; +is_exception(bs_match_SUITE, {matching_and_andalso_3,2}) -> true; +is_exception(guard_SUITE, {'-complex_not/1-fun-4-',1}) -> true; +is_exception(guard_SUITE, {'-complex_not/1-fun-5-',1}) -> true; +is_exception(guard_SUITE, {basic_andalso_orelse,1}) -> true; +is_exception(guard_SUITE, {bad_guards,1}) -> true; +is_exception(guard_SUITE, {bad_guards_2,2}) -> true; +is_exception(guard_SUITE, {bad_guards_3,2}) -> true; +is_exception(guard_SUITE, {cqlc,4}) -> true; +is_exception(guard_SUITE, {csemi7,3}) -> true; +is_exception(guard_SUITE, {misc,1}) -> true; +is_exception(guard_SUITE, {nested_not_2b,4}) -> true; +is_exception(guard_SUITE, {tricky_1,2}) -> true; +is_exception(map_SUITE, {map_guard_update,2}) -> true; +is_exception(map_SUITE, {map_guard_update_variables,3}) -> true; +is_exception(_, _) -> false. + sys_pre_attributes(Config) -> DataDir = proplists:get_value(data_dir, Config), File = filename:join(DataDir, "attributes.erl"), @@ -1126,8 +1241,15 @@ get_unique_beam_files() -> get_unique_files(Ext) -> Wc = filename:join(filename:dirname(code:which(?MODULE)), "*"++Ext), - [F || F <- filelib:wildcard(Wc), not is_cloned(F, Ext)]. + [F || F <- filelib:wildcard(Wc), + not is_cloned(F, Ext), not is_lfe_module(F, Ext)]. is_cloned(File, Ext) -> Mod = list_to_atom(filename:basename(File, Ext)), test_lib:is_cloned_mod(Mod). + +is_lfe_module(File, Ext) -> + case filename:basename(File, Ext) of + "lfe_" ++ _ -> true; + _ -> false + end. diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl index b768f49e2c..f8839da42f 100644 --- a/lib/compiler/test/core_SUITE.erl +++ b/lib/compiler/test/core_SUITE.erl @@ -26,8 +26,9 @@ seq_in_guard/1,make_effect_seq/1,eval_is_boolean/1, unsafe_case/1,nomatch_shadow/1,reversed_annos/1, map_core_test/1,eval_case/1,bad_boolean_guard/1, - bs_shadowed_size_var/1 - ]). + bs_shadowed_size_var/1, + cover_v3_kernel_1/1,cover_v3_kernel_2/1,cover_v3_kernel_3/1, + cover_v3_kernel_4/1,cover_v3_kernel_5/1]). -include_lib("common_test/include/ct.hrl"). @@ -53,8 +54,10 @@ groups() -> [dehydrated_itracer,nested_tries,seq_in_guard,make_effect_seq, eval_is_boolean,unsafe_case,nomatch_shadow,reversed_annos, map_core_test,eval_case,bad_boolean_guard, - bs_shadowed_size_var - ]}]. + bs_shadowed_size_var, + cover_v3_kernel_1,cover_v3_kernel_2,cover_v3_kernel_3, + cover_v3_kernel_4,cover_v3_kernel_5 + ]}]. init_per_suite(Config) -> @@ -64,10 +67,10 @@ end_per_suite(_Config) -> ok. init_per_group(_GroupName, Config) -> - Config. + Config. end_per_group(_GroupName, Config) -> - Config. + Config. ?comp(dehydrated_itracer). @@ -82,6 +85,11 @@ end_per_group(_GroupName, Config) -> ?comp(eval_case). ?comp(bad_boolean_guard). ?comp(bs_shadowed_size_var). +?comp(cover_v3_kernel_1). +?comp(cover_v3_kernel_2). +?comp(cover_v3_kernel_3). +?comp(cover_v3_kernel_4). +?comp(cover_v3_kernel_5). try_it(Mod, Conf) -> diff --git a/lib/compiler/test/core_SUITE_data/cover_v3_kernel_1.core b/lib/compiler/test/core_SUITE_data/cover_v3_kernel_1.core new file mode 100644 index 0000000000..9e5788796f --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/cover_v3_kernel_1.core @@ -0,0 +1,147 @@ +module 'cover_v3_kernel_1' ['cover_v3_kernel_1'/0, + 'module_info'/0, + 'module_info'/1] + attributes [] +'cover_v3_kernel_1'/0 = + %% Line 4 + fun () -> + case <> of + <> when 'true' -> + %% Line 5 + case apply 'bad_and_args'/1 + ('x') of + <'error'> when 'true' -> + %% Line 7 + case apply 'bad_and_args'/2 + (1, 2) of + <'error'> when 'true' -> + %% Line 8 + case apply 'bad_and_args'/2 + (1, 'true') of + <'error'> when 'true' -> + %% Line 9 + case apply 'bad_and_args'/2 + ('true', 42) of + <'error'> when 'true' -> + %% Line 10 + case apply 'bad_and_args'/2 + ('true', 'false') of + <'error'> when 'true' -> + %% Line 11 + case apply 'bad_and_args'/2 + ('false', 'true') of + <'error'> when 'true' -> + %% Line 12 + case apply 'bad_and_args'/2 + ('true', 'true') of + <'ok'> when 'true' -> + %% Line 14 + 'ok' + ( <_@c6> when 'true' -> + primop 'match_fail' + ({'badmatch',_@c6}) + -| ['compiler_generated'] ) + end + ( <_@c5> when 'true' -> + primop 'match_fail' + ({'badmatch',_@c5}) + -| ['compiler_generated'] ) + end + ( <_@c4> when 'true' -> + primop 'match_fail' + ({'badmatch',_@c4}) + -| ['compiler_generated'] ) + end + ( <_@c3> when 'true' -> + primop 'match_fail' + ({'badmatch',_@c3}) + -| ['compiler_generated'] ) + end + ( <_@c2> when 'true' -> + primop 'match_fail' + ({'badmatch',_@c2}) + -| ['compiler_generated'] ) + end + ( <_@c1> when 'true' -> + primop 'match_fail' + ({'badmatch',_@c1}) + -| ['compiler_generated'] ) + end + ( <_@c0> when 'true' -> + primop 'match_fail' + ({'badmatch',_@c0}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + ( primop 'match_fail' + ({'function_clause'}) + -| [{'function_name',{'cover_v3_kernel_1',0}}] ) + -| ['compiler_generated'] ) + end +'bad_and_args'/1 = + %% Line 16 + fun (_@c0) -> + case _@c0 of + <A> + when try + call 'erlang':'and'(A, 42) + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + %% Line 17 + <_@c4> when 'true' -> + 'error' + ( <_@c3> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_@c3}) + -| [{'function_name',{'bad_and_args',1}}] ) + -| ['compiler_generated'] ) + end +'bad_and_args'/2 = + %% Line 19 + fun (_@c1,_@c0) -> + case <_@c1,_@c0> of + <X,Y> + when try + call 'erlang':'and'(X, Y) + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + %% Line 20 + <_@c6,_@c7> when 'true' -> + 'error' + ( <_@c5,_@c4> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_@c5,_@c4}) + -| [{'function_name',{'bad_and_args',2}}] ) + -| ['compiler_generated'] ) + end +'module_info'/0 = + fun () -> + case <> of + <> when 'true' -> + call 'erlang':'get_module_info' + ('cover_v3_kernel_1') + ( <> when 'true' -> + ( primop 'match_fail' + ({'function_clause'}) + -| [{'function_name',{'module_info',0}}] ) + -| ['compiler_generated'] ) + end +'module_info'/1 = + fun (_@c0) -> + case _@c0 of + <X> when 'true' -> + call 'erlang':'get_module_info' + ('cover_v3_kernel_1', X) + ( <_@c1> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_@c1}) + -| [{'function_name',{'module_info',1}}] ) + -| ['compiler_generated'] ) + end +end diff --git a/lib/compiler/test/core_SUITE_data/cover_v3_kernel_2.core b/lib/compiler/test/core_SUITE_data/cover_v3_kernel_2.core new file mode 100644 index 0000000000..165aacd691 --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/cover_v3_kernel_2.core @@ -0,0 +1,98 @@ +module 'cover_v3_kernel_2' ['cover_v3_kernel_2'/0, + 'module_info'/0, + 'module_info'/1] + attributes [] +'cover_v3_kernel_2'/0 = + %% Line 4 + fun () -> + case <> of + <> when 'true' -> + %% Line 5 + case apply 'strange_case'/1 + ('a') of + <'ok'> when 'true' -> + %% Line 6 + case apply 'strange_case'/1 + ('b') of + <'ok'> when 'true' -> + %% Line 7 + case apply 'strange_case'/1 + ('c') of + <'error'> when 'true' -> + %% Line 8 + case apply 'strange_case'/1 + (42) of + <'error'> when 'true' -> + %% Line 9 + 'ok' + ( <_cor3> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor3}) + -| ['compiler_generated'] ) + end + ( <_cor2> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor2}) + -| ['compiler_generated'] ) + end + ( <_cor1> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor1}) + -| ['compiler_generated'] ) + end + ( <_cor0> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor0}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + ( primop 'match_fail' + ({'function_clause'}) + -| [{'function_name',{'cover_v3_kernel_2',0}}] ) + -| ['compiler_generated'] ) + end +'strange_case'/1 = + %% Line 12 + fun (_cor0) -> + case _cor0 of + <X> when + case X of + <'a'> when 'true' -> 'true' + <'b'> when 'true' -> 'true' + <Other> when 'true' -> 'false' + end -> + 'ok' + %% Line 13 + <_cor4> when 'true' -> + 'error' + ( <_cor3> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_cor3}) + -| [{'function_name',{'strange_case',1}}] ) + -| ['compiler_generated'] ) + end +'module_info'/0 = + fun () -> + case <> of + <> when 'true' -> + call 'erlang':'get_module_info' + ('cover_v3_kernel_2') + ( <> when 'true' -> + ( primop 'match_fail' + ({'function_clause'}) + -| [{'function_name',{'module_info',0}}] ) + -| ['compiler_generated'] ) + end +'module_info'/1 = + fun (_cor0) -> + case _cor0 of + <X> when 'true' -> + call 'erlang':'get_module_info' + ('cover_v3_kernel_2', X) + ( <_cor1> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_cor1}) + -| [{'function_name',{'module_info',1}}] ) + -| ['compiler_generated'] ) + end +end diff --git a/lib/compiler/test/core_SUITE_data/cover_v3_kernel_3.core b/lib/compiler/test/core_SUITE_data/cover_v3_kernel_3.core new file mode 100644 index 0000000000..88a9edc354 --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/cover_v3_kernel_3.core @@ -0,0 +1,98 @@ +module 'cover_v3_kernel_3' ['cover_v3_kernel_3'/0, + 'module_info'/0, + 'module_info'/1] + attributes [] +'cover_v3_kernel_3'/0 = + %% Line 4 + fun () -> + case <> of + <> when 'true' -> + %% Line 5 + case apply 'strange_case'/1 + (1) of + <'ok'> when 'true' -> + %% Line 6 + case apply 'strange_case'/1 + (2) of + <'ok'> when 'true' -> + %% Line 7 + case apply 'strange_case'/1 + (42) of + <'error'> when 'true' -> + %% Line 8 + case apply 'strange_case'/1 + ('atom') of + <'error'> when 'true' -> + %% Line 9 + 'ok' + ( <_cor3> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor3}) + -| ['compiler_generated'] ) + end + ( <_cor2> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor2}) + -| ['compiler_generated'] ) + end + ( <_cor1> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor1}) + -| ['compiler_generated'] ) + end + ( <_cor0> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor0}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + ( primop 'match_fail' + ({'function_clause'}) + -| [{'function_name',{'cover_v3_kernel_3',0}}] ) + -| ['compiler_generated'] ) + end +'strange_case'/1 = + %% Line 12 + fun (_cor0) -> + case _cor0 of + <X> when + case X of + <1> when 'true' -> 'true' + <2> when 'true' -> 'true' + <Other> when 'true' -> 'false' + end -> + 'ok' + %% Line 13 + <_cor4> when 'true' -> + 'error' + ( <_cor3> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_cor3}) + -| [{'function_name',{'strange_case',1}}] ) + -| ['compiler_generated'] ) + end +'module_info'/0 = + fun () -> + case <> of + <> when 'true' -> + call 'erlang':'get_module_info' + ('cover_v3_kernel_3') + ( <> when 'true' -> + ( primop 'match_fail' + ({'function_clause'}) + -| [{'function_name',{'module_info',0}}] ) + -| ['compiler_generated'] ) + end +'module_info'/1 = + fun (_cor0) -> + case _cor0 of + <X> when 'true' -> + call 'erlang':'get_module_info' + ('cover_v3_kernel_3', X) + ( <_cor1> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_cor1}) + -| [{'function_name',{'module_info',1}}] ) + -| ['compiler_generated'] ) + end +end diff --git a/lib/compiler/test/core_SUITE_data/cover_v3_kernel_4.core b/lib/compiler/test/core_SUITE_data/cover_v3_kernel_4.core new file mode 100644 index 0000000000..905e236f26 --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/cover_v3_kernel_4.core @@ -0,0 +1,82 @@ +module 'cover_v3_kernel_4' ['cover_v3_kernel_4'/0, + 'module_info'/0, + 'module_info'/1] + attributes [] +'cover_v3_kernel_4'/0 = + %% Line 4 + fun () -> + %% Line 5 + case apply 'turned_case'/1 + (20) of + <'ok'> when 'true' -> + %% Line 6 + case apply 'turned_case'/1 + (0) of + <'error'> when 'true' -> + %% Line 7 + 'ok' + ( <_@c1> when 'true' -> + primop 'match_fail' + ({'badmatch',_@c1}) + -| ['compiler_generated'] ) + end + ( <_@c0> when 'true' -> + primop 'match_fail' + ({'badmatch',_@c0}) + -| ['compiler_generated'] ) + end +'turned_case'/1 = + %% Line 9 + fun (_@c0) -> + let <True> = + apply %% Line 10 + 'id'/1 + (%% Line 10 + 'true') + in %% Line 11 + case <> of + %% Line 12 + <> + when try + ( let <_@c4> = + case call 'erlang':'<' + (_@c0, 10) of + ( <( 'false' + -| ['compiler_generated'] )> when 'true' -> + True + -| ['compiler_generated'] ) + ( <( 'true' + -| ['compiler_generated'] )> when 'true' -> + 'false' + -| ['compiler_generated'] ) + ( <_@c2> when 'true' -> + _@c2 + -| ['compiler_generated'] ) + end + in ( call 'erlang':'=:=' + (( _@c4 + -| ['compiler_generated'] ), 'true') + -| ['compiler_generated'] ) + -| ['compiler_generated'] ) + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + %% Line 13 + <> when 'true' -> + 'error' + end +'id'/1 = + %% Line 16 + fun (_@c0) -> + _@c0 +'module_info'/0 = + fun () -> + call 'erlang':'get_module_info' + ('cover_v3_kernel_4') +'module_info'/1 = + fun (_@c0) -> + call 'erlang':'get_module_info' + ('cover_v3_kernel_4', _@c0) +end
\ No newline at end of file diff --git a/lib/compiler/test/core_SUITE_data/cover_v3_kernel_5.core b/lib/compiler/test/core_SUITE_data/cover_v3_kernel_5.core new file mode 100644 index 0000000000..48c1bb84e6 --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/cover_v3_kernel_5.core @@ -0,0 +1,98 @@ +module 'cover_v3_kernel_5' ['cover_v3_kernel_5'/0, + 'module_info'/0, + 'module_info'/1] + attributes [] +'cover_v3_kernel_5'/0 = + %% Line 4 + fun () -> + case <> of + <> when 'true' -> + %% Line 5 + case apply 'strange_case'/1 + (1) of + <'ok'> when 'true' -> + %% Line 6 + case apply 'strange_case'/1 + (2) of + <'ok'> when 'true' -> + %% Line 7 + case apply 'strange_case'/1 + (42) of + <'error'> when 'true' -> + %% Line 8 + case apply 'strange_case'/1 + ('atom') of + <'error'> when 'true' -> + %% Line 9 + 'ok' + ( <_cor3> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor3}) + -| ['compiler_generated'] ) + end + ( <_cor2> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor2}) + -| ['compiler_generated'] ) + end + ( <_cor1> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor1}) + -| ['compiler_generated'] ) + end + ( <_cor0> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor0}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + ( primop 'match_fail' + ({'function_clause'}) + -| [{'function_name',{'cover_v3_kernel_5',0}}] ) + -| ['compiler_generated'] ) + end +'strange_case'/1 = + %% Line 12 + fun (_cor0) -> + case _cor0 of + <X> when + case X of + <1> when 'true' -> 'true' + <2> when 'true' -> 'true' + <Other> when 'true' -> X + end -> + 'ok' + %% Line 13 + <_cor4> when 'true' -> + 'error' + ( <_cor3> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_cor3}) + -| [{'function_name',{'strange_case',1}}] ) + -| ['compiler_generated'] ) + end +'module_info'/0 = + fun () -> + case <> of + <> when 'true' -> + call 'erlang':'get_module_info' + ('cover_v3_kernel_5') + ( <> when 'true' -> + ( primop 'match_fail' + ({'function_clause'}) + -| [{'function_name',{'module_info',0}}] ) + -| ['compiler_generated'] ) + end +'module_info'/1 = + fun (_cor0) -> + case _cor0 of + <X> when 'true' -> + call 'erlang':'get_module_info' + ('cover_v3_kernel_5', X) + ( <_cor1> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_cor1}) + -| [{'function_name',{'module_info',1}}] ) + -| ['compiler_generated'] ) + end +end diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index 429d6b79e0..a662d85272 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -35,7 +35,7 @@ basic_andalso_orelse/1,traverse_dcd/1, check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1, bad_constants/1,bad_guards/1, - guard_in_catch/1]). + guard_in_catch/1,beam_bool_SUITE/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -54,7 +54,7 @@ groups() -> rel_ops,rel_op_combinations, literal_type_tests,basic_andalso_orelse,traverse_dcd, check_qlc_hrl,andalso_semi,t_tuple_size,binary_part, - bad_constants,bad_guards,guard_in_catch]}]. + bad_constants,bad_guards,guard_in_catch,beam_bool_SUITE]}]. init_per_suite(Config) -> Config. @@ -88,8 +88,31 @@ misc(Config) when is_list(Config) -> {ok,buf,<<>>} = get_data({o,false,0}, 0, buf), error = get_data({o,false,0}, 42, buf), + relief = misc_2(0), + error = misc_2(1), + error = misc_2(true), + + if + is_integer(Config) =/= true -> + ok + end, + + true = misc_3(1, 0), + true = misc_3(0, 0), + false = misc_3(0, 2), + + %% Abuse of boolean values. + + Zero = id(0), + One = id(1), + ok = if (Zero == 0) > false -> ok end, + ok = if (Zero == 0) =:= (One == 1) -> ok end, + ok = if (Zero == 0) =:= (One == 1) -> ok end, + ok = if is_atom(Zero > One) -> ok end, + error = if abs(Zero > One) -> ok; true -> error end, + ok = if is_integer(Zero) >= is_integer(One) -> ok end, + ok. - misc_1([{W},{X},{Y},{Z}]) -> if @@ -99,6 +122,17 @@ misc_1([{W},{X},{Y},{Z}]) -> none end. +misc_2(0) -> relief; +misc_2(Adapter = 1) when Adapter -> franklin; +misc_2(_) -> error. + +misc_3(LenUp, LenDw) -> + if + %% Cover handling of #k_alt{}. + LenUp >= 1 orelse ((LenDw >= 2) xor true) -> true; + true -> false + end. + get_data({o,Active,Raw}, BytesToRead, Buffer) when Raw =:= raw; Raw =:= 0 -> if @@ -164,6 +198,12 @@ basic_not(Config) when is_list(Config) -> check(fun() -> if not glurf -> ok; true -> error end end, error), check(fun() -> if not Glurf -> ok; true -> error end end, error), + check(fun() -> if not (not true) -> broken end end, broken), + + check(fun() -> if not (True xor True) -> ok end end, ok), + check(fun() -> if not (True xor False) -> ok; + true -> error end end, error), + ok. complex_not(Config) when is_list(Config) -> @@ -188,8 +228,60 @@ complex_not(Config) when is_list(Config) -> check(fun() -> if not(element(1, ATuple) orelse element(3, ATuple)) -> ok; true -> error end end, error), + %% complex_not_1/4 + ok = complex_not_1(1, 1, 1, a), + error = complex_not_1(1, 1, 1, []), + error = complex_not_1(1, 1, 3, a), + error = complex_not_1(1, 1, 3, []), + error = complex_not_1(1, 2, 1, a), + error = complex_not_1(1, 2, 1, []), + error = complex_not_1(1, 2, 3, a), + error = complex_not_1(1, 2, 3, []), + + %% complex_not_2/4 + ok = complex_not_2(1, 2, 0, x), + error = complex_not_2(1, 2, 0, []), + error = complex_not_2(1, 2, 3, x), + error = complex_not_2(1, 2, 3, []), + error = complex_not_2(1, 1, 0, x), + error = complex_not_2(1, 1, 0, []), + error = complex_not_2(1, 1, 3, x), + error = complex_not_2(1, 1, 3, []), + ok. +complex_not_1(A, B, C, D) -> + Res = complex_not_1a(A, B, C, D), + Res = complex_not_1b(A, B, C, D). + +complex_not_1a(A, B, C, D) + when (not (A < B)) andalso (not (B < C)) andalso (not is_list(D)) -> + ok; +complex_not_1a(_, _, _, _) -> + error. + +complex_not_1b(A, B, C, D) + when (not (A < B)) and (not (B < C)) and (not is_list(D)) -> + ok; +complex_not_1b(_, _, _, _) -> + error. + +complex_not_2(A, B, C, D) -> + Res = complex_not_2a(A, B, C, D), + Res = complex_not_2b(A, B, C, D). + +complex_not_2a(A, B, C, D) + when A < B andalso not (B < C) andalso not is_list(D) -> + ok; +complex_not_2a(_, _, _, _) -> + error. + +complex_not_2b(A, B, C, D) + when A < B, not (B < C), not is_list(D) -> + ok; +complex_not_2b(_, _, _, _) -> + error. + nested_nots(Config) when is_list(Config) -> true = nested_not_1(0, 0), true = nested_not_1(0, 1), @@ -210,19 +302,36 @@ nested_nots(Config) when is_list(Config) -> false = nested_not_2(true, true, atom), ok. -nested_not_1(X, Y) when not (((X>Y) or not(is_atom(X))) and +nested_not_1(X, Y) -> + Res = nested_not_1a(X, Y), + Res = nested_not_1b(X, Y). + +nested_not_1a(X, Y) when not (((X>Y) or not(is_atom(X))) and (is_atom(Y) or (X==3.4))) -> true; -nested_not_1(_, _) -> +nested_not_1a(_, _) -> + false. + +nested_not_1b(X, Y) when not (((X>Y) orelse not(is_atom(X))) andalso + (is_atom(Y) orelse (X==3.4))) -> + true; +nested_not_1b(_, _) -> false. nested_not_2(X, Y, Z) -> - nested_not_2(X, Y, Z, true). + Res = nested_not_2a(X, Y, Z, true), + Res = nested_not_2b(X, Y, Z, true). -nested_not_2(X, Y, Z, True) +nested_not_2a(X, Y, Z, True) when not(True and not((not(X) and not(Y)) or not(is_atom(Z)))) -> true; -nested_not_2(_, _, _, _) -> +nested_not_2a(_, _, _, _) -> + false. + +nested_not_2b(X, Y, Z, True) + when not(True andalso not((not(X) andalso not(Y)) orelse not(is_atom(Z)))) -> + true; +nested_not_2b(_, _, _, _) -> false. semicolon(Config) when is_list(Config) -> @@ -1094,6 +1203,13 @@ tricky(Config) when is_list(Config) -> false = rb(100000, [1], 42), true = rb(100000, [], 42), true = rb(555, [a,b,c], 19), + + error = tricky_3(42), + error = tricky_3(42.0), + error = tricky_3(<<>>), + error = tricky_3(#{}), + error = tricky_3({a,b}), + ok. tricky_1(X, Y) when abs((X == 1) or (Y == 2)) -> ok; @@ -1102,6 +1218,15 @@ tricky_1(_, _) -> not_ok. tricky_2(X) when float(X) or float(X) -> ok; tricky_2(_) -> error. +tricky_3(X) + when abs(X) or bit_size(X) or byte_size(X) or ceil(X) or + float(X) or floor(X) or length(X) or + map_size(X) or node() or node(X) or round(X) or + self() or size(X) or tl(X) or trunc(X) or tuple_size(X) -> + ok; +tricky_3(_) -> + error. + %% From dets_v9:read_buckets/11, simplified. rb(Size, ToRead, SoFar) when SoFar + Size < 81920; ToRead == [] -> true; @@ -1925,6 +2050,155 @@ do_guard_in_catch_bin(From) -> saint end. +%%% +%%% The beam_bool pass has been eliminated. Here are the tests from +%%% beam_bool_SUITE. +%%% + +beam_bool_SUITE(_Config) -> + before_and_inside_if(), + scotland(), + y_registers(), + protected(), + maps(), + ok. + +before_and_inside_if() -> + no = before_and_inside_if([a], [b], delete), + no = before_and_inside_if([a], [b], x), + no = before_and_inside_if([a], [], delete), + no = before_and_inside_if([a], [], x), + no = before_and_inside_if([], [], delete), + yes = before_and_inside_if([], [], x), + yes = before_and_inside_if([], [b], delete), + yes = before_and_inside_if([], [b], x), + + {ch1,ch2} = before_and_inside_if_2([a], [b], blah), + {ch1,ch2} = before_and_inside_if_2([a], [b], xx), + {ch1,ch2} = before_and_inside_if_2([a], [], blah), + {ch1,ch2} = before_and_inside_if_2([a], [], xx), + {no,no} = before_and_inside_if_2([], [b], blah), + {no,no} = before_and_inside_if_2([], [b], xx), + {ch1,no} = before_and_inside_if_2([], [], blah), + {no,ch2} = before_and_inside_if_2([], [], xx), + ok. + +%% Thanks to Simon Cornish and Kostis Sagonas. +%% Used to crash beam_bool. +before_and_inside_if(XDo1, XDo2, Do3) -> + Do1 = (XDo1 =/= []), + Do2 = (XDo2 =/= []), + if + %% This expression occurs in a try/catch (protected) + %% block, which cannot refer to variables outside of + %% the block that are boolean expressions. + Do1 =:= true; + Do1 =:= false, Do2 =:= false, Do3 =:= delete -> + no; + true -> + yes + end. + +%% Thanks to Simon Cornish. +%% Used to generate code that would not set {y,0} on +%% all paths before its use (and therefore fail +%% validation by the beam_validator). +before_and_inside_if_2(XDo1, XDo2, Do3) -> + Do1 = (XDo1 =/= []), + Do2 = (XDo2 =/= []), + CH1 = if Do1 == true; + Do1 == false,Do2==false,Do3 == blah -> + ch1; + true -> + no + end, + CH2 = if Do1 == true; + Do1 == false,Do2==false,Do3 == xx -> + ch2; + true -> + no + end, + {CH1,CH2}. + + +%% beam_bool would remove the initialization of {y,0}. +%% (Thanks to Thomas Arts and QuickCheck.) + +scotland() -> + million = do_scotland(placed), + {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(false)), + {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(true)), + {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(echo)), + ok. + +do_scotland(Echo) -> + found(case Echo of + Echo when true; Echo, Echo, Echo -> + Echo; + echo -> + [] + end, + Echo = placed). + +found(_, _) -> million. + + +%% ERL-143: beam_bool could not handle Y registers as a destination. +y_registers() -> + {'EXIT',{badarith,[_|_]}} = (catch baker(valentine)), + {'EXIT',{badarith,[_|_]}} = (catch baker(clementine)), + + {not_ok,true} = potter([]), + {ok,false} = potter([{encoding,any}]), + + ok. + +%% Thanks to Quickcheck. +baker(Baker) -> + (valentine == Baker) + + case Baker of + Baker when Baker; Baker -> + Baker; + Baker -> + [] + end. + +%% Thanks to Jose Valim. +potter(Modes) -> + Raw = lists:keyfind(encoding, 1, Modes) == false, + Final = case Raw of + X when X == false; X == nil -> ok; + _ -> not_ok + end, + {Final,Raw}. + +protected() -> + {'EXIT',{if_clause,_}} = (catch photographs({1, surprise, true}, opinions)), + + {{true}} = welcome({perfect, true}), + {'EXIT',{if_clause,_}} = (catch welcome({perfect, false})), + ok. + +photographs({_Violation, surprise, Deep}, opinions) -> + {if + 0; "here", Deep -> + Deep = Deep + end}. + +welcome({perfect, Profit}) -> + if + Profit, Profit, Profit; 0 -> + {id({Profit})} + end. + +maps() -> + ok = evidence(#{0 => 42}). + +%% Cover handling of put_map in in split_block_label_used/2. +evidence(#{0 := Charge}) when 0; #{[] => Charge} == #{[] => 42} -> + ok. + + %% Call this function to turn off constant propagation. id(I) -> I. diff --git a/lib/compiler/test/lfe-core.patch b/lib/compiler/test/lfe-core.patch new file mode 100644 index 0000000000..756d131e2c --- /dev/null +++ b/lib/compiler/test/lfe-core.patch @@ -0,0 +1,97 @@ +Date: Sun, 13 Nov 2016 10:11:11 +0100 +Subject: [PATCH] Fix invalid variable names + +--- + test/lfe_andor_SUITE.core | 16 ++++++++-------- + test/lfe_guard_SUITE.core | 14 +++++++------- + 2 files changed, 15 insertions(+), 15 deletions(-) + +diff --git a/test/lfe_andor_SUITE.core b/test/lfe_andor_SUITE.core +index 96ff765..df58b39 100644 +--- a/test/lfe_andor_SUITE.core ++++ b/test/lfe_andor_SUITE.core +@@ -288,19 +288,19 @@ module 'lfe_andor_SUITE' ['$handle_undefined_function'/2, + 'lc$^0'/1 = + fun (_2) -> + case <_2> of +- <[_x|_|-0-|]> when 'true' -> ++ <[_x|_lfe0]> when 'true' -> + letrec + 'lc$^1'/1 = + fun (_3) -> + case <_3> of +- <[_y|_|-1-|]> when 'true' -> ++ <[_y|_lfe1]> when 'true' -> + let <_4> = + apply 'lc$^1'/1 +- (_|-1-|) ++ (_lfe1) + in [{_x,_y}|_4] + <[]> when 'true' -> + apply 'lc$^0'/1 +- (_|-0-|) ++ (_lfe0) + ( <_5> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_5}) +@@ -455,19 +455,19 @@ module 'lfe_andor_SUITE' ['$handle_undefined_function'/2, + 'lc$^2'/1 = + fun (_2) -> + case <_2> of +- <[_x|_|-2-|]> when 'true' -> ++ <[_x|_lfe2]> when 'true' -> + letrec + 'lc$^3'/1 = + fun (_3) -> + case <_3> of +- <[_y|_|-3-|]> when 'true' -> ++ <[_y|_lfe3]> when 'true' -> + let <_4> = + apply 'lc$^3'/1 +- (_|-3-|) ++ (_lfe3) + in [{_x,_y}|_4] + <[]> when 'true' -> + apply 'lc$^2'/1 +- (_|-2-|) ++ (_lfe2) + ( <_5> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_5}) +diff --git a/test/lfe_guard_SUITE.core b/test/lfe_guard_SUITE.core +index 38f1d99..920be82 100644 +--- a/test/lfe_guard_SUITE.core ++++ b/test/lfe_guard_SUITE.core +@@ -2857,22 +2857,22 @@ module 'lfe_guard_SUITE' ['$handle_undefined_function'/2, + 'false' -> + case <_t> of + <{_a,_b,_c,_d}> when 'true' -> +- let <_|-0-|> = ++ let <_lfe0> = + <_a> +- in let <_|-1-|> = ++ in let <_lfe1> = + <_b> +- in let <_|-2-|> = ++ in let <_lfe2> = + <_c> +- in let <_|-3-|> = ++ in let <_lfe3> = + <_d> + in let <_4> = + let <_3> = + call 'erlang':'+' +- (_|-0-|, _|-1-|) ++ (_lfe0, _lfe1) + in call 'erlang':'+' +- (_3, _|-2-|) ++ (_3, _lfe2) + in call 'erlang':'+' +- (_4, _|-3-|) ++ (_4, _lfe3) + ( <_5> when 'true' -> + primop 'match_fail' + ({'badmatch',{_5}}) +-- +2.7.4 (Apple Git-66) + diff --git a/lib/compiler/test/lfe-source.patch b/lib/compiler/test/lfe-source.patch new file mode 100644 index 0000000000..cbd6748bc9 --- /dev/null +++ b/lib/compiler/test/lfe-source.patch @@ -0,0 +1,117 @@ +Date: Sun, 13 Nov 2016 09:40:36 +0100 +Subject: [PATCH] Rename and fix up LFE test suites + +--- + test/{andor_SUITE.lfe => lfe_andor_SUITE.lfe} | 16 ++++++++-------- + test/{guard_SUITE.lfe => lfe_guard_SUITE.lfe} | 8 ++++---- + 2 files changed, 12 insertions(+), 12 deletions(-) + rename test/{andor_SUITE.lfe => lfe_andor_SUITE.lfe} (97%) + rename test/{guard_SUITE.lfe => lfe_guard_SUITE.lfe} (99%) + +diff --git a/test/andor_SUITE.lfe b/test/lfe_andor_SUITE.lfe +similarity index 97% +rename from test/andor_SUITE.lfe +rename to test/lfe_andor_SUITE.lfe +index 64feddd..1802b3f 100644 +--- a/test/andor_SUITE.lfe ++++ b/test/lfe_andor_SUITE.lfe +@@ -26,14 +26,14 @@ + + (include-file "test_server.lfe") + +-(defmodule andor_SUITE ++(defmodule lfe_andor_SUITE + (export (all 0) (suite 0) (groups 0) (init_per_suite 1) (end_per_suite 1) + (init_per_group 2) (end_per_group 2) + (t_case 1) (t_and_or 1) (t_andalso 1) (t_orelse 1) (inside 1) + (overlap 1) (combined 1) (in_case 1) (before_and_inside_if 1) + )) + +-(defmacro MODULE () `'andor_SUITE) ++(defmacro MODULE () `'lfe_andor_SUITE) + + (defun all () + ;; (: test_lib recompile (MODULE)) +@@ -206,7 +206,7 @@ + + (defun t-andalso-1 + ([(tuple x y)] +- (: lfe_io format '"(andalso ~w ~w): " (list x y)) ++ (: io format '"(andalso ~w ~w): " (list x y)) + (let* ((v0 (andalso (echo x) (echo y))) + (v1 (when (=:= v0 v1)) + (eif (andalso x y) 'true 'true 'false))) +@@ -248,7 +248,7 @@ + + (defun t-orelse-1 + ([(tuple x y)] +- (: lfe_io format '"(orelse ~w ~w): " (list x y)) ++ (: io format '"(orelse ~w ~w): " (list x y)) + (let* ((v0 (orelse (echo x) (echo y))) + (v1 (when (=:= v0 v1)) + (eif (orelse x y) 'true 'true 'false))) +@@ -289,7 +289,7 @@ + (when (=:= r1 r2) (=:= xm xm2) (=:= ym ym2) (=:= x x2) + (=:= y y2) (=:= w w2) (=:= h h2)) + (inside-guard xm ym x y w h))) +- (: lfe_io fwrite ++ (: io fwrite + '"(andalso (=< ~p ~p) (< ~p ~p) (=< ~p ~p) (< ~p ~p)) ==> ~p\n" + (list x xm xm (+ x w) y ym ym (+ y h) r1))) + r1)) +@@ -499,12 +499,12 @@ + ;; Utilities + + (defun check (v1 v0) +- (eif (/= v1 v0) (progn (: lfe_io fwrite '"error: ~w.\n" (list v1)) ++ (eif (/= v1 v0) (progn (: io fwrite '"error: ~w.\n" (list v1)) + (exit 'suite_failed)) +- 'true (: lfe_io fwrite '"ok: ~w.\n" (list v1)))) ++ 'true (: io fwrite '"ok: ~w.\n" (list v1)))) + + (defun echo (x) +- (: lfe_io fwrite '"(eval ~w); " (list x)) ++ (: io fwrite '"(eval ~w); " (list x)) + x) + + ;; Call this function to turn off constant propagation. +diff --git a/test/guard_SUITE.lfe b/test/lfe_guard_SUITE.lfe +similarity index 99% +rename from test/guard_SUITE.lfe +rename to test/lfe_guard_SUITE.lfe +index 33b1344..2eeb1a6 100644 +--- a/test/guard_SUITE.lfe ++++ b/test/lfe_guard_SUITE.lfe +@@ -26,7 +26,7 @@ + + (include-file "test_server.lfe") + +-(defmodule guard_SUITE ++(defmodule lfe_guard_SUITE + (export (all 0) (suite 0) (groups 0) (init_per_suite 1) (end_per_suite 1) + (init_per_group 2) (end_per_group 2) + (misc 1) (const_cond 1) (basic_not 1) (complex_not 1) (nested_nots 1) +@@ -42,7 +42,7 @@ + (check_qlc_hrl 1) (andalso_semi 1) (t_tuple_size 1) (binary_part 1) + )) + +-(defmacro MODULE () `'guard_SUITE) ++(defmacro MODULE () `'lfe_guard_SUITE) + + (defun all () + ;; (: test_lib recompile (MODULE)) +@@ -764,9 +764,9 @@ + + (defun is_function_2 + ([config] (when (is_list config)) +- (line (test-pat 'true (is_function (id (function guard_SUITE all 1)) 1))) ++ (line (test-pat 'true (is_function (id (function lfe_guard_SUITE all 1)) 1))) + (line (test-pat 'true (is_function (id (lambda () 'ok)) 0))) +- (line (test-pat 'false (is_function (id (function guard_SUITE all 1)) 0))) ++ (line (test-pat 'false (is_function (id (function lfe_guard_SUITE all 1)) 0))) + (line (test-pat 'false (is_function (id (lambda () 'ok)) 1))) + + (let ((F (lambda (_) 'ok))) +-- +2.7.4 (Apple Git-66) + diff --git a/lib/compiler/test/lfe.readme b/lib/compiler/test/lfe.readme new file mode 100644 index 0000000000..2fc88e0252 --- /dev/null +++ b/lib/compiler/test/lfe.readme @@ -0,0 +1,31 @@ +Creating the LFE-derived test suites +==================================== + +Here is how to create `lfe_andor_SUITE.core` and `lfe_guard_SUITE.core` +files. + +First clone and build LFE. + + git clone https://github.com/rvirding/lfe.git + cd lfe + git checkout v1.2.0 + MAKEFLAGS='' make compile + export PATH=$(pwd)/bin:$PATH + +Apply the source patch to rename and fix up the LFE source code: + + cd test + git apply $ERL_TOP/lib/compiler/test/lfe-source.patch + git reset --hard HEAD + +Compile the modules to Core Erlang: + + lfec +to-core0 lfe*.lfe + +Apply the core patch to correct some invalid variable names: + + git apply $ERL_TOP/lib/compiler/test/lfe-core.patch + +Copy the patched .core file to the test suite: + + cp lfe*.core $ERL_TOP/lib/compiler/test diff --git a/lib/compiler/test/lfe_andor_SUITE.core b/lib/compiler/test/lfe_andor_SUITE.core new file mode 100644 index 0000000000..df58b39ae6 --- /dev/null +++ b/lib/compiler/test/lfe_andor_SUITE.core @@ -0,0 +1,2014 @@ +module 'lfe_andor_SUITE' ['$handle_undefined_function'/2, + 'LFE-EXPAND-EXPORTED-MACRO'/3, + 'all'/0, + 'before_and_inside_if'/1, + 'combined'/1, + 'end_per_group'/2, + 'end_per_suite'/1, + 'groups'/0, + 'in_case'/1, + 'init_per_group'/2, + 'init_per_suite'/1, + 'inside'/1, + 'module_info'/0, + 'module_info'/1, + 'overlap'/1, + 'suite'/0, + 't_and_or'/1, + 't_andalso'/1, + 't_case'/1, + 't_orelse'/1] + attributes [] +'all'/0 = + %% Line 38 + fun () -> + ['t_case'|['t_and_or'|['t_andalso'|['t_orelse'|['inside'|['overlap'|['combined'|['in_case'|['before_and_inside_if']]]]]]]]] +'suite'/0 = + %% Line 44 + fun () -> + [] +'groups'/0 = + %% Line 46 + fun () -> + [] +'init_per_suite'/1 = + %% Line 48 + fun (_config) -> + _config +'end_per_suite'/1 = + %% Line 50 + fun (_config) -> + 'ok' +'init_per_group'/2 = + %% Line 52 + fun (_name,_config) -> + _config +'end_per_group'/2 = + %% Line 54 + fun (_name,_config) -> + _config +'t_case'/1 = + %% Line 56 + fun (_0) -> + case <_0> of + <'suite'> when 'true' -> + [] + <'doc'> when 'true' -> + [84|[101|[115|[116|[32|[105|[110|[32|[99|[97|[115|[101|[46]]]]]]]]]]]]] + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_andor_SUITE',['test-pat'|[['quote'|['less']]|[['t-case-a'|[1|[2]]]]]]}) + let <_val> = + <apply 't-case-a'/2 + (1, 2)> + in case <_val> of + <'less'> when 'true' -> + _val + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',{_2}}) + -| ['compiler_generated'] ) + end + ( <_25> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_25}) + -| [{'function_name',{'t_case',1}}] ) + -| ['compiler_generated'] ) + end +'t-case-a'/2 = + %% Line 94 + fun (_a,_b) -> + case call 'erlang':'<' + (_a, _b) of + <[_0|_1]> when 'true' -> + 'ok' + <'true'> when 'true' -> + 'less' + <'false'> when 'true' -> + 'not_less' + <{'a','b','c'}> when 'true' -> + 'ok' + <_2> when 'true' -> + 'ok' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'t-case-b'/2 = + %% Line 102 + fun (_a,_b) -> + case call 'erlang':'=:=' + (_a, _b) of + <'blurf'> when 'true' -> + 'ok' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'t-case-c'/2 = + %% Line 106 + fun (_a,_b) -> + case let <_0> = + call 'erlang':'=:=' + (_a, _b) + in call 'erlang':'not' + (_0) of + <'true'> when 'true' -> + 'ne' + <'false'> when 'true' -> + 'eq' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'t-case-d'/3 = + %% Line 111 + fun (_a,_b,_x) -> + case let <_0> = + call 'erlang':'=:=' + (_a, _b) + in call 'erlang':'and' + (_0, _x) of + <'true'> when 'true' -> + 't' + <'false'> when 'true' -> + 'f' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'t-case-e'/2 = + %% Line 116 + fun (_a,_b) -> + case call 'erlang':'=:=' + (_a, _b) of + <_bool> + when try + let <_0> = + call 'erlang':'is_tuple' + (_a) + in _0 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + apply 'id'/1 + (_bool) + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'t-case-xy'/3 = + %% Line 120 + fun (_x,_y,_z) -> + let <_r0> = + <apply 't-case-x'/3 + (_x, _y, _z)> + in case <apply 't-case-y'/3 + (_x, _y, _z)> of + <_res> + when try + let <_0> = + call 'erlang':'=:=' + (_res, _r0) + in _0 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + _res + ( <_1> when 'true' -> + primop 'match_fail' + ({'badmatch',{_1}}) + -| ['compiler_generated'] ) + end +'t-case-x'/3 = + %% Line 125 + fun (_x,_y,_z) -> + case let <_0> = + call 'erlang':'abs' + (_x) + in call 'erlang':'=:=' + (_0, 42) of + <'true'> when 'true' -> + call 'erlang':'=:=' + (_y, 100) + <'false'> when 'true' -> + call 'erlang':'=:=' + (_z, 700) + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'t-case-y'/3 = + %% Line 130 + fun (_x,_y,_z) -> + case let <_0> = + call 'erlang':'abs' + (_x) + in call 'erlang':'=:=' + (_0, 42) of + <'false'> when 'true' -> + call 'erlang':'=:=' + (_z, 700) + <'true'> when 'true' -> + call 'erlang':'=:=' + (_y, 100) + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'t_and_or'/1 = + %% Line 135 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_andor_SUITE',['test-pat'|[['quote'|['true']]|[['and'|[['quote'|['true']]|[['quote'|['true']]]]]]]]}) + let <_val> = + <call 'erlang':'and' + ('true', 'true')> + in case <_val> of + <'true'> when 'true' -> + _val + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',{_2}}) + -| ['compiler_generated'] ) + end + ( <_42> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_42}) + -| [{'function_name',{'t_and_or',1}}] ) + -| ['compiler_generated'] ) + end +'t_andalso'/1 = + %% Line 172 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do let <_bs> = + <['true'|['false']]> + in let <_ps> = + <letrec + 'lc$^0'/1 = + fun (_2) -> + case <_2> of + <[_x|_lfe0]> when 'true' -> + letrec + 'lc$^1'/1 = + fun (_3) -> + case <_3> of + <[_y|_lfe1]> when 'true' -> + let <_4> = + apply 'lc$^1'/1 + (_lfe1) + in [{_x,_y}|_4] + <[]> when 'true' -> + apply 'lc$^0'/1 + (_lfe0) + ( <_5> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_5}) + -| [{'function_name',{'t_andalso',1}}] ) + -| ['compiler_generated'] ) + end + in apply 'lc$^1'/1 + (_bs) + <[]> when 'true' -> + [] + ( <_6> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_6}) + -| [{'function_name',{'t_andalso',1}}] ) + -| ['compiler_generated'] ) + end + in apply 'lc$^0'/1 + (_bs)> + in let <_7> = + fun (_p) -> + apply 't-andalso-1'/1 + (_p) + in call 'lists':'foreach' + (_7, _ps) + do call 'erlang':'put' + ('test_server_loc', {'lfe_andor_SUITE',['test-pat'|[['quote'|['true']]|[['andalso'|[['quote'|['true']]|[['quote'|['true']]]]]]]]}) + let <_val> = + <case 'true' of + <'true'> when 'true' -> + 'true' + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ('if_clause') + -| ['compiler_generated'] ) + end> + in case <_val> of + <'true'> when 'true' -> + _val + ( <_8> when 'true' -> + primop 'match_fail' + ({'badmatch',{_8}}) + -| ['compiler_generated'] ) + end + ( <_57> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_57}) + -| [{'function_name',{'t_andalso',1}}] ) + -| ['compiler_generated'] ) + end +'t-andalso-1'/1 = + %% Line 207 + fun (_0) -> + case <_0> of + <{_x,_y}> when 'true' -> + do call 'io':'format' + ([40|[97|[110|[100|[97|[108|[115|[111|[32|[126|[119|[32|[126|[119|[41|[58|[32]]]]]]]]]]]]]]]]], [_x,_y]) + let <_v0> = + <case apply 'echo'/1 + (_x) of + <'true'> when 'true' -> + apply 'echo'/1 + (_y) + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ('if_clause') + -| ['compiler_generated'] ) + end> + in case <case 1 of + <_1> + when try + let <_3> = + let <_2> = + case _x of + <'true'> when 'true' -> + _y + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in ( call 'erlang':'=:=' + (_2, 'true') + -| ['compiler_generated'] ) + in _3 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'true' + <_4> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> of + <_v1> + when try + let <_5> = + call 'erlang':'=:=' + (_v0, _v1) + in _5 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + let <_6> = + call 'erlang':'and' + (_x, _y) + in apply 'check'/2 + (_v1, _6) + ( <_7> when 'true' -> + primop 'match_fail' + ({'badmatch',{_7}}) + -| ['compiler_generated'] ) + end + ( <_8> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_8}) + -| [{'function_name',{'t-andalso-1',1}}] ) + -| ['compiler_generated'] ) + end +'t_orelse'/1 = + %% Line 215 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do let <_bs> = + <['true'|['false']]> + in let <_ps> = + <letrec + 'lc$^2'/1 = + fun (_2) -> + case <_2> of + <[_x|_lfe2]> when 'true' -> + letrec + 'lc$^3'/1 = + fun (_3) -> + case <_3> of + <[_y|_lfe3]> when 'true' -> + let <_4> = + apply 'lc$^3'/1 + (_lfe3) + in [{_x,_y}|_4] + <[]> when 'true' -> + apply 'lc$^2'/1 + (_lfe2) + ( <_5> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_5}) + -| [{'function_name',{'t_orelse',1}}] ) + -| ['compiler_generated'] ) + end + in apply 'lc$^3'/1 + (_bs) + <[]> when 'true' -> + [] + ( <_6> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_6}) + -| [{'function_name',{'t_orelse',1}}] ) + -| ['compiler_generated'] ) + end + in apply 'lc$^2'/1 + (_bs)> + in let <_7> = + fun (_p) -> + apply 't-orelse-1'/1 + (_p) + in call 'lists':'foreach' + (_7, _ps) + do call 'erlang':'put' + ('test_server_loc', {'lfe_andor_SUITE',['test-pat'|[['quote'|['true']]|[['orelse'|[['quote'|['true']]|[['quote'|['true']]]]]]]]}) + let <_val> = + <case 'true' of + <'true'> when 'true' -> + 'true' + <'false'> when 'true' -> + 'true' + ( <_omega> when 'true' -> + primop 'match_fail' + ('if_clause') + -| ['compiler_generated'] ) + end> + in case <_val> of + <'true'> when 'true' -> + _val + ( <_8> when 'true' -> + primop 'match_fail' + ({'badmatch',{_8}}) + -| ['compiler_generated'] ) + end + ( <_57> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_57}) + -| [{'function_name',{'t_orelse',1}}] ) + -| ['compiler_generated'] ) + end +'t-orelse-1'/1 = + %% Line 249 + fun (_0) -> + case <_0> of + <{_x,_y}> when 'true' -> + do call 'io':'format' + ([40|[111|[114|[101|[108|[115|[101|[32|[126|[119|[32|[126|[119|[41|[58|[32]]]]]]]]]]]]]]]], [_x,_y]) + let <_v0> = + <case apply 'echo'/1 + (_x) of + <'true'> when 'true' -> + 'true' + <'false'> when 'true' -> + apply 'echo'/1 + (_y) + ( <_omega> when 'true' -> + primop 'match_fail' + ('if_clause') + -| ['compiler_generated'] ) + end> + in case <case 1 of + <_1> + when try + let <_3> = + let <_2> = + case _x of + <'true'> when 'true' -> + 'true' + <'false'> when 'true' -> + _y + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in ( call 'erlang':'=:=' + (_2, 'true') + -| ['compiler_generated'] ) + in _3 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'true' + <_4> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> of + <_v1> + when try + let <_5> = + call 'erlang':'=:=' + (_v0, _v1) + in _5 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + let <_6> = + call 'erlang':'or' + (_x, _y) + in apply 'check'/2 + (_v1, _6) + ( <_7> when 'true' -> + primop 'match_fail' + ({'badmatch',{_7}}) + -| ['compiler_generated'] ) + end + ( <_8> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_8}) + -| [{'function_name',{'t-orelse-1',1}}] ) + -| ['compiler_generated'] ) + end +'inside'/1 = + %% Line 257 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_andor_SUITE',['test-pat'|[['quote'|['true']]|[['inside'|[-8|[1]]]]]]}) + let <_val> = + <apply 'inside'/2 + (-8, 1)> + in case <_val> of + <'true'> when 'true' -> + _val + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',{_2}}) + -| ['compiler_generated'] ) + end + ( <_12> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_12}) + -| [{'function_name',{'inside',1}}] ) + -| ['compiler_generated'] ) + end +'inside'/2 = + %% Line 272 + fun (_xm,_ym) -> + let <_x> = + <-1.00000000000000000000e+01> + in let <_y> = + <-2.00000000000000000000e+00> + in let <_w> = + <2.00000000000000000000e+01> + in let <_h> = + <4.00000000000000000000e+00> + in let <_r0> = + <apply 'inside'/6 + (_xm, _ym, _x, _y, _w, _h)> + in case <case 1 of + <_0> + when try + let <_4> = + let <_3> = + case call 'erlang':'=<' + (_x, _xm) of + <'true'> when 'true' -> + case let <_1> = + call 'erlang':'+' + (_x, _w) + in call 'erlang':'<' + (_xm, _1) of + <'true'> when 'true' -> + case call 'erlang':'=<' + (_y, _ym) of + <'true'> when 'true' -> + let <_2> = + call 'erlang':'+' + (_y, _h) + in call 'erlang':'<' + (_ym, _2) + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in ( call 'erlang':'=:=' + (_3, 'true') + -| ['compiler_generated'] ) + in _4 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'true' + <_5> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> of + <_r1> + when try + let <_6> = + call 'erlang':'=:=' + (_r0, _r1) + in _6 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do case let <_7> = + apply 'id'/1 + (_r1) + in call 'erlang':'not' + (_7) of + <_o0> when 'true' -> + case <case 1 of + <_8> + when try + let <_12> = + let <_11> = + case call 'erlang':'=<' + (_x, _xm) of + <'true'> when 'true' -> + case let <_9> = + call 'erlang':'+' + (_x, _w) + in call 'erlang':'<' + (_xm, _9) of + <'true'> when 'true' -> + case call 'erlang':'=<' + (_y, _ym) of + <'true'> when 'true' -> + let <_10> = + call 'erlang':'+' + (_y, _h) + in call 'erlang':'<' + (_ym, _10) + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in call 'erlang':'not' + (_11) + in _12 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'true' + <_13> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> of + <_o1> + when try + let <_14> = + call 'erlang':'=:=' + (_o0, _o1) + in _14 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + _o1 + ( <_15> when 'true' -> + primop 'match_fail' + ({'badmatch',{_15}}) + -| ['compiler_generated'] ) + end + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end + do case <apply 'inside-guard'/6 + (_xm, _ym, _x, _y, _w, _h)> of + <{_r2,_xm2,_ym2,_x2,_y2,_w2,_h2}> + when try + let <_16> = + call 'erlang':'=:=' + (_r1, _r2) + in let <_17> = + call 'erlang':'=:=' + (_xm, _xm2) + in let <_18> = + call 'erlang':'=:=' + (_ym, _ym2) + in let <_19> = + call 'erlang':'=:=' + (_x, _x2) + in let <_20> = + call 'erlang':'=:=' + (_y, _y2) + in let <_21> = + call 'erlang':'=:=' + (_w, _w2) + in let <_22> = + call 'erlang':'=:=' + (_h, _h2) + in let <_23> = + call 'erlang':'and' + (_16, _17) + in let <_24> = + call 'erlang':'and' + (_23, _18) + in let <_25> = + call 'erlang':'and' + (_24, _19) + in let <_26> = + call 'erlang':'and' + (_25, _20) + in let <_27> = + call 'erlang':'and' + (_26, _21) + in call 'erlang':'and' + (_27, _22) + of <Try> -> + Try + catch <T,R> -> + 'false' -> + let <_30> = + let <_28> = + call 'erlang':'+' + (_x, _w) + in let <_29> = + call 'erlang':'+' + (_y, _h) + in [_x,_xm,_xm,_28,_y,_ym,_ym,_29,_r1] + in call 'io':'fwrite' + ([40|[97|[110|[100|[97|[108|[115|[111|[32|[40|[61|[60|[32|[126|[112|[32|[126|[112|[41|[32|[40|[60|[32|[126|[112|[32|[126|[112|[41|[32|[40|[61|[60|[32|[126|[112|[32|[126|[112|[41|[32|[40|[60|[32|[126|[112|[32|[126|[112|[41|[41|[32|[61|[61|[62|[32|[126|[112|[10]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]], _30) + ( <_31> when 'true' -> + primop 'match_fail' + ({'badmatch',{_31}}) + -| ['compiler_generated'] ) + end + _r1 + ( <_32> when 'true' -> + primop 'match_fail' + ({'badmatch',{_32}}) + -| ['compiler_generated'] ) + end +'inside'/6 = + %% Line 297 + fun (_xm,_ym,_x,_y,_w,_h) -> + case call 'erlang':'=<' + (_x, _xm) of + <'true'> when 'true' -> + case let <_0> = + call 'erlang':'+' + (_x, _w) + in call 'erlang':'<' + (_xm, _0) of + <'true'> when 'true' -> + case call 'erlang':'=<' + (_y, _ym) of + <'true'> when 'true' -> + let <_1> = + call 'erlang':'+' + (_y, _h) + in call 'erlang':'<' + (_ym, _1) + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ('if_clause') + -| ['compiler_generated'] ) + end + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ('if_clause') + -| ['compiler_generated'] ) + end + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ('if_clause') + -| ['compiler_generated'] ) + end +'inside-guard'/6 = + %% Line 300 + fun (_5,_4,_3,_2,_1,_0) -> + case <_5,_4,_3,_2,_1,_0> of + <_xm,_ym,_x,_y,_w,_h> + when try + let <_9> = + let <_8> = + case call 'erlang':'=<' + (_x, _xm) of + <'true'> when 'true' -> + case let <_6> = + call 'erlang':'+' + (_x, _w) + in call 'erlang':'<' + (_xm, _6) of + <'true'> when 'true' -> + case call 'erlang':'=<' + (_y, _ym) of + <'true'> when 'true' -> + let <_7> = + call 'erlang':'+' + (_y, _h) + in call 'erlang':'<' + (_ym, _7) + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in ( call 'erlang':'=:=' + (_8, 'true') + -| ['compiler_generated'] ) + in _9 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + {'true',_xm,_ym,_x,_y,_w,_h} + <_xm,_ym,_x,_y,_w,_h> when 'true' -> + {'false',_xm,_ym,_x,_y,_w,_h} + ( <_15,_14,_13,_12,_11,_10> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_15,_14,_13,_12,_11,_10}) + -| [{'function_name',{'inside-guard',6}}] ) + -| ['compiler_generated'] ) + end +'overlap'/1 = + %% Line 307 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_andor_SUITE',['test-pat'|[['quote'|['true']]|[['overlap'|[7.00000000000000000000e+00|[2.00000000000000000000e+00|[8.00000000000000000000e+00|[5.00000000000000000000e-01]]]]]]]]}) + let <_val> = + <apply 'overlap'/4 + (7.00000000000000000000e+00, 2.00000000000000000000e+00, 8.00000000000000000000e+00, 5.00000000000000000000e-01)> + in case <_val> of + <'true'> when 'true' -> + _val + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',{_2}}) + -| ['compiler_generated'] ) + end + ( <_10> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_10}) + -| [{'function_name',{'overlap',1}}] ) + -| ['compiler_generated'] ) + end +'overlap'/4 = + %% Line 321 + fun (_pos1,_len1,_pos2,_len2) -> + let <_r0> = + <case _pos1 of + <_pos1> + when try + let <_3> = + let <_2> = + case case call 'erlang':'=<' + (_pos2, _pos1) of + <'true'> when 'true' -> + let <_0> = + call 'erlang':'+' + (_pos2, _len2) + in call 'erlang':'<' + (_pos1, _0) + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end of + <'true'> when 'true' -> + 'true' + <'false'> when 'true' -> + case call 'erlang':'=<' + (_pos1, _pos2) of + <'true'> when 'true' -> + let <_1> = + call 'erlang':'+' + (_pos1, _len1) + in call 'erlang':'<' + (_pos2, _1) + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in ( call 'erlang':'=:=' + (_2, 'true') + -| ['compiler_generated'] ) + in _3 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'true' + <_pos1> when 'true' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> + in case <case case call 'erlang':'=<' + (_pos2, _pos1) of + <'true'> when 'true' -> + let <_4> = + call 'erlang':'+' + (_pos2, _len2) + in call 'erlang':'<' + (_pos1, _4) + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ('if_clause') + -| ['compiler_generated'] ) + end of + <'true'> when 'true' -> + 'true' + <'false'> when 'true' -> + case call 'erlang':'=<' + (_pos1, _pos2) of + <'true'> when 'true' -> + let <_5> = + call 'erlang':'+' + (_pos1, _len1) + in call 'erlang':'<' + (_pos2, _5) + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ('if_clause') + -| ['compiler_generated'] ) + end + ( <_omega> when 'true' -> + primop 'match_fail' + ('if_clause') + -| ['compiler_generated'] ) + end> of + <_r1> + when try + let <_6> = + call 'erlang':'=:=' + (_r0, _r1) + in _6 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + case <case _pos1 of + <_pos1> + when try + let <_10> = + let <_9> = + case case call 'erlang':'=<' + (_pos2, _pos1) of + <'true'> when 'true' -> + let <_7> = + call 'erlang':'+' + (_pos2, _len2) + in call 'erlang':'<' + (_pos1, _7) + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end of + <'true'> when 'true' -> + 'true' + <'false'> when 'true' -> + case call 'erlang':'=<' + (_pos1, _pos2) of + <'true'> when 'true' -> + let <_8> = + call 'erlang':'+' + (_pos1, _len1) + in call 'erlang':'<' + (_pos2, _8) + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in ( call 'erlang':'=:=' + (_9, 'true') + -| ['compiler_generated'] ) + in _10 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'true' + <_pos1> when 'true' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> of + <_r2> + when try + let <_11> = + call 'erlang':'=:=' + (_r2, _r1) + in _11 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + apply 'id'/1 + (_r2) + ( <_12> when 'true' -> + primop 'match_fail' + ({'badmatch',{_12}}) + -| ['compiler_generated'] ) + end + ( <_13> when 'true' -> + primop 'match_fail' + ({'badmatch',{_13}}) + -| ['compiler_generated'] ) + end +'combined'/1 = + %% Line 348 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_andor_SUITE',['test-pat'|[['quote'|['false']]|[['comb'|[['quote'|['false']]|[['quote'|['false']]|[['quote'|['false']]]]]]]]]}) + let <_val> = + <apply 'comb'/3 + ('false', 'false', 'false')> + in case <_val> of + <'false'> when 'true' -> + _val + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',{_2}}) + -| ['compiler_generated'] ) + end + ( <_26> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_26}) + -| [{'function_name',{'combined',1}}] ) + -| ['compiler_generated'] ) + end +'comb'/3 = + %% Line 383 + fun (_a,_b,_c) -> + let <_r0> = + <case case _a of + <'true'> when 'true' -> + _b + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ('if_clause') + -| ['compiler_generated'] ) + end of + <'true'> when 'true' -> + 'true' + <'false'> when 'true' -> + _c + ( <_omega> when 'true' -> + primop 'match_fail' + ('if_clause') + -| ['compiler_generated'] ) + end> + in case <case 1 of + <_0> + when try + let <_2> = + let <_1> = + case case _a of + <'true'> when 'true' -> + _b + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end of + <'true'> when 'true' -> + 'true' + <'false'> when 'true' -> + _c + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in ( call 'erlang':'=:=' + (_1, 'true') + -| ['compiler_generated'] ) + in _2 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'true' + <_3> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> of + <_r1> + when try + let <_4> = + call 'erlang':'=:=' + (_r0, _r1) + in _4 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + let <_n0> = + <case 1 of + <_5> + when try + let <_7> = + let <_6> = + case case _a of + <'true'> when 'true' -> + _b + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end of + <'true'> when 'true' -> + 'true' + <'false'> when 'true' -> + _c + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in call 'erlang':'not' + (_6) + in _7 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'true' + <_8> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> + in case <let <_9> = + call 'erlang':'not' + (_r1) + in apply 'id'/1 + (_9)> of + <_n1> + when try + let <_10> = + call 'erlang':'=:=' + (_n0, _n1) + in _10 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + case <case case _a of + <'true'> when 'true' -> + _b + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ('if_clause') + -| ['compiler_generated'] ) + end of + <'true'> when 'true' -> + 'true' + <'false'> when 'true' -> + _c + ( <_omega> when 'true' -> + primop 'match_fail' + ('if_clause') + -| ['compiler_generated'] ) + end> of + <_r2> + when try + let <_11> = + call 'erlang':'=:=' + (_r1, _r2) + in _11 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + case <case 1 of + <_12> + when try + let <_14> = + let <_13> = + case case _a of + <'true'> when 'true' -> + _b + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end of + <'true'> when 'true' -> + 'true' + <'false'> when 'true' -> + _c + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in ( call 'erlang':'=:=' + (_13, 'true') + -| ['compiler_generated'] ) + in _14 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'true' + <_15> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> of + <_r3> + when try + let <_16> = + call 'erlang':'=:=' + (_r2, _r3) + in _16 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + case <let <_17> = + call 'erlang':'not' + (_r3) + in apply 'id'/1 + (_17)> of + <_n2> + when try + let <_18> = + call 'erlang':'=:=' + (_n1, _n2) + in _18 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + case <case 1 of + <_19> + when try + let <_21> = + let <_20> = + case case _a of + <'true'> when 'true' -> + _b + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end of + <'true'> when 'true' -> + 'true' + <'false'> when 'true' -> + _c + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in ( call 'erlang':'=:=' + (_20, 'true') + -| ['compiler_generated'] ) + in _21 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'true' + <_22> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> of + <_r4> + when try + let <_23> = + call 'erlang':'=:=' + (_r3, _r4) + in _23 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + apply 'id'/1 + (_r4) + ( <_24> when 'true' -> + primop 'match_fail' + ({'badmatch',{_24}}) + -| ['compiler_generated'] ) + end + ( <_25> when 'true' -> + primop 'match_fail' + ({'badmatch',{_25}}) + -| ['compiler_generated'] ) + end + ( <_26> when 'true' -> + primop 'match_fail' + ({'badmatch',{_26}}) + -| ['compiler_generated'] ) + end + ( <_27> when 'true' -> + primop 'match_fail' + ({'badmatch',{_27}}) + -| ['compiler_generated'] ) + end + ( <_28> when 'true' -> + primop 'match_fail' + ({'badmatch',{_28}}) + -| ['compiler_generated'] ) + end + ( <_29> when 'true' -> + primop 'match_fail' + ({'badmatch',{_29}}) + -| ['compiler_generated'] ) + end +'in_case'/1 = + %% Line 402 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_andor_SUITE',['test-pat'|[['quote'|['edge_rings']]|[['in-case-1'|[1|[1|[1|[1|[1]]]]]]]]]}) + let <_val> = + <apply 'in-case-1'/5 + (1, 1, 1, 1, 1)> + in case <_val> of + <'edge_rings'> when 'true' -> + _val + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',{_2}}) + -| ['compiler_generated'] ) + end + ( <_13> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_13}) + -| [{'function_name',{'in_case',1}}] ) + -| ['compiler_generated'] ) + end +'in-case-1'/5 = + %% Line 419 + fun (_lenup,_lendw,_lenn,_rot,_count) -> + let <_r0> = + <apply 'in-case-1-body'/5 + (_lenup, _lendw, _lenn, _rot, _count)> + in case <apply 'in-case-1-guard'/5 + (_lenup, _lendw, _lenn, _rot, _count)> of + <_res> + when try + let <_0> = + call 'erlang':'=:=' + (_r0, _res) + in _0 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + _res + ( <_1> when 'true' -> + primop 'match_fail' + ({'badmatch',{_1}}) + -| ['compiler_generated'] ) + end +'in-case-1-body'/5 = + %% Line 425 + fun (_lenup,_lendw,_lenn,_rot,_count) -> + case let <_5> = + let <_2> = + let <_0> = + call 'erlang':'/' + (_lenup, _count) + in call 'erlang':'>' + (_0, 7.06999999999999961808e-01) + in let <_3> = + let <_1> = + call 'erlang':'/' + (_lenn, _count) + in call 'erlang':'>' + (_1, 7.06999999999999961808e-01) + in call 'erlang':'and' + (_2, _3) + in let <_6> = + let <_4> = + call 'erlang':'abs' + (_rot) + in call 'erlang':'>' + (_4, 7.06999999999999961808e-01) + in call 'erlang':'and' + (_5, _6) of + <'true'> when 'true' -> + 'edge_rings' + <'false'> when 'true' -> + case let <_11> = + let <_9> = + let <_7> = + call 'erlang':'>=' + (_lenup, 1) + in let <_8> = + call 'erlang':'>=' + (_lendw, 1) + in call 'erlang':'or' + (_7, _8) + in let <_10> = + call 'erlang':'=<' + (_lenn, 1) + in call 'erlang':'or' + (_9, _10) + in let <_12> = + call 'erlang':'>' + (_count, 4) + in call 'erlang':'or' + (_11, _12) of + <'true'> when 'true' -> + 'not_loop' + <'false'> when 'true' -> + 'loop' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'in-case-1-guard'/5 = + %% Line 435 + fun (_lenup,_lendw,_lenn,_rot,_count) -> + case case let <_0> = + call 'erlang':'/' + (_lenup, _count) + in call 'erlang':'>' + (_0, 7.06999999999999961808e-01) of + <'true'> when 'true' -> + case let <_1> = + call 'erlang':'/' + (_lenn, _count) + in call 'erlang':'>' + (_1, 7.06999999999999961808e-01) of + <'true'> when 'true' -> + let <_2> = + call 'erlang':'abs' + (_rot) + in call 'erlang':'>' + (_2, 7.06999999999999961808e-01) + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ('if_clause') + -| ['compiler_generated'] ) + end + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ('if_clause') + -| ['compiler_generated'] ) + end of + <'true'> when 'true' -> + 'edge_rings' + <'false'> + when try + let <_4> = + let <_3> = + case call 'erlang':'>=' + (_lenup, 1) of + <'true'> when 'true' -> + 'true' + <'false'> when 'true' -> + case call 'erlang':'>=' + (_lendw, 1) of + <'true'> when 'true' -> + 'true' + <'false'> when 'true' -> + case call 'erlang':'=<' + (_lenn, 1) of + <'true'> when 'true' -> + 'true' + <'false'> when 'true' -> + call 'erlang':'<' + (_count, 4) + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in ( call 'erlang':'=:=' + (_3, 'true') + -| ['compiler_generated'] ) + in _4 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'not_loop' + <'false'> when 'true' -> + 'loop' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'before_and_inside_if'/1 = + %% Line 443 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_andor_SUITE',['test-pat'|[['quote'|['no']]|[['before-and-inside-if'|[['quote'|[['a']]]|[['quote'|[['b']]]|[['quote'|['delete']]]]]]]]]}) + let <_val> = + <apply 'before-and-inside-if'/3 + (['a'], ['b'], 'delete')> + in case <_val> of + <'no'> when 'true' -> + _val + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',{_2}}) + -| ['compiler_generated'] ) + end + ( <_18> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_18}) + -| [{'function_name',{'before_and_inside_if',1}}] ) + -| ['compiler_generated'] ) + end +'before-and-inside-if'/3 = + %% Line 468 + fun (XDo1,XDo2,Do3) -> + let <Do1> = + <call 'erlang':'=/=' + (XDo1, [])> + in let <Do2> = + <call 'erlang':'=/=' + (XDo2, [])> + in case 1 of + <_0> + when try + let <_7> = + let <_5> = + call 'erlang':'=:=' + (Do1, 'true') + in let <_6> = + let <_3> = + let <_1> = + call 'erlang':'=:=' + (Do1, 'false') + in let <_2> = + call 'erlang':'=:=' + (Do2, 'false') + in call 'erlang':'and' + (_1, _2) + in let <_4> = + call 'erlang':'=:=' + (Do3, 'delete') + in call 'erlang':'and' + (_3, _4) + in call 'erlang':'or' + (_5, _6) + in _7 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'no' + <_8> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'yes' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'before-and-inside-if-2'/3 = + %% Line 484 + fun (XDo1,XDo2,Do3) -> + let <Do1> = + <call 'erlang':'=/=' + (XDo1, [])> + in let <Do2> = + <call 'erlang':'=/=' + (XDo2, [])> + in let <CH1> = + <case 1 of + <_0> + when try + let <_7> = + let <_5> = + call 'erlang':'==' + (Do1, 'true') + in let <_6> = + let <_3> = + let <_1> = + call 'erlang':'==' + (Do1, 'false') + in let <_2> = + call 'erlang':'==' + (Do2, 'false') + in call 'erlang':'and' + (_1, _2) + in let <_4> = + call 'erlang':'==' + (Do3, 'blah') + in call 'erlang':'and' + (_3, _4) + in call 'erlang':'or' + (_5, _6) + in _7 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ch1' + <_8> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'no' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> + in let <CH2> = + <case 1 of + <_9> + when try + let <_16> = + let <_14> = + call 'erlang':'==' + (Do1, 'true') + in let <_15> = + let <_12> = + let <_10> = + call 'erlang':'==' + (Do1, 'false') + in let <_11> = + call 'erlang':'==' + (Do2, 'false') + in call 'erlang':'and' + (_10, _11) + in let <_13> = + call 'erlang':'==' + (Do3, 'xx') + in call 'erlang':'and' + (_12, _13) + in call 'erlang':'or' + (_14, _15) + in _16 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ch2' + <_17> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'no' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> + in {CH1,CH2} +'check'/2 = + %% Line 501 + fun (_v1,_v0) -> + case 1 of + <_0> + when try + let <_1> = + call 'erlang':'/=' + (_v1, _v0) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'io':'fwrite' + ([101|[114|[114|[111|[114|[58|[32|[126|[119|[46|[10]]]]]]]]]]], [_v1]) + call 'erlang':'exit' + ('suite_failed') + <_2> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + call 'io':'fwrite' + ([111|[107|[58|[32|[126|[119|[46|[10]]]]]]]], [_v1]) + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'echo'/1 = + %% Line 506 + fun (_x) -> + do call 'io':'fwrite' + ([40|[101|[118|[97|[108|[32|[126|[119|[41|[59|[32]]]]]]]]]]], [_x]) + _x +'id'/1 = + %% Line 511 + fun (_i) -> + _i +'$handle_undefined_function'/2 = + %% Line 29 + fun (_f,_as) -> + case let <_0> = + call 'lfe_env':'new' + () + in apply 'LFE-EXPAND-EXPORTED-MACRO'/3 + (_f, _as, _0) of + <{'yes',_exp}> when 'true' -> + call 'lfe_eval':'expr' + (_exp) + <'no'> when 'true' -> + let <_a,_b> = + <_f,_as> + in call 'error_handler':'raise_undef_exception' + ('lfe_andor_SUITE', _a, _b) + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'LFE-EXPAND-EXPORTED-MACRO'/3 = + %% Line 29 + fun (_2,_1,_0) -> + 'no' +'module_info'/0 = + fun () -> + call 'erlang':'get_module_info' + ('lfe_andor_SUITE') +'module_info'/1 = + fun (_x) -> + call 'erlang':'get_module_info' + ('lfe_andor_SUITE', _x) +end diff --git a/lib/compiler/test/lfe_guard_SUITE.core b/lib/compiler/test/lfe_guard_SUITE.core new file mode 100644 index 0000000000..920be82f61 --- /dev/null +++ b/lib/compiler/test/lfe_guard_SUITE.core @@ -0,0 +1,3438 @@ +module 'lfe_guard_SUITE' ['$handle_undefined_function'/2, + 'LFE-EXPAND-EXPORTED-MACRO'/3, + 'all'/0, + 'and_guard'/1, + 'andalso_semi'/1, + 'basic_andalso_orelse'/1, + 'basic_not'/1, + 'binary_part'/1, + 'build_in_guard'/1, + 'check_qlc_hrl'/1, + 'comma'/1, + 'complex_not'/1, + 'complex_or_guards'/1, + 'complex_semicolon'/1, + 'const_cond'/1, + 'end_per_group'/2, + 'end_per_suite'/1, + 'gbif'/1, + 'groups'/0, + 'init_per_group'/2, + 'init_per_suite'/1, + 'is_function_2'/1, + 'literal_type_tests'/1, + 'misc'/1, + 'module_info'/0, + 'module_info'/1, + 'more_or_guards'/1, + 'more_xor_guards'/1, + 'nested_nots'/1, + 'old_guard_tests'/1, + 'or_guard'/1, + 'rel_ops'/1, + 'semicolon'/1, + 'suite'/0, + 't_is_boolean'/1, + 't_tuple_size'/1, + 'traverse_dcd'/1, + 'tricky'/1, + 'xor_guard'/1] + attributes [] +'all'/0 = + %% Line 47 + fun () -> + ['misc'|['const_cond'|['basic_not'|['complex_not'|['nested_nots'|['semicolon'|['complex_semicolon'|['comma'|['or_guard'|['more_or_guards'|['complex_or_guards'|['and_guard'|['xor_guard'|['more_xor_guards'|['build_in_guard'|['old_guard_tests'|['gbif'|['t_is_boolean'|['is_function_2'|['tricky'|['rel_ops'|['literal_type_tests'|['basic_andalso_orelse'|['traverse_dcd'|['check_qlc_hrl'|['andalso_semi'|['t_tuple_size'|['binary_part']]]]]]]]]]]]]]]]]]]]]]]]]]]] +'suite'/0 = + %% Line 58 + fun () -> + [] +'groups'/0 = + %% Line 60 + fun () -> + [] +'init_per_suite'/1 = + %% Line 62 + fun (_config) -> + _config +'end_per_suite'/1 = + %% Line 64 + fun (_config) -> + 'ok' +'init_per_group'/2 = + %% Line 66 + fun (_name,_config) -> + _config +'end_per_group'/2 = + %% Line 68 + fun (_name,_config) -> + _config +'misc'/1 = + %% Line 70 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[42|[['case'|[['id'|[42]]|[['x'|[['when'|[['-'|['x']]]]|[['quote'|['ok']]]]]|[['x'|['x']]]]]]]]]}) + let <_val> = + <case apply 'id'/1 + (42) of + <_x> + when try + let <_3> = + let <_2> = + call 'erlang':'-' + (_x) + in ( call 'erlang':'=:=' + (_2, 'true') + -| ['compiler_generated'] ) + in _3 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_x> when 'true' -> + _x + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> + in case <_val> of + <42> when 'true' -> + _val + ( <_4> when 'true' -> + primop 'match_fail' + ({'badmatch',{_4}}) + -| ['compiler_generated'] ) + end + ( <_17> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_17}) + -| [{'function_name',{'misc',1}}] ) + -| ['compiler_generated'] ) + end +'misc-1'/1 = + %% Line 93 + fun (_0) -> + case <_0> of + <[{_w},{_x},{_y},{_z}]> when 'true' -> + case 1 of + <_1> + when try + let <_4> = + let <_3> = + case call 'erlang':'>' + (_x, _y) of + <'true'> when 'true' -> + let <_2> = + call 'erlang':'abs' + (_z) + in call 'erlang':'=:=' + (_2, 2) + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in ( call 'erlang':'=:=' + (_3, 'true') + -| ['compiler_generated'] ) + in _4 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + apply 'id'/1 + (_w) + <_5> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'none' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end + ( <_6> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_6}) + -| [{'function_name',{'misc-1',1}}] ) + -| ['compiler_generated'] ) + end +'get-data'/3 = + %% Line 99 + fun (_2,_1,_0) -> + case <_2,_1,_0> of + <{'o',_active,_raw},_bytes,_buffer> + when try + let <_5> = + let <_3> = + call 'erlang':'=:=' + (_raw, 'raw') + in let <_4> = + call 'erlang':'=:=' + (_raw, 0) + in call 'erlang':'or' + (_3, _4) + in _5 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + case 1 of + <_6> + when try + let <_8> = + let <_7> = + case call 'erlang':'=/=' + (_active, 'false') of + <'true'> when 'true' -> + 'true' + <'false'> when 'true' -> + call 'erlang':'=:=' + (_bytes, 0) + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in ( call 'erlang':'=:=' + (_7, 'true') + -| ['compiler_generated'] ) + in _8 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + {'ok',_buffer,#{}#} + <_9> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'error' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end + ( <_12,_11,_10> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_12,_11,_10}) + -| [{'function_name',{'get-data',3}}] ) + -| ['compiler_generated'] ) + end +'const_cond'/1 = + %% Line 104 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[['quote'|['ok']]|[['const-cond'|[{}|[0]]]]]]}) + let <_val> = + <apply 'const-cond'/2 + ({}, 0)> + in case <_val> of + <'ok'> when 'true' -> + _val + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',{_2}}) + -| ['compiler_generated'] ) + end + ( <_7> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_7}) + -| [{'function_name',{'const_cond',1}}] ) + -| ['compiler_generated'] ) + end +'const-cond'/2 = + %% Line 113 + fun (_t,_sz) -> + case _t of + <_0> + when try + 'false' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'never' + <_1> + when try + let <_3> = + call 'erlang':'is_tuple' + (_t) + in let <_4> = + call 'erlang':'==' + ('eq', 'eq') + in let <_5> = + let <_2> = + call 'erlang':'tuple_size' + (_t) + in call 'erlang':'==' + (_2, _sz) + in let <_6> = + call 'erlang':'and' + (_3, _4) + in call 'erlang':'and' + (_6, _5) + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_7> + when try + let <_9> = + call 'erlang':'is_tuple' + (_t) + in let <_10> = + call 'erlang':'==' + ('eq', 'leq') + in let <_11> = + let <_8> = + call 'erlang':'tuple_size' + (_t) + in call 'erlang':'==' + (_8, _sz) + in let <_12> = + call 'erlang':'and' + (_9, _10) + in call 'erlang':'and' + (_12, _11) + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_13> when 'true' -> + 'error' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'basic_not'/1 = + %% Line 120 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + let <_true> = + <apply 'id'/1 + ('true')> + in let <_false> = + <apply 'id'/1 + ('false')> + in let <_glurf> = + <apply 'id'/1 + ('glurf')> + in let <_a> = + <apply 'id'/1 + (5)> + in let <_b> = + <apply 'id'/1 + (3.75000000000000000000e+01)> + in let <_c> = + <apply 'id'/1 + (-1)> + in let <_d> = + <apply 'id'/1 + (5)> + in let <_atuple> = + <{_false,_true,_glurf}> + in do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['check'|[['lambda'|[[]|[['eif'|[['not'|[['quote'|['false']]]]|[['quote'|['ok']]|[['quote'|['true']]|[['quote'|['error']]]]]]]]]]|[['quote'|['ok']]]]]}) + let <_5> = + fun () -> + case 1 of + <_2> + when try + let <_3> = + call 'erlang':'not' + ('false') + in _3 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_4> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'error' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end + in apply 'check'/2 + (_5, 'ok') + ( <_128> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_128}) + -| [{'function_name',{'basic_not',1}}] ) + -| ['compiler_generated'] ) + end +'complex_not'/1 = + %% Line 164 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + let <_atuple> = + <apply 'id'/1 + ({'false','true','gurka'})> + in do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['check'|[['lambda'|[[]|[['eif'|[['not'|[['element'|[1|['atuple']]]]]|[['quote'|['ok']]|[['quote'|['true']]|[['quote'|['error']]]]]]]]]]|[['quote'|['ok']]]]]}) + let <_6> = + fun () -> + case 1 of + <_2> + when try + let <_4> = + let <_3> = + call 'erlang':'element' + (1, _atuple) + in call 'erlang':'not' + (_3) + in _4 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_5> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'error' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end + in apply 'check'/2 + (_6, 'ok') + ( <_50> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_50}) + -| [{'function_name',{'complex_not',1}}] ) + -| ['compiler_generated'] ) + end +'nested_nots'/1 = + %% Line 191 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[['quote'|['true']]|[['nested-not-1'|[0|[0]]]]]]}) + let <_val> = + <apply 'nested-not-1'/2 + (0, 0)> + in case <_val> of + <'true'> when 'true' -> + _val + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',{_2}}) + -| ['compiler_generated'] ) + end + ( <_18> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_18}) + -| [{'function_name',{'nested_nots',1}}] ) + -| ['compiler_generated'] ) + end +'nested-not-1'/2 = + %% Line 213 + fun (_1,_0) -> + case <_1,_0> of + <_x,_y> + when try + let <_10> = + let <_9> = + let <_7> = + let <_3> = + call 'erlang':'>' + (_x, _y) + in let <_4> = + let <_2> = + call 'erlang':'is_atom' + (_x) + in call 'erlang':'not' + (_2) + in call 'erlang':'or' + (_3, _4) + in let <_8> = + let <_5> = + call 'erlang':'is_atom' + (_y) + in let <_6> = + call 'erlang':'==' + (_x, 3.39999999999999991118e+00) + in call 'erlang':'or' + (_5, _6) + in call 'erlang':'and' + (_7, _8) + in call 'erlang':'not' + (_9) + in _10 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'true' + <_11,_12> when 'true' -> + 'false' + ( <_14,_13> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_14,_13}) + -| [{'function_name',{'nested-not-1',2}}] ) + -| ['compiler_generated'] ) + end +'nested-not-2'/3 = + %% Line 219 + fun (_x,_y,_z) -> + apply 'nested-not-2'/4 + (_x, _y, _z, 'true') +'nested-not-2'/4 = + %% Line 222 + fun (_3,_2,_1,_0) -> + case <_3,_2,_1,_0> of + <_x,_y,_z,_true> + when try + let <_12> = + let <_11> = + let <_10> = + let <_9> = + let <_7> = + let <_4> = + call 'erlang':'not' + (_x) + in let <_5> = + call 'erlang':'not' + (_y) + in call 'erlang':'and' + (_4, _5) + in let <_8> = + let <_6> = + call 'erlang':'is_atom' + (_z) + in call 'erlang':'not' + (_6) + in call 'erlang':'or' + (_7, _8) + in call 'erlang':'not' + (_9) + in call 'erlang':'and' + (_true, _10) + in call 'erlang':'not' + (_11) + in _12 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'true' + <_13,_14,_15,_16> when 'true' -> + 'false' + ( <_20,_19,_18,_17> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_20,_19,_18,_17}) + -| [{'function_name',{'nested-not-2',4}}] ) + -| ['compiler_generated'] ) + end +'semicolon'/1 = + %% Line 228 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + ( <_2> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_2}) + -| [{'function_name',{'semicolon',1}}] ) + -| ['compiler_generated'] ) + end +'complex_semicolon'/1 = + %% Line 233 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + ( <_2> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_2}) + -| [{'function_name',{'complex_semicolon',1}}] ) + -| ['compiler_generated'] ) + end +'comma'/1 = + %% Line 239 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['check'|[['lambda'|[[]|[['eif'|[['progn'|[['quote'|['true']]|[['quote'|['false']]]]]|[['quote'|['ok']]|[['quote'|['true']]|[['quote'|['error']]]]]]]]]]|[['quote'|['error']]]]]}) + let <_6> = + fun () -> + case 1 of + <_2> + when try + let <_4> = + let <_3> = + call 'erlang':'and' + ('true', 'false') + in ( call 'erlang':'=:=' + (_3, 'true') + -| ['compiler_generated'] ) + in _4 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_5> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'error' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end + in apply 'check'/2 + (_6, 'error') + ( <_181> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_181}) + -| [{'function_name',{'comma',1}}] ) + -| ['compiler_generated'] ) + end +'or_guard'/1 = + %% Line 305 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do let <_true,_false,_glurf> = + <apply 'id'/1 + ('true'),apply 'id'/1 + ('false'),apply 'id'/1 + ('glurf')> + in do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['check'|[['lambda'|[[]|[['eif'|[['or'|[['quote'|['true']]|[['quote'|['false']]]]]|[['quote'|['ok']]]]]]]]|[['quote'|['ok']]]]]}) + let <_4> = + fun () -> + case 1 of + <_2> + when try + let <_3> = + call 'erlang':'or' + ('true', 'false') + in _3 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end + in apply 'check'/2 + (_4, 'ok') + 'ok' + ( <_64> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_64}) + -| [{'function_name',{'or_guard',1}}] ) + -| ['compiler_generated'] ) + end +'more_or_guards'/1 = + %% Line 346 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do let <_true> = + <apply 'id'/1 + ('true')> + in let <_false> = + <apply 'id'/1 + ('false')> + in let <_atuple> = + <apply 'id'/1 + ({'false','true','gurks'})> + in do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['check'|[['lambda'|[[]|[['eif'|[['or'|[['element'|[42|['atuple']]]|['false']]]|[['quote'|['ok']]|[['quote'|['true']]|[['quote'|['error']]]]]]]]]]|[['quote'|['error']]]]]}) + let <_6> = + fun () -> + case 1 of + <_2> + when try + let <_4> = + let <_3> = + call 'erlang':'element' + (42, _atuple) + in call 'erlang':'or' + (_3, _false) + in _4 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_5> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'error' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end + in apply 'check'/2 + (_6, 'error') + 'ok' + ( <_68> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_68}) + -| [{'function_name',{'more_or_guards',1}}] ) + -| ['compiler_generated'] ) + end +'complex_or_guards'/1 = + %% Line 409 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[['quote'|['ok']]|[['complex-or-1'|[{'a','b','c','d'}|[{1,2,3}]]]]]]}) + let <_val> = + <apply 'complex-or-1'/2 + ({'a','b','c','d'}, {1,2,3})> + in case <_val> of + <'ok'> when 'true' -> + _val + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',{_2}}) + -| ['compiler_generated'] ) + end + ( <_55> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_55}) + -| [{'function_name',{'complex_or_guards',1}}] ) + -| ['compiler_generated'] ) + end +'complex-or-1'/2 = + %% Line 487 + fun (_a,_b) -> + case 1 of + <_0> + when try + let <_11> = + let <_9> = + let <_3> = + let <_1> = + call 'erlang':'tuple_size' + (_a) + in call 'erlang':'<' + (3, _1) + in let <_4> = + let <_2> = + call 'erlang':'tuple_size' + (_a) + in call 'erlang':'<' + (_2, 9) + in call 'erlang':'and' + (_3, _4) + in let <_10> = + let <_7> = + let <_5> = + call 'erlang':'tuple_size' + (_b) + in call 'erlang':'<' + (2, _5) + in let <_8> = + let <_6> = + call 'erlang':'tuple_size' + (_b) + in call 'erlang':'<' + (_6, 7) + in call 'erlang':'and' + (_7, _8) + in call 'erlang':'or' + (_9, _10) + in _11 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_12> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'error' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'complex-or-2'/1 = + %% Line 492 + fun (_tuple) -> + case 1 of + <_0> + when try + let <_6> = + let <_4> = + call 'erlang':'element' + (1, _tuple) + in let <_5> = + let <_3> = + let <_2> = + let <_1> = + call 'erlang':'element' + (2, _tuple) + in call 'erlang':'tuple_size' + (_1) + in call 'erlang':'>' + (_2, 3) + in call 'erlang':'not' + (_3) + in call 'erlang':'or' + (_4, _5) + in _6 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_7> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'error' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'complex-or-3'/2 = + %% Line 496 + fun (_a,_b) -> + case 1 of + <_0> + when try + let <_5> = + let <_3> = + let <_2> = + let <_1> = + call 'erlang':'size' + (_b) + in call 'erlang':'>' + (_1, 3) + in call 'erlang':'not' + (_2) + in let <_4> = + call 'erlang':'element' + (1, _a) + in call 'erlang':'or' + (_3, _4) + in _5 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_6> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'error' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'complex-or-4'/2 = + %% Line 499 + fun (_a,_b) -> + case 1 of + <_0> + when try + let <_7> = + let <_5> = + let <_4> = + let <_2> = + call 'erlang':'is_tuple' + (_a) + in let <_3> = + let <_1> = + call 'erlang':'size' + (_a) + in call 'erlang':'>' + (_1, 3) + in call 'erlang':'and' + (_2, _3) + in call 'erlang':'not' + (_4) + in let <_6> = + call 'erlang':'element' + (1, _b) + in call 'erlang':'or' + (_5, _6) + in _7 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_8> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'error' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'complex-or-5'/2 = + %% Line 503 + fun (_a,_b) -> + case 1 of + <_0> + when try + let <_8> = + let <_6> = + let <_4> = + let <_2> = + call 'erlang':'is_tuple' + (_a) + in let <_3> = + let <_1> = + call 'erlang':'size' + (_a) + in call 'erlang':'>' + (_1, 3) + in call 'erlang':'and' + (_2, _3) + in call 'erlang':'not' + (_4) + in let <_7> = + let <_5> = + call 'erlang':'element' + (1, _b) + in call 'erlang':'not' + (_5) + in call 'erlang':'or' + (_6, _7) + in _8 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_9> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'error' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'complex-or-6'/2 = + %% Line 507 + fun (_a,_b) -> + case 1 of + <_0> + when try + let <_11> = + let <_9> = + let <_5> = + let <_3> = + let <_1> = + call 'erlang':'element' + (1, _a) + in call 'erlang':'not' + (_1) + in let <_4> = + let <_2> = + call 'erlang':'element' + (2, _a) + in call 'erlang':'not' + (_2) + in call 'erlang':'and' + (_3, _4) + in call 'erlang':'not' + (_5) + in let <_10> = + let <_8> = + let <_7> = + let <_6> = + call 'erlang':'size' + (_b) + in call 'erlang':'>' + (_6, 3) + in call 'erlang':'not' + (_7) + in call 'erlang':'not' + (_8) + in call 'erlang':'or' + (_9, _10) + in _11 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_12> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'error' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'and_guard'/1 = + %% Line 512 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['check'|[['lambda'|[[]|[['eif'|[['and'|[['quote'|['true']]|[['quote'|['false']]]]]|[['quote'|['ok']]|[['quote'|['true']]|[['quote'|['error']]]]]]]]]]|[['quote'|['error']]]]]}) + let <_5> = + fun () -> + case 1 of + <_2> + when try + let <_3> = + call 'erlang':'and' + ('true', 'false') + in _3 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_4> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'error' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end + in apply 'check'/2 + (_5, 'error') + ( <_120> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_120}) + -| [{'function_name',{'and_guard',1}}] ) + -| ['compiler_generated'] ) + end +'relprod'/2 = + %% Line 588 + fun (_1,_0) -> + case <_1,_0> of + <_r1,_r2> + when try + let <_10> = + let <_4> = + let <_2> = + call 'erlang':'size' + (_r1) + in call 'erlang':'=:=' + (_2, 3) + in let <_5> = + let <_3> = + call 'erlang':'element' + (1, _r1) + in call 'erlang':'=:=' + (_3, 'Set') + in call 'erlang':'and' + (_4, _5) + in let <_11> = + let <_8> = + let <_6> = + call 'erlang':'size' + (_r2) + in call 'erlang':'=:=' + (_6, 3) + in let <_9> = + let <_7> = + call 'erlang':'element' + (1, _r2) + in call 'erlang':'=:=' + (_7, 'Set') + in call 'erlang':'and' + (_8, _9) + in call 'erlang':'and' + (_10, _11) + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + ( <_13,_12> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_13,_12}) + -| [{'function_name',{'relprod',2}}] ) + -| ['compiler_generated'] ) + end +'xor_guard'/1 = + %% Line 595 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['check'|[['lambda'|[[]|[['eif'|[['xor'|[['quote'|['true']]|[['quote'|['false']]]]]|[['quote'|['ok']]]]]]]]|[['quote'|['ok']]]]]}) + let <_4> = + fun () -> + case 1 of + <_2> + when try + let <_3> = + call 'erlang':'xor' + ('true', 'false') + in _3 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end + in apply 'check'/2 + (_4, 'ok') + ( <_54> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_54}) + -| [{'function_name',{'xor_guard',1}}] ) + -| ['compiler_generated'] ) + end +'more_xor_guards'/1 = + %% Line 636 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + let <_true,_false,_atuple> = + <apply 'id'/1 + ('true'),apply 'id'/1 + ('false'),apply 'id'/1 + ({'false','true','gurka'})> + in do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['check'|[['lambda'|[[]|[['eif'|[['xor'|[['element'|[42|['atuple']]]|['false']]]|[['quote'|['ok']]|[['quote'|['true']]|[['quote'|['error']]]]]]]]]]|[['quote'|['error']]]]]}) + let <_6> = + fun () -> + case 1 of + <_2> + when try + let <_4> = + let <_3> = + call 'erlang':'element' + (42, _atuple) + in call 'erlang':'xor' + (_3, _false) + in _4 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_5> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'error' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end + in apply 'check'/2 + (_6, 'error') + ( <_29> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_29}) + -| [{'function_name',{'more_xor_guards',1}}] ) + -| ['compiler_generated'] ) + end +'build_in_guard'/1 = + %% Line 666 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + let <_subbin> = + <#{#<64>(8,1,'integer',['unsigned'|['big']]), + #<20>(8,1,'integer',['unsigned'|['big']]), + #<0>(8,1,'integer',['unsigned'|['big']]), + #<0>(8,1,'integer',['unsigned'|['big']]), + #<0>(8,1,'integer',['unsigned'|['big']]), + #<0>(8,1,'integer',['unsigned'|['big']]), + #<0>(8,1,'integer',['unsigned'|['big']]), + #<0>(8,1,'integer',['unsigned'|['big']])}#> + in let <_b> = + <#{#<1>(8,1,'integer',['unsigned'|['big']]), + #<_subbin>('all',8,'binary',['unsigned'|['big']]), + #<3.50000000000000000000e+00>(64,1,'float',['unsigned'|['big']])}#> + in do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[['quote'|['ok']]|[['eif'|[['=:='|['b'|[['binary'|[1|[['subbin'|['binary']]|[[3.50000000000000000000e+00|['float']]]]]]]]]|[['quote'|['ok']]]]]]]]}) + let <_val> = + <case 1 of + <_2> + when try + let <_3> = + call 'erlang':'=:=' + (_b, #{#<1>(8,1,'integer',['unsigned'|['big']]), + #<_subbin>('all',8,'binary',['unsigned'|['big']]), + #<3.50000000000000000000e+00>(64,1,'float',['unsigned'|['big']])}#) + in _3 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> + in case <_val> of + <'ok'> when 'true' -> + _val + ( <_4> when 'true' -> + primop 'match_fail' + ({'badmatch',{_4}}) + -| ['compiler_generated'] ) + end + ( <_5> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_5}) + -| [{'function_name',{'build_in_guard',1}}] ) + -| ['compiler_generated'] ) + end +'old_guard_tests'/1 = + %% Line 674 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + ( <_2> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_2}) + -| [{'function_name',{'old_guard_tests',1}}] ) + -| ['compiler_generated'] ) + end +'gbif'/1 = + %% Line 679 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[['quote'|['error']]|[['gbif-1'|[1|[{'false','true'}]]]]]]}) + let <_val> = + <apply 'gbif-1'/2 + (1, {'false','true'})> + in case <_val> of + <'error'> when 'true' -> + _val + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',{_2}}) + -| ['compiler_generated'] ) + end + ( <_4> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_4}) + -| [{'function_name',{'gbif',1}}] ) + -| ['compiler_generated'] ) + end +'gbif-1'/2 = + %% Line 685 + fun (_1,_0) -> + case <_1,_0> of + <_p,_t> + when try + let <_3> = + let <_2> = + call 'erlang':'element' + (_p, _t) + in ( call 'erlang':'=:=' + (_2, 'true') + -| ['compiler_generated'] ) + in _3 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_4,_5> when 'true' -> + 'error' + ( <_7,_6> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_7,_6}) + -| [{'function_name',{'gbif-1',2}}] ) + -| ['compiler_generated'] ) + end +'t_is_boolean'/1 = + %% Line 690 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[['quote'|['true']]|[['is_boolean'|[['quote'|['true']]]]]]]}) + let <_val> = + <call 'erlang':'is_boolean' + ('true')> + in case <_val> of + <'true'> when 'true' -> + _val + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',{_2}}) + -| ['compiler_generated'] ) + end + ( <_70> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_70}) + -| [{'function_name',{'t_is_boolean',1}}] ) + -| ['compiler_generated'] ) + end +'bool'/1 = + %% Line 744 + fun (_0) -> + case <_0> of + <_x> + when try + let <_1> = + call 'erlang':'is_boolean' + (_x) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_2> when 'true' -> + 'error' + ( <_3> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_3}) + -| [{'function_name',{'bool',1}}] ) + -| ['compiler_generated'] ) + end +'my-is-bool'/1 = + %% Line 748 + fun (_v) -> + let <_r0> = + <apply 'my-is-bool-a'/1 + (_v)> + in case <apply 'my-is-bool-b'/1 + (_v)> of + <_res> + when try + let <_0> = + call 'erlang':'=:=' + (_res, _r0) + in _0 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + _res + ( <_1> when 'true' -> + primop 'match_fail' + ({'badmatch',{_1}}) + -| ['compiler_generated'] ) + end +'my-is-bool-a'/1 = + %% Line 753 + fun (_v) -> + case _v of + <'true'> when 'true' -> + 'true' + <'false'> when 'true' -> + 'true' + <_0> when 'true' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'my-is-bool-b'/1 = + %% Line 759 + fun (_v) -> + case _v of + <'false'> when 'true' -> + 'true' + <'true'> when 'true' -> + 'true' + <_0> when 'true' -> + 'false' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'is_function_2'/1 = + %% Line 765 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[['quote'|['true']]|[['is_function'|[['id'|[['function'|['lfe_guard_SUITE'|['all'|[1]]]]]]|[1]]]]]]}) + let <_val> = + <let <_3> = + let <_2> = + call 'erlang':'make_fun' + ('lfe_guard_SUITE', 'all', 1) + in apply 'id'/1 + (_2) + in call 'erlang':'is_function' + (_3, 1)> + in case <_val> of + <'true'> when 'true' -> + _val + ( <_4> when 'true' -> + primop 'match_fail' + ({'badmatch',{_4}}) + -| ['compiler_generated'] ) + end + ( <_17> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_17}) + -| [{'function_name',{'is_function_2',1}}] ) + -| ['compiler_generated'] ) + end +'tricky'/1 = + %% Line 775 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[['quote'|['not_ok']]|[['tricky-1'|[1|[2]]]]]]}) + let <_val> = + <apply 'tricky-1'/2 + (1, 2)> + in case <_val> of + <'not_ok'> when 'true' -> + _val + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',{_2}}) + -| ['compiler_generated'] ) + end + ( <_12> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_12}) + -| [{'function_name',{'tricky',1}}] ) + -| ['compiler_generated'] ) + end +'tricky-1'/2 = + %% Line 791 + fun (_1,_0) -> + case <_1,_0> of + <_x,_y> + when try + let <_6> = + let <_5> = + let <_4> = + let <_2> = + call 'erlang':'==' + (_x, 1) + in let <_3> = + call 'erlang':'==' + (_y, 2) + in call 'erlang':'or' + (_2, _3) + in call 'erlang':'abs' + (_4) + in ( call 'erlang':'=:=' + (_5, 'true') + -| ['compiler_generated'] ) + in _6 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_7,_8> when 'true' -> + 'not_ok' + ( <_10,_9> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_10,_9}) + -| [{'function_name',{'tricky-1',2}}] ) + -| ['compiler_generated'] ) + end +'tricky-2'/1 = + %% Line 795 + fun (_0) -> + case <_0> of + <_x> + when try + let <_3> = + let <_1> = + call 'erlang':'float' + (_x) + in let <_2> = + call 'erlang':'float' + (_x) + in call 'erlang':'or' + (_1, _2) + in _3 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_4> when 'true' -> + 'error' + ( <_5> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_5}) + -| [{'function_name',{'tricky-2',1}}] ) + -| ['compiler_generated'] ) + end +'rb'/3 = + %% Line 801 + fun (_2,_1,_0) -> + case <_2,_1,_0> of + <_size,_toread,_sofar> + when try + let <_6> = + let <_4> = + let <_3> = + call 'erlang':'+' + (_sofar, _size) + in call 'erlang':'<' + (_3, 81920) + in let <_5> = + call 'erlang':'==' + (_toread, []) + in call 'erlang':'or' + (_4, _5) + in _6 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'true' + <_7,_8,_9> when 'true' -> + 'false' + ( <_12,_11,_10> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_12,_11,_10}) + -| [{'function_name',{'rb',3}}] ) + -| ['compiler_generated'] ) + end +'rel_ops'/1 = + %% Line 830 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['T'|['=/='|[1|[1.00000000000000000000e+00]]]]}) + case <case 1 of + <_2> + when try + let <_3> = + call 'erlang':'=/=' + (1, 1.00000000000000000000e+00) + in _3 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_4> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'error' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> of + <'ok'> when 'true' -> + case <case 1 of + <_5> + when try + let <_7> = + let <_6> = + call 'erlang':'=/=' + (1, 1.00000000000000000000e+00) + in call 'erlang':'not' + (_6) + in _7 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'error' + <_8> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> of + <'ok'> when 'true' -> + let <_x,_y,_true,_false> = + <apply 'id'/1 + (1),apply 'id'/1 + (1.00000000000000000000e+00),apply 'id'/1 + ('true'),apply 'id'/1 + ('false')> + in case <case 1 of + <_9> + when try + let <_10> = + call 'erlang':'=/=' + (_x, _y) + in _10 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_11> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'error' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> of + <'ok'> when 'true' -> + case <case 1 of + <_12> + when try + let <_15> = + let <_14> = + let <_13> = + call 'erlang':'=/=' + (_x, _y) + in call 'erlang':'or' + (_false, _13) + in call 'erlang':'or' + (_14, _false) + in _15 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_16> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'error' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> of + <'ok'> when 'true' -> + case <case 1 of + <_17> + when try + let <_19> = + let <_18> = + call 'erlang':'=/=' + (_x, _y) + in call 'erlang':'and' + (_18, _true) + in _19 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_20> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'error' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> of + <'ok'> when 'true' -> + case <case 1 of + <_21> + when try + let <_23> = + let <_22> = + call 'erlang':'=/=' + (_x, _y) + in call 'erlang':'not' + (_22) + in _23 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'error' + <_24> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> of + <'ok'> when 'true' -> + case <case 1 of + <_25> + when try + let <_29> = + let <_28> = + let <_27> = + let <_26> = + call 'erlang':'=/=' + (_x, _y) + in call 'erlang':'not' + (_26) + in call 'erlang':'or' + (_false, _27) + in call 'erlang':'or' + (_28, _false) + in _29 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'error' + <_30> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> of + <'ok'> when 'true' -> + 'ok' + ( <_31> when 'true' -> + primop 'match_fail' + ({'badmatch',{_31}}) + -| ['compiler_generated'] ) + end + ( <_32> when 'true' -> + primop 'match_fail' + ({'badmatch',{_32}}) + -| ['compiler_generated'] ) + end + ( <_33> when 'true' -> + primop 'match_fail' + ({'badmatch',{_33}}) + -| ['compiler_generated'] ) + end + ( <_34> when 'true' -> + primop 'match_fail' + ({'badmatch',{_34}}) + -| ['compiler_generated'] ) + end + ( <_35> when 'true' -> + primop 'match_fail' + ({'badmatch',{_35}}) + -| ['compiler_generated'] ) + end + ( <_36> when 'true' -> + primop 'match_fail' + ({'badmatch',{_36}}) + -| ['compiler_generated'] ) + end + ( <_37> when 'true' -> + primop 'match_fail' + ({'badmatch',{_37}}) + -| ['compiler_generated'] ) + end + ( <_769> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_769}) + -| [{'function_name',{'rel_ops',1}}] ) + -| ['compiler_generated'] ) + end +'literal_type_tests'/1 = + %% Line 873 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + case 'guard_suite' of + <'guard_suite'> when 'true' -> + apply 'literal-type-tests-1'/1 + (_config) + <_2> when 'true' -> + {'skip',[69|[110|[111|[117|[103|[104|[32|[116|[111|[32|[114|[117|[110|[32|[116|[104|[105|[115|[32|[99|[97|[115|[101|[32|[111|[110|[99|[101|[46]]]]]]]]]]]]]]]]]]]]]]]]]]]]]} + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end + ( <_3> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_3}) + -| [{'function_name',{'literal_type_tests',1}}] ) + -| ['compiler_generated'] ) + end +'literal-type-tests-1'/1 = + %% Line 879 + fun (_config) -> + 'ok' +'basic_andalso_orelse'/1 = + %% Line 967 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + let <_t> = + <apply 'id'/1 + ({'type','integers',23,42})> + in do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[65|[['eif'|[['andalso'|[['=:='|[['element'|[1|['t']]]|[['quote'|['type']]]]]|[['=:='|[['tuple_size'|['t']]|[4]]]|[['=:='|[['element'|[2|['t']]]|[['quote'|['integers']]]]]]]]]|[['+'|[['element'|[3|['t']]]|[['element'|[4|['t']]]]]]|[['quote'|['true']]|[['quote'|['error']]]]]]]]]]}) + let <_val> = + <case 1 of + <_2> + when try + let <_7> = + let <_6> = + case let <_3> = + call 'erlang':'element' + (1, _t) + in call 'erlang':'=:=' + (_3, 'type') of + <'true'> when 'true' -> + case let <_4> = + call 'erlang':'tuple_size' + (_t) + in call 'erlang':'=:=' + (_4, 4) of + <'true'> when 'true' -> + let <_5> = + call 'erlang':'element' + (2, _t) + in call 'erlang':'=:=' + (_5, 'integers') + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in ( call 'erlang':'=:=' + (_6, 'true') + -| ['compiler_generated'] ) + in _7 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + let <_8> = + call 'erlang':'element' + (3, _t) + in let <_9> = + call 'erlang':'element' + (4, _t) + in call 'erlang':'+' + (_8, _9) + <_10> + when try + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'error' + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end> + in case <_val> of + <65> when 'true' -> + _val + ( <_11> when 'true' -> + primop 'match_fail' + ({'badmatch',{_11}}) + -| ['compiler_generated'] ) + end + ( <_47> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_47}) + -| [{'function_name',{'basic_andalso_orelse',1}}] ) + -| ['compiler_generated'] ) + end +'basic-rt'/1 = + %% Line 1020 + fun (_0) -> + case <_0> of + <_t> + when try + let <_5> = + let <_4> = + case call 'erlang':'is_tuple' + (_t) of + <'true'> when 'true' -> + case let <_1> = + call 'erlang':'tuple_size' + (_t) + in call 'erlang':'=:=' + (_1, 4) of + <'true'> when 'true' -> + case let <_2> = + call 'erlang':'element' + (1, _t) + in call 'erlang':'=:=' + (_2, 'type') of + <'true'> when 'true' -> + let <_3> = + call 'erlang':'element' + (2, _t) + in call 'erlang':'==' + (_3, 'integers') + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in ( call 'erlang':'=:=' + (_4, 'true') + -| ['compiler_generated'] ) + in _5 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + let <_6> = + call 'erlang':'element' + (3, _t) + in let <_7> = + call 'erlang':'element' + (4, _t) + in call 'erlang':'+' + (_6, _7) + <_t> + when try + let <_11> = + let <_10> = + case call 'erlang':'is_tuple' + (_t) of + <'true'> when 'true' -> + case let <_8> = + call 'erlang':'tuple_size' + (_t) + in call 'erlang':'=:=' + (_8, 2) of + <'true'> when 'true' -> + let <_9> = + call 'erlang':'element' + (1, _t) + in call 'erlang':'=:=' + (_9, 'vector') + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in ( call 'erlang':'=:=' + (_10, 'true') + -| ['compiler_generated'] ) + in _11 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + case <call 'erlang':'element' + (2, _t)> of + <{_x,_y}> when 'true' -> + case 1 of + <_12> + when try + let <_16> = + let <_15> = + let <_13> = + call 'erlang':'is_float' + (_x) + in let <_14> = + call 'erlang':'is_float' + (_y) + in call 'erlang':'and' + (_13, _14) + in ( call 'erlang':'=:=' + (_15, 'true') + -| ['compiler_generated'] ) + in _16 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + let <_19> = + let <_17> = + call 'erlang':'*' + (_x, _x) + in let <_18> = + call 'erlang':'*' + (_y, _y) + in call 'erlang':'+' + (_17, _18) + in call 'math':'sqrt' + (_19) + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end + ( <_20> when 'true' -> + primop 'match_fail' + ({'badmatch',{_20}}) + -| ['compiler_generated'] ) + end + <['+',_a,_b]> when 'true' -> + let <_22> = + let <_21> = + call 'erlang':'+' + (_a, _b) + in apply 'id'/1 + (_21) + in call 'erlang':'*' + (_22, 2) + <{_r1,_r2}> + when try + let <_28> = + let <_27> = + case let <_23> = + call 'erlang':'size' + (_r1) + in call 'erlang':'=:=' + (_23, 3) of + <'true'> when 'true' -> + case let <_24> = + call 'erlang':'element' + (1, _r1) + in call 'erlang':'=:=' + (_24, 'Set') of + <'true'> when 'true' -> + case let <_25> = + call 'erlang':'size' + (_r2) + in call 'erlang':'=:=' + (_25, 3) of + <'true'> when 'true' -> + let <_26> = + call 'erlang':'element' + (1, _r2) + in call 'erlang':'=:=' + (_26, 'Set') + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in ( call 'erlang':'=:=' + (_27, 'true') + -| ['compiler_generated'] ) + in _28 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + let <_r1> = + <apply 'id'/1 + (_r1)> + in let <_r2> = + <apply 'id'/1 + (_r2)> + in _r1 + <_t> + when try + let <_32> = + let <_31> = + case call 'erlang':'is_tuple' + (_t) of + <'true'> when 'true' -> + case let <_29> = + call 'erlang':'tuple_size' + (_t) + in call 'erlang':'=:=' + (_29, 2) of + <'true'> when 'true' -> + let <_30> = + call 'erlang':'element' + (1, _t) + in call 'erlang':'=:=' + (_30, 'klurf') + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in ( call 'erlang':'=:=' + (_31, 'true') + -| ['compiler_generated'] ) + in _32 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + let <_34> = + let <_33> = + call 'erlang':'element' + (2, _t) + in apply 'id'/1 + (_33) + in call 'erlang':'*' + (3, _34) + <_35> when 'true' -> + 'error' + ( <_36> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_36}) + -| [{'function_name',{'basic-rt',1}}] ) + -| ['compiler_generated'] ) + end +'traverse_dcd'/1 = + %% Line 1043 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + let <_l0> = + <[{'log_header','dcd_log',[49|[46|[48]]],'a','b','c'}|[{'log_header','dcd_log',[50|[46|[48]]],'a','b','c'}|[{'log_header','dcd_log',[48|[46|[48]]],'a','b','c'}|['blurf']]]]> + in case <apply 'traverse-dcd'/3 + ({'cont',_l0}, 'log', 'funny')> of + <{'cont',[{'log_header','dcd_log',[48|[46|[48]]],'a','b','c'}|['blurf']],'log','funny'}> when 'true' -> + let <_l1> = + <[{'log_header','dcd_log',[49|[46|[48]]]}]> + in case <apply 'traverse-dcd'/3 + ({'cont',_l1}, 'log', 'funny')> of + <{'cont',_l1,'log','funny'}> when 'true' -> + let <_l2> = + <[{'a','tuple'}]> + in case <apply 'traverse-dcd'/3 + ({'cont',_l2}, 'log', 'funny')> of + <{'cont',_l2,'log','funny'}> when 'true' -> + 'ok' + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',{_2}}) + -| ['compiler_generated'] ) + end + ( <_3> when 'true' -> + primop 'match_fail' + ({'badmatch',{_3}}) + -| ['compiler_generated'] ) + end + ( <_4> when 'true' -> + primop 'match_fail' + ({'badmatch',{_4}}) + -| ['compiler_generated'] ) + end + ( <_5> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_5}) + -| [{'function_name',{'traverse_dcd',1}}] ) + -| ['compiler_generated'] ) + end +'traverse-dcd'/3 = + %% Line 1066 + fun (_2,_1,_0) -> + case <_2,_1,_0> of + <{_cont,[_logh|_rest]},_log,_fun> + when try + let <_11> = + let <_6> = + case call 'erlang':'is_tuple' + (_logh) of + <'true'> when 'true' -> + case let <_3> = + call 'erlang':'tuple_size' + (_logh) + in call 'erlang':'=:=' + (_3, 6) of + <'true'> when 'true' -> + case let <_4> = + call 'erlang':'element' + (1, _logh) + in call 'erlang':'=:=' + (_4, 'log_header') of + <'true'> when 'true' -> + let <_5> = + call 'erlang':'element' + (2, _logh) + in call 'erlang':'==' + (_5, 'dcd_log') + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in ( call 'erlang':'=:=' + (_6, 'true') + -| ['compiler_generated'] ) + in let <_12> = + let <_10> = + case call 'erlang':'is_tuple' + (_logh) of + <'true'> when 'true' -> + case let <_7> = + call 'erlang':'tuple_size' + (_logh) + in call 'erlang':'=:=' + (_7, 6) of + <'true'> when 'true' -> + case let <_8> = + call 'erlang':'element' + (1, _logh) + in call 'erlang':'=:=' + (_8, 'log_header') of + <'true'> when 'true' -> + let <_9> = + call 'erlang':'element' + (3, _logh) + in call 'erlang':'>=' + (_9, [49|[46|[48]]]) + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in ( call 'erlang':'=:=' + (_10, 'true') + -| ['compiler_generated'] ) + in call 'erlang':'and' + (_11, _12) + of <Try> -> + Try + catch <T,R> -> + 'false' -> + apply 'traverse-dcd'/3 + ({_cont,_rest}, _log, _fun) + <{_cont,_recs},_log,_fun> when 'true' -> + {_cont,_recs,_log,_fun} + ( <_15,_14,_13> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_15,_14,_13}) + -| [{'function_name',{'traverse-dcd',3}}] ) + -| ['compiler_generated'] ) + end +'check_qlc_hrl'/1 = + %% Line 1078 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + let <_st> = + <{'r1','false','dum'}> + in do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[['quote'|['foo']]|[['cqlc'|[['quote'|['qlc']]|[['quote'|['q']]|[['quote'|[[{'lc',1,2,3}]]]|['st']]]]]]]]}) + let <_val> = + <apply 'cqlc'/4 + ('qlc', 'q', [{'lc',1,2,3}], _st)> + in case <_val> of + <'foo'> when 'true' -> + _val + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',{_2}}) + -| ['compiler_generated'] ) + end + ( <_5> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_5}) + -| [{'function_name',{'check_qlc_hrl',1}}] ) + -| ['compiler_generated'] ) + end +'cqlc'/4 = + %% Line 1094 + fun (_m,_f,_as,_st) -> + let <_arity> = + <call 'erlang':'length' + (_as)> + in case _as of + <[{'lc',_0,_1,_2}|_3]> + when try + let <_11> = + call 'erlang':'=:=' + (_m, 'qlc') + in let <_12> = + call 'erlang':'=:=' + (_f, 'q') + in let <_13> = + call 'erlang':'<' + (_arity, 3) + in let <_14> = + let <_10> = + let <_8> = + case let <_4> = + call 'erlang':'element' + (1, _st) + in call 'erlang':'=:=' + (_4, 'r1') of + <'true'> when 'true' -> + 'true' + <'false'> when 'true' -> + 'fail' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in let <_9> = + let <_6> = + let <_5> = + call 'erlang':'tuple_size' + (_st) + in call 'erlang':'=:=' + (_5, 3) + in let <_7> = + call 'erlang':'element' + (2, _st) + in call 'erlang':'and' + (_6, _7) + in call 'erlang':'and' + (_8, _9) + in call 'erlang':'not' + (_10) + in let <_15> = + call 'erlang':'and' + (_11, _12) + in let <_16> = + call 'erlang':'and' + (_15, _13) + in call 'erlang':'and' + (_16, _14) + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'foo' + <_17> when 'true' -> + _st + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'andalso_semi'/1 = + %% Line 1106 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[['quote'|['ok']]|[['andalso-semi-foo'|[0]]]]]}) + let <_val> = + <apply 'andalso-semi-foo'/1 + (0)> + in case <_val> of + <'ok'> when 'true' -> + _val + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',{_2}}) + -| ['compiler_generated'] ) + end + ( <_8> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_8}) + -| [{'function_name',{'andalso_semi',1}}] ) + -| ['compiler_generated'] ) + end +'andalso-semi-foo'/1 = + %% Line 1117 + fun (_0) -> + case <_0> of + <_bar> + when try + let <_3> = + let <_1> = + case call 'erlang':'is_integer' + (_bar) of + <'true'> when 'true' -> + call 'erlang':'=:=' + (_bar, 0) + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in let <_2> = + call 'erlang':'=:=' + (_bar, 1) + in call 'erlang':'or' + (_1, _2) + in _3 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + ( <_4> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_4}) + -| [{'function_name',{'andalso-semi-foo',1}}] ) + -| ['compiler_generated'] ) + end +'andalso-semi-bar'/1 = + %% Line 1121 + fun (_0) -> + case <_0> of + <_bar> + when try + let <_4> = + let <_2> = + case call 'erlang':'is_list' + (_bar) of + <'true'> when 'true' -> + let <_1> = + call 'erlang':'length' + (_bar) + in call 'erlang':'=:=' + (_1, 3) + <'false'> when 'true' -> + 'false' + ( <_omega> when 'true' -> + _omega + -| ['compiler_generated'] ) + end + in let <_3> = + call 'erlang':'=:=' + (_bar, 1) + in call 'erlang':'or' + (_2, _3) + in _4 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + ( <_5> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_5}) + -| [{'function_name',{'andalso-semi-bar',1}}] ) + -| ['compiler_generated'] ) + end +'t_tuple_size'/1 = + %% Line 1125 + fun (_0) -> + case <_0> of + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[10|[['do-tuple-size'|[{1,2,3,4}]]]]]}) + let <_val> = + <apply 'do-tuple-size'/1 + ({1,2,3,4})> + in case <_val> of + <10> when 'true' -> + _val + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',{_2}}) + -| ['compiler_generated'] ) + end + ( <_7> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_7}) + -| [{'function_name',{'t_tuple_size',1}}] ) + -| ['compiler_generated'] ) + end +'do-tuple-size'/1 = + %% Line 1139 + fun (_0) -> + case <_0> of + <_t> + when try + let <_2> = + let <_1> = + call 'erlang':'tuple_size' + (_t) + in call 'erlang':'=:=' + (_1, 4) + in _2 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + case <_t> of + <{_a,_b,_c,_d}> when 'true' -> + let <_lfe0> = + <_a> + in let <_lfe1> = + <_b> + in let <_lfe2> = + <_c> + in let <_lfe3> = + <_d> + in let <_4> = + let <_3> = + call 'erlang':'+' + (_lfe0, _lfe1) + in call 'erlang':'+' + (_3, _lfe2) + in call 'erlang':'+' + (_4, _lfe3) + ( <_5> when 'true' -> + primop 'match_fail' + ({'badmatch',{_5}}) + -| ['compiler_generated'] ) + end + ( <_6> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_6}) + -| [{'function_name',{'do-tuple-size',1}}] ) + -| ['compiler_generated'] ) + end +'ludicrous-tuple-size'/1 = + %% Line 1144 + fun (_0) -> + case <_0> of + <_t> + when try + let <_2> = + let <_1> = + call 'erlang':'tuple_size' + (_t) + in call 'erlang':'=:=' + (_1, 40652400101488115101757819767848575661943) + in _2 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_t> + when try + let <_4> = + let <_3> = + call 'erlang':'tuple_size' + (_t) + in call 'erlang':'=:=' + (_3, 18446744073709551616) + in _4 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_t> + when try + let <_8> = + let <_6> = + call 'erlang':'tuple_size' + (_t) + in let <_7> = + let <_5> = + call 'erlang':'bsl' + (1, 64) + in call 'erlang':'-' + (_5, 1) + in call 'erlang':'=:=' + (_6, _7) + in _8 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_t> + when try + let <_10> = + let <_9> = + call 'erlang':'tuple_size' + (_t) + in call 'erlang':'=:=' + (_9, 18446744073709551615) + in _10 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_11> when 'true' -> + 'error' + ( <_12> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_12}) + -| [{'function_name',{'ludicrous-tuple-size',1}}] ) + -| ['compiler_generated'] ) + end +'mask-error'/1 = + %% Line 1152 + fun (_0) -> + case <_0> of + <{'EXIT',{_err,_1}}> when 'true' -> + _err + <_else> when 'true' -> + _else + ( <_2> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_2}) + -| [{'function_name',{'mask-error',1}}] ) + -| ['compiler_generated'] ) + end +'binary_part'/1 = + %% Line 1156 + fun (_0) -> + case <_0> of + <'doc'> when 'true' -> + [84|[101|[115|[116|[115|[32|[116|[104|[101|[32|[98|[105|[110|[97|[114|[121|[95|[112|[97|[114|[116|[47|[50|[44|[51|[32|[103|[117|[97|[114|[100|[32|[40|[71|[67|[41|[32|[98|[105|[102|[39|[115]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]] + <_config> + when try + let <_1> = + call 'erlang':'is_list' + (_config) + in _1 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + do call 'erlang':'put' + ('test_server_loc', {'lfe_guard_SUITE',['test-pat',1,['bp-test',#{#<1>(8,1,'integer',['unsigned'|['big']]), + #<2>(8,1,'integer',['unsigned'|['big']]), + #<3>(8,1,'integer',['unsigned'|['big']])}#]]}) + let <_val> = + <apply 'bp-test'/1 + (#{#<1>(8,1,'integer',['unsigned'|['big']]), + #<2>(8,1,'integer',['unsigned'|['big']]), + #<3>(8,1,'integer',['unsigned'|['big']])}#)> + in case <_val> of + <1> when 'true' -> + _val + ( <_2> when 'true' -> + primop 'match_fail' + ({'badmatch',{_2}}) + -| ['compiler_generated'] ) + end + ( <_53> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_53}) + -| [{'function_name',{'binary_part',1}}] ) + -| ['compiler_generated'] ) + end +'bp-test'/1 = + %% Line 1225 + fun (_0) -> + case <_0> of + <_b> + when try + let <_2> = + let <_1> = + call 'erlang':'length' + (_b) + in call 'erlang':'=:=' + (_1, 137) + in _2 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 1 + <_b> + when try + let <_4> = + let <_3> = + call 'erlang':'binary_part' + (_b, {1,1}) + in call 'erlang':'=:=' + (_3, #{#<2>(8,1,'integer',['unsigned'|['big']])}#) + in _4 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 1 + <_b> + when try + let <_6> = + let <_5> = + call 'erlang':'binary_part' + (_b, 1, 1) + in call 'erlang':'=:=' + (_5, #{#<1>(8,1,'integer',['unsigned'|['big']])}#) + in _6 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 2 + <_b> + when try + let <_8> = + let <_7> = + call 'erlang':'binary_part' + (_b, {1,2}) + in call 'erlang':'=:=' + (_7, #{#<3>(8,1,'integer',['unsigned'|['big']]), + #<3>(8,1,'integer',['unsigned'|['big']])}#) + in _8 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 3 + <_9> when 'true' -> + 'error' + ( <_10> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_10}) + -| [{'function_name',{'bp-test',1}}] ) + -| ['compiler_generated'] ) + end +'bp-test'/2 = + %% Line 1232 + fun (_1,_0) -> + case <_1,_0> of + <_b,_a> + when try + let <_3> = + let <_2> = + call 'erlang':'length' + (_b) + in call 'erlang':'=:=' + (_2, _a) + in _3 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 1 + <_b,_a> + when try + let <_5> = + let <_4> = + call 'erlang':'binary_part' + (_b, {_a,1}) + in call 'erlang':'=:=' + (_4, #{#<2>(8,1,'integer',['unsigned'|['big']])}#) + in _5 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 1 + <_b,_a> + when try + let <_7> = + let <_6> = + call 'erlang':'binary_part' + (_b, _a, 1) + in call 'erlang':'=:=' + (_6, #{#<1>(8,1,'integer',['unsigned'|['big']])}#) + in _7 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 2 + <_b,_a> + when try + let <_9> = + let <_8> = + call 'erlang':'binary_part' + (_b, {_a,2}) + in call 'erlang':'=:=' + (_8, #{#<3>(8,1,'integer',['unsigned'|['big']]), + #<3>(8,1,'integer',['unsigned'|['big']])}#) + in _9 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 3 + <_10,_11> when 'true' -> + 'error' + ( <_13,_12> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_13,_12}) + -| [{'function_name',{'bp-test',2}}] ) + -| ['compiler_generated'] ) + end +'bp-test-x'/2 = + %% Line 1239 + fun (_1,_0) -> + case <_1,_0> of + <_b,_a> + when try + let <_3> = + let <_2> = + call 'erlang':'length' + (_b) + in call 'erlang':'=:=' + (_2, _a) + in _3 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 1 + <_b,_a> + when try + let <_5> = + let <_4> = + call 'erlang':'binary_part' + (_b, _a) + in call 'erlang':'=:=' + (_4, #{#<2>(8,1,'integer',['unsigned'|['big']])}#) + in _5 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 1 + <_b,_a> + when try + let <_7> = + let <_6> = + call 'erlang':'binary_part' + (_b, _a) + in call 'erlang':'=:=' + (_6, #{#<1>(8,1,'integer',['unsigned'|['big']])}#) + in _7 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 2 + <_b,_a> + when try + let <_9> = + let <_8> = + call 'erlang':'binary_part' + (_b, _a) + in call 'erlang':'=:=' + (_8, #{#<3>(8,1,'integer',['unsigned'|['big']]), + #<3>(8,1,'integer',['unsigned'|['big']])}#) + in _9 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 3 + <_10,_11> when 'true' -> + 'error' + ( <_13,_12> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_13,_12}) + -| [{'function_name',{'bp-test-x',2}}] ) + -| ['compiler_generated'] ) + end +'bp-test-y'/2 = + %% Line 1246 + fun (_1,_0) -> + case <_1,_0> of + <_b,_a> + when try + let <_3> = + let <_2> = + call 'erlang':'length' + (_b) + in call 'erlang':'=:=' + (_2, _a) + in _3 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 1 + <_b,_a> + when try + let <_5> = + let <_4> = + call 'erlang':'binary_part' + (_b, {1,_a}) + in call 'erlang':'=:=' + (_4, #{#<2>(8,1,'integer',['unsigned'|['big']])}#) + in _5 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 1 + <_b,_a> + when try + let <_7> = + let <_6> = + call 'erlang':'binary_part' + (_b, 1, _a) + in call 'erlang':'=:=' + (_6, #{#<1>(8,1,'integer',['unsigned'|['big']])}#) + in _7 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 2 + <_b,_a> + when try + let <_9> = + let <_8> = + call 'erlang':'binary_part' + (_b, {1,_a}) + in call 'erlang':'=:=' + (_8, #{#<3>(8,1,'integer',['unsigned'|['big']]), + #<3>(8,1,'integer',['unsigned'|['big']])}#) + in _9 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 3 + <_10,_11> when 'true' -> + 'error' + ( <_13,_12> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_13,_12}) + -| [{'function_name',{'bp-test-y',2}}] ) + -| ['compiler_generated'] ) + end +'bp-test'/3 = + %% Line 1253 + fun (_2,_1,_0) -> + case <_2,_1,_0> of + <_b,_a,_3> + when try + let <_5> = + let <_4> = + call 'erlang':'length' + (_b) + in call 'erlang':'=:=' + (_4, _a) + in _5 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 1 + <_b,_a,_c> + when try + let <_7> = + let <_6> = + call 'erlang':'binary_part' + (_b, {_a,_c}) + in call 'erlang':'=:=' + (_6, #{#<2>(8,1,'integer',['unsigned'|['big']])}#) + in _7 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 1 + <_b,_a,_c> + when try + let <_9> = + let <_8> = + call 'erlang':'binary_part' + (_b, _a, _c) + in call 'erlang':'=:=' + (_8, #{#<1>(8,1,'integer',['unsigned'|['big']])}#) + in _9 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 2 + <_b,_a,_c> + when try + let <_11> = + let <_10> = + call 'erlang':'binary_part' + (_b, {_a,_c}) + in call 'erlang':'=:=' + (_10, #{#<3>(8,1,'integer',['unsigned'|['big']]), + #<3>(8,1,'integer',['unsigned'|['big']])}#) + in _11 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 3 + <_12,_13,_14> when 'true' -> + 'error' + ( <_17,_16,_15> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_17,_16,_15}) + -| [{'function_name',{'bp-test',3}}] ) + -| ['compiler_generated'] ) + end +'id'/1 = + %% Line 1262 + fun (_i) -> + _i +'check'/2 = + %% Line 1264 + fun (_f,_result) -> + case apply _f + () of + <_r> + when try + let <_0> = + call 'erlang':'=:=' + (_r, _result) + in _0 + of <Try> -> + Try + catch <T,R> -> + 'false' -> + 'ok' + <_other> when 'true' -> + do call 'lfe_io':'format' + ([69|[120|[112|[101|[99|[116|[101|[100|[58|[32|[126|[112|[10]]]]]]]]]]]]], [_result]) + do call 'lfe_io':'format' + ([32|[32|[32|[32|[32|[71|[111|[116|[58|[32|[126|[112|[10]]]]]]]]]]]]], [_other]) + call 'test_server':'fail' + () + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'fc'/1 = + %% Line 1272 + fun (_0) -> + case <_0> of + <{'EXIT',{'function_clause'}}> when 'true' -> + 'ok' + <{'EXIT',{{'case_clause',_1},_2}}> when 'true' -> + 'ok' + ( <_3> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_3}) + -| [{'function_name',{'fc',1}}] ) + -| ['compiler_generated'] ) + end +'$handle_undefined_function'/2 = + %% Line 29 + fun (_f,_as) -> + case let <_0> = + call 'lfe_env':'new' + () + in apply 'LFE-EXPAND-EXPORTED-MACRO'/3 + (_f, _as, _0) of + <{'yes',_exp}> when 'true' -> + call 'lfe_eval':'expr' + (_exp) + <'no'> when 'true' -> + let <_a,_b> = + <_f,_as> + in call 'error_handler':'raise_undef_exception' + ('lfe_guard_SUITE', _a, _b) + ( <_omega> when 'true' -> + primop 'match_fail' + ({'case_clause',_omega}) + -| ['compiler_generated'] ) + end +'LFE-EXPAND-EXPORTED-MACRO'/3 = + %% Line 29 + fun (_2,_1,_0) -> + 'no' +'module_info'/0 = + fun () -> + call 'erlang':'get_module_info' + ('lfe_guard_SUITE') +'module_info'/1 = + fun (_x) -> + call 'erlang':'get_module_info' + ('lfe_guard_SUITE', _x) +end diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index f543f0d4de..621524114f 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -229,14 +229,6 @@ silly_coverage(Config) when is_list(Config) -> {label,2}|non_proper_list]}],99}, expect_error(fun() -> beam_except:module(ExceptInput, []) end), - %% beam_bool - BoolInput = {?MODULE,[{foo,0}],[], - [{function,foo,0,2, - [{label,1}, - {func_info,{atom,?MODULE},{atom,foo},0}, - {label,2}|non_proper_list]}],99}, - expect_error(fun() -> beam_bool:module(BoolInput, []) end), - %% beam_dead. This is tricky. Our function must look OK to %% beam_utils:clean_labels/1, but must crash beam_dead. DeadInput = {?MODULE,[{foo,0}],[], diff --git a/lib/compiler/test/record_SUITE_data/record_access_in_guards.erl b/lib/compiler/test/record_SUITE_data/record_access_in_guards.erl index 9b72432246..dbd2419ad2 100644 --- a/lib/compiler/test/record_SUITE_data/record_access_in_guards.erl +++ b/lib/compiler/test/record_SUITE_data/record_access_in_guards.erl @@ -27,12 +27,12 @@ -record(r3, {a = fun(_) -> #r1{} end(1), b}). t() -> - foo = fun(A) when A#r1.a > A#r1.b -> foo end(#r1{b = 2}), - 0 = fun(A) when A#r2.a -> 0 end(#r2{a = true}), + foo = rec_call(fun(A) when A#r1.a > A#r1.b -> foo end, #r1{b = 2}), + 0 = rec_call(fun(A) when A#r2.a -> 0 end, #r2{a = true}), 1 = fun(A) when (#r1{a = A})#r1.a > 2 -> 1 end(3), 2 = fun(N) when ((#r2{a = #r{a = 4}, b = length([a,b,c])})#r2.a)#r.a > N -> - 2 end(2), - 3 = fun(A) when (A#r2.a)#r1.a =:= 3 -> 3 end(#r2{a = #r1{a = 3}}), + 2 end(2), + 3 = rec_call(fun(A) when (A#r2.a)#r1.a =:= 3 -> 3 end, #r2{a = #r1{a = 3}}), ok = fun() -> F = fun(A) when record(A#r.a, r1) -> 4; (A) when record(A#r1.a, r1) -> 5 @@ -41,9 +41,9 @@ t() -> 4 = F(#r{a = #r1{}}), ok end(), - 3 = fun(A) when record(A#r1.a, r), - (A#r1.a)#r.a > 3 -> 3 - end(#r1{a = #r{a = 4}}), + 3 = rec_call(fun(A) when record(A#r1.a, r), + (A#r1.a)#r.a > 3 -> 3 + end, #r1{a = #r{a = 4}}), 7 = fun(A) when record(A#r3.a, r1) -> 7 end(#r3{}), [#r1{a = 2,b = 1}] = fun() -> @@ -71,9 +71,10 @@ t() -> (_) -> p end(#r1{a = 2}), - 3 = fun(A) when A#r1.a > 3, - record(A, r1) -> 3 - end(#r1{a = 5}), + o = rec_call(fun(A) when (A#r1.a =:= 2) orelse (A#r2.a =:= 1) -> o end, #r1{a = 2}), + o = rec_call(fun(A) when A#r1.a =:= 2; A#r2.a =:= 1 -> o end, #r2{a = 1}), + + 3 = rec_call(fun(A) when A#r1.a > 3, record(A, r1) -> 3 end, #r1{a = 5}), ok = fun() -> F = fun(A) when (A#r2.a =:= 1) orelse (A#r2.a) -> 2; @@ -93,6 +94,8 @@ t() -> (_) -> b end(#r1{a = 1}), + a = rec_call(fun(A) when not (A#r.a =:= 1) or false -> a end, #r{a = 42}), + ok = fun() -> F = fun(A) when not (A#r.a =:= 1) -> yes; (_) -> no @@ -103,14 +106,14 @@ t() -> ok end(), - a = fun(A) when record(A, r), - A#r.a =:= 1, - A#r.b =:= 2 ->a - end(#r{a = 1, b = 2}), - a = fun(A) when erlang:is_record(A, r), - A#r.a =:= 1, - A#r.b =:= 2 -> a - end(#r{a = 1, b = 2}), + a = rec_call(fun(A) when record(A, r), + A#r.a =:= 1, + A#r.b =:= 2 -> a + end, #r{a = 1, b = 2}), + a = rec_call(fun(A) when erlang:is_record(A, r), + A#r.a =:= 1, + A#r.b =:= 2 -> a + end, #r{a = 1, b = 2}), a = fun(A) when is_record(A, r), A#r.a =:= 1, A#r.b =:= 2 -> a @@ -144,8 +147,7 @@ t() -> ok end(), - both = fun(A) when A#r.a, A#r.b -> both - end(#r{a = true, b = true}), + both = rec_call(fun(A) when A#r.a, A#r.b -> both end, #r{a = true, b = true}), ok = fun() -> F = fun(A, B) when ((A#r1.a) orelse (B#r2.a)) @@ -176,3 +178,24 @@ t() -> ok. +rec_call(F, Rec) -> + Corrupted1 = setelement(1, Rec, wrong), + Corrupted2 = erlang:append_element(Rec, extra), + Corrupted3 = erlang:append_element(Corrupted1, extra), + fc(F, Corrupted1), + fc(F, Corrupted2), + fc(F, Corrupted3), + F(Rec). + +fc(F, Term) -> + try + F(Term), + error(expected_to_fail) + catch + error:function_clause -> + ok; + error:{case_clause,_} -> + Comp = ?MODULE:module_info(compile), + {_,Opts} = lists:keyfind(options, 1, Comp), + true = lists:member(inline, Opts) + end. diff --git a/lib/hipe/amd64/hipe_amd64_encode.erl b/lib/hipe/amd64/hipe_amd64_encode.erl index df15732cea..16bd705055 100644 --- a/lib/hipe/amd64/hipe_amd64_encode.erl +++ b/lib/hipe/amd64/hipe_amd64_encode.erl @@ -63,7 +63,7 @@ -export([% condition codes cc/1, % 8-bit registers - %% al/0, cl/0, dl/0, bl/0, ah/0, ch/0, dh/0, bh/0, + %% al/0, cl/0, dl/0, bl/0, % 32-bit registers %% eax/0, ecx/0, edx/0, ebx/0, esp/0, ebp/0, esi/0, edi/0, % operands @@ -127,19 +127,15 @@ cc(g) -> ?CC_G. -define(CL, 2#001). -define(DL, 2#010). -define(BL, 2#011). --define(AH, 2#100). --define(CH, 2#101). --define(DH, 2#110). --define(BH, 2#111). +-define(SPL, 2#100). +-define(BPL, 2#101). +-define(SIL, 2#110). +-define(DIL, 2#111). %% al() -> ?AL. %% cl() -> ?CL. %% dl() -> ?DL. %% bl() -> ?BL. -%% ah() -> ?AH. -%% ch() -> ?CH. -%% dh() -> ?DH. -%% bh() -> ?BH. %%% 32-bit registers @@ -208,6 +204,7 @@ rex_([]) -> 0; rex_([{r8, Reg8}| Rest]) -> % 8 bit registers case Reg8 of {rm_mem, _} -> rex_(Rest); + {rm_reg, R} -> rex_([{r8, R} | Rest]); 4 -> (1 bsl 8) bor rex_(Rest); 5 -> (1 bsl 8) bor rex_(Rest); 6 -> (1 bsl 8) bor rex_(Rest); @@ -825,12 +822,26 @@ shd_op_encode(Opcode, Opnds) -> test_encode(Opnds) -> case Opnds of + {al, {imm8,Imm8}} -> + [16#A8, Imm8]; + {ax, {imm16,Imm16}} -> + [?PFX_OPND_16BITS, 16#A9 | le16(Imm16, [])]; {eax, {imm32,Imm32}} -> [16#A9 | le32(Imm32, [])]; + {rax, {imm32,Imm32}} -> + [rex([{w,1}]), 16#A9 | le32(Imm32, [])]; + {{rm8,RM8}, {imm8,Imm8}} -> + [rex([{r8,RM8}]), 16#F6 | encode_rm(RM8, 2#000, [Imm8])]; + {{rm16,RM16}, {imm16,Imm16}} -> + [?PFX_OPND_16BITS, 16#F7 | encode_rm(RM16, 2#000, le16(Imm16, []))]; {{rm32,RM32}, {imm32,Imm32}} -> [16#F7 | encode_rm(RM32, 2#000, le32(Imm32, []))]; + {{rm64,RM64}, {imm32,Imm32}} -> + [rex([{w,1}]), 16#F7 | encode_rm(RM64, 2#000, le32(Imm32, []))]; {{rm32,RM32}, {reg32,Reg32}} -> - [16#85 | encode_rm(RM32, Reg32, [])] + [16#85 | encode_rm(RM32, Reg32, [])]; + {{rm64,RM64}, {reg64,Reg64}} -> + [rex([{w,1}]), 16#85 | encode_rm(RM64, Reg64, [])] end. %% test_sizeof(Opnds) -> @@ -1309,18 +1320,21 @@ dotest1(OS) -> Imm32 = {imm32,Word32}, Imm16 = {imm16,Word16}, Imm8 = {imm8,Word8}, + RM64 = {rm64,rm_reg(?EDX)}, RM32 = {rm32,rm_reg(?EDX)}, RM16 = {rm16,rm_reg(?EDX)}, RM8 = {rm8,rm_reg(?EDX)}, + RM8REX = {rm8,rm_reg(?SIL)}, Rel32 = {rel32,Word32}, Rel8 = {rel8,Word8}, Moffs32 = {moffs32,Word32}, Moffs16 = {moffs16,Word32}, Moffs8 = {moffs8,Word32}, CC = {cc,?CC_G}, + Reg64 = {reg64,?EAX}, Reg32 = {reg32,?EAX}, Reg16 = {reg16,?EAX}, - Reg8 = {reg8,?AH}, + Reg8 = {reg8,?SPL}, EA = {ea,ea_base(?ECX)}, % exercise each instruction definition t(OS,'adc',{eax,Imm32}), @@ -1465,9 +1479,17 @@ dotest1(OS) -> t(OS,'sub',{RM32,Imm8}), t(OS,'sub',{RM32,Reg32}), t(OS,'sub',{Reg32,RM32}), + t(OS,'test',{al,Imm8}), + t(OS,'test',{ax,Imm16}), t(OS,'test',{eax,Imm32}), + t(OS,'test',{rax,Imm32}), + t(OS,'test',{RM8,Imm8}), + t(OS,'test',{RM8REX,Imm8}), + t(OS,'test',{RM16,Imm16}), t(OS,'test',{RM32,Imm32}), + t(OS,'test',{RM64,Imm32}), t(OS,'test',{RM32,Reg32}), + t(OS,'test',{RM64,Reg64}), t(OS,'xor',{eax,Imm32}), t(OS,'xor',{RM32,Imm32}), t(OS,'xor',{RM32,Imm8}), diff --git a/lib/hipe/arm/hipe_rtl_to_arm.erl b/lib/hipe/arm/hipe_rtl_to_arm.erl index 2f9181d517..c964c222aa 100644 --- a/lib/hipe/arm/hipe_rtl_to_arm.erl +++ b/lib/hipe/arm/hipe_rtl_to_arm.erl @@ -62,7 +62,6 @@ conv_insn(I, Map, Data) -> case I of #alu{} -> conv_alu(I, Map, Data); #alub{} -> conv_alub(I, Map, Data); - #branch{} -> conv_branch(I, Map, Data); #call{} -> conv_call(I, Map, Data); #comment{} -> conv_comment(I, Map, Data); #enter{} -> conv_enter(I, Map, Data); @@ -111,6 +110,17 @@ commute_arithop(ArithOp) -> _ -> ArithOp end. +conv_cmpop('add') -> 'cmn'; +conv_cmpop('sub') -> 'cmp'; +conv_cmpop('and') -> 'tst'; +conv_cmpop('xor') -> 'teq'; +conv_cmpop(_) -> none. + +cmpop_commutes('cmp') -> false; +cmpop_commutes('cmn') -> true; +cmpop_commutes('tst') -> true; +cmpop_commutes('teq') -> true. + mk_alu(S, Dst, Src1, RtlAluOp, Src2) -> case hipe_rtl:is_shift_op(RtlAluOp) of true -> @@ -223,71 +233,77 @@ fix_aluop_imm(AluOp, Imm) -> % {FixAm1,NewAluOp,Am1} conv_alub(I, Map, Data) -> %% dst = src1 aluop src2; if COND goto label - {Dst, Map0} = conv_dst(hipe_rtl:alub_dst(I), Map), - {Src1, Map1} = conv_src(hipe_rtl:alub_src1(I), Map0), - {Src2, Map2} = conv_src(hipe_rtl:alub_src2(I), Map1), + {Src1, Map0} = conv_src(hipe_rtl:alub_src1(I), Map), + {Src2, Map1} = conv_src(hipe_rtl:alub_src2(I), Map0), RtlAluOp = hipe_rtl:alub_op(I), - Cond0 = conv_alub_cond(RtlAluOp, hipe_rtl:alub_cond(I)), - Cond = - case {RtlAluOp,Cond0} of - {'mul','vs'} -> 'ne'; % overflow becomes not-equal - {'mul','vc'} -> 'eq'; % no-overflow becomes equal - {'mul',_} -> exit({?MODULE,I}); - {_,_} -> Cond0 - end, - I2 = mk_pseudo_bc( - Cond, - hipe_rtl:alub_true_label(I), - hipe_rtl:alub_false_label(I), - hipe_rtl:alub_pred(I)), - S = true, - I1 = mk_alu(S, Dst, Src1, RtlAluOp, Src2), - {I1 ++ I2, Map2, Data}. - -conv_branch(I, Map, Data) -> - %% <unused> = src1 - src2; if COND goto label - {Src1, Map0} = conv_src(hipe_rtl:branch_src1(I), Map), - {Src2, Map1} = conv_src(hipe_rtl:branch_src2(I), Map0), - Cond = conv_branch_cond(hipe_rtl:branch_cond(I)), - I2 = mk_branch(Src1, Cond, Src2, - hipe_rtl:branch_true_label(I), - hipe_rtl:branch_false_label(I), - hipe_rtl:branch_pred(I)), - {I2, Map1, Data}. + RtlCond = hipe_rtl:alub_cond(I), + HasDst = hipe_rtl:alub_has_dst(I), + CmpOp = conv_cmpop(RtlAluOp), + Cond0 = conv_alub_cond(RtlAluOp, RtlCond), + case (not HasDst) andalso CmpOp =/= none of + true -> + I1 = mk_branch(Src1, CmpOp, Src2, Cond0, + hipe_rtl:alub_true_label(I), + hipe_rtl:alub_false_label(I), + hipe_rtl:alub_pred(I)), + {I1, Map1, Data}; + false -> + {Dst, Map2} = + case HasDst of + false -> {new_untagged_temp(), Map1}; + true -> conv_dst(hipe_rtl:alub_dst(I), Map1) + end, + Cond = + case {RtlAluOp,Cond0} of + {'mul','vs'} -> 'ne'; % overflow becomes not-equal + {'mul','vc'} -> 'eq'; % no-overflow becomes equal + {'mul',_} -> exit({?MODULE,I}); + {_,_} -> Cond0 + end, + I2 = mk_pseudo_bc( + Cond, + hipe_rtl:alub_true_label(I), + hipe_rtl:alub_false_label(I), + hipe_rtl:alub_pred(I)), + S = true, + I1 = mk_alu(S, Dst, Src1, RtlAluOp, Src2), + {I1 ++ I2, Map2, Data} + end. -mk_branch(Src1, Cond, Src2, TrueLab, FalseLab, Pred) -> +mk_branch(Src1, CmpOp, Src2, Cond, TrueLab, FalseLab, Pred) -> case hipe_arm:is_temp(Src1) of true -> case hipe_arm:is_temp(Src2) of true -> - mk_branch_rr(Src1, Src2, Cond, TrueLab, FalseLab, Pred); + mk_branch_rr(Src1, CmpOp, Src2, Cond, TrueLab, FalseLab, Pred); _ -> - mk_branch_ri(Src1, Cond, Src2, TrueLab, FalseLab, Pred) + mk_branch_ri(Src1, CmpOp, Src2, Cond, TrueLab, FalseLab, Pred) end; _ -> case hipe_arm:is_temp(Src2) of true -> - NewCond = commute_cond(Cond), - mk_branch_ri(Src2, NewCond, Src1, TrueLab, FalseLab, Pred); + NewCond = + case cmpop_commutes(CmpOp) of + true -> Cond; + false -> commute_cond(Cond) + end, + mk_branch_ri(Src2, CmpOp, Src1, NewCond, TrueLab, FalseLab, Pred); _ -> - mk_branch_ii(Src1, Cond, Src2, TrueLab, FalseLab, Pred) + mk_branch_ii(Src1, CmpOp, Src2, Cond, TrueLab, FalseLab, Pred) end end. -mk_branch_ii(Imm1, Cond, Imm2, TrueLab, FalseLab, Pred) -> +mk_branch_ii(Imm1, CmpOp, Imm2, Cond, TrueLab, FalseLab, Pred) -> Tmp = new_untagged_temp(), mk_li(Tmp, Imm1, - mk_branch_ri(Tmp, Cond, Imm2, + mk_branch_ri(Tmp, CmpOp, Imm2, Cond, TrueLab, FalseLab, Pred)). -mk_branch_ri(Src, Cond, Imm, TrueLab, FalseLab, Pred) -> - {FixAm1,NewCmpOp,Am1} = fix_aluop_imm('cmp', Imm), - FixAm1 ++ mk_cmp_bc(NewCmpOp, Src, Am1, Cond, TrueLab, FalseLab, Pred). - -mk_branch_rr(Src1, Src2, Cond, TrueLab, FalseLab, Pred) -> - mk_cmp_bc('cmp', Src1, Src2, Cond, TrueLab, FalseLab, Pred). +mk_branch_ri(Src, CmpOp, Imm, Cond, TrueLab, FalseLab, Pred) -> + {FixAm1,NewCmpOp,Am1} = fix_aluop_imm(CmpOp, Imm), + FixAm1 ++ mk_branch_rr(Src, NewCmpOp, Am1, Cond, TrueLab, FalseLab, Pred). -mk_cmp_bc(CmpOp, Src, Am1, Cond, TrueLab, FalseLab, Pred) -> +mk_branch_rr(Src, CmpOp, Am1, Cond, TrueLab, FalseLab, Pred) -> [hipe_arm:mk_cmp(CmpOp, Src, Am1) | mk_pseudo_bc(Cond, TrueLab, FalseLab, Pred)]. @@ -637,6 +653,7 @@ conv_alub_cond(RtlAluOp, Cond) -> % may be unsigned, depends on aluop case {RtlAluOp, Cond} of % handle allowed alub unsigned conditions {'add', 'ltu'} -> 'hs'; % add+ltu == unsigned overflow == carry set == hs %% add more cases when needed + {'sub', _} -> conv_branch_cond(Cond); _ -> conv_cond(Cond) end. diff --git a/lib/hipe/icode/hipe_icode.erl b/lib/hipe/icode/hipe_icode.erl index 78508dff22..d2d08e0253 100644 --- a/lib/hipe/icode/hipe_icode.erl +++ b/lib/hipe/icode/hipe_icode.erl @@ -438,6 +438,7 @@ if_true_label/1, if_false_label/1, if_args/1, + if_args_update/2, if_pred/1, %% is_if/1, @@ -594,6 +595,7 @@ uses/1, defines/1, is_safe/1, + reduce_unused/1, strip_comments/1, subst/2, subst_uses/2, @@ -713,6 +715,9 @@ if_op_update(IF, NewOp) -> IF#icode_if{op=NewOp}. -spec if_args(#icode_if{}) -> [icode_term_arg()]. if_args(#icode_if{args=Args}) -> Args. +-spec if_args_update(#icode_if{}, [icode_term_arg()]) -> #icode_if{}. +if_args_update(IF, Args) -> IF#icode_if{args=Args}. + -spec if_true_label(#icode_if{}) -> icode_lbl(). if_true_label(#icode_if{true_label=TrueLbl}) -> TrueLbl. @@ -1765,6 +1770,18 @@ is_safe(Instr) -> #icode_end_try{} -> false end. +%% @doc Produces a simplified instruction sequence that is equivalent to [Instr] +%% under the assumption that all results of Instr are unused, or 'false' if +%% there is no such sequence (other than [Instr] itself). + +-spec reduce_unused(icode_instr()) -> false | [icode_instr()]. + +reduce_unused(Instr) -> + case is_safe(Instr) of + true -> []; + false -> false + end. + %%----------------------------------------------------------------------- -spec highest_var(icode_instrs()) -> non_neg_integer(). diff --git a/lib/hipe/icode/hipe_icode_ssa_const_prop.erl b/lib/hipe/icode/hipe_icode_ssa_const_prop.erl index 4ab4d7e95d..5d3d5413bc 100644 --- a/lib/hipe/icode/hipe_icode_ssa_const_prop.erl +++ b/lib/hipe/icode/hipe_icode_ssa_const_prop.erl @@ -97,11 +97,13 @@ visit_expression(Instruction, Environment) -> visit_begin_handler (Instruction, EvaluatedArguments, Environment); #icode_begin_try{} -> visit_begin_try (Instruction, EvaluatedArguments, Environment); - #icode_fail{} -> + #icode_fail{} -> visit_fail (Instruction, EvaluatedArguments, Environment); - _ -> - %% label, end_try, comment, return, - {[], [], Environment} + #icode_comment{} -> {[], [], Environment}; + #icode_end_try{} -> {[], [], Environment}; + #icode_enter{} -> {[], [], Environment}; + #icode_label{} -> {[], [], Environment}; + #icode_return{} -> {[], [], Environment} end. %%----------------------------------------------------------------------------- @@ -463,11 +465,15 @@ update_instruction(Instruction, Environment) -> update_type(Instruction, Environment); #icode_switch_tuple_arity{} -> update_switch_tuple_arity(Instruction, Environment); - _ -> - %% goto, comment, label, return, begin_handler, end_try, - %% begin_try, fail - %% We could but don't handle: catch?, fail? - [Instruction] + %% We could but don't handle: catch?, fail? + #icode_begin_handler{} -> [Instruction]; + #icode_begin_try{} -> [Instruction]; + #icode_comment{} -> [Instruction]; + #icode_end_try{} -> [Instruction]; + #icode_fail{} -> [Instruction]; + #icode_goto{} -> [Instruction]; + #icode_label{} -> [Instruction]; + #icode_return{} -> [Instruction] end. %%----------------------------------------------------------------------------- @@ -502,14 +508,12 @@ update_call(Instruction, Environment) -> [Instruction, NewInstructions]), NewInstructions end; -%% %% [] -> %% No destination; we don't touch this -%% [] -> -%% NewArguments = update_arguments(hipe_icode:call_args(Instruction), -%% Environment), -%% [hipe_icode:call_args_update(Instruction, NewArguments)]; + %% [] -> %% No destination; we don't touch this %% List-> %% Means register allocation; not implemented at this point _ -> - [Instruction] + NewArguments = update_arguments(hipe_icode:call_args(Instruction), + Environment), + [hipe_icode:call_args_update(Instruction, NewArguments)] end. %%----------------------------------------------------------------------------- @@ -574,7 +578,9 @@ update_if(Instruction, Environment) -> %% Convert the if-test to a type test if possible. Op = hipe_icode:if_op(Instruction), case Op =:= '=:=' orelse Op =:= '=/=' of - false -> [Instruction]; + false -> + [hipe_icode:if_args_update( + Instruction, update_arguments(Args, Environment))]; true -> [Arg1, Arg2] = Args, case EvaluatedArguments of @@ -604,8 +610,9 @@ conv_if_to_type(I, Const, Arg) when is_atom(Const); NewI = hipe_icode:mk_type([Arg], Test, T, F), ?CONST_PROP_MSG("if: ~w ---> type ~w\n", [I, NewI]), [NewI]; -conv_if_to_type(I, _, _) -> - [I]. +conv_if_to_type(I, Const, Arg) -> + %% Note: we are potentially commuting the (equality) comparison here + [hipe_icode:if_args_update(I, [Arg, hipe_icode:mk_const(Const)])]. %%----------------------------------------------------------------------------- diff --git a/lib/hipe/llvm/hipe_llvm_main.erl b/lib/hipe/llvm/hipe_llvm_main.erl index c8fc9cc856..0957dd4df2 100644 --- a/lib/hipe/llvm/hipe_llvm_main.erl +++ b/lib/hipe/llvm/hipe_llvm_main.erl @@ -84,7 +84,7 @@ compile_with_llvm(FunName, Arity, LLVMCode, Options, UseBuffer) -> __ = file:close(File_llvm), %% Invoke LLVM compiler tools to produce an object file llvm_opt(Dir, Filename, Options), - llvm_llc(Dir, Filename, Options), + llvm_llc(Dir, Filename, Ver, Options), compile(Dir, Filename, "gcc"), %%FIXME: use llc -filetype=obj and skip this! {ok, Dir, Dir ++ Filename ++ ".o"}. @@ -103,12 +103,14 @@ llvm_opt(Dir, Filename, Options) -> %% @doc Invoke llc tool to compile the bitcode to object file %% (_name.bc -> _name.o). -llvm_llc(Dir, Filename, Options) -> +llvm_llc(Dir, Filename, Ver, Options) -> Source = Dir ++ Filename ++ ".bc", OptLevel = trans_optlev_flag(llc, Options), + VerFlags = llc_ver_flags(Ver), Align = find_stack_alignment(), LlcFlags = [OptLevel, "-code-model=medium", "-stack-alignment=" ++ Align - , "-tailcallopt", "-filetype=asm"], %%FIXME + , "-tailcallopt", "-filetype=asm" %FIXME + | VerFlags], Command = "llc " ++ fix_opts(LlcFlags) ++ " " ++ Source, %% io:format("LLC: ~s~n", [Command]), case os:cmd(Command) of @@ -153,6 +155,12 @@ trans_optlev_flag(Tool, Options) -> undefined -> "-O2" end. +llc_ver_flags(Ver = {_, _}) when Ver >= {3,9} -> + %% Works around a bug in the x86-call-frame-opt pass (as of LLVM 3.9) that + %% break the garbage collection stack descriptors. + ["-no-x86-call-frame-opt"]; +llc_ver_flags({_, _}) -> []. + %%------------------------------------------------------------------------------ %% Functions to manage Relocations %%------------------------------------------------------------------------------ diff --git a/lib/hipe/llvm/hipe_rtl_to_llvm.erl b/lib/hipe/llvm/hipe_rtl_to_llvm.erl index 53aa8c57b2..f8911c1909 100644 --- a/lib/hipe/llvm/hipe_rtl_to_llvm.erl +++ b/lib/hipe/llvm/hipe_rtl_to_llvm.erl @@ -10,7 +10,8 @@ -include("../rtl/hipe_literals.hrl"). -include("hipe_llvm_arch.hrl"). --define(WORD_WIDTH, (?bytes_to_bits(hipe_rtl_arch:word_size()))). +-define(BITS_IN_WORD, (?bytes_to_bits(hipe_rtl_arch:word_size()))). +-define(BITS_IN_BYTE, (?bytes_to_bits(1))). -define(BRANCH_META_TAKEN, "0"). -define(BRANCH_META_NOT_TAKEN, "1"). -define(FIRST_FREE_META_NO, 2). @@ -95,9 +96,9 @@ do_alloca_stack([], _, _, Acc) -> Acc; do_alloca_stack([D|Ds], Params, Roots, Acc) -> {Name, _I} = trans_dst(D), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), - ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(?BITS_IN_BYTE)), case hipe_rtl:is_var(D) of true -> Num = hipe_rtl:var_index(D), @@ -155,9 +156,6 @@ translate_instr(I, Relocs, Data) -> #alub{} -> {I2, Relocs2} = trans_alub(I, Relocs), {I2, Relocs2, Data}; - #branch{} -> - {I2, Relocs2} = trans_branch(I, Relocs), - {I2, Relocs2, Data}; #call{} -> {I2, Relocs2} = case hipe_rtl:call_fun(I) of @@ -233,7 +231,7 @@ trans_alu(I, Relocs) -> {Src1, I1} = trans_src(hipe_rtl:alu_src1(I)), {Src2, I2} = trans_src(hipe_rtl:alu_src2(I)), Op = trans_op(hipe_rtl:alu_op(I)), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), I3 = hipe_llvm:mk_operation(TmpDst, Op, WordTy, Src1, Src2, []), I4 = store_stack_dst(TmpDst, RtlDst), {[I4, I3, I2, I1], Relocs}. @@ -254,18 +252,20 @@ trans_alub(I, Relocs) -> trans_alub_overflow(I, Sign, Relocs) -> {Src1, I1} = trans_src(hipe_rtl:alub_src1(I)), {Src2, I2} = trans_src(hipe_rtl:alub_src2(I)), - RtlDst = hipe_rtl:alub_dst(I), TmpDst = mk_temp(), Name = trans_alub_op(I, Sign), NewRelocs = relocs_store(Name, {call, remote, {llvm, Name, 2}}, Relocs), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), ReturnType = hipe_llvm:mk_struct([WordTy, hipe_llvm:mk_int(1)]), T1 = mk_temp(), I3 = hipe_llvm:mk_call(T1, false, [], [], ReturnType, "@" ++ Name, [{WordTy, Src1}, {WordTy, Src2}], []), %% T1{0}: result of the operation I4 = hipe_llvm:mk_extractvalue(TmpDst, ReturnType, T1 , "0", []), - I5 = store_stack_dst(TmpDst, RtlDst), + I5 = case hipe_rtl:alub_has_dst(I) of + false -> []; + true -> store_stack_dst(TmpDst, hipe_rtl:alub_dst(I)) + end, T2 = mk_temp(), %% T1{1}: Boolean variable indicating overflow I6 = hipe_llvm:mk_extractvalue(T2, ReturnType, T1, "1", []), @@ -310,42 +310,35 @@ trans_alub_op(I, Sign) -> Name ++ Type. trans_alub_no_overflow(I, Relocs) -> + {Src1, I1} = trans_src(hipe_rtl:alub_src1(I)), + {Src2, I2} = trans_src(hipe_rtl:alub_src2(I)), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), %% alu - T = hipe_rtl:mk_alu(hipe_rtl:alub_dst(I), hipe_rtl:alub_src1(I), - hipe_rtl:alub_op(I), hipe_rtl:alub_src2(I)), - %% A trans_alu instruction cannot change relocations - {I1, _} = trans_alu(T, Relocs), + {CmpLhs, CmpRhs, I5, Cond} = + case {hipe_rtl:alub_has_dst(I), hipe_rtl:alub_op(I)} of + {false, 'sub'} -> + Cond0 = trans_branch_rel_op(hipe_rtl:alub_cond(I)), + {Src1, Src2, [], Cond0}; + {HasDst, AlubOp} -> + TmpDst = mk_temp(), + Op = trans_op(AlubOp), + I3 = hipe_llvm:mk_operation(TmpDst, Op, WordTy, Src1, Src2, []), + I4 = case HasDst of + false -> []; + true -> store_stack_dst(TmpDst, hipe_rtl:alub_dst(I)) + end, + Cond0 = trans_alub_rel_op(hipe_rtl:alub_cond(I)), + {TmpDst, "0", [I4, I3], Cond0} + end, %% icmp - %% Translate destination as src, to match with the semantics of instruction - {Dst, I2} = trans_src(hipe_rtl:alub_dst(I)), - Cond = trans_rel_op(hipe_rtl:alub_cond(I)), T3 = mk_temp(), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), - I5 = hipe_llvm:mk_icmp(T3, Cond, WordTy, Dst, "0"), + I6 = hipe_llvm:mk_icmp(T3, Cond, WordTy, CmpLhs, CmpRhs), %% br Metadata = branch_metadata(hipe_rtl:alub_pred(I)), True_label = mk_jump_label(hipe_rtl:alub_true_label(I)), False_label = mk_jump_label(hipe_rtl:alub_false_label(I)), - I6 = hipe_llvm:mk_br_cond(T3, True_label, False_label, Metadata), - {[I6, I5, I2, I1], Relocs}. - -%% -%% branch -%% -trans_branch(I, Relocs) -> - {Src1, I1} = trans_src(hipe_rtl:branch_src1(I)), - {Src2, I2} = trans_src(hipe_rtl:branch_src2(I)), - Cond = trans_rel_op(hipe_rtl:branch_cond(I)), - %% icmp - T1 = mk_temp(), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), - I3 = hipe_llvm:mk_icmp(T1, Cond, WordTy, Src1, Src2), - %% br - True_label = mk_jump_label(hipe_rtl:branch_true_label(I)), - False_label = mk_jump_label(hipe_rtl:branch_false_label(I)), - Metadata = branch_metadata(hipe_rtl:branch_pred(I)), - I4 = hipe_llvm:mk_br_cond(T1, True_label, False_label, Metadata), - {[I4, I3, I2, I1], Relocs}. + I7 = hipe_llvm:mk_br_cond(T3, True_label, False_label, Metadata), + {[I7, I6, I5, I2, I1], Relocs}. branch_metadata(X) when X =:= 0.5 -> []; branch_metadata(X) when X > 0.5 -> ?BRANCH_META_TAKEN; @@ -366,7 +359,7 @@ trans_call(I, Relocs) -> {Name, I3, Relocs2} = trans_call_name(RtlCallName, hipe_rtl:call_type(I), Relocs1, CallArgs, FinalArgs), T1 = mk_temp(), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), I4 = case hipe_rtl:call_fail(I) of @@ -450,7 +443,7 @@ trans_call_name(RtlCallName, RtlCallType, Relocs, CallArgs, FinalArgs) -> %% order to make the call TT1 = mk_temp(), {RegName, II1} = trans_src(Reg), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), II2 = hipe_llvm:mk_conversion(TT1, inttoptr, WordTy, RegName, WordTyPtr), @@ -503,7 +496,7 @@ trans_enter(I, Relocs) -> {Name, I2, NewRelocs} = trans_call_name(hipe_rtl:enter_fun(I), hipe_rtl:enter_type(I), Relocs, CallArgs, FinalArgs), T1 = mk_temp(), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), I3 = hipe_llvm:mk_call(T1, true, "cc 11", [], FunRetTy, Name, FinalArgs, []), I4 = hipe_llvm:mk_ret([{FunRetTy, T1}]), @@ -518,7 +511,7 @@ trans_fconv(I, Relocs) -> TmpDst = mk_temp(), {Src, I1} = trans_float_src(hipe_rtl:fconv_src(I)), FloatTy = hipe_llvm:mk_double(), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), I2 = hipe_llvm:mk_conversion(TmpDst, sitofp, WordTy, Src, FloatTy), I3 = store_float_stack(TmpDst, RtlDst), {[I3, I2, I1], Relocs}. @@ -538,7 +531,7 @@ trans_fload(I, Relocs) -> {Src, I1} = trans_float_src(RtlSrc), {Offset, I2} = trans_float_src(_Offset), T1 = mk_temp(), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), FloatTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_double()), I3 = hipe_llvm:mk_operation(T1, add, WordTy, Src, Offset, []), T2 = mk_temp(), @@ -619,7 +612,7 @@ trans_fstore(I, Relocs) -> trans_fstore_reg(I, Relocs) -> {Base, I0} = trans_reg(hipe_rtl:fstore_base(I), dst), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), FloatTy = hipe_llvm:mk_double(), FloatTyPtr = hipe_llvm:mk_pointer(FloatTy), @@ -659,7 +652,7 @@ trans_load(I, Relocs) -> {Src, I1} = trans_src(hipe_rtl:load_src(I)), {Offset, I2} = trans_src(hipe_rtl:load_offset(I)), T1 = mk_temp(), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), I3 = hipe_llvm:mk_operation(T1, add, WordTy, Src, Offset, []), %%---------------------------------------------------------------- @@ -737,7 +730,7 @@ trans_move(I, Relocs) -> %% return %% trans_return(I, Relocs) -> - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), {VarRet, I1} = case hipe_rtl:return_varlist(I) of [] -> @@ -777,7 +770,7 @@ trans_store(I, Relocs) -> {Offset, I2} = trans_src(hipe_rtl:store_offset(I)), {Value, I3} = trans_src(hipe_rtl:store_src(I)), T1 = mk_temp(), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), I4 = hipe_llvm:mk_operation(T1, add, WordTy, Base, Offset, []), I5 = @@ -811,14 +804,14 @@ trans_switch(I, Relocs, Data) -> JumpLabels = [mk_jump_label(L) || L <- Labels], SortOrder = hipe_rtl:switch_sort_order(I), NrLabels = length(Labels), - ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(?BITS_IN_BYTE)), TableType = hipe_llvm:mk_array(NrLabels, ByteTyPtr), TableTypeP = hipe_llvm:mk_pointer(TableType), TypedJumpLabels = [{hipe_llvm:mk_label_type(), X} || X <- JumpLabels], T1 = mk_temp(), {Src2, []} = trans_dst(RtlSrc), TableName = "table_" ++ tl(Src2), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), I2 = hipe_llvm:mk_getelementptr(T1, TableTypeP, "@"++TableName, [{WordTy, "0"}, {WordTy, Src}], false), T2 = mk_temp(), @@ -933,7 +926,7 @@ create_fail_blocks(Label, FailLabels, Acc) -> false -> Acc; {value, {Label, FailLabel, SpAdj}, RestFailLabels} -> - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), I1 = hipe_llvm:mk_label(FailLabel), LP = hipe_llvm:mk_landingpad(), I2 = @@ -962,7 +955,7 @@ create_fail_blocks(Label, FailLabels, Acc) -> %% @doc Convert RTL argument list to LLVM argument list. trans_args(ArgList) -> - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), MakeArg = fun(A) -> {Name, I1} = trans_src(A), @@ -972,13 +965,13 @@ trans_args(ArgList) -> %% @doc Convert a list of Precoloured registers to LLVM argument list. fix_reg_args(ArgList) -> - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), [{WordTy, A} || A <- ArgList]. %% @doc Load Precoloured registers. load_fixed_regs(RegList) -> Names = [mk_temp_reg(R) || R <- RegList], - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), Fun1 = fun (X, Y) -> @@ -991,7 +984,7 @@ load_fixed_regs(RegList) -> store_fixed_regs(RegList, Name) -> Names = [mk_temp_reg(R) || R <- RegList], Indexes = lists:seq(0, erlang:length(RegList) - 1), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), Fun1 = @@ -1064,7 +1057,7 @@ mk_temp_reg(Name) -> store_stack_dst(TempDst, Dst) -> {Dst2, II1} = trans_dst(Dst), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), II2 = hipe_llvm:mk_store(WordTy, TempDst, WordTyPtr, Dst2, [], [], false), [II2, II1]. @@ -1082,7 +1075,7 @@ trans_float_src(Src) -> Name = "@DL" ++ integer_to_list(hipe_rtl:const_label_label(Src)), T1 = mk_temp(), %% XXX: Hardcoded offset - ByteTy = hipe_llvm:mk_int(8), + ByteTy = hipe_llvm:mk_int(?BITS_IN_BYTE), ByteTyPtr = hipe_llvm:mk_pointer(ByteTy), I1 = hipe_llvm:mk_getelementptr(T1, ByteTyPtr, Name, [{ByteTy, integer_to_list(?FLOAT_OFFSET)}], true), @@ -1098,7 +1091,7 @@ trans_float_src(Src) -> end. trans_src(A) -> - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), case hipe_rtl:is_imm(A) of true -> @@ -1161,7 +1154,7 @@ trans_dst(A) -> true -> "%DL" ++ integer_to_list(hipe_rtl:const_label_label(A)) ++ "_var"; false -> - exit({?MODULE, trans_dst, {"Bad RTL argument",A}}) + error(badarg, [A]) end end end, @@ -1201,7 +1194,7 @@ map_precoloured_reg(Index) -> fix_reg_dst(Register) -> case Register of {Name, Offset} -> %% Case of %fcalls, %hplim - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), pointer_from_reg(Name, WordTy, Offset); Name -> %% Case of %p and %hp {Name, []} @@ -1209,7 +1202,7 @@ fix_reg_dst(Register) -> %% @doc Load precoloured src register. fix_reg_src(Register) -> - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), case Register of {Name, Offset} -> %% Case of %fcalls, %hplim @@ -1259,14 +1252,19 @@ trans_op(Op) -> Other -> exit({?MODULE, trans_op, {"Unknown RTL operator", Other}}) end. -trans_rel_op(Op) -> +trans_branch_rel_op(Op) -> case Op of - eq -> eq; - ne -> ne; gtu -> ugt; geu -> uge; ltu -> ult; leu -> ule; + _ -> trans_alub_rel_op(Op) + end. + +trans_alub_rel_op(Op) -> + case Op of + eq -> eq; + ne -> ne; gt -> sgt; ge -> sge; lt -> slt; @@ -1299,7 +1297,10 @@ insn_dst(I) -> #alu{} -> [hipe_rtl:alu_dst(I)]; #alub{} -> - [hipe_rtl:alub_dst(I)]; + case hipe_rtl:alub_has_dst(I) of + true -> [hipe_rtl:alub_dst(I)]; + false -> [] + end; #call{} -> case hipe_rtl:call_dstlist(I) of [] -> []; @@ -1331,10 +1332,10 @@ insn_dst(I) -> llvm_type_from_size(Size) -> case Size of - byte -> hipe_llvm:mk_int(8); + byte -> hipe_llvm:mk_int(?BITS_IN_BYTE); int16 -> hipe_llvm:mk_int(16); int32 -> hipe_llvm:mk_int(32); - word -> hipe_llvm:mk_int(64) + word -> hipe_llvm:mk_int(?BITS_IN_WORD) end. %% @doc Create definition for the compiled function. The parameters that are @@ -1364,13 +1365,13 @@ create_function_definition(Fun, Params, Code, LocalVars) -> lists:flatten([EntryLabel, ExceptionSync, I2, LocalVars, StoredParams, I3]), Final_Code = EntryBlock ++ Code, FunctionOptions = [nounwind, noredzone, list_to_atom("gc \"erlang\"")], - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), hipe_llvm:mk_fun_def([], [], "cc 11", [], FunRetTy, FunctionName, Args, FunctionOptions, [], Final_Code). header_params(Params) -> - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), [{WordTy, "%v" ++ integer_to_list(hipe_rtl:var_index(P))} || P <- Params]. store_params(Params) -> @@ -1379,7 +1380,7 @@ store_params(Params) -> Index = hipe_rtl:var_index(X), {Name, _} = trans_dst(X), ParamName = "%v" ++ integer_to_list(Index), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), hipe_llvm:mk_store(WordTy, ParamName, WordTyPtr, Name, [], [], false) end, @@ -1396,11 +1397,11 @@ fixed_registers() -> end. header_regs(Registers) -> - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), [{WordTy, "%" ++ X ++ "_in"} || X <- Registers]. load_regs(Registers) -> - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), Fun1 = fun(X) -> @@ -1501,28 +1502,30 @@ seperate_relocs([R|Rs], CallAcc, AtomAcc, ClosureAcc, LabelAcc, JmpTableAcc) -> %% @doc External declaration of an atom. declare_atom({AtomName, _}) -> - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), - hipe_llvm:mk_const_decl("@" ++ AtomName, "external constant", WordTy, ""). + %% The type has to be byte, or a backend might assume the constant is aligned + %% and incorrectly optimise away type tests + ByteTy = hipe_llvm:mk_int(?BITS_IN_BYTE), + hipe_llvm:mk_const_decl("@" ++ AtomName, "external constant", ByteTy, ""). %% @doc Creation of local variable for an atom. load_atom({AtomName, _}) -> Dst = "%" ++ AtomName ++ "_var", Name = "@" ++ AtomName, - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), - WordTyPtr = hipe_llvm:mk_pointer(WordTy), - hipe_llvm:mk_conversion(Dst, ptrtoint, WordTyPtr, Name, WordTy). + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(?BITS_IN_BYTE)), + hipe_llvm:mk_conversion(Dst, ptrtoint, ByteTyPtr, Name, WordTy). %% @doc External declaration of a closure. declare_closure({ClosureName, _})-> - ByteTy = hipe_llvm:mk_int(8), + ByteTy = hipe_llvm:mk_int(?BITS_IN_BYTE), hipe_llvm:mk_const_decl("@" ++ ClosureName, "external constant", ByteTy, ""). %% @doc Creation of local variable for a closure. load_closure({ClosureName, _})-> Dst = "%" ++ ClosureName ++ "_var", Name = "@" ++ ClosureName, - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), - ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(?BITS_IN_BYTE)), hipe_llvm:mk_conversion(Dst, ptrtoint, ByteTyPtr, Name, WordTy). %% @doc Declaration of a local variable for a switch jump table. @@ -1553,7 +1556,7 @@ declare_closure_labels(ClosureLabels, Relocs, Fun) -> List3 = string:join(List2, ",\n"), List4 = "[\n" ++ List3 ++ "\n]\n", NrLabels = length(LabelList), - ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(?BITS_IN_BYTE)), TableType = hipe_llvm:mk_array(NrLabels, ByteTyPtr), ConstDecl = hipe_llvm:mk_const_decl("@table_closures", "constant", TableType, List4), @@ -1568,7 +1571,7 @@ is_external_call(_, _) -> true. call_to_decl({Name, {call, _, MFA}}) -> {M, _F, A} = MFA, CConv = "cc 11", - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), {Type, Args} = case M of @@ -1583,14 +1586,14 @@ call_to_decl({Name, {call, _, MFA}}) -> %% @doc These functions are always declared, even if not used. fixed_fun_decl() -> - ByteTy = hipe_llvm:mk_int(8), + ByteTy = hipe_llvm:mk_int(?BITS_IN_BYTE), ByteTyPtr = hipe_llvm:mk_pointer(ByteTy), LandPad = hipe_llvm:mk_fun_decl([], [], [], [], hipe_llvm:mk_int(32), "@__gcc_personality_v0", [hipe_llvm:mk_int(32), hipe_llvm:mk_int(64), ByteTyPtr, ByteTyPtr], []), GCROOTDecl = hipe_llvm:mk_fun_decl([], [], [], [], hipe_llvm:mk_void(), "@llvm.gcroot", [hipe_llvm:mk_pointer(ByteTyPtr), ByteTyPtr], []), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), FixPinnedRegs = hipe_llvm:mk_fun_decl([], [], [], [], FunRetTy, "@hipe_bifs.llvm_fix_pinned_regs.0", [], []), @@ -1604,7 +1607,7 @@ fixed_fun_decl() -> %% values, add the offset and convert them again to pointers. declare_constant(Label) -> Name = "@DL" ++ integer_to_list(Label), - ByteTy = hipe_llvm:mk_int(8), + ByteTy = hipe_llvm:mk_int(?BITS_IN_BYTE), hipe_llvm:mk_const_decl(Name, "external constant", ByteTy, ""). %% @doc Load a constant is achieved by converting a pointer to an integer of @@ -1612,8 +1615,8 @@ declare_constant(Label) -> load_constant(Label) -> Dst = "%DL" ++ integer_to_list(Label) ++ "_var", Name = "@DL" ++ integer_to_list(Label), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), - ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(?BITS_IN_BYTE)), hipe_llvm:mk_conversion(Dst, ptrtoint, ByteTyPtr, Name, WordTy). %% @doc Store external constants and calls to dictionary. diff --git a/lib/hipe/ppc/hipe_ppc_frame.erl b/lib/hipe/ppc/hipe_ppc_frame.erl index 8d37159ad8..58924409a8 100644 --- a/lib/hipe/ppc/hipe_ppc_frame.erl +++ b/lib/hipe/ppc/hipe_ppc_frame.erl @@ -98,7 +98,10 @@ do_pseudo_move(I, Context, FPoff) -> Offset = pseudo_offset(Src, FPoff, Context), mk_load(hipe_ppc:ldop_word(), Dst, Offset, mk_sp(), []); _ -> - [hipe_ppc:mk_alu('or', Dst, Src, Src)] + case hipe_ppc:temp_reg(Dst) =:= hipe_ppc:temp_reg(Src) of + true -> []; + false -> [hipe_ppc:mk_alu('or', Dst, Src, Src)] + end end end. diff --git a/lib/hipe/ppc/hipe_ppc_pp.erl b/lib/hipe/ppc/hipe_ppc_pp.erl index e69e6b64a2..0ff7a76bce 100644 --- a/lib/hipe/ppc/hipe_ppc_pp.erl +++ b/lib/hipe/ppc/hipe_ppc_pp.erl @@ -170,6 +170,12 @@ pp_insn(Dev, I, Pre) -> io:format(Dev, ", ", []), pp_temp(Dev, Base2), io:format(Dev, "\n", []); + #unary{unop={UnOp,I1,I2,I3}, dst=Dst, src=Src} -> + io:format(Dev, "\t~s ", [UnOp]), + pp_temp(Dev, Dst), + io:format(Dev, ", ", []), + pp_temp(Dev, Src), + io:format(Dev, ", ~s, ~s, ~s\n", [to_hex(I1),to_hex(I2),to_hex(I3)]); #unary{unop=UnOp, dst=Dst, src=Src} -> io:format(Dev, "\t~w ", [unop_name(UnOp)]), pp_temp(Dev, Dst), diff --git a/lib/hipe/ppc/hipe_rtl_to_ppc.erl b/lib/hipe/ppc/hipe_rtl_to_ppc.erl index a01e67a789..09f1ce5a49 100644 --- a/lib/hipe/ppc/hipe_rtl_to_ppc.erl +++ b/lib/hipe/ppc/hipe_rtl_to_ppc.erl @@ -80,7 +80,6 @@ conv_insn(I, Map, Data) -> case I of #alu{} -> conv_alu(I, Map, Data); #alub{} -> conv_alub(I, Map, Data); - #branch{} -> conv_branch(I, Map, Data); #call{} -> conv_call(I, Map, Data); #comment{} -> conv_comment(I, Map, Data); #enter{} -> conv_enter(I, Map, Data); @@ -441,36 +440,53 @@ mk_alu_rr(Dst, Src1, RtlAluOp, Src2) -> conv_alub(I, Map, Data) -> %% dst = src1 aluop src2; if COND goto label - {Dst, Map0} = conv_dst(hipe_rtl:alub_dst(I), Map), - {Src1, Map1} = conv_src(hipe_rtl:alub_src1(I), Map0), - {Src2, Map2} = conv_src(hipe_rtl:alub_src2(I), Map1), - {AluOp, BCond} = - case {hipe_rtl:alub_op(I), hipe_rtl:alub_cond(I)} of - {'add', 'ltu'} -> - {'addc', 'eq'}; - {RtlAlubOp, RtlAlubCond} -> - {conv_alub_op(RtlAlubOp), conv_alub_cond(RtlAlubCond)} - end, - BC = mk_pseudo_bc(BCond, - hipe_rtl:alub_true_label(I), - hipe_rtl:alub_false_label(I), - hipe_rtl:alub_pred(I)), - I2 = - case {AluOp, BCond} of - {'addc', 'eq'} -> % copy XER[CA] to CR0[EQ] before the BC - TmpR = new_untagged_temp(), - [hipe_ppc:mk_mfspr(TmpR, 'xer'), - hipe_ppc:mk_mtcr(TmpR) | - BC]; - _ -> BC - end, - {NewSrc1, NewSrc2} = - case AluOp of - 'subf' -> {Src2, Src1}; - _ -> {Src1, Src2} - end, - I1 = mk_alub(Dst, NewSrc1, AluOp, NewSrc2, BCond), - {I1 ++ I2, Map2, Data}. + HasDst = hipe_rtl:alub_has_dst(I), + {Src1, Map0} = conv_src(hipe_rtl:alub_src1(I), Map), + {Src2, Map1} = conv_src(hipe_rtl:alub_src2(I), Map0), + RtlAlubOp = hipe_rtl:alub_op(I), + RtlAlubCond = hipe_rtl:alub_cond(I), + case {HasDst, RtlAlubOp} of + {false, sub} -> + {BCond,Sign} = conv_branch_cond(RtlAlubCond), + I2 = mk_branch(Src1, BCond, Sign, Src2, + hipe_rtl:alub_true_label(I), + hipe_rtl:alub_false_label(I), + hipe_rtl:alub_pred(I)), + {I2, Map1, Data}; + _ -> + {Dst, Map2} = + case HasDst of + false -> {new_untagged_temp(), Map1}; + true -> conv_dst(hipe_rtl:alub_dst(I), Map1) + end, + {AluOp, BCond} = + case {RtlAlubOp, RtlAlubCond} of + {'add', 'ltu'} -> + {'addc', 'eq'}; + {_, _} -> + {conv_alub_op(RtlAlubOp), conv_alub_cond(RtlAlubCond)} + end, + BC = mk_pseudo_bc(BCond, + hipe_rtl:alub_true_label(I), + hipe_rtl:alub_false_label(I), + hipe_rtl:alub_pred(I)), + I2 = + case {AluOp, BCond} of + {'addc', 'eq'} -> % copy XER[CA] to CR0[EQ] before the BC + TmpR = new_untagged_temp(), + [hipe_ppc:mk_mfspr(TmpR, 'xer'), + hipe_ppc:mk_mtcr(TmpR) | + BC]; + _ -> BC + end, + {NewSrc1, NewSrc2} = + case AluOp of + 'subf' -> {Src2, Src1}; + _ -> {Src1, Src2} + end, + I1 = mk_alub(Dst, NewSrc1, AluOp, NewSrc2, BCond), + {I1 ++ I2, Map2, Data} + end. conv_alub_op(RtlAluOp) -> case {get(hipe_target_arch), RtlAluOp} of @@ -689,17 +705,6 @@ mk_alub_rr_Rc(Dst, Src1, AluOp, Src2) -> end, [hipe_ppc:mk_alu(AluOpDot, Dst, Src1, Src2)]. -conv_branch(I, Map, Data) -> - %% <unused> = src1 - src2; if COND goto label - {Src1, Map0} = conv_src(hipe_rtl:branch_src1(I), Map), - {Src2, Map1} = conv_src(hipe_rtl:branch_src2(I), Map0), - {BCond,Sign} = conv_branch_cond(hipe_rtl:branch_cond(I)), - I2 = mk_branch(Src1, BCond, Sign, Src2, - hipe_rtl:branch_true_label(I), - hipe_rtl:branch_false_label(I), - hipe_rtl:branch_pred(I)), - {I2, Map1, Data}. - conv_branch_cond(Cond) -> % may be unsigned case Cond of gtu -> {'gt', 'unsigned'}; diff --git a/lib/hipe/rtl/hipe_rtl.erl b/lib/hipe/rtl/hipe_rtl.erl index 0726827299..d39969a0ed 100644 --- a/lib/hipe/rtl/hipe_rtl.erl +++ b/lib/hipe/rtl/hipe_rtl.erl @@ -187,18 +187,14 @@ mk_branch/5, mk_branch/6, - branch_src1/1, - branch_src2/1, - branch_cond/1, - branch_true_label/1, - branch_false_label/1, - branch_pred/1, + mk_branch/7, %% is_branch/1, %% branch_true_label_update/2, %% branch_false_label_update/2, mk_alub/7, mk_alub/8, + alub_has_dst/1, alub_dst/1, alub_src1/1, alub_op/1, @@ -338,6 +334,7 @@ defines/1, redirect_jmp/3, is_safe/1, + reduce_unused/1, %% highest_var/1, pp/1, pp/2, @@ -588,37 +585,25 @@ is_label(#label{}) -> true; is_label(_) -> false. %% -%% branch -%% - -mk_branch(Src1, Op, Src2, True, False) -> - mk_branch(Src1, Op, Src2, True, False, 0.5). -mk_branch(Src1, Op, Src2, True, False, P) -> - #branch{src1=Src1, 'cond'=Op, src2=Src2, true_label=True, - false_label=False, p=P}. -branch_src1(#branch{src1=Src1}) -> Src1. -branch_src1_update(Br, NewSrc) -> Br#branch{src1=NewSrc}. -branch_src2(#branch{src2=Src2}) -> Src2. -branch_src2_update(Br, NewSrc) -> Br#branch{src2=NewSrc}. -branch_cond(#branch{'cond'=Cond}) -> Cond. -branch_true_label(#branch{true_label=TrueLbl}) -> TrueLbl. -branch_true_label_update(Br, NewTrue) -> Br#branch{true_label=NewTrue}. -branch_false_label(#branch{false_label=FalseLbl}) -> FalseLbl. -branch_false_label_update(Br, NewFalse) -> Br#branch{false_label=NewFalse}. -branch_pred(#branch{p=P}) -> P. - -%% %% alub %% -type alub_cond() :: 'eq' | 'ne' | 'ge' | 'geu' | 'gt' | 'gtu' | 'le' | 'leu' | 'lt' | 'ltu' | 'overflow' | 'not_overflow'. +mk_branch(Src1, Cond, Src2, True, False) -> + mk_branch(Src1, Cond, Src2, True, False, 0.5). +mk_branch(Src1, Cond, Src2, True, False, P) -> + mk_branch(Src1, 'sub', Src2, Cond, True, False, P). +mk_branch(Src1, Op, Src2, Cond, True, False, P) -> + mk_alub([], Src1, Op, Src2, Cond, True, False, P). + mk_alub(Dst, Src1, Op, Src2, Cond, True, False) -> mk_alub(Dst, Src1, Op, Src2, Cond, True, False, 0.5). mk_alub(Dst, Src1, Op, Src2, Cond, True, False, P) -> #alub{dst=Dst, src1=Src1, op=Op, src2=Src2, 'cond'=Cond, true_label=True, false_label=False, p=P}. +alub_has_dst(#alub{dst=Dst}) -> Dst =/= []. alub_dst(#alub{dst=Dst}) -> Dst. alub_dst_update(A, NewDst) -> A#alub{dst=NewDst}. alub_src1(#alub{src1=Src1}) -> Src1. @@ -943,8 +928,7 @@ args(I) -> case I of #alu{} -> [alu_src1(I), alu_src2(I)]; #alub{} -> [alub_src1(I), alub_src2(I)]; - #branch{} -> [branch_src1(I), branch_src2(I)]; - #call{} -> + #call{} -> Args = call_arglist(I) ++ hipe_rtl_arch:call_used(), case call_is_known(I) of false -> [call_fun(I) | Args]; @@ -987,8 +971,8 @@ args(I) -> defines(Instr) -> Defs = case Instr of #alu{} -> [alu_dst(Instr)]; + #alub{dst=[]} -> []; #alub{} -> [alub_dst(Instr)]; - #branch{} -> []; #call{} -> call_dstlist(Instr) ++ hipe_rtl_arch:call_defined(); #comment{} -> []; #enter{} -> []; @@ -1042,9 +1026,6 @@ subst_uses(Subst, I) -> #alub{} -> I0 = alub_src1_update(I, subst1(Subst, alub_src1(I))), alub_src2_update(I0, subst1(Subst, alub_src2(I))); - #branch{} -> - I0 = branch_src1_update(I, subst1(Subst, branch_src1(I))), - branch_src2_update(I0, subst1(Subst, branch_src2(I))); #call{} -> case call_is_known(I) of false -> @@ -1126,11 +1107,6 @@ subst_uses_llvm(Subst, I) -> {NewSrc1, _ } = subst1_llvm(Subst1, alub_src1(I)), I0 = alub_src1_update(I, NewSrc1), alub_src2_update(I0, NewSrc2); - #branch{} -> - {NewSrc2, Subst1} = subst1_llvm(Subst, branch_src2(I)), - {NewSrc1, _ } = subst1_llvm(Subst1, branch_src1(I)), - I0 = branch_src1_update(I, NewSrc1), - branch_src2_update(I0, NewSrc2); #call{} -> case call_is_known(I) of false -> @@ -1243,10 +1219,10 @@ subst_defines(Subst, I)-> case I of #alu{} -> alu_dst_update(I, subst1(Subst, alu_dst(I))); + #alub{dst=[]} -> + I; #alub{} -> alub_dst_update(I, subst1(Subst, alub_dst(I))); - #branch{} -> - I; #call{} -> call_dstlist_update(I, subst_list(Subst, call_dstlist(I))); #comment{} -> @@ -1313,7 +1289,6 @@ is_safe(Instr) -> case Instr of #alu{} -> true; #alub{} -> false; - #branch{} -> false; #call{} -> false; #comment{} -> false; #enter{} -> false; @@ -1340,6 +1315,24 @@ is_safe(Instr) -> #switch{} -> false %% Maybe this is safe... end. +%% @spec reduce_unused(rtl_instruction()) +%% -> false | [rtl_instruction()]. +%% +%% @doc Produces a simplified instruction sequence that is equivalent to [Instr] +%% under the assumption that all results of Instr are unused, or 'false' if +%% there is no such sequence (other than [Instr] itself). + +reduce_unused(Instr) -> + case Instr of + #alub{dst=Dst} when Dst =/= [] -> + [Instr#alub{dst=[]}]; + _ -> + case is_safe(Instr) of + true -> []; + false -> false + end + end. + %% %% True if argument is an alu-operator %% @@ -1386,17 +1379,6 @@ redirect_jmp(Jmp, ToOld, ToNew) -> %% OBS: In a jmp instruction more than one labels may be identical %% and thus need redirection! case Jmp of - #branch{} -> - TmpJmp = case branch_true_label(Jmp) of - ToOld -> branch_true_label_update(Jmp, ToNew); - _ -> Jmp - end, - case branch_false_label(TmpJmp) of - ToOld -> - branch_false_label_update(TmpJmp, ToNew); - _ -> - TmpJmp - end; #switch{} -> NewLbls = [case Lbl =:= ToOld of true -> ToNew; @@ -1591,13 +1573,6 @@ pp_instr(Dev, I) -> io:format(Dev, "~n", []); #label{} -> io:format(Dev, "L~w:~n", [label_name(I)]); - #branch{} -> - io:format(Dev, " if (", []), - pp_arg(Dev, branch_src1(I)), - io:format(Dev, " ~w ", [branch_cond(I)]), - pp_arg(Dev, branch_src2(I)), - io:format(Dev, ") then L~w (~.2f) else L~w~n", - [branch_true_label(I), branch_pred(I), branch_false_label(I)]); #switch{} -> io:format(Dev, " switch (", []), pp_arg(Dev, switch_src(I)), @@ -1606,7 +1581,10 @@ pp_instr(Dev, I) -> io:format(Dev, ">\n", []); #alub{} -> io:format(Dev, " ", []), - pp_arg(Dev, alub_dst(I)), + case alub_has_dst(I) of + true -> pp_arg(Dev, alub_dst(I)); + false -> io:format(Dev, "_", []) + end, io:format(Dev, " <- ", []), pp_arg(Dev, alub_src1(I)), io:format(Dev, " ~w ", [alub_op(I)]), diff --git a/lib/hipe/rtl/hipe_rtl.hrl b/lib/hipe/rtl/hipe_rtl.hrl index cc76e7e5c4..74020c6045 100644 --- a/lib/hipe/rtl/hipe_rtl.hrl +++ b/lib/hipe/rtl/hipe_rtl.hrl @@ -28,7 +28,6 @@ -record(alu, {dst, src1, op, src2}). -record(alub, {dst, src1, op, src2, 'cond', true_label, false_label, p}). --record(branch, {src1, src2, 'cond', true_label, false_label, p}). -record(call, {dstlist, 'fun', arglist, type, continuation, failcontinuation, normalcontinuation = []}). -record(comment, {text}). diff --git a/lib/hipe/rtl/hipe_rtl_binary_construct.erl b/lib/hipe/rtl/hipe_rtl_binary_construct.erl index 367d76b24d..baf5f7d27a 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_construct.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_construct.erl @@ -429,8 +429,8 @@ realloc_binary(SizeReg, ProcBin, Base) -> hipe_tagscheme:set_field_from_term(ProcBinFlagsTag, ProcBin, Flags), hipe_tagscheme:get_field_from_term(ProcBinValTag, ProcBin, BinPointer), hipe_tagscheme:get_field_from_pointer(BinOrigSizeTag, BinPointer, OrigSize), - hipe_rtl:mk_branch(OrigSize, 'ltu', ResultingSize, - ReallocLblName, NoReallocLblName), + hipe_rtl:mk_branch(OrigSize, 'geu', ResultingSize, NoReallocLblName, + ReallocLblName), NoReallocLbl, hipe_tagscheme:get_field_from_term(ProcBinBytesTag, ProcBin, Base), hipe_rtl:mk_goto(ContLblName), @@ -757,9 +757,9 @@ test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode) -> [AlignedLbl, CLbl] = create_lbls(2), [hipe_rtl:mk_alu(Tmp, SrcOffset, 'or', NumBits), hipe_rtl:mk_alu(Tmp, Tmp, 'or', Offset), - hipe_rtl:mk_alub(Tmp, Tmp, 'and', ?LOW_BITS, 'eq', - hipe_rtl:label_name(AlignedLbl), - hipe_rtl:label_name(CLbl)), + hipe_rtl:mk_branch(Tmp, 'and', ?LOW_BITS, 'eq', + hipe_rtl:label_name(AlignedLbl), + hipe_rtl:label_name(CLbl), 0.5), AlignedLbl, AlignedCode, CLbl, @@ -1284,8 +1284,7 @@ is_divisible(Dividend, Divisor, SuccLbl, FailLbl) -> true -> %% Divisor is a power of 2 %% Test that the Log2-1 lowest bits are clear Mask = hipe_rtl:mk_imm(Divisor - 1), - [Tmp] = create_regs(1), - [hipe_rtl:mk_alub(Tmp, Dividend, 'and', Mask, eq, SuccLbl, FailLbl, 0.99)]; + [hipe_rtl:mk_branch(Dividend, 'and', Mask, eq, SuccLbl, FailLbl, 0.99)]; false -> %% We need division, fall back to a primop [hipe_rtl:mk_call([], is_divisible, [Dividend, hipe_rtl:mk_imm(Divisor)], diff --git a/lib/hipe/rtl/hipe_rtl_binary_match.erl b/lib/hipe/rtl/hipe_rtl_binary_match.erl index d999cd2743..520b055ba7 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_match.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_match.erl @@ -659,9 +659,8 @@ test_alignment_code(Size, Unit, SLblName, FalseLblName) -> end. get_fast_test_code(Size, AndTest, SLblName, FalseLblName) -> - [Tmp] = create_gcsafe_regs(1), - [hipe_rtl:mk_alub(Tmp, Size, 'and', hipe_rtl:mk_imm(AndTest), - 'eq', SLblName, FalseLblName)]. + [hipe_rtl:mk_branch(Size, 'and', hipe_rtl:mk_imm(AndTest), 'eq', + SLblName, FalseLblName, 0.5)]. %% This is really slow get_slow_test_code(Size, Unit, SLblName, FalseLblName) -> diff --git a/lib/hipe/rtl/hipe_rtl_cfg.erl b/lib/hipe/rtl/hipe_rtl_cfg.erl index f49e8f815f..e802b320c2 100644 --- a/lib/hipe/rtl/hipe_rtl_cfg.erl +++ b/lib/hipe/rtl/hipe_rtl_cfg.erl @@ -83,9 +83,7 @@ mk_goto(Name) -> branch_successors(Instr) -> case Instr of - #branch{} -> [hipe_rtl:branch_true_label(Instr), - hipe_rtl:branch_false_label(Instr)]; - #alub{} -> [hipe_rtl:alub_true_label(Instr), + #alub{} -> [hipe_rtl:alub_true_label(Instr), hipe_rtl:alub_false_label(Instr)]; #switch{} -> hipe_rtl:switch_labels(Instr); #call{} -> @@ -106,7 +104,6 @@ fails_to(Instr) -> is_branch(Instr) -> case Instr of - #branch{} -> true; #alub{} -> true; #switch{} -> true; #goto{} -> true; @@ -127,7 +124,7 @@ is_branch(Instr) -> is_pure_branch(Instr) -> case Instr of - #branch{} -> true; + #alub{} -> not hipe_rtl:alub_has_dst(Instr); #switch{} -> true; #goto{} -> true; _ -> false diff --git a/lib/hipe/rtl/hipe_rtl_lcm.erl b/lib/hipe/rtl/hipe_rtl_lcm.erl index 71bd06c0df..67ddd0f649 100644 --- a/lib/hipe/rtl/hipe_rtl_lcm.erl +++ b/lib/hipe/rtl/hipe_rtl_lcm.erl @@ -378,7 +378,6 @@ is_expr(I) -> %% end; #alub{} -> false; %% TODO: Split instruction to consider alu expression? - #branch{} -> false; #call{} -> false; %% We cannot prove that a call has no side-effects #comment{} -> false; #enter{} -> false; diff --git a/lib/hipe/rtl/hipe_rtl_ssa_const_prop.erl b/lib/hipe/rtl/hipe_rtl_ssa_const_prop.erl index 7158383010..f887eeab66 100644 --- a/lib/hipe/rtl/hipe_rtl_ssa_const_prop.erl +++ b/lib/hipe/rtl/hipe_rtl_ssa_const_prop.erl @@ -110,8 +110,6 @@ visit_expression(Instruction, Environment) -> visit_alu(Instruction, Environment); #alub{} -> visit_alub(Instruction, Environment); - #branch{} -> - visit_branch(Instruction, Environment); #call{} -> visit_call(Instruction, Environment); %% #comment{} -> @@ -184,42 +182,6 @@ set_to(Dst, Val, Env) -> {[], SSAWork, Env1}. %%----------------------------------------------------------------------------- -%% Procedure : visit_branch/2 -%% Purpose : do symbolic exection of branch instructions. -%% Arguments : Inst - The instruction -%% Env - The environment -%% Returns : { FlowWorkList, SSAWorkList, NewEnvironment} -%%----------------------------------------------------------------------------- - -visit_branch(Inst, Env) -> %% Titta också på exekverbarflagga - Val1 = lookup_lattice_value(hipe_rtl:branch_src1(Inst), Env), - Val2 = lookup_lattice_value(hipe_rtl:branch_src2(Inst), Env), - CFGWL = case evaluate_relop(Val1, hipe_rtl:branch_cond(Inst), Val2) of - true -> [hipe_rtl:branch_true_label(Inst)]; - false -> [hipe_rtl:branch_false_label(Inst)]; - bottom -> [hipe_rtl:branch_true_label(Inst), - hipe_rtl:branch_false_label(Inst)]; - top -> [] - end, - {CFGWL, [], Env}. - -%%----------------------------------------------------------------------------- -%% Procedure : evaluate_relop/3 -%% Purpose : evaluate the given relop. While taking care to handle top & -%% bottom in some sane way. -%% Arguments : Val1, Val2 - The operands Integers or top or bottom -%% RelOp - some relop atom from rtl. -%% Returns : bottom, top, true or false -%%----------------------------------------------------------------------------- - -evaluate_relop(Val1, RelOp, Val2) -> - if - (Val1==bottom) or (Val2==bottom) -> bottom ; - (Val1==top) or (Val2==top) -> top; - true -> hipe_rtl_arch:eval_cond(RelOp, Val1, Val2) - end. - -%%----------------------------------------------------------------------------- %% Procedure : evaluate_fixnumop/2 %% Purpose : try to evaluate a fixnumop. %% Arguments : Val1 - operand (an integer, 'top' or 'bottom') @@ -408,6 +370,7 @@ partial_eval_branch(Cond, N0, Z0, V0, C0) -> Cond =:= 'ne' -> {true, Z0, true, true}; Cond =:= 'gt'; Cond =:= 'le' -> {N0, Z0, V0, true}; + Cond =:= 'leu'; Cond =:= 'gtu' -> {true, Z0, true, C0 }; Cond =:= 'lt'; Cond =:= 'ge' -> {N0, true, V0, true}; @@ -450,7 +413,11 @@ visit_alub(Inst, Env) -> false -> [hipe_rtl:alub_false_label(Inst)] end end, - {[], NewSSA, NewEnv} = set_to(hipe_rtl:alub_dst(Inst), NewVal, Env), + {[], NewSSA, NewEnv} = + case hipe_rtl:alub_has_dst(Inst) of + false -> {[], [], Env}; + true -> set_to(hipe_rtl:alub_dst(Inst), NewVal, Env) + end, {Labels, NewSSA, NewEnv}. %%----------------------------------------------------------------------------- @@ -688,8 +655,6 @@ update_instruction(Inst, Env) -> update_alu(Inst, Env); #alub{} -> update_alub(Inst, Env); - #branch{} -> - update_branch(Inst, Env); #call{} -> subst_all_uses(Inst, Env); %% #comment{} -> @@ -902,33 +867,6 @@ update_alu(Inst, Env) -> {Val,_,_,_,_} = evaluate_alu(Val1, hipe_rtl:alu_op(Inst), Val2), [hipe_rtl:mk_move(hipe_rtl:alu_dst(Inst), hipe_rtl:mk_imm(Val))] end. - -%%----------------------------------------------------------------------------- -%% Procedure : update_branch/2 -%% Purpose : update an branch-instruction -%% Arguments : Inst - the instruction. -%% Env - in which everything happens. -%% Returns : list of new instruction -%%----------------------------------------------------------------------------- - -update_branch(Inst, Env) -> - Src1 = hipe_rtl:branch_src1(Inst), - Src2 = hipe_rtl:branch_src2(Inst), - Val1 = lookup_lattice_value(Src1, Env), - Val2 = lookup_lattice_value(Src2, Env), - if - (Val1 =:= bottom) and (Val2 =:= bottom) -> - [Inst]; - Val1 =:= bottom -> - [hipe_rtl:subst_uses([{Src2, hipe_rtl:mk_imm(Val2)}], Inst)]; - Val2 =:= bottom -> - [hipe_rtl:subst_uses([{Src1, hipe_rtl:mk_imm(Val1)}], Inst)]; - true -> - case hipe_rtl_arch:eval_cond(hipe_rtl:branch_cond(Inst), Val1, Val2) of - true -> [hipe_rtl:mk_goto(hipe_rtl:branch_true_label(Inst))]; - false -> [hipe_rtl:mk_goto(hipe_rtl:branch_false_label(Inst))] - end - end. %%----------------------------------------------------------------------------- %% Procedure : update_alub/2 @@ -943,8 +881,12 @@ update_branch(Inst, Env) -> %% some small helpers. alub_to_move(Inst, Res, Lab) -> - [hipe_rtl:mk_move(hipe_rtl:alub_dst(Inst), Res), - hipe_rtl:mk_goto(Lab)]. + Goto = [hipe_rtl:mk_goto(Lab)], + case hipe_rtl:alub_has_dst(Inst) of + false -> Goto; + true -> + [hipe_rtl:mk_move(hipe_rtl:alub_dst(Inst), Res) | Goto] + end. make_alub_subst_list(bottom, _, Tail) -> Tail; make_alub_subst_list(top, Src, _) -> diff --git a/lib/hipe/rtl/hipe_tagscheme.erl b/lib/hipe/rtl/hipe_tagscheme.erl index 8cf45772b5..5d11b9b82e 100644 --- a/lib/hipe/rtl/hipe_tagscheme.erl +++ b/lib/hipe/rtl/hipe_tagscheme.erl @@ -171,22 +171,21 @@ test_nil(X, TrueLab, FalseLab, Pred) -> hipe_rtl:mk_branch(X, eq, hipe_rtl:mk_imm(?NIL), TrueLab, FalseLab, Pred). test_cons(X, TrueLab, FalseLab, Pred) -> - Tmp = hipe_rtl:mk_new_reg_gcsafe(), Mask = hipe_rtl:mk_imm(?TAG_PRIMARY_MASK - ?TAG_PRIMARY_LIST), - hipe_rtl:mk_alub(Tmp, X, 'and', Mask, 'eq', TrueLab, FalseLab, Pred). + hipe_rtl:mk_branch(X, 'and', Mask, 'eq', TrueLab, FalseLab, Pred). test_is_boxed(X, TrueLab, FalseLab, Pred) -> - Tmp = hipe_rtl:mk_new_reg_gcsafe(), Mask = hipe_rtl:mk_imm(?TAG_PRIMARY_MASK - ?TAG_PRIMARY_BOXED), - hipe_rtl:mk_alub(Tmp, X, 'and', Mask, 'eq', TrueLab, FalseLab, Pred). + hipe_rtl:mk_branch(X, 'and', Mask, 'eq', TrueLab, FalseLab, Pred). get_header(Res, X) -> hipe_rtl:mk_load(Res, X, hipe_rtl:mk_imm(-(?TAG_PRIMARY_BOXED))). mask_and_compare(X, Mask, Value, TrueLab, FalseLab, Pred) -> Tmp = hipe_rtl:mk_new_reg_gcsafe(), - [hipe_rtl:mk_alu(Tmp, X, 'and', hipe_rtl:mk_imm(Mask)), - hipe_rtl:mk_branch(Tmp, 'eq', hipe_rtl:mk_imm(Value), TrueLab, FalseLab, Pred)]. + [hipe_rtl:mk_alu(Tmp, X, 'sub', hipe_rtl:mk_imm(Value)), + hipe_rtl:mk_branch(Tmp, 'and', hipe_rtl:mk_imm(Mask), + eq, TrueLab, FalseLab, Pred)]. test_immed1(X, Value, TrueLab, FalseLab, Pred) -> mask_and_compare(X, ?TAG_IMMED1_MASK, Value, TrueLab, FalseLab, Pred). @@ -238,13 +237,12 @@ test_atom(X, TrueLab, FalseLab, Pred) -> test_tuple(X, TrueLab, FalseLab, Pred) -> Tmp = hipe_rtl:mk_new_reg_gcsafe(), - Tmp2 = hipe_rtl:mk_new_reg_gcsafe(), HalfTrueLab = hipe_rtl:mk_new_label(), [test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred), HalfTrueLab, get_header(Tmp, X), - hipe_rtl:mk_alub(Tmp2, Tmp, 'and', hipe_rtl:mk_imm(?TAG_HEADER_MASK), 'eq', - TrueLab, FalseLab, Pred)]. + hipe_rtl:mk_branch(Tmp, 'and', hipe_rtl:mk_imm(?TAG_HEADER_MASK), 'eq', + TrueLab, FalseLab, Pred)]. test_tuple_N(X, N, TrueLab, FalseLab, Pred) -> Tmp = hipe_rtl:mk_new_reg_gcsafe(), @@ -466,12 +464,17 @@ test_fixnums_1([Arg1, Arg2|Args], Acc) -> test_two_fixnums(Arg1, Arg2, FalseLab) -> TrueLab = hipe_rtl:mk_new_label(), - case hipe_rtl:is_imm(Arg2) of + case hipe_rtl:is_imm(Arg1) orelse hipe_rtl:is_imm(Arg2) of true -> - Value = hipe_rtl:imm_value(Arg2), + {Imm, Var} = + case hipe_rtl:is_imm(Arg1) of + true -> {Arg1, Arg2}; + false -> {Arg2, Arg1} + end, + Value = hipe_rtl:imm_value(Imm), case Value band ?TAG_IMMED1_MASK of ?TAG_IMMED1_SMALL -> - [test_fixnum(Arg1, hipe_rtl:label_name(TrueLab), FalseLab, 0.99), + [test_fixnum(Var, hipe_rtl:label_name(TrueLab), FalseLab, 0.99), TrueLab]; _ -> [hipe_rtl:mk_goto(FalseLab)] @@ -512,28 +515,48 @@ unsafe_fixnum_sub(Arg1, Arg2, Res) -> %%% (16X+tag)+((16Y+tag)-tag) = 16X+tag+16Y = 16(X+Y)+tag %%% (16X+tag)-((16Y+tag)-tag) = 16X+tag-16Y = 16(X-Y)+tag -fixnum_addsub(AluOp, Arg1, Arg2, Res, OtherLab) -> - Tmp = hipe_rtl:mk_new_reg_gcsafe(), +fixnum_addsub(AluOp, Arg1, Arg2, FinalRes, OtherLab) -> + NoOverflowLab = hipe_rtl:mk_new_label(), %% XXX: Consider moving this test to the users of fixnum_addsub. - case Arg1 =/= Res andalso Arg2 =/= Res of - true -> - %% Args differ from res. - NoOverflowLab = hipe_rtl:mk_new_label(), - [hipe_rtl:mk_alu(Tmp, Arg2, sub, hipe_rtl:mk_imm(?TAG_IMMED1_SMALL)), - hipe_rtl:mk_alub(Res, Arg1, AluOp, Tmp, not_overflow, - hipe_rtl:label_name(NoOverflowLab), - hipe_rtl:label_name(OtherLab), 0.99), - NoOverflowLab]; + {Res, Tail} = + case Arg1 =/= FinalRes andalso Arg2 =/= FinalRes of + true -> + %% Args differ from res. + {FinalRes, [NoOverflowLab]}; + false -> + %% At least one of the arguments is the same as Res. + Tmp = hipe_rtl:mk_new_reg_gcsafe(), + {Tmp, [NoOverflowLab, hipe_rtl:mk_move(FinalRes, Tmp)]} + end, + case (hipe_rtl:is_imm(Arg1) andalso AluOp =:= 'add') + orelse hipe_rtl:is_imm(Arg2) + of + true -> + %% Pre-compute the untagged immediate. The optimisers won't do this for us + %% since they don't know that the untag never underflows. + {Var, Imm0} = + case hipe_rtl:is_imm(Arg2) of + true -> {Arg1, Arg2}; + false -> {Arg2, Arg1} + end, + Imm = hipe_rtl:mk_imm(hipe_rtl:imm_value(Imm0) - ?TAG_IMMED1_SMALL), + [hipe_rtl:mk_alub(Res, Var, AluOp, Imm, not_overflow, + hipe_rtl:label_name(NoOverflowLab), + hipe_rtl:label_name(OtherLab), 0.99) + |Tail]; false -> - %% At least one of the arguments is the same as Res. - Tmp2 = hipe_rtl:mk_new_var(), % XXX: shouldn't this var be a reg? - NoOverflowLab = hipe_rtl:mk_new_label(), - [hipe_rtl:mk_alu(Tmp, Arg2, sub, hipe_rtl:mk_imm(?TAG_IMMED1_SMALL)), - hipe_rtl:mk_alub(Tmp2, Arg1, AluOp, Tmp, not_overflow, + %% Commute add to save a move on x86 + {UntagFirst, Lhs, Rhs} = + case AluOp of + 'add' -> {Arg1, Res, Arg2}; + 'sub' -> {Arg2, Arg1, Res} + end, + [hipe_rtl:mk_alu(Res, UntagFirst, sub, + hipe_rtl:mk_imm(?TAG_IMMED1_SMALL)), + hipe_rtl:mk_alub(Res, Lhs, AluOp, Rhs, not_overflow, hipe_rtl:label_name(NoOverflowLab), - hipe_rtl:label_name(OtherLab), 0.99), - NoOverflowLab, - hipe_rtl:mk_move(Res, Tmp2)] + hipe_rtl:label_name(OtherLab), 0.99) + |Tail] end. %%% ((16X+tag) div 16) * ((16Y+tag)-tag) + tag = X*16Y+tag = 16(XY)+tag @@ -687,7 +710,6 @@ element(Dst, Index, Tuple, FailLabName, unknown, IndexInfo) -> IndexOkLab = hipe_rtl:mk_new_label(), Ptr = hipe_rtl:mk_new_reg(), % offset from Tuple Header = hipe_rtl:mk_new_reg_gcsafe(), - Tmp = hipe_rtl:mk_new_reg_gcsafe(), UIndex = hipe_rtl:mk_new_reg_gcsafe(), Arity = hipe_rtl:mk_new_reg_gcsafe(), InvIndex = hipe_rtl:mk_new_reg_gcsafe(), @@ -700,9 +722,9 @@ element(Dst, Index, Tuple, FailLabName, unknown, IndexInfo) -> BoxedOkLab, hipe_rtl:mk_alu(Ptr, Tuple, 'sub', hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)), hipe_rtl:mk_load(Header, Ptr, hipe_rtl:mk_imm(0)), - hipe_rtl:mk_alub(Tmp, Header, 'and', - hipe_rtl:mk_imm(?TAG_HEADER_MASK), 'eq', - hipe_rtl:label_name(TupleOkLab), FailLabName, 0.99), + hipe_rtl:mk_branch(Header, 'and', + hipe_rtl:mk_imm(?TAG_HEADER_MASK), 'eq', + hipe_rtl:label_name(TupleOkLab), FailLabName, 0.99), TupleOkLab, untag_fixnum(UIndex, Index), hipe_rtl:mk_alu(Arity, Header, 'srl', @@ -716,9 +738,9 @@ element(Dst, Index, Tuple, FailLabName, unknown, IndexInfo) -> BoxedOkLab, hipe_rtl:mk_alu(Ptr, Tuple, 'sub', hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)), hipe_rtl:mk_load(Header, Ptr, hipe_rtl:mk_imm(0)), - hipe_rtl:mk_alub(Tmp, Header, 'and', - hipe_rtl:mk_imm(?TAG_HEADER_MASK), 'eq', - hipe_rtl:label_name(TupleOkLab), FailLabName, 0.99), + hipe_rtl:mk_branch(Header, 'and', + hipe_rtl:mk_imm(?TAG_HEADER_MASK), 'eq', + hipe_rtl:label_name(TupleOkLab), FailLabName, 0.99), TupleOkLab, hipe_rtl:mk_alu(Arity, Header, 'srl', hipe_rtl:mk_imm(?HEADER_ARITY_OFFS))| @@ -734,9 +756,9 @@ element(Dst, Index, Tuple, FailLabName, unknown, IndexInfo) -> BoxedOkLab, hipe_rtl:mk_alu(Ptr, Tuple, 'sub', hipe_rtl:mk_imm(?TAG_PRIMARY_BOXED)), hipe_rtl:mk_load(Header, Ptr, hipe_rtl:mk_imm(0)), - hipe_rtl:mk_alub(Tmp, Header, 'and', - hipe_rtl:mk_imm(?TAG_HEADER_MASK), 'eq', - hipe_rtl:label_name(TupleOkLab), FailLabName, 0.99), + hipe_rtl:mk_branch(Header, 'and', + hipe_rtl:mk_imm(?TAG_HEADER_MASK), 'eq', + hipe_rtl:label_name(TupleOkLab), FailLabName, 0.99), TupleOkLab, untag_fixnum(UIndex, Index), hipe_rtl:mk_alu(Arity, Header, 'srl', @@ -870,12 +892,10 @@ heap_arch_spec(HP) -> hipe_rtl_arch:pcb_store(?P_OFF_HEAP_FIRST, HP)]. test_heap_binary(Binary, TrueLblName, FalseLblName) -> - Tmp1 = hipe_rtl:mk_new_reg_gcsafe(), - Tmp2 = hipe_rtl:mk_new_reg_gcsafe(), - [get_header(Tmp1, Binary), - hipe_rtl:mk_alu(Tmp2, Tmp1, 'and', hipe_rtl:mk_imm(?TAG_HEADER_MASK)), - hipe_rtl:mk_branch(Tmp2, eq, hipe_rtl:mk_imm(?TAG_HEADER_HEAP_BIN), - TrueLblName, FalseLblName)]. + Tmp = hipe_rtl:mk_new_reg_gcsafe(), + [get_header(Tmp, Binary), + mask_and_compare(Tmp, ?TAG_HEADER_MASK, ?TAG_HEADER_HEAP_BIN, + TrueLblName, FalseLblName, 0.5)]. mk_sub_binary(Dst, ByteSize, ByteOffs, BitSize, BitOffs, Orig) -> mk_sub_binary(Dst, ByteSize, ByteOffs, BitSize, BitOffs, @@ -903,11 +923,10 @@ build_sub_binary(Dst, ByteSize, ByteOffs, BitSize, BitOffs, set_field_from_term({sub_binary, orig}, Dst, Orig)]. test_subbinary(Binary, TrueLblName, FalseLblName) -> - Tmp1 = hipe_rtl:mk_new_reg_gcsafe(), - Tmp2 = hipe_rtl:mk_new_reg_gcsafe(), - [get_header(Tmp1, Binary), - hipe_rtl:mk_alu(Tmp2, Tmp1, 'and', hipe_rtl:mk_imm(?TAG_HEADER_MASK)), - hipe_rtl:mk_branch(Tmp2, eq, hipe_rtl:mk_imm(?TAG_HEADER_SUB_BIN), TrueLblName, FalseLblName)]. + Tmp = hipe_rtl:mk_new_reg_gcsafe(), + [get_header(Tmp, Binary), + mask_and_compare(Tmp, ?TAG_HEADER_MASK, ?TAG_HEADER_SUB_BIN, + TrueLblName, FalseLblName, 0.5)]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% diff --git a/lib/hipe/sparc/hipe_rtl_to_sparc.erl b/lib/hipe/sparc/hipe_rtl_to_sparc.erl index e170fec3d6..7fab0d95c7 100644 --- a/lib/hipe/sparc/hipe_rtl_to_sparc.erl +++ b/lib/hipe/sparc/hipe_rtl_to_sparc.erl @@ -63,7 +63,6 @@ conv_insn(I, Map, Data) -> case I of #alu{} -> conv_alu(I, Map, Data); #alub{} -> conv_alub(I, Map, Data); - #branch{} -> conv_branch(I, Map, Data); #call{} -> conv_call(I, Map, Data); #comment{} -> conv_comment(I, Map, Data); #enter{} -> conv_enter(I, Map, Data); @@ -281,7 +280,12 @@ mk_alu_rs(XAluOp, Src1, Src2, Dst) -> conv_alub(I, Map, Data) -> %% dst = src1 aluop src2; if COND goto label - {Dst, Map0} = conv_dst(hipe_rtl:alub_dst(I), Map), + HasDst = hipe_rtl:alub_has_dst(I), + {Dst, Map0} = + case HasDst of + false -> {hipe_sparc:mk_g0(), Map}; + true -> conv_dst(hipe_rtl:alub_dst(I), Map) + end, {Src1, Map1} = conv_src(hipe_rtl:alub_src1(I), Map0), {Src2, Map2} = conv_src(hipe_rtl:alub_src2(I), Map1), Cond = conv_cond(hipe_rtl:alub_cond(I)), @@ -307,67 +311,33 @@ conv_alub(I, Map, Data) -> I1 ++ [hipe_sparc:mk_rdy(TmpHi), hipe_sparc:mk_alu('sra', Dst, hipe_sparc:mk_uimm5(31), TmpSign) | - conv_alub2(G0, TmpSign, 'sub', NewCond, TmpHi, I)]; + conv_alub2(G0, TmpSign, 'cmpcc', NewCond, TmpHi, I)]; _ -> - conv_alub2(Dst, Src1, RtlAlubOp, Cond, Src2, I) + XAluOp = + case (not HasDst) andalso RtlAlubOp =:= 'sub' of + true -> 'cmpcc'; % == a subcc that commutes + false -> conv_alubop_cc(RtlAlubOp) + end, + conv_alub2(Dst, Src1, XAluOp, Cond, Src2, I) end, {I2, Map2, Data}. --ifdef(notdef). % XXX: only for sparc64, alas -conv_alub2(Dst, Src1, RtlAlubOp, Cond, Src2, I) -> - case conv_cond_rcond(Cond) of - [] -> - conv_alub_bp(Dst, Src1, RtlAlubOp, Cond, Src2, I); - RCond -> - conv_alub_br(Dst, Src1, RtlAlubOp, RCond, Src2, I) - end. +conv_alub2(Dst, Src1, XAluOp, Cond, Src2, I) -> + conv_alub_bp(Dst, Src1, XAluOp, Cond, Src2, I). -conv_alub_br(Dst, Src1, RtlAlubOp, RCond, Src2, I) -> - TrueLab = hipe_rtl:alub_true_label(I), - FalseLab = hipe_rtl:alub_false_label(I), - Pred = hipe_rtl:alub_pred(I), - %% "Dst = Src1 AluOp Src2; if COND" becomes - %% "Dst = Src1 AluOp Src2; if-COND(Dst)" - {I2, _DidCommute} = mk_alu(conv_alubop_nocc(RtlAlubOp), Src1, Src2, Dst), - I2 ++ mk_pseudo_br(RCond, Dst, TrueLab, FalseLab, Pred). - -conv_cond_rcond(Cond) -> - case Cond of - 'e' -> 'z'; - 'ne' -> 'nz'; - 'g' -> 'gz'; - 'ge' -> 'gez'; - 'l' -> 'lz'; - 'le' -> 'lez'; - _ -> [] % vs, vc, gu, geu, lu, leu - end. - -conv_alubop_nocc(RtlAlubOp) -> - case RtlAlubOp of - 'add' -> 'add'; - 'sub' -> 'sub'; - %% mul: handled elsewhere - 'or' -> 'or'; - 'and' -> 'and'; - 'xor' -> 'xor' - %% no shift ops - end. - -mk_pseudo_br(RCond, Dst, TrueLab, FalseLab, Pred) -> - [hipe_sparc:mk_pseudo_br(RCond, Dst, TrueLab, FalseLab, Pred)]. --else. -conv_alub2(Dst, Src1, RtlAlubOp, Cond, Src2, I) -> - conv_alub_bp(Dst, Src1, RtlAlubOp, Cond, Src2, I). --endif. - -conv_alub_bp(Dst, Src1, RtlAlubOp, Cond, Src2, I) -> +conv_alub_bp(Dst, Src1, XAluOp, Cond, Src2, I) -> TrueLab = hipe_rtl:alub_true_label(I), FalseLab = hipe_rtl:alub_false_label(I), Pred = hipe_rtl:alub_pred(I), %% "Dst = Src1 AluOp Src2; if COND" becomes %% "Dst = Src1 AluOpCC Src22; if-COND(CC)" - {I2, _DidCommute} = mk_alu(conv_alubop_cc(RtlAlubOp), Src1, Src2, Dst), - I2 ++ mk_pseudo_bp(Cond, TrueLab, FalseLab, Pred). + {I2, DidCommute} = mk_alu(XAluOp, Src1, Src2, Dst), + NewCond = + case DidCommute andalso XAluOp =:= 'cmpcc' of + true -> commute_cond(Cond); % subcc does not commute; its conditions do + false -> Cond + end, + I2 ++ mk_pseudo_bp(NewCond, TrueLab, FalseLab, Pred). conv_alubop_cc(RtlAlubOp) -> case RtlAlubOp of @@ -380,69 +350,6 @@ conv_alubop_cc(RtlAlubOp) -> %% no shift ops end. -conv_branch(I, Map, Data) -> - %% <unused> = src1 - src2; if COND goto label - {Src1, Map0} = conv_src(hipe_rtl:branch_src1(I), Map), - {Src2, Map1} = conv_src(hipe_rtl:branch_src2(I), Map0), - Cond = conv_cond(hipe_rtl:branch_cond(I)), - I2 = conv_branch2(Src1, Cond, Src2, I), - {I2, Map1, Data}. - --ifdef(notdef). % XXX: only for sparc64, alas -conv_branch2(Src1, Cond, Src2, I) -> - case conv_cond_rcond(Cond) of - [] -> - conv_branch_bp(Src1, Cond, Src2, I); - RCond -> - conv_branch_br(Src1, RCond, Src2, I) - end. - -conv_branch_br(Src1, RCond, Src2, I) -> - TrueLab = hipe_rtl:branch_true_label(I), - FalseLab = hipe_rtl:branch_false_label(I), - Pred = hipe_rtl:branch_pred(I), - %% "if src1-COND-src2" becomes - %% "sub src1,src2,tmp; if-COND(tmp)" - Dst = hipe_sparc:mk_new_temp('untagged'), - XAluOp = 'cmp', % == a sub that commutes - {I1, DidCommute} = mk_alu(XAluOp, Src1, Src2, Dst), - NewRCond = - case DidCommute of - true -> commute_rcond(RCond); - false -> RCond - end, - I1 ++ mk_pseudo_br(NewRCond, Dst, TrueLab, FalseLab, Pred). - -commute_rcond(RCond) -> % if x RCond y, then y commute_rcond(RCond) x - case RCond of - 'z' -> 'z'; % ==, == - 'nz' -> 'nz'; % !=, != - 'gz' -> 'lz'; % >, < - 'gez' -> 'lez'; % >=, <= - 'lz' -> 'gz'; % <, > - 'lez' -> 'gez' % <=, >= - end. --else. -conv_branch2(Src1, Cond, Src2, I) -> - conv_branch_bp(Src1, Cond, Src2, I). --endif. - -conv_branch_bp(Src1, Cond, Src2, I) -> - TrueLab = hipe_rtl:branch_true_label(I), - FalseLab = hipe_rtl:branch_false_label(I), - Pred = hipe_rtl:branch_pred(I), - %% "if src1-COND-src2" becomes - %% "subcc src1,src2,%g0; if-COND(CC)" - Dst = hipe_sparc:mk_g0(), - XAluOp = 'cmpcc', % == a subcc that commutes - {I1, DidCommute} = mk_alu(XAluOp, Src1, Src2, Dst), - NewCond = - case DidCommute of - true -> commute_cond(Cond); - false -> Cond - end, - I1 ++ mk_pseudo_bp(NewCond, TrueLab, FalseLab, Pred). - conv_call(I, Map, Data) -> {Args, Map0} = conv_src_list(hipe_rtl:call_arglist(I), Map), {Dsts, Map1} = conv_dst_list(hipe_rtl:call_dstlist(I), Map0), diff --git a/lib/hipe/sparc/hipe_sparc_frame.erl b/lib/hipe/sparc/hipe_sparc_frame.erl index 37f29e660a..bd94d3318c 100644 --- a/lib/hipe/sparc/hipe_sparc_frame.erl +++ b/lib/hipe/sparc/hipe_sparc_frame.erl @@ -110,7 +110,10 @@ do_pseudo_move(I, Context, FPoff) -> Offset = pseudo_offset(Src, FPoff, Context), mk_load(hipe_sparc:mk_sp(), Offset, Dst, []); _ -> - [hipe_sparc:mk_mov(Src, Dst)] + case hipe_sparc:temp_reg(Dst) =:= hipe_sparc:temp_reg(Src) of + true -> []; + false -> [hipe_sparc:mk_mov(Src, Dst)] + end end end. diff --git a/lib/hipe/ssa/hipe_ssa.inc b/lib/hipe/ssa/hipe_ssa.inc index 83ab320306..b511bb6f25 100644 --- a/lib/hipe/ssa/hipe_ssa.inc +++ b/lib/hipe/ssa/hipe_ssa.inc @@ -1,4 +1,4 @@ -%% -*- erlang-indent-level: 2 -*- +%% -*- mode: erlang; erlang-indent-level: 2 -*- %% %% %CopyrightBegin% %% @@ -943,9 +943,9 @@ do_code([Instr|Instrs], LiveOut, Changed, Acc) -> false -> do_code(Instrs, LiveIn, Changed, [Instr|Acc]); true -> - case ?CODE:is_safe(Instr) of + case ?CODE:is_call(Instr) of true -> - case ?CODE:is_call(Instr) of + case ?CODE:is_safe(Instr) of true -> case ?CODE:call_continuation(Instr) of [] -> @@ -955,11 +955,6 @@ do_code([Instr|Instrs], LiveOut, Changed, Acc) -> do_code(Instrs, LiveOut, true, [NewInstr|Acc]) end; false -> - do_code(Instrs, LiveOut, true, Acc) - end; - false -> %% not a safe instruction - cannot be removed - case ?CODE:is_call(Instr) of - true -> case ?CODE:call_dstlist(Instr) of [] -> %% result was not used anyway; no change do_code(Instrs, LiveIn, Changed, [Instr|Acc]); @@ -968,9 +963,14 @@ do_code([Instr|Instrs], LiveOut, Changed, Acc) -> do_code(Instrs, LiveIn, true, [NewInstr|Acc]); [_|_] -> %% calls with multiple dests are left untouched do_code(Instrs, LiveIn, Changed, [Instr|Acc]) - end; - false -> - do_code(Instrs, LiveIn, Changed, [Instr|Acc]) + end + end; + false -> + case ?CODE:reduce_unused(Instr) of + false -> % not a safe instruction - cannot be removed + do_code(Instrs, LiveIn, Changed, [Instr|Acc]); + Replacement -> + do_code(lists:reverse(Replacement, Instrs), LiveOut, true, Acc) end end end; diff --git a/lib/hipe/x86/hipe_rtl_to_x86.erl b/lib/hipe/x86/hipe_rtl_to_x86.erl index 4c8c98551c..851b7da2dd 100644 --- a/lib/hipe/x86/hipe_rtl_to_x86.erl +++ b/lib/hipe/x86/hipe_rtl_to_x86.erl @@ -91,26 +91,31 @@ conv_insn(I, Map, Data) -> #alub{} -> %% dst = src1 op src2; if COND goto label BinOp = conv_binop(hipe_rtl:alub_op(I)), - {Dst, Map0} = conv_dst(hipe_rtl:alub_dst(I), Map), - {FixSrc1, Src1, Map1} = conv_src(hipe_rtl:alub_src1(I), Map0), - {FixSrc2, Src2, Map2} = conv_src(hipe_rtl:alub_src2(I), Map1), + {FixSrc1, Src1, Map0} = conv_src(hipe_rtl:alub_src1(I), Map), + {FixSrc2, Src2, Map1} = conv_src(hipe_rtl:alub_src2(I), Map0), Cc = conv_cond(hipe_rtl:alub_cond(I)), - I1 = [hipe_x86:mk_pseudo_jcc(Cc, - hipe_rtl:alub_true_label(I), - hipe_rtl:alub_false_label(I), - hipe_rtl:alub_pred(I))], - I2 = conv_alu(Dst, Src1, BinOp, Src2, I1), - {FixSrc1++FixSrc2++I2, Map2, Data}; - #branch{} -> - %% <unused> = src1 - src2; if COND goto label - {FixSrc1, Src1, Map0} = conv_src(hipe_rtl:branch_src1(I), Map), - {FixSrc2, Src2, Map1} = conv_src(hipe_rtl:branch_src2(I), Map0), - Cc = conv_cond(hipe_rtl:branch_cond(I)), - I2 = conv_branch(Src1, Cc, Src2, - hipe_rtl:branch_true_label(I), - hipe_rtl:branch_false_label(I), - hipe_rtl:branch_pred(I)), - {FixSrc1++FixSrc2++I2, Map1, Data}; + BranchOp = conv_branchop(BinOp), + HasDst = hipe_rtl:alub_has_dst(I), + {I2, Map3} = + case (not HasDst) andalso BranchOp =/= none of + true -> + {conv_branch(Src1, BranchOp, Src2, Cc, + hipe_rtl:alub_true_label(I), + hipe_rtl:alub_false_label(I), + hipe_rtl:alub_pred(I)), Map1}; + false -> + {Dst, Map2} = + case HasDst of + false -> {new_untagged_temp(), Map1}; + true -> conv_dst(hipe_rtl:alub_dst(I), Map1) + end, + I1 = [hipe_x86:mk_pseudo_jcc(Cc, + hipe_rtl:alub_true_label(I), + hipe_rtl:alub_false_label(I), + hipe_rtl:alub_pred(I))], + {conv_alu(Dst, Src1, BinOp, Src2, I1), Map2} + end, + {FixSrc1++FixSrc2++I2, Map3, Data}; #call{} -> %% push <arg1> %% ... @@ -252,7 +257,9 @@ conv_insn(I, Map, Data) -> conv_alu_nocc(Dst, Src1, 'add', Src2, Tail) -> case (not same_opnd(Dst, Src1)) andalso (not same_opnd(Dst, Src2)) - andalso (hipe_x86:is_temp(Src1) orelse hipe_x86:is_temp(Src2)) + %% We could use orelse instead of xor here to generate lea T1(T2), T3, but + %% they seem to move coalesce so well that move+add is better for them. + andalso (hipe_x86:is_temp(Src1) xor hipe_x86:is_temp(Src2)) of false -> conv_alu(Dst, Src1, 'add', Src2, Tail); true -> % Use LEA @@ -263,6 +270,16 @@ conv_alu_nocc(Dst, Src1, 'add', Src2, Tail) -> end, [hipe_x86:mk_lea(Mem, Dst) | Tail] end; +conv_alu_nocc(Dst, Src1, 'sub', Src2, Tail) -> + case (not same_opnd(Dst, Src1)) andalso hipe_x86:is_temp(Src1) + andalso (not hipe_x86:is_temp(Src2)) + of + false -> conv_alu(Dst, Src1, 'sub', Src2, Tail); + true -> % Use LEA + Imm = hipe_x86:mk_imm(-hipe_x86:imm_value(Src2)), + Mem = hipe_x86:mk_mem(Src1, Imm, typeof_dst(Dst)), + [hipe_x86:mk_lea(Mem, Dst) | Tail] + end; conv_alu_nocc(Dst, Src1, BinOp, Src2, Tail) -> conv_alu(Dst, Src1, BinOp, Src2, Tail). @@ -360,28 +377,41 @@ conv_shift(Dst, Src1, BinOp, Src2) -> %%% Finalise the conversion of a conditional branch operation, taking %%% care to not introduce more temps and moves than necessary. -conv_branch(Src1, Cc, Src2, TrueLab, FalseLab, Pred) -> +conv_branchop('sub') -> 'cmp'; +conv_branchop('and') -> 'test'; +conv_branchop(_) -> none. + +branchop_commutes('cmp') -> false; +branchop_commutes('test') -> true. + +conv_branch(Src1, Op, Src2, Cc, TrueLab, FalseLab, Pred) -> case hipe_x86:is_imm(Src1) of false -> - mk_branch(Src1, Cc, Src2, TrueLab, FalseLab, Pred); + mk_branch(Src1, Op, Src2, Cc, TrueLab, FalseLab, Pred); true -> case hipe_x86:is_imm(Src2) of false -> - NewCc = commute_cc(Cc), - mk_branch(Src2, NewCc, Src1, TrueLab, FalseLab, Pred); + NewCc = case branchop_commutes(Op) of + true -> Cc; + false -> commute_cc(Cc) + end, + mk_branch(Src2, Op, Src1, NewCc, TrueLab, FalseLab, Pred); true -> %% two immediates, let the optimiser clean it up Tmp = new_untagged_temp(), [hipe_x86:mk_move(Src1, Tmp) | - mk_branch(Tmp, Cc, Src2, TrueLab, FalseLab, Pred)] + mk_branch(Tmp, Op, Src2, Cc, TrueLab, FalseLab, Pred)] end end. -mk_branch(Src1, Cc, Src2, TrueLab, FalseLab, Pred) -> +mk_branch(Src1, Op, Src2, Cc, TrueLab, FalseLab, Pred) -> %% PRE: not(is_imm(Src1)) - [hipe_x86:mk_cmp(Src2, Src1), + [mk_branchtest(Src1, Op, Src2), hipe_x86:mk_pseudo_jcc(Cc, TrueLab, FalseLab, Pred)]. +mk_branchtest(Src1, cmp, Src2) -> hipe_x86:mk_cmp(Src2, Src1); +mk_branchtest(Src1, test, Src2) -> hipe_x86:mk_test(Src2, Src1). + %%% Convert an RTL ALU or ALUB binary operator. conv_binop(BinOp) -> diff --git a/lib/hipe/x86/hipe_x86.erl b/lib/hipe/x86/hipe_x86.erl index 33d7f77cf1..45bf1ad736 100644 --- a/lib/hipe/x86/hipe_x86.erl +++ b/lib/hipe/x86/hipe_x86.erl @@ -37,7 +37,7 @@ mk_imm_from_addr/2, mk_imm_from_atom/1, is_imm/1, - %% imm_value/1, + imm_value/1, mk_mem/3, %% is_mem/1, @@ -201,7 +201,7 @@ shift_src/1, shift_dst/1, - %% mk_test/2, + mk_test/2, test_src/1, test_dst/1, @@ -218,6 +218,10 @@ %% highest_temp/1 ]). +%% Other utilities +-export([neg_cc/1 + ]). + %%% %%% Low-level accessors. %%% @@ -241,7 +245,7 @@ mk_imm_from_addr(Addr, Type) -> mk_imm_from_atom(Atom) -> mk_imm(Atom). is_imm(X) -> case X of #x86_imm{} -> true; _ -> false end. -%% imm_value(#x86_imm{value=Value}) -> Value. +imm_value(#x86_imm{value=Value}) -> Value. mk_mem(Base, Off, Type) -> #x86_mem{base=Base, off=Off, type=Type}. %% is_mem(X) -> case X of #x86_mem{} -> true; _ -> false end. @@ -305,7 +309,7 @@ mk_cmp(Src, Dst) -> #cmp{src=Src, dst=Dst}. cmp_src(#cmp{src=Src}) -> Src. cmp_dst(#cmp{dst=Dst}) -> Dst. -%% mk_test(Src, Dst) -> #test{src=Src, dst=Dst}. +mk_test(Src, Dst) -> #test{src=Src, dst=Dst}. test_src(#test{src=Src}) -> Src. test_dst(#test{dst=Dst}) -> Dst. diff --git a/lib/hipe/x86/hipe_x86_assemble.erl b/lib/hipe/x86/hipe_x86_assemble.erl index e21223a5b1..e692ff0ebb 100644 --- a/lib/hipe/x86/hipe_x86_assemble.erl +++ b/lib/hipe/x86/hipe_x86_assemble.erl @@ -599,10 +599,20 @@ temp_to_xmm(#x86_temp{reg=Reg}) -> {xmm, Reg}. -ifdef(HIPE_AMD64). +temp_to_rm8(#x86_temp{reg=Reg}) -> + {rm8, ?HIPE_X86_ENCODE:rm_reg(Reg)}. temp_to_rm64(#x86_temp{reg=Reg}) -> {rm64, hipe_amd64_encode:rm_reg(Reg)}. +-else. +temp_to_rm8(#x86_temp{reg=Reg}) -> + true = ?HIPE_X86_ENCODE:reg_has_8bit(Reg), + {rm8, ?HIPE_X86_ENCODE:rm_reg(Reg)}. +temp_to_rm16(#x86_temp{reg=Reg}) -> + {rm16, ?HIPE_X86_ENCODE:rm_reg(Reg)}. -endif. +temp_to_rm32(#x86_temp{reg=Reg}) -> + {rm32, ?HIPE_X86_ENCODE:rm_reg(Reg)}. temp_to_rmArch(#x86_temp{reg=Reg}) -> {?RMArch, ?HIPE_X86_ENCODE:rm_reg(Reg)}. temp_to_rm64fp(#x86_temp{reg=Reg}) -> @@ -878,15 +888,29 @@ resolve_alu_args(Src, Dst, Context) -> %%% test resolve_test_args(Src, Dst, Context) -> case Src of - #x86_imm{} -> % imm8 not allowed - {_ImmSize,ImmValue} = translate_imm(Src, Context, false), - NewDst = - case Dst of - #x86_temp{reg=0} -> ?EAX; - #x86_temp{} -> temp_to_rmArch(Dst); - #x86_mem{} -> mem_to_rmArch(Dst) - end, - {NewDst, {imm32,ImmValue}}; + %% Since we're using an 8-bit instruction, the immediate is not sign + %% extended. Thus, we can use immediates up to 255. + #x86_imm{value=ImmVal} + when is_integer(ImmVal), ImmVal >= 0, ImmVal =< 255 -> + Imm = {imm8, ImmVal}, + case Dst of + #x86_temp{reg=0} -> {al, Imm}; + #x86_temp{} -> resolve_test_imm8_reg(Imm, Dst); + #x86_mem{} -> {mem_to_rm8(Dst), Imm} + end; + #x86_imm{value=ImmVal} when is_integer(ImmVal), ImmVal >= 0 -> + {case Dst of + #x86_temp{reg=0} -> eax; + #x86_temp{} -> temp_to_rm32(Dst); + #x86_mem{} -> mem_to_rm32(Dst) + end, {imm32, ImmVal}}; + #x86_imm{} -> % Negative ImmVal; use word-sized instr, imm32 + {_, ImmVal} = translate_imm(Src, Context, false), + {case Dst of + #x86_temp{reg=0} -> ?EAX; + #x86_temp{} -> temp_to_rmArch(Dst); + #x86_mem{} -> mem_to_rmArch(Dst) + end, {imm32, ImmVal}}; #x86_temp{} -> NewDst = case Dst of @@ -896,6 +920,18 @@ resolve_test_args(Src, Dst, Context) -> {NewDst, temp_to_regArch(Src)} end. +-ifdef(HIPE_AMD64). +resolve_test_imm8_reg(Imm, Dst) -> {temp_to_rm8(Dst), Imm}. +-else. +resolve_test_imm8_reg(Imm = {imm8, ImmVal}, Dst = #x86_temp{reg=Reg}) -> + case ?HIPE_X86_ENCODE:reg_has_8bit(Reg) of + true -> {temp_to_rm8(Dst), Imm}; + false -> + %% Register does not exist in 8-bit version; use 16-bit instead + {temp_to_rm16(Dst), {imm16, ImmVal}} + end. +-endif. + %%% shifts resolve_shift_args(Src, Dst, Context) -> RM32 = diff --git a/lib/hipe/x86/hipe_x86_defuse.erl b/lib/hipe/x86/hipe_x86_defuse.erl index 4455def74e..ab26370a80 100644 --- a/lib/hipe/x86/hipe_x86_defuse.erl +++ b/lib/hipe/x86/hipe_x86_defuse.erl @@ -60,7 +60,7 @@ insn_def(I) -> #pseudo_tailcall_prepare{} -> tailcall_clobbered(); #shift{dst=Dst} -> dst_def(Dst); %% call, cmp, comment, jcc, jmp_fun, jmp_label, jmp_switch, label - %% pseudo_jcc, pseudo_tailcall, push, ret + %% pseudo_jcc, pseudo_tailcall, push, ret, test _ -> [] end. @@ -120,6 +120,7 @@ insn_use(I) -> #push{src=Src} -> addtemp(Src, []); #ret{} -> [hipe_x86:mk_temp(?HIPE_X86_REGISTERS:?RV(), 'tagged')]; #shift{src=Src,dst=Dst} -> addtemp(Src, addtemp(Dst, [])); + #test{src=Src, dst=Dst} -> addtemp(Src, addtemp(Dst, [])); %% comment, jcc, jmp_label, label, pseudo_jcc, pseudo_tailcall_prepare _ -> [] end. diff --git a/lib/hipe/x86/hipe_x86_encode.erl b/lib/hipe/x86/hipe_x86_encode.erl index 3b7be86608..2d1663d0d6 100644 --- a/lib/hipe/x86/hipe_x86_encode.erl +++ b/lib/hipe/x86/hipe_x86_encode.erl @@ -65,6 +65,7 @@ cc/1, % 8-bit registers %% al/0, cl/0, dl/0, bl/0, ah/0, ch/0, dh/0, bh/0, + reg_has_8bit/1, % 32-bit registers %% eax/0, ecx/0, edx/0, ebx/0, esp/0, ebp/0, esi/0, edi/0, % operands @@ -143,6 +144,8 @@ cc(g) -> ?CC_G. %% dh() -> ?DH. %% bh() -> ?BH. +reg_has_8bit(Reg) -> Reg =< ?BL. + %%% 32-bit registers -define(EAX, 2#000). @@ -700,8 +703,16 @@ shd_op_sizeof(Opnds) -> test_encode(Opnds) -> case Opnds of + {al, {imm8,Imm8}} -> + [16#A8, Imm8]; + {ax, {imm16,Imm16}} -> + [?PFX_OPND, 16#A9 | le16(Imm16, [])]; {eax, {imm32,Imm32}} -> [16#A9 | le32(Imm32, [])]; + {{rm8,RM8}, {imm8,Imm8}} -> + [16#F6 | encode_rm(RM8, 2#000, [Imm8])]; + {{rm16,RM16}, {imm16,Imm16}} -> + [?PFX_OPND, 16#F7 | encode_rm(RM16, 2#000, le16(Imm16, []))]; {{rm32,RM32}, {imm32,Imm32}} -> [16#F7 | encode_rm(RM32, 2#000, le32(Imm32, []))]; {{rm32,RM32}, {reg32,Reg32}} -> @@ -710,8 +721,16 @@ test_encode(Opnds) -> test_sizeof(Opnds) -> case Opnds of + {al, {imm8,_}} -> + 1 + 1; + {ax, {imm16,_}} -> + 2 + 2; {eax, {imm32,_}} -> 1 + 4; + {{rm8,RM8}, {imm8,_}} -> + 1 + sizeof_rm(RM8) + 1; + {{rm16,RM16}, {imm16,_}} -> + 2 + sizeof_rm(RM16) + 2; {{rm32,RM32}, {imm32,_}} -> 1 + sizeof_rm(RM32) + 4; {{rm32,RM32}, {reg32,_}} -> @@ -1283,7 +1302,11 @@ dotest1(OS) -> t(OS,'sub',{RM32,Imm8}), t(OS,'sub',{RM32,Reg32}), t(OS,'sub',{Reg32,RM32}), + t(OS,'test',{al,Imm8}), + t(OS,'test',{ax,Imm16}), t(OS,'test',{eax,Imm32}), + t(OS,'test',{RM8,Imm8}), + t(OS,'test',{RM16,Imm16}), t(OS,'test',{RM32,Imm32}), t(OS,'test',{RM32,Reg32}), t(OS,'xor',{eax,Imm32}), diff --git a/lib/hipe/x86/hipe_x86_frame.erl b/lib/hipe/x86/hipe_x86_frame.erl index fc782571bf..17253ad46f 100644 --- a/lib/hipe/x86/hipe_x86_frame.erl +++ b/lib/hipe/x86/hipe_x86_frame.erl @@ -116,6 +116,8 @@ do_insn(I, LiveOut, Context, FPoff) -> {do_ret(I, Context, FPoff), context_framesize(Context)}; #shift{} -> {[do_shift(I, Context, FPoff)], FPoff}; + #test{} -> + {[do_test(I, Context, FPoff)], FPoff}; _ -> % comment, jmp, label, pseudo_jcc, pseudo_tailcall_prepare {[I], FPoff} end. @@ -188,6 +190,12 @@ do_shift(I, Context, FPoff) -> Dst = conv_opnd(Dst0, FPoff, Context), I#shift{src=Src,dst=Dst}. +do_test(I, Context, FPoff) -> + #test{src=Src0,dst=Dst0} = I, + Src = conv_opnd(Src0, FPoff, Context), + Dst = conv_opnd(Dst0, FPoff, Context), + I#test{src=Src,dst=Dst}. + conv_opnd(Opnd, FPoff, Context) -> case opnd_is_pseudo(Opnd) of false -> diff --git a/lib/hipe/x86/hipe_x86_postpass.erl b/lib/hipe/x86/hipe_x86_postpass.erl index 4515822a34..f88a841cca 100644 --- a/lib/hipe/x86/hipe_x86_postpass.erl +++ b/lib/hipe/x86/hipe_x86_postpass.erl @@ -120,19 +120,15 @@ peep([#move{src=Src1, dst=Dst}, %% ElimCmp0 %% -------- -peep([C=#cmp{src=Src, dst=Dst},J=#jcc{cc=Cond, label=Lab}|Insns],Res,Lst) -> - case (((Src =:= #x86_imm{value=0}) or (Dst =:= #x86_imm{value=0})) and - ((Cond =:= 'eq') or (Cond =:= 'neq'))) of - true -> - Src2 = case Src of #x86_imm{value=0} -> Src; _ -> Dst end, - Cond2 = case Cond of 'eq' -> 'z'; 'neq' -> 'nz' end, - Test = #test{src=Src2, dst=#x86_imm{value=0}}, - Jump = #jcc{cc=Cond2, label=Lab}, - peep(Insns, [Jump, Test|Res], [elimCmp0|Lst]); - _ -> - peep(Insns, [J,C|Res], Lst) - end; - +peep([#cmp{src=#x86_imm{value=0}, dst=Dst=#x86_temp{}}|Insns],Res,Lst) -> + %% TEST leaves the adjust flag undefined, whereas CMP sets it properly (in + %% this case to 0). However, since HiPE does not use any instructions that + %% read the adjust flag, we can do this transform safely. + peep(Insns, [#test{src=Dst, dst=Dst} | Res], [elimCmp0_1|Lst]); +peep([#cmp{src=Src=#x86_temp{}, dst=#x86_imm{value=0}}, + J=#jcc{cc=Cond}|Insns],Res,Lst) + when Cond =:= 'e'; Cond =:= 'ne' -> % We're commuting the comparison + peep(Insns, [J, #test{src=Src, dst=Src} | Res], [elimCmp0_2|Lst]); %% ElimCmpTest %% ----------- @@ -187,6 +183,18 @@ peep([B = #alu{aluop=Op,src=#x86_imm{value=Val},dst=Dst}|Insns], Res, Lst) -> peep(Insns, [B|Res], Lst) end; +%% LeaToAdd +%% This rule transforms lea into add when the destination is the same as one of +%% the operands. Sound because lea is never used where the condition codes are +%% live (and would be clobbered by add). +%% ---------- +peep([#lea{mem=#x86_mem{base=#x86_temp{reg=DstR},off=Src}, + temp=Dst=#x86_temp{reg=DstR}}|Insns], Res, Lst) -> + peep(Insns, [#alu{aluop='add',src=Src,dst=Dst}|Res], [leaToAdd|Lst]); +peep([#lea{mem=#x86_mem{base=Src,off=#x86_temp{reg=DstR}}, + temp=Dst=#x86_temp{reg=DstR}}|Insns], Res, Lst) -> + peep(Insns, [#alu{aluop='add',src=Src,dst=Dst}|Res], [leaToAdd|Lst]); + %% SubToDec %% This rule turns "subl $1,Dst; jl Lab" into "decl Dst; jl Lab", which %% changes reduction counter tests to use decl instead of subl. @@ -209,6 +217,11 @@ trivial_goto_elimination(Insns) -> goto_elim(Insns, []). goto_elim([#jmp_label{label=Label}, I = #label{label=Label}|Insns], Res) -> goto_elim([I|Insns], Res); +goto_elim([#jcc{cc=CC, label=Label} = IJCC, + #jmp_label{label=BranchTgt}, + #label{label=Label} = ILBL|Insns], Res) -> + goto_elim([IJCC#jcc{cc=hipe_x86:neg_cc(CC), label=BranchTgt}, + ILBL|Insns], Res); goto_elim([I | Insns], Res) -> goto_elim(Insns, [I|Res]); goto_elim([], Res) -> diff --git a/lib/hipe/x86/hipe_x86_pp.erl b/lib/hipe/x86/hipe_x86_pp.erl index ff26a31877..942201a051 100644 --- a/lib/hipe/x86/hipe_x86_pp.erl +++ b/lib/hipe/x86/hipe_x86_pp.erl @@ -188,6 +188,12 @@ pp_insn(Dev, I, Pre) -> io:format(Dev, ", ", []), pp_dst(Dev, Dst), io:format(Dev, "\n", []); + #test{src=Src, dst=Dst} -> + io:format(Dev, "\ttest ", []), + pp_src(Dev, Src), + io:format(Dev, ", ", []), + pp_dst(Dev, Dst), + io:format(Dev, "\n", []); #fp_binop{src=Src, dst=Dst, op=Op} -> io:format(Dev, "\t~s ", [Op]), pp_dst(Dev, Dst), diff --git a/lib/hipe/x86/hipe_x86_ra_finalise.erl b/lib/hipe/x86/hipe_x86_ra_finalise.erl index edfd7b332c..1fd617570a 100644 --- a/lib/hipe/x86/hipe_x86_ra_finalise.erl +++ b/lib/hipe/x86/hipe_x86_ra_finalise.erl @@ -162,6 +162,10 @@ ra_insn(I, Map, FpMap) -> Src = ra_opnd(Src0, Map), Dst = ra_opnd(Dst0, Map), I#shift{src=Src,dst=Dst}; + #test{src=Src0,dst=Dst0} -> + Src = ra_opnd(Src0, Map), + Dst = ra_opnd(Dst0, Map), + I#test{src=Src,dst=Dst}; _ -> exit({?MODULE,ra_insn,I}) end. diff --git a/lib/hipe/x86/hipe_x86_ra_naive.erl b/lib/hipe/x86/hipe_x86_ra_naive.erl index 35de692e07..9371e4b1a5 100644 --- a/lib/hipe/x86/hipe_x86_ra_naive.erl +++ b/lib/hipe/x86/hipe_x86_ra_naive.erl @@ -100,6 +100,8 @@ do_insn(I) -> % Insn -> Insn list do_fp_binop(I); #shift{} -> do_shift(I); + #test{} -> + do_test(I); #label{} -> [I]; #pseudo_jcc{} -> @@ -310,6 +312,11 @@ do_shift(I) -> FixDst ++ [I#shift{dst=Dst}] end. +do_test(I) -> + #test{src=Src0,dst=Dst0} = I, + {FixSrc, Src, FixDst, Dst} = do_binary(Src0, Dst0), + FixSrc ++ FixDst ++ [I#test{src=Src,dst=Dst}]. + %%% Fix the operands of a binary op. %%% 1. remove pseudos from any explicit memory operands %%% 2. if both operands are (implicit or explicit) memory operands, diff --git a/lib/hipe/x86/hipe_x86_ra_postconditions.erl b/lib/hipe/x86/hipe_x86_ra_postconditions.erl index f496b71828..e7c397b5b7 100644 --- a/lib/hipe/x86/hipe_x86_ra_postconditions.erl +++ b/lib/hipe/x86/hipe_x86_ra_postconditions.erl @@ -83,6 +83,8 @@ do_insn(I, TempMap, Strategy) -> % Insn -> {Insn list, DidSpill} do_fmove(I, TempMap, Strategy); #shift{} -> do_shift(I, TempMap, Strategy); + #test{} -> + do_test(I, TempMap, Strategy); _ -> %% comment, jmp*, label, pseudo_call, pseudo_jcc, pseudo_tailcall, %% pseudo_tailcall_prepare, push, ret @@ -308,6 +310,14 @@ do_shift(I, TempMap, Strategy) -> {FixDst ++ [I#shift{dst=Dst}], DidSpill} end. +%%% Fix a test op. + +do_test(I, TempMap, Strategy) -> + #test{src=Src0,dst=Dst0} = I, + {FixSrc, Src, FixDst, Dst, DidSpill} = + do_binary(Src0, Dst0, TempMap, Strategy), + {FixSrc ++ FixDst ++ [I#test{src=Src,dst=Dst}], DidSpill}. + %%% Fix the operands of a binary op. %%% 1. remove pseudos from any explicit memory operands %%% 2. if both operands are (implicit or explicit) memory operands, diff --git a/lib/inets/src/http_client/httpc_request.erl b/lib/inets/src/http_client/httpc_request.erl index e8d020c165..89872a3831 100644 --- a/lib/inets/src/http_client/httpc_request.erl +++ b/lib/inets/src/http_client/httpc_request.erl @@ -88,9 +88,11 @@ send(SendAddr, Socket, SocketType, case Address of SendAddr -> {TmpHdrs2, Path ++ Query}; - _Proxy -> + _Proxy when SocketType == ip_comm -> TmpHdrs3 = handle_proxy(HttpOptions, TmpHdrs2), - {TmpHdrs3, AbsUri} + {TmpHdrs3, AbsUri}; + _ -> + {TmpHdrs2, Path ++ Query} end, FinalHeaders = diff --git a/lib/kernel/src/kernel.appup.src b/lib/kernel/src/kernel.appup.src index 82cf73cbda..b505524471 100644 --- a/lib/kernel/src/kernel.appup.src +++ b/lib/kernel/src/kernel.appup.src @@ -18,9 +18,7 @@ %% %CopyrightEnd% {"%VSN%", %% Up from - max one major revision back - [{<<"5\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* - {<<"4\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-18.* + [{<<"5\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-19.* %% Down to - max one major revision back - [{<<"5\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* - {<<"4\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-18.* + [{<<"5\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-19.* }. diff --git a/lib/mnesia/src/mnesia.erl b/lib/mnesia/src/mnesia.erl index 9c7321ee43..7b0e4976a0 100644 --- a/lib/mnesia/src/mnesia.erl +++ b/lib/mnesia/src/mnesia.erl @@ -138,6 +138,36 @@ -include("mnesia.hrl"). -import(mnesia_lib, [verbose/2]). +-type create_option() :: + {'access_mode', 'read_write' | 'read_only'} | + {'attributes', [atom()]} | + {'disc_copies', [node()]} | + {'disc_only_copies', [node]} | + {'index', [index_attr()]} | + {'load_order', non_neg_integer()} | + {'majority', boolean()} | + {'ram_copies', [node()]} | + {'record_name', atom()} | + {'snmp', SnmpStruct::term()} | + {'storage_properties', [{Backend::module(), [BackendProp::_]}]} | + {'type', 'set' | 'ordered_set' | 'bag'} | + {'local_content', boolean()}. + +-type t_result(Res) :: {'atomic', Res} | {'aborted', Reason::term()}. +-type activity() :: 'ets' | 'async_dirty' | 'sync_dirty' | 'transaction' | 'sync_transaction' | + {'transaction', Retries::non_neg_integer()} | + {'sync_transaction', Retries::non_neg_integer()}. +-type table() :: atom(). +-type storage_type() :: 'ram_copies' | 'disc_copies' | 'disc_only_copies'. +-type index_attr() :: atom() | non_neg_integer(). +-type write_locks() :: 'write' | 'sticky_write'. +-type read_locks() :: 'read'. +-type lock_kind() :: write_locks() | read_locks(). +-type select_continuation() :: term(). +-type snmp_struct() :: [{atom(), snmp_type() | tuple_of(snmp_type())}]. +-type snmp_type() :: 'fix_string' | 'string' | 'integer'. +-type tuple_of(_) :: tuple(). + -define(DEFAULT_ACCESS, ?MODULE). %% Select @@ -196,7 +226,7 @@ e_has_var(X, Pos) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Start and stop - +-spec start() -> 'ok' | {'error', term()}. start() -> start([]). @@ -216,6 +246,7 @@ start_() -> {error, R} end. +-spec start([{Option::atom(), Value::_}]) -> 'ok' | {'error', term()}. start(ExtraEnv) when is_list(ExtraEnv) -> case mnesia_lib:ensure_loaded(?APPLICATION) of ok -> @@ -238,6 +269,7 @@ patched_start([Head | _]) -> patched_start([]) -> start_(). +-spec stop() -> 'stopped' | {'error', term()}. stop() -> case application:stop(?APPLICATION) of ok -> stopped; @@ -245,6 +277,7 @@ stop() -> Other -> Other end. +-spec change_config(Config::atom(), Value::_) -> ok | {error, term()}. change_config(extra_db_nodes, Ns) when is_list(Ns) -> mnesia_controller:connect_nodes(Ns); change_config(dc_dump_limit, N) when is_number(N), N > 0 -> @@ -312,12 +345,12 @@ ms() -> %% Activity mgt -spec abort(_) -> no_return(). - abort(Reason = {aborted, _}) -> exit(Reason); abort(Reason) -> exit({aborted, Reason}). +-spec is_transaction() -> boolean(). is_transaction() -> case get(mnesia_activity_state) of {_, Tid, _Ts} when element(1,Tid) == tid -> @@ -326,29 +359,52 @@ is_transaction() -> false end. +-spec transaction(Fun) -> t_result(Res) when + Fun :: fun(() -> Res). transaction(Fun) -> transaction(get(mnesia_activity_state), Fun, [], infinity, ?DEFAULT_ACCESS, async). + +-spec transaction(Fun, Retries) -> t_result(Res) when + Fun :: fun(() -> Res), + Retries :: non_neg_integer() | 'infinity'; + (Fun, [Arg::_]) -> t_result(Res) when + Fun :: fun((...) -> Res). transaction(Fun, Retries) when is_integer(Retries), Retries >= 0 -> transaction(get(mnesia_activity_state), Fun, [], Retries, ?DEFAULT_ACCESS, async); transaction(Fun, Retries) when Retries == infinity -> transaction(get(mnesia_activity_state), Fun, [], Retries, ?DEFAULT_ACCESS, async); transaction(Fun, Args) -> transaction(get(mnesia_activity_state), Fun, Args, infinity, ?DEFAULT_ACCESS, async). + +-spec transaction(Fun, [Arg::_], Retries) -> t_result(Res) when + Fun :: fun((...) -> Res), + Retries :: non_neg_integer() | 'infinity'. transaction(Fun, Args, Retries) -> transaction(get(mnesia_activity_state), Fun, Args, Retries, ?DEFAULT_ACCESS, async). +-spec sync_transaction(Fun) -> t_result(Res) when + Fun :: fun(() -> Res). sync_transaction(Fun) -> transaction(get(mnesia_activity_state), Fun, [], infinity, ?DEFAULT_ACCESS, sync). + +-spec sync_transaction(Fun, Retries) -> t_result(Res) when + Fun :: fun(() -> Res), + Retries :: non_neg_integer() | 'infinity'; + (Fun, [Arg::_]) -> t_result(Res) when + Fun :: fun((...) -> Res). sync_transaction(Fun, Retries) when is_integer(Retries), Retries >= 0 -> transaction(get(mnesia_activity_state), Fun, [], Retries, ?DEFAULT_ACCESS, sync); sync_transaction(Fun, Retries) when Retries == infinity -> transaction(get(mnesia_activity_state), Fun, [], Retries, ?DEFAULT_ACCESS, sync); sync_transaction(Fun, Args) -> transaction(get(mnesia_activity_state), Fun, Args, infinity, ?DEFAULT_ACCESS, sync). + +-spec sync_transaction(Fun, [Arg::_], Retries) -> t_result(Res) when + Fun :: fun((...) -> Res), + Retries :: non_neg_integer() | 'infinity'. sync_transaction(Fun, Args, Retries) -> transaction(get(mnesia_activity_state), Fun, Args, Retries, ?DEFAULT_ACCESS, sync). - transaction(State, Fun, Args, Retries, Mod, Kind) when is_function(Fun), is_list(Args), Retries == infinity, is_atom(Mod) -> mnesia_tm:transaction(State, Fun, Args, Retries, Mod, Kind); @@ -364,28 +420,60 @@ non_transaction(State, Fun, Args, ActivityKind, Mod) non_transaction(_State, Fun, Args, _ActivityKind, _Mod) -> {aborted, {badarg, Fun, Args}}. +-spec async_dirty(Fun) -> Res | no_return() when + Fun :: fun(() -> Res). async_dirty(Fun) -> async_dirty(Fun, []). + +-spec async_dirty(Fun, [Arg::_]) -> Res | no_return() when + Fun :: fun((...) -> Res). async_dirty(Fun, Args) -> non_transaction(get(mnesia_activity_state), Fun, Args, async_dirty, ?DEFAULT_ACCESS). +-spec sync_dirty(Fun) -> Res | no_return() when + Fun :: fun(() -> Res). sync_dirty(Fun) -> sync_dirty(Fun, []). + +-spec sync_dirty(Fun, [Arg::_]) -> Res | no_return() when + Fun :: fun((...) -> Res). sync_dirty(Fun, Args) -> non_transaction(get(mnesia_activity_state), Fun, Args, sync_dirty, ?DEFAULT_ACCESS). +-spec ets(Fun) -> Res | no_return() when + Fun :: fun(() -> Res). ets(Fun) -> ets(Fun, []). + +-spec ets(Fun, [Arg::_]) -> Res | no_return() when + Fun :: fun((...) -> Res). ets(Fun, Args) -> non_transaction(get(mnesia_activity_state), Fun, Args, ets, ?DEFAULT_ACCESS). +-spec activity(Kind, Fun) -> t_result(Res) | Res when + Kind :: activity(), + Fun :: fun(() -> Res). activity(Kind, Fun) -> activity(Kind, Fun, []). + +-spec activity(Kind, Fun, [Arg::_]) -> t_result(Res) | Res when + Kind :: activity(), + Fun :: fun((...) -> Res); + (Kind, Fun, Mod) -> t_result(Res) | Res when + Kind :: activity(), + Fun :: fun(() -> Res), + Mod :: atom(). + activity(Kind, Fun, Args) when is_list(Args) -> activity(Kind, Fun, Args, mnesia_monitor:get_env(access_module)); activity(Kind, Fun, Mod) -> activity(Kind, Fun, [], Mod). +-spec activity(Kind, Fun, [Arg::_], Mod) -> t_result(Res) | Res when + Kind :: activity(), + Fun :: fun((...) -> Res), + Mod :: atom(). + activity(Kind, Fun, Args, Mod) -> State = get(mnesia_activity_state), case Kind of @@ -415,7 +503,11 @@ wrap_trans(State, Fun, Args, Retries, Mod, Kind) -> %% Nodes may either be a list of nodes or one node as an atom %% Mnesia on all Nodes must be connected to each other, but %% it is not neccessary that they are up and running. - +-spec lock(LockItem, LockKind) -> list() | tuple() | no_return() when + LockItem :: {'record', table(), Key::term()} | + {'table', table()} | + {'global', Key::term(), MnesiaNodes::[node()]}, + LockKind :: lock_kind() | 'load'. lock(LockItem, LockKind) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -426,6 +518,9 @@ lock(LockItem, LockKind) -> abort(no_transaction) end. +-spec lock_table(Tab::table(), LockKind) -> [MnesiaNode] | no_return() when + MnesiaNode :: node(), + LockKind :: lock_kind() | load. lock_table(Tab, LockKind) -> lock({table, Tab}, LockKind). @@ -447,11 +542,13 @@ lock(Tid, Ts, LockItem, LockKind) -> end. %% Grab a read lock on a whole table +-spec read_lock_table(Tab::table()) -> ok. read_lock_table(Tab) -> lock({table, Tab}, read), ok. %% Grab a write lock on a whole table +-spec write_lock_table(Tab::table()) -> ok. write_lock_table(Tab) -> lock({table, Tab}, write), ok. @@ -516,17 +613,19 @@ good_global_nodes(Nodes) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Access within an activity - updates - +-spec write(Record::tuple()) -> 'ok'. write(Val) when is_tuple(Val), tuple_size(Val) > 2 -> Tab = element(1, Val), write(Tab, Val, write); write(Val) -> abort({bad_type, Val}). +-spec s_write(Record::tuple()) -> 'ok'. s_write(Val) when is_tuple(Val), tuple_size(Val) > 2 -> Tab = element(1, Val), write(Tab, Val, sticky_write). +-spec write(Tab::table(), Record::tuple(), LockKind::write_locks()) -> 'ok'. write(Tab, Val, LockKind) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -573,16 +672,19 @@ write_to_store(Tab, Store, Oid, Val) -> end, ok. +-spec delete({Tab::table(), Key::_}) -> 'ok'. delete({Tab, Key}) -> delete(Tab, Key, write); delete(Oid) -> abort({bad_type, Oid}). +-spec s_delete({Tab::table(), Key::_}) -> 'ok'. s_delete({Tab, Key}) -> delete(Tab, Key, sticky_write); s_delete(Oid) -> abort({bad_type, Oid}). +-spec delete(Tab::table(), Key::_, LockKind::write_locks()) -> 'ok'. delete(Tab, Key, LockKind) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -619,18 +721,21 @@ delete(Tid, Ts, Tab, Key, LockKind) delete(_Tid, _Ts, Tab, _Key, _LockKind) -> abort({bad_type, Tab}). +-spec delete_object(Rec::tuple()) -> 'ok'. delete_object(Val) when is_tuple(Val), tuple_size(Val) > 2 -> Tab = element(1, Val), delete_object(Tab, Val, write); delete_object(Val) -> abort({bad_type, Val}). +-spec s_delete_object(Rec::tuple()) -> 'ok'. s_delete_object(Val) when is_tuple(Val), tuple_size(Val) > 2 -> Tab = element(1, Val), delete_object(Tab, Val, sticky_write); s_delete_object(Val) -> abort({bad_type, Val}). +-spec delete_object(Tab::table(), Rec::tuple(), LockKind::write_locks()) -> 'ok'. delete_object(Tab, Val, LockKind) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -690,19 +795,23 @@ do_delete_object(Tid, Ts, Tab, Val, LockKind) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Access within an activity - read +-spec read(Tab::table(), Key::_) -> [tuple()]. read(Tab, Key) -> read(Tab, Key, read). +-spec read({Tab::table(), Key::_}) -> [tuple()]. read({Tab, Key}) -> read(Tab, Key, read); read(Oid) -> abort({bad_type, Oid}). +-spec wread({Tab::table(), Key::_}) -> [tuple()]. wread({Tab, Key}) -> read(Tab, Key, write); wread(Oid) -> abort({bad_type, Oid}). +-spec read(Tab::table(), Key::_, LockKind::lock_kind()) -> [tuple()]. read(Tab, Key, LockKind) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -739,6 +848,7 @@ read(Tid, Ts, Tab, Key, LockKind) read(_Tid, _Ts, Tab, _Key, _LockKind) -> abort({bad_type, Tab}). +-spec first(Tab::table()) -> Key::term(). first(Tab) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -766,6 +876,7 @@ first(Tid, Ts, Tab) first(_Tid, _Ts,Tab) -> abort({bad_type, Tab}). +-spec last(Tab::table()) -> Key::term(). last(Tab) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -793,6 +904,7 @@ last(Tid, Ts, Tab) last(_Tid, _Ts,Tab) -> abort({bad_type, Tab}). +-spec next(Tab::table(), Key::term()) -> NextKey::term(). next(Tab,Key) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS,Tid,Ts} -> @@ -819,6 +931,7 @@ next(Tid,Ts,Tab,Key) next(_Tid, _Ts,Tab,_) -> abort({bad_type, Tab}). +-spec prev(Tab::table(), Key::term()) -> PrevKey::term(). prev(Tab,Key) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS,Tid,Ts} -> @@ -953,6 +1066,8 @@ ts_keys_1([], Acc) -> %%%%%%%%%%%%%%%%%%%%% %% Iterators +-spec foldl(Fun, Acc0, Tab::table()) -> Acc when + Fun::fun((Record::tuple(), Acc0) -> Acc). foldl(Fun, Acc, Tab) -> foldl(Fun, Acc, Tab, read). @@ -993,6 +1108,8 @@ do_foldl(A, O, Tab, Key, Fun, Acc, Type, Stored) -> %% Type is set or bag {_, Tid, Ts} = get(mnesia_activity_state), do_foldl(Tid, Ts, Tab, dirty_next(Tab, Key), Fun, NewAcc, Type, NewStored). +-spec foldr(Fun, Acc0, Tab::table()) -> Acc when + Fun::fun((Record::tuple(), Acc0) -> Acc). foldr(Fun, Acc, Tab) -> foldr(Fun, Acc, Tab, read). foldr(Fun, Acc, Tab, LockKind) when is_function(Fun) -> @@ -1106,12 +1223,15 @@ add_written_to_bag([{_, _ , delete} | Tail], _Objs, _Ack) -> add_written_to_bag([{_, Val, delete_object} | Tail], Objs, Ack) -> add_written_to_bag(Tail, lists:delete(Val, Objs), lists:delete(Val, Ack)). +-spec match_object(Pattern::tuple()) -> [Record::tuple()]. match_object(Pat) when is_tuple(Pat), tuple_size(Pat) > 2 -> Tab = element(1, Pat), match_object(Tab, Pat, read); match_object(Pat) -> abort({bad_type, Pat}). +-spec match_object(Tab,Pattern,LockKind) -> [Record] when + Tab::table(),Pattern::tuple(),LockKind::lock_kind(),Record::tuple(). match_object(Tab, Pat, LockKind) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -1271,9 +1391,13 @@ deloid(Oid, [H | T]) -> %%%%%%%%%%%%%%%%%% % select - +-spec select(Tab, Spec) -> [Match] when + Tab::table(), Spec::ets:match_spec(), Match::term(). select(Tab, Pat) -> select(Tab, Pat, read). +-spec select(Tab, Spec, LockKind) -> [Match] when + Tab::table(), Spec::ets:match_spec(), + Match::term(),LockKind::lock_kind(). select(Tab, Pat, LockKind) when is_atom(Tab), Tab /= schema, is_list(Pat) -> case get(mnesia_activity_state) of @@ -1332,6 +1456,11 @@ select_lock(Tid,Ts,LockKind,Spec,Tab) -> end. %% Breakable Select +-spec select(Tab, Spec, N, LockKind) -> {[Match], Cont} | '$end_of_table' when + Tab::table(), Spec::ets:match_spec(), + Match::term(), N::non_neg_integer(), + LockKind::lock_kind(), + Cont::select_continuation(). select(Tab, Pat, NObjects, LockKind) when is_atom(Tab), Tab /= schema, is_list(Pat), is_integer(NObjects) -> case get(mnesia_activity_state) of @@ -1388,6 +1517,9 @@ fun_select(Tid, Ts, Tab, Spec, LockKind, TabPat, Init, NObjects, Node, Storage) select_state(Init(Spec),Def) end. +-spec select(Cont) -> {[Match], Cont} | '$end_of_table' when + Match::term(), + Cont::select_continuation(). select(Cont) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -1437,6 +1569,7 @@ get_record_pattern([]) -> []; get_record_pattern([{M,C,_B}|R]) -> [{M,C,['$_']} | get_record_pattern(R)]. +-spec all_keys(Tab::table()) -> [Key::term()]. all_keys(Tab) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -1461,12 +1594,20 @@ all_keys(Tid, Ts, Tab, LockKind) all_keys(_Tid, _Ts, Tab, _LockKind) -> abort({bad_type, Tab}). +-spec index_match_object(Pattern, Attr) -> [Record] when + Pattern::tuple(), Attr::index_attr(), Record::tuple(). index_match_object(Pat, Attr) when is_tuple(Pat), tuple_size(Pat) > 2 -> Tab = element(1, Pat), index_match_object(Tab, Pat, Attr, read); index_match_object(Pat, _Attr) -> abort({bad_type, Pat}). +-spec index_match_object(Tab, Pattern, Attr, LockKind) -> [Record] when + Tab::table(), + Pattern::tuple(), + Attr::index_attr(), + LockKind::lock_kind(), + Record::tuple(). index_match_object(Tab, Pat, Attr, LockKind) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -1503,6 +1644,11 @@ index_match_object(Tid, Ts, Tab, Pat, Attr, LockKind) index_match_object(_Tid, _Ts, Tab, Pat, _Attr, _LockKind) -> abort({bad_type, Tab, Pat}). +-spec index_read(Tab, Key, Attr) -> [Record] when + Tab::table(), + Key::term(), + Attr::index_attr(), + Record::tuple(). index_read(Tab, Key, Attr) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -1542,13 +1688,14 @@ index_read(_Tid, _Ts, Tab, _Key, _Attr, _LockKind) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Dirty access regardless of activities - updates - +-spec dirty_write(Record::tuple()) -> 'ok'. dirty_write(Val) when is_tuple(Val), tuple_size(Val) > 2 -> Tab = element(1, Val), dirty_write(Tab, Val); dirty_write(Val) -> abort({bad_type, Val}). +-spec dirty_write(Tab::table(), Record::tuple()) -> 'ok'. dirty_write(Tab, Val) -> do_dirty_write(async_dirty, Tab, Val). @@ -1560,11 +1707,13 @@ do_dirty_write(SyncMode, Tab, Val) do_dirty_write(_SyncMode, Tab, Val) -> abort({bad_type, Tab, Val}). +-spec dirty_delete({Tab::table(), Key::_}) -> 'ok'. dirty_delete({Tab, Key}) -> dirty_delete(Tab, Key); dirty_delete(Oid) -> abort({bad_type, Oid}). +-spec dirty_delete(Tab::table(), Key::_) -> 'ok'. dirty_delete(Tab, Key) -> do_dirty_delete(async_dirty, Tab, Key). @@ -1574,12 +1723,14 @@ do_dirty_delete(SyncMode, Tab, Key) when is_atom(Tab), Tab /= schema -> do_dirty_delete(_SyncMode, Tab, _Key) -> abort({bad_type, Tab}). +-spec dirty_delete_object(Record::tuple()) -> 'ok'. dirty_delete_object(Val) when is_tuple(Val), tuple_size(Val) > 2 -> Tab = element(1, Val), dirty_delete_object(Tab, Val); dirty_delete_object(Val) -> abort({bad_type, Val}). +-spec dirty_delete_object(Tab::table(), Record::tuple()) -> 'ok'. dirty_delete_object(Tab, Val) -> do_dirty_delete_object(async_dirty, Tab, Val). @@ -1597,12 +1748,15 @@ do_dirty_delete_object(_SyncMode, Tab, Val) -> abort({bad_type, Tab, Val}). %% A Counter is an Oid being {CounterTab, CounterName} - +-spec dirty_update_counter({Tab::table(), Key::_}, Incr::integer()) -> + NewVal::integer(). dirty_update_counter({Tab, Key}, Incr) -> dirty_update_counter(Tab, Key, Incr); dirty_update_counter(Counter, _Incr) -> abort({bad_type, Counter}). +-spec dirty_update_counter(Tab::table(), Key::_, Incr::integer()) -> + NewVal::integer(). dirty_update_counter(Tab, Key, Incr) -> do_dirty_update_counter(async_dirty, Tab, Key, Incr). @@ -1621,23 +1775,28 @@ do_dirty_update_counter(_SyncMode, Tab, _Key, Incr) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Dirty access regardless of activities - read +-spec dirty_read({Tab::table(), Key::_}) -> [tuple()]. dirty_read({Tab, Key}) -> dirty_read(Tab, Key); dirty_read(Oid) -> abort({bad_type, Oid}). +-spec dirty_read(Tab::table(), Key::_) -> [tuple()]. dirty_read(Tab, Key) when is_atom(Tab), Tab /= schema -> dirty_rpc(Tab, mnesia_lib, db_get, [Tab, Key]); dirty_read(Tab, _Key) -> abort({bad_type, Tab}). +-spec dirty_match_object(Pattern::tuple()) -> [Record::tuple()]. dirty_match_object(Pat) when is_tuple(Pat), tuple_size(Pat) > 2 -> Tab = element(1, Pat), dirty_match_object(Tab, Pat); dirty_match_object(Pat) -> abort({bad_type, Pat}). +-spec dirty_match_object(Tab,Pattern) -> [Record] when + Tab::table(), Pattern::tuple(), Record::tuple(). dirty_match_object(Tab, Pat) when is_atom(Tab), Tab /= schema, is_tuple(Pat), tuple_size(Pat) > 2 -> dirty_rpc(Tab, ?MODULE, remote_dirty_match_object, [Tab, Pat]); @@ -1667,6 +1826,8 @@ remote_dirty_match_object(Tab, Pat, []) -> remote_dirty_match_object(Tab, Pat, _PosList) -> abort({bad_type, Tab, Pat}). +-spec dirty_select(Tab, Spec) -> [Match] when + Tab::table(), Spec::ets:match_spec(), Match::term(). dirty_select(Tab, Spec) when is_atom(Tab), Tab /= schema, is_list(Spec) -> dirty_rpc(Tab, ?MODULE, remote_dirty_select, [Tab, Spec]); dirty_select(Tab, Spec) -> @@ -1715,6 +1876,7 @@ dirty_sel_cont(#mnesia_select{cont='$end_of_table'}) -> '$end_of_table'; dirty_sel_cont(#mnesia_select{node=Node,tab=Tab,storage=Type,cont=Cont,orig=Ms}) -> do_dirty_rpc(Tab,Node,mnesia_lib,db_select_cont,[Type,Cont,Ms]). +-spec dirty_all_keys(Tab::table()) -> [Key::term()]. dirty_all_keys(Tab) when is_atom(Tab), Tab /= schema -> case ?catch_val({Tab, wild_pattern}) of {'EXIT', _} -> @@ -1730,12 +1892,19 @@ dirty_all_keys(Tab) when is_atom(Tab), Tab /= schema -> dirty_all_keys(Tab) -> abort({bad_type, Tab}). +-spec dirty_index_match_object(Pattern, Attr) -> [Record] when + Pattern::tuple(), Attr::index_attr(), Record::tuple(). dirty_index_match_object(Pat, Attr) when is_tuple(Pat), tuple_size(Pat) > 2 -> Tab = element(1, Pat), dirty_index_match_object(Tab, Pat, Attr); dirty_index_match_object(Pat, _Attr) -> abort({bad_type, Pat}). +-spec dirty_index_match_object(Tab, Pattern, Attr) -> [Record] when + Tab::table(), + Pattern::tuple(), + Attr::index_attr(), + Record::tuple(). dirty_index_match_object(Tab, Pat, Attr) when is_atom(Tab), Tab /= schema, is_tuple(Pat), tuple_size(Pat) > 2 -> case mnesia_schema:attr_tab_to_pos(Tab, Attr) of @@ -1759,6 +1928,11 @@ dirty_index_match_object(Tab, Pat, Attr) dirty_index_match_object(Tab, Pat, _Attr) -> abort({bad_type, Tab, Pat}). +-spec dirty_index_read(Tab, Key, Attr) -> [Record] when + Tab::table(), + Key::term(), + Attr::index_attr(), + Record::tuple(). dirty_index_read(Tab, Key, Attr) when is_atom(Tab), Tab /= schema -> Pos = mnesia_schema:attr_tab_to_pos(Tab, Attr), case has_var(Key) of @@ -1770,26 +1944,31 @@ dirty_index_read(Tab, Key, Attr) when is_atom(Tab), Tab /= schema -> dirty_index_read(Tab, _Key, _Attr) -> abort({bad_type, Tab}). +%% do not use only for backwards compatibility dirty_slot(Tab, Slot) when is_atom(Tab), Tab /= schema, is_integer(Slot) -> dirty_rpc(Tab, mnesia_lib, db_slot, [Tab, Slot]); dirty_slot(Tab, Slot) -> abort({bad_type, Tab, Slot}). +-spec dirty_first(Tab::table()) -> Key::term(). dirty_first(Tab) when is_atom(Tab), Tab /= schema -> dirty_rpc(Tab, mnesia_lib, db_first, [Tab]); dirty_first(Tab) -> abort({bad_type, Tab}). +-spec dirty_last(Tab::table()) -> Key::term(). dirty_last(Tab) when is_atom(Tab), Tab /= schema -> dirty_rpc(Tab, mnesia_lib, db_last, [Tab]); dirty_last(Tab) -> abort({bad_type, Tab}). +-spec dirty_next(Tab::table(), Key::_) -> NextKey::term(). dirty_next(Tab, Key) when is_atom(Tab), Tab /= schema -> dirty_rpc(Tab, mnesia_lib, db_next_key, [Tab, Key]); dirty_next(Tab, _Key) -> abort({bad_type, Tab}). +-spec dirty_prev(Tab::table(), Key::_) -> PrevKey::term(). dirty_prev(Tab, Key) when is_atom(Tab), Tab /= schema -> dirty_rpc(Tab, mnesia_lib, db_prev_key, [Tab, Key]); dirty_prev(Tab, _Key) -> @@ -1840,7 +2019,7 @@ do_dirty_rpc(Tab, Node, M, F, Args) -> %% Info %% Info about one table --spec table_info(atom(), any()) -> any(). +-spec table_info(Tab::table(), Item::term()) -> Info::term(). table_info(Tab, Item) -> case get(mnesia_activity_state) of undefined -> @@ -1928,16 +2107,20 @@ bad_info_reply(_Tab, memory) -> 0; bad_info_reply(Tab, Item) -> abort({no_exists, Tab, Item}). %% Raw info about all tables +-spec schema() -> ok. schema() -> mnesia_schema:info(). %% Raw info about one tables +-spec schema(Tab::table()) -> ok. schema(Tab) -> mnesia_schema:info(Tab). +-spec error_description(Error::term()) -> string(). error_description(Err) -> mnesia_lib:error_desc(Err). +-spec info() -> ok. info() -> case mnesia_lib:is_running() of yes -> @@ -2063,6 +2246,7 @@ display_tab_info() -> Rdisp = fun({Rpat, Rtabs}) -> io:format("~p = ~p~n", [Rpat, Rtabs]) end, lists:foreach(Rdisp, lists:sort(Repl)). +-spec get_backend_types() -> [BackendType::term()]. get_backend_types() -> case ?catch_val({schema, user_property, mnesia_backend_types}) of {'EXIT', _} -> @@ -2071,6 +2255,7 @@ get_backend_types() -> lists:sort(Ts) end. +-spec get_index_plugins() -> [IndexPlugins::term()]. get_index_plugins() -> case ?catch_val({schema, user_property, mnesia_index_plugins}) of {'EXIT', _} -> @@ -2119,6 +2304,7 @@ storage_count(T, {U, R, D, DO, Ext}) -> {ext, A, _} -> {U, R, D, DO, orddict:append(A, T, Ext)} end. +-spec system_info(Iterm::term()) -> Info::term(). system_info(Item) -> try system_info2(Item) catch _:Error -> abort(Error) @@ -2368,83 +2554,134 @@ load_mnesia_or_abort() -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Database mgt +-spec create_schema(Ns::[node()]) -> 'ok' | {'error', Reason::term()}. create_schema(Ns) -> create_schema(Ns, []). +-spec create_schema(Ns::[node()], [Prop]) -> 'ok' | {'error', Reason::term()} when + Prop :: BackendType | IndexPlugin, + BackendType :: {backend_types, [{Name::atom(), Module::module()}]}, + IndexPlugin :: {index_plugins, [{{Name::atom()}, Module::module(), Function::atom()}]}. create_schema(Ns, Properties) -> mnesia_bup:create_schema(Ns, Properties). +-spec delete_schema(Ns::[node()]) -> 'ok' | {'error', Reason::term()}. delete_schema(Ns) -> mnesia_schema:delete_schema(Ns). +-spec add_backend_type(Name::atom(), Module::module()) -> t_result('ok'). add_backend_type(Alias, Module) -> mnesia_schema:add_backend_type(Alias, Module). +-spec backup(Dest::term()) -> 'ok' | {'error', Reason::term()}. backup(Opaque) -> mnesia_log:backup(Opaque). +-spec backup(Dest::term(), Mod::module()) -> + 'ok' | {'error', Reason::term()}. backup(Opaque, Mod) -> mnesia_log:backup(Opaque, Mod). +-spec traverse_backup(Src::term(), Dest::term(), Fun, Acc) -> + {'ok', Acc} | {'error', Reason::term()} when + Fun :: fun((Items, Acc) -> {Items,Acc}). traverse_backup(S, T, Fun, Acc) -> mnesia_bup:traverse_backup(S, T, Fun, Acc). +-spec traverse_backup(Src::term(), SrcMod::module(), + Dest::term(), DestMod::module(), + Fun, Acc) -> + {'ok', Acc} | {'error', Reason::term()} when + Fun :: fun((Items, Acc) -> {Items,Acc}). traverse_backup(S, SM, T, TM, F, A) -> mnesia_bup:traverse_backup(S, SM, T, TM, F, A). +-spec install_fallback(Src::term()) -> 'ok' | {'error', Reason::term()}. install_fallback(Opaque) -> mnesia_bup:install_fallback(Opaque). +-spec install_fallback(Src::term(), Mod::module()|[Opt]) -> + 'ok' | {'error', Reason::term()} when + Opt :: Module | Scope | Dir, + Module :: {'module', Mod::module()}, + Scope :: {'scope', 'global' | 'local'}, + Dir :: {'mnesia_dir', Dir::string()}. install_fallback(Opaque, Mod) -> mnesia_bup:install_fallback(Opaque, Mod). +-spec uninstall_fallback() -> 'ok' | {'error', Reason::term()}. uninstall_fallback() -> mnesia_bup:uninstall_fallback(). +-spec uninstall_fallback(Args) -> 'ok' | {'error', Reason::term()} when + Args :: [{'mnesia_dir', Dir::string()}]. uninstall_fallback(Args) -> mnesia_bup:uninstall_fallback(Args). +-spec activate_checkpoint([Arg]) -> {'ok', Name, [node()]} | {'error', Reason::term()} when + Arg :: {'name', Name} | {'max', [table()]} | {'min', [table()]} | + {'allow_remote', boolean()} | {'ram_overrides_dump', boolean()}. activate_checkpoint(Args) -> mnesia_checkpoint:activate(Args). +-spec deactivate_checkpoint(Name::_) -> 'ok' | {'error', Reason::term()}. deactivate_checkpoint(Name) -> mnesia_checkpoint:deactivate(Name). +-spec backup_checkpoint(Name::_, Dest::_) -> 'ok' | {'error', Reason::term()}. backup_checkpoint(Name, Opaque) -> mnesia_log:backup_checkpoint(Name, Opaque). +-spec backup_checkpoint(Name::_, Dest::_, Mod::module()) -> + 'ok' | {'error', Reason::term()}. backup_checkpoint(Name, Opaque, Mod) -> mnesia_log:backup_checkpoint(Name, Opaque, Mod). +-spec restore(Src::_, [Arg]) -> t_result([table()]) when + Op :: 'skip_tables' | 'clear_tables' | 'keep_tables' | 'restore_tables', + Arg :: {'module', module()} | {Op, [table()]} | {'default_op', Op}. restore(Opaque, Args) -> mnesia_schema:restore(Opaque, Args). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Table mgt - +-spec create_table([Arg]) -> t_result('ok') when + Arg :: {'name', table()} | create_option(). create_table(Arg) -> mnesia_schema:create_table(Arg). + +-spec create_table(Name::table(), [create_option()]) -> t_result('ok'). create_table(Name, Arg) when is_list(Arg) -> mnesia_schema:create_table([{name, Name}| Arg]); create_table(Name, Arg) -> {aborted, badarg, Name, Arg}. +-spec delete_table(Tab::table()) -> t_result('ok'). delete_table(Tab) -> mnesia_schema:delete_table(Tab). +-spec add_table_copy(Tab::table(), N::node(), ST::storage_type()) -> t_result(ok). add_table_copy(Tab, N, S) -> mnesia_schema:add_table_copy(Tab, N, S). + +-spec del_table_copy(Tab::table(), N::node()) -> t_result(ok). del_table_copy(Tab, N) -> mnesia_schema:del_table_copy(Tab, N). +-spec move_table_copy(Tab::table(), From::node(), To::node()) -> t_result(ok). move_table_copy(Tab, From, To) -> mnesia_schema:move_table(Tab, From, To). +-spec add_table_index(Tab::table(), I::index_attr()) -> t_result(ok). add_table_index(Tab, Ix) -> mnesia_schema:add_table_index(Tab, Ix). +-spec del_table_index(Tab::table(), I::index_attr()) -> t_result(ok). del_table_index(Tab, Ix) -> mnesia_schema:del_table_index(Tab, Ix). +-spec transform_table(Tab::table(), Fun, [Attr]) -> t_result(ok) when + Attr :: atom(), + Fun:: fun((Record::tuple()) -> Transformed::tuple()). transform_table(Tab, Fun, NewA) -> try val({Tab, record_name}) of OldRN -> mnesia_schema:transform_table(Tab, Fun, NewA, OldRN) @@ -2452,12 +2689,18 @@ transform_table(Tab, Fun, NewA) -> mnesia:abort(Reason) end. +-spec transform_table(Tab::table(), Fun, [Attr], RecName) -> t_result(ok) when + RecName :: atom(), + Attr :: atom(), + Fun:: fun((Record::tuple()) -> Transformed::tuple()). transform_table(Tab, Fun, NewA, NewRN) -> mnesia_schema:transform_table(Tab, Fun, NewA, NewRN). +-spec change_table_copy_type(Tab::table(), Node::node(), To::storage_type()) -> t_result(ok). change_table_copy_type(T, N, S) -> mnesia_schema:change_table_copy_type(T, N, S). +-spec clear_table(Tab::table()) -> t_result(ok). clear_table(Tab) -> case get(mnesia_activity_state) of State = {Mod, Tid, _Ts} when element(1, Tid) =/= tid -> @@ -2487,19 +2730,22 @@ clear_table(Tid, Ts, Tab, Obj) when element(1, Tid) =:= tid -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Table mgt - user properties - +-spec read_table_property(Tab::table(), PropKey::term()) -> Res::tuple(). read_table_property(Tab, PropKey) -> val({Tab, user_property, PropKey}). +-spec write_table_property(Tab::table(), Prop::tuple()) -> t_result(ok). write_table_property(Tab, Prop) -> mnesia_schema:write_table_property(Tab, Prop). +-spec delete_table_property(Tab::table(), PropKey::term()) -> t_result(ok). delete_table_property(Tab, PropKey) -> mnesia_schema:delete_table_property(Tab, PropKey). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Table mgt - user properties +-spec change_table_frag(Tab::table(), FP::term()) -> t_result(ok). change_table_frag(Tab, FragProp) -> mnesia_schema:change_table_frag(Tab, FragProp). @@ -2507,28 +2753,38 @@ change_table_frag(Tab, FragProp) -> %% Table mgt - table load %% Dump a ram table to disc +-spec dump_tables([Tab::table()]) -> t_result(ok). dump_tables(Tabs) -> mnesia_schema:dump_tables(Tabs). %% allow the user to wait for some tables to be loaded +-spec wait_for_tables([Tab::table()], TMO::timeout()) -> + 'ok' | {'timeout', [table()]} | {'error', Reason::term()}. wait_for_tables(Tabs, Timeout) -> mnesia_controller:wait_for_tables(Tabs, Timeout). +-spec force_load_table(Tab::table()) -> 'yes' | {'error', Reason::term()}. force_load_table(Tab) -> case mnesia_controller:force_load_table(Tab) of ok -> yes; % Backwards compatibility Other -> Other end. +-spec change_table_access_mode(Tab::table(), Mode) -> t_result(ok) when + Mode :: 'read_only'|'read_write'. change_table_access_mode(T, Access) -> mnesia_schema:change_table_access_mode(T, Access). +-spec change_table_load_order(Tab::table(), Order) -> t_result(ok) when + Order :: non_neg_integer(). change_table_load_order(T, O) -> mnesia_schema:change_table_load_order(T, O). +-spec change_table_majority(Tab::table(), M::boolean()) -> t_result(ok). change_table_majority(T, M) -> mnesia_schema:change_table_majority(T, M). +-spec set_master_nodes(Ns::[node()]) -> 'ok' | {'error', Reason::term()}. set_master_nodes(Nodes) when is_list(Nodes) -> UseDir = system_info(use_dir), IsRunning = system_info(is_running), @@ -2567,6 +2823,8 @@ log_valid_master_nodes(Cstructs, Nodes, UseDir, IsRunning) -> Args = lists:map(Fun, Cstructs), mnesia_recover:log_master_nodes(Args, UseDir, IsRunning). +-spec set_master_nodes(Tab::table(), Ns::[node()]) -> + 'ok' | {'error', Reason::term()}. set_master_nodes(Tab, Nodes) when is_list(Nodes) -> UseDir = system_info(use_dir), IsRunning = system_info(is_running), @@ -2617,31 +2875,39 @@ set_master_nodes(Tab, Nodes) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Misc admin - +-spec dump_log() -> 'dumped'. dump_log() -> mnesia_controller:sync_dump_log(user). +-spec sync_log() -> 'ok' | {'error', Reason::term()}. sync_log() -> mnesia_monitor:sync_log(latest_log). +-spec subscribe(What) -> {'ok', node()} | {'error', Reason::term()} when + What :: 'system' | 'activity' | {'table', table(), 'simple' | 'detailed'}. subscribe(What) -> mnesia_subscr:subscribe(self(), What). +-spec unsubscribe(What) -> {'ok', node()} | {'error', Reason::term()} when + What :: 'system' | 'activity' | {'table', table(), 'simple' | 'detailed'}. unsubscribe(What) -> mnesia_subscr:unsubscribe(self(), What). +-spec report_event(Event::_) -> 'ok'. report_event(Event) -> mnesia_lib:report_system_event({mnesia_user, Event}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Snmp - +-spec snmp_open_table(Tab::table(), Snmp::snmp_struct()) -> ok. snmp_open_table(Tab, Us) -> mnesia_schema:add_snmp(Tab, Us). +-spec snmp_close_table(Tab::table()) -> ok. snmp_close_table(Tab) -> mnesia_schema:del_snmp(Tab). +-spec snmp_get_row(Tab::table(), [integer()]) -> {'ok', Row::tuple()} | 'undefined'. snmp_get_row(Tab, RowIndex) when is_atom(Tab), Tab /= schema, is_list(RowIndex) -> case get(mnesia_activity_state) of {Mod, Tid, Ts=#tidstore{store=Store}} when element(1, Tid) =:= tid -> @@ -2677,7 +2943,7 @@ snmp_get_row(Tab, _RowIndex) -> abort({bad_type, Tab}). %%%%%%%%%%%%% - +-spec snmp_get_next_index(Tab::table(), [integer()]) -> {'ok', [integer()]} | 'endOfTable'. snmp_get_next_index(Tab, RowIndex) when is_atom(Tab), Tab /= schema, is_list(RowIndex) -> {Next,OrigKey} = dirty_rpc(Tab, mnesia_snmp_hook, get_next_index, [Tab, RowIndex]), case get(mnesia_activity_state) of @@ -2719,7 +2985,7 @@ get_ordered_snmp_key(_, []) -> endOfTable. %%%%%%%%%% - +-spec snmp_get_mnesia_key(Tab::table(), [integer()]) -> {'ok', Key::term()} | 'undefined'. snmp_get_mnesia_key(Tab, RowIndex) when is_atom(Tab), Tab /= schema, is_list(RowIndex) -> case get(mnesia_activity_state) of {_Mod, Tid, Ts} when element(1, Tid) =:= tid -> @@ -2783,17 +3049,27 @@ snmp_filter_key(undefined, RowIndex, Tab, Store) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Textfile access - +-spec load_textfile(File::file:filename()) -> t_result(ok) | {'error', term()}. load_textfile(F) -> mnesia_text:load_textfile(F). + +-spec dump_to_textfile(File :: file:filename()) -> 'ok' | 'error' | {'error', term()}. dump_to_textfile(F) -> mnesia_text:dump_to_textfile(F). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% QLC Handles %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-spec table(Tab::table()) -> qlc:query_handle(). table(Tab) -> table(Tab, []). + +-spec table(Tab::table(), Options) -> qlc:query_handle() when + Options :: Option | [Option], + Option :: MnesiaOpt | QlcOption, + MnesiaOpt :: {'traverse', SelectOp} | {lock, lock_kind()} | {n_objects, non_neg_integer()}, + SelectOp :: 'select' | {'select', ets:match_spec()}, + QlcOption :: {'key_equality', '==' | '=:='}. table(Tab,Opts) -> {[Trav,Lock,NObjects],QlcOptions0} = qlc_opts(Opts,[{traverse,select},{lock,read},{n_objects,100}]), diff --git a/lib/mnesia/src/mnesia_lib.erl b/lib/mnesia/src/mnesia_lib.erl index 10e232c800..1fdc656600 100644 --- a/lib/mnesia/src/mnesia_lib.erl +++ b/lib/mnesia/src/mnesia_lib.erl @@ -1192,25 +1192,15 @@ db_select(Storage, Tab, Pat) -> end. db_select_init({ext, Alias, Mod}, Tab, Pat, Limit) -> - case Mod:select(Alias, Tab, Pat, Limit) of - {Matches, Continuation} when is_list(Matches) -> - {Matches, {Alias, Continuation}}; - R -> - R - end; + Mod:select(Alias, Tab, Pat, Limit); db_select_init(disc_only_copies, Tab, Pat, Limit) -> dets:select(Tab, Pat, Limit); db_select_init(_, Tab, Pat, Limit) -> ets:select(Tab, Pat, Limit). -db_select_cont({ext, Alias, Mod}, Cont0, Ms) -> +db_select_cont({ext, _Alias, Mod}, Cont0, Ms) -> Cont = Mod:repair_continuation(Cont0, Ms), - case Mod:select(Cont) of - {Matches, Continuation} when is_list(Matches) -> - {Matches, {Alias, Continuation}}; - R -> - R - end; + Mod:select(Cont); db_select_cont(disc_only_copies, Cont0, Ms) -> Cont = dets:repair_continuation(Cont0, Ms), dets:select(Cont); diff --git a/lib/mnesia/test/ext_test.erl b/lib/mnesia/test/ext_test.erl index 45ddb148bc..b7904c95ac 100644 --- a/lib/mnesia/test/ext_test.erl +++ b/lib/mnesia/test/ext_test.erl @@ -233,5 +233,5 @@ select_1({Acc, C}) -> select(ext_ets, Tab, Ms, Limit) when is_integer(Limit); Limit =:= infinity -> ets:select(mnesia_lib:val({?MODULE,Tab}), Ms, Limit). -repair_continuation({Alias, Cont}, Ms) -> - {Alias, ets:repair_continuation(Cont, Ms)}. +repair_continuation(Cont, Ms) -> + ets:repair_continuation(Cont, Ms). diff --git a/lib/odbc/configure.in b/lib/odbc/configure.in index d26daa5eda..2dec6e5abf 100644 --- a/lib/odbc/configure.in +++ b/lib/odbc/configure.in @@ -65,7 +65,7 @@ dnl --------------------------------------------------------------------- dnl Special windows stuff regarding CFLAGS and details in the environment... dnl --------------------------------------------------------------------- LM_WINDOWS_ENVIRONMENT - + AC_PROG_MAKE_SET AC_CHECK_PROGS(LD, ld.sh) @@ -136,8 +136,8 @@ AC_CHECK_MEMBERS([struct sockaddr_in6.sin6_addr], [], [], dnl Checks for library functions. AC_CHECK_FUNCS([memset socket]) - -# ODBC + +# ODBC $RM -f "$ERL_TOP/lib/odbc/SKIP" LM_CHECK_THR_LIB @@ -146,24 +146,24 @@ AC_SUBST(THR_LIBS) odbc_lib_link_success=no AC_SUBST(TARGET_FLAGS) - case $host_os in - darwin1[[0-5]].*|darwin[[0-9]].*) + case $host_os in + darwin1[[0-9]].*) TARGET_FLAGS="-DUNIX" if test ! -d "$with_odbc" || test "$with_odbc" = "yes"; then - ODBC_LIB= -L"/usr/lib" - ODBC_INCLUDE="-I/usr/lib/include" + ODBC_LIB= -L"/usr/local/lib" + ODBC_INCLUDE="-I/usr/local/include" else ODBC_LIB=-L"$with_odbc/lib" ODBC_INCLUDE="-I$with_odbc/include" fi - - AC_CHECK_LIB(iodbc, SQLAllocHandle,[ODBC_LIB="$ODBC_LIB -liodbc"; odbc_lib_link_success=yes]) + + AC_CHECK_LIB(iodbc, SQLAllocHandle,[ODBC_LIB="$ODBC_LIB -lodbc"; odbc_lib_link_success=yes]) ;; win32|cygwin) TARGET_FLAGS="-DWIN32" AC_CHECK_LIB(ws2_32, main) if test ! -d "$with_odbc" || test "$with_odbc" = "yes"; then - ODBC_LIB="" + ODBC_LIB="" ODBC_INCLUDE="" else ODBC_LIB=-L"$with_odbc/lib" @@ -196,7 +196,7 @@ AC_SUBST(TARGET_FLAGS) elif test -d "${libdir}/64/."; then libdir="${libdir}/64" fi - fi + fi ODBC_LIB="-L$libdir" ODBC_INCLUDE="-I$erl_xcomp_isysroot$rdir/include" break @@ -207,7 +207,7 @@ AC_SUBST(TARGET_FLAGS) echo "No odbc library found" > "$ERL_TOP/lib/odbc/SKIP" else AC_MSG_RESULT($ODBC_LIB) - AC_CHECK_LIB(odbc, SQLAllocHandle,[ODBC_LIB="$ODBC_LIB -lodbc"; odbc_lib_link_success=yes]) + AC_CHECK_LIB(odbc, SQLAllocHandle,[ODBC_LIB="$ODBC_LIB -lodbc"; odbc_lib_link_success=yes]) fi ;; diff --git a/lib/sasl/src/sasl.appup.src b/lib/sasl/src/sasl.appup.src index ecd320c1ea..7f866507a0 100644 --- a/lib/sasl/src/sasl.appup.src +++ b/lib/sasl/src/sasl.appup.src @@ -18,9 +18,7 @@ %% %CopyrightEnd% {"%VSN%", %% Up from - max one major revision back - [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* - {<<"2\\.[5-7](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-18.* + [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-19.* %% Down to - max one major revision back - [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* - {<<"2\\.[5-7](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-18.* + [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-19.* }. diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index efe6cc9eb4..6a16c8689e 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -643,6 +643,8 @@ get_items([], _Dict) -> check_item({_,{mod,{M,A}}},_) when is_atom(M) -> {M,A}; +check_item({_,{mod,[]}},_) -> % default mod is [], so accept as entry + []; check_item({_,{vsn,Vsn}},I) -> case string_p(Vsn) of true -> Vsn; @@ -678,6 +680,8 @@ check_item({_,{modules,Mods}},I) -> true -> Mods; _ -> throw({bad_param, I}) end; +check_item({_,{start_phases,undefined}},_) -> % default start_phase is undefined, + undefined; % so accept as entry check_item({_,{start_phases,Phase}},I) -> case t_list_p(Phase) of true -> Phase; diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl index bf95ceb70c..dd5f277a77 100644 --- a/lib/sasl/test/systools_SUITE.erl +++ b/lib/sasl/test/systools_SUITE.erl @@ -59,7 +59,7 @@ no_appup_relup/1, bad_appup_relup/1, app_start_type_relup/1, regexp_relup/1]). -export([normal_hybrid/1,hybrid_no_old_sasl/1,hybrid_no_new_sasl/1]). --export([otp_6226_outdir/1]). +-export([otp_6226_outdir/1, app_file_defaults/1]). -export([init_per_suite/1, end_per_suite/1, init_per_testcase/2, end_per_testcase/2]). -export([delete_tree/1]). @@ -97,7 +97,7 @@ groups() -> no_appup_relup, bad_appup_relup, app_start_type_relup, regexp_relup ]}, {hybrid, [], [normal_hybrid,hybrid_no_old_sasl,hybrid_no_new_sasl]}, - {options, [], [otp_6226_outdir]}]. + {options, [], [otp_6226_outdir,app_file_defaults]}]. init_per_group(_GroupName, Config) -> Config. @@ -2014,6 +2014,37 @@ otp_6226_outdir(Config) when is_list(Config) -> ok. +%% Test that all default values can be used as values in the .app file +app_file_defaults(Config) -> + PrivDir = ?config(priv_dir,Config), + Name = app1, + NameStr = atom_to_list(Name), + Vsn = "1.0", + AppSpec = app_spec(Name,#{vsn=>"1.0"}), + ok = file:write_file(filename:join(PrivDir,NameStr ++ ".app"), + io_lib:format("~p.~n",[AppSpec])), + {ok,_} = systools_make:read_application(NameStr,Vsn,[PrivDir],[]), + ok. + +app_spec(Name,New) -> + {application,Name,app_spec(New)}. + +app_spec(New) -> + Default = #{description => "", + id => "", + vsn => "", + modules => [], + maxP => infinity, + maxT => infinity, + registered => [], + included_applications => [], + applications => [], + env => [], + mod => [], + start_phases => undefined, + runtime_dependencies => []}, + maps:to_list(maps:merge(Default,New)). + %%%%%% %%%%%% Utilities %%%%%% diff --git a/lib/sasl/test/test_lib.hrl b/lib/sasl/test/test_lib.hrl index 2d897e9903..9a54937f96 100644 --- a/lib/sasl/test/test_lib.hrl +++ b/lib/sasl/test/test_lib.hrl @@ -1,3 +1,3 @@ -define(ertsvsn,"4.4"). --define(kernelvsn,"4.0"). --define(stdlibvsn,"2.5"). +-define(kernelvsn,"5.0"). +-define(stdlibvsn,"3.0"). diff --git a/lib/ssh/src/Makefile b/lib/ssh/src/Makefile index 69d5a47f83..7ab6f22424 100644 --- a/lib/ssh/src/Makefile +++ b/lib/ssh/src/Makefile @@ -96,7 +96,7 @@ APP_TARGET= $(EBIN)/$(APP_FILE) APPUP_SRC= $(APPUP_FILE).src APPUP_TARGET= $(EBIN)/$(APPUP_FILE) -INTERNAL_HRL_FILES = ssh_auth.hrl ssh_connect.hrl ssh_transport.hrl ssh.hrl ssh_userauth.hrl ssh_xfer.hrl +INTERNAL_HRL_FILES = ssh_auth.hrl ssh_connect.hrl ssh_transport.hrl ssh.hrl ssh_userauth.hrl ssh_xfer.hrl ssh_dbg.hrl # ---------------------------------------------------- # FLAGS diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index dd414894d4..7451c9e6d0 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -928,6 +928,7 @@ handle_event(internal, Msg=#ssh_msg_channel_request{}, StateName, D) - handle_connection_msg(Msg, StateName, D); handle_event(internal, Msg=#ssh_msg_channel_success{}, StateName, D) -> + update_inet_buffers(D#data.socket), handle_connection_msg(Msg, StateName, D); handle_event(internal, Msg=#ssh_msg_channel_failure{}, StateName, D) -> @@ -1007,6 +1008,7 @@ handle_event(cast, {reply_request,success,ChannelId}, {connected,_}, D) -> case ssh_channel:cache_lookup(cache(D), ChannelId) of #channel{remote_id = RemoteId} -> Msg = ssh_connection:channel_success_msg(RemoteId), + update_inet_buffers(D#data.socket), {keep_state, send_msg(Msg,D)}; undefined -> @@ -1194,12 +1196,12 @@ handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock, ssh_message:decode(set_kex_overload_prefix(DecryptedBytes,D)) of Msg = #ssh_msg_kexinit{} -> - {keep_state, D, [{next_event, internal, {Msg,DecryptedBytes}}, - {next_event, internal, prepare_next_packet} + {keep_state, D, [{next_event, internal, prepare_next_packet}, + {next_event, internal, {Msg,DecryptedBytes}} ]}; Msg -> - {keep_state, D, [{next_event, internal, Msg}, - {next_event, internal, prepare_next_packet} + {keep_state, D, [{next_event, internal, prepare_next_packet}, + {next_event, internal, Msg} ]} catch _C:_E -> @@ -1738,6 +1740,11 @@ send_replies(Repls, State) -> Repls). get_repl({connection_reply,Msg}, {CallRepls,S}) -> + if is_record(Msg, ssh_msg_channel_success) -> + update_inet_buffers(S#data.socket); + true -> + ok + end, {CallRepls, send_msg(Msg,S)}; get_repl({channel_data,undefined,_Data}, Acc) -> Acc; @@ -1926,3 +1933,13 @@ handshake(Pid, Ref, Timeout) -> {error, timeout} end. +update_inet_buffers(Socket) -> + {ok, BufSzs0} = inet:getopts(Socket, [sndbuf,recbuf]), + MinVal = 655360, + case + [{Tag,MinVal} || {Tag,Val} <- BufSzs0, + Val < MinVal] + of + [] -> ok; + NewOpts -> inet:setopts(Socket, NewOpts) + end. diff --git a/lib/ssh/src/ssh_dbg.erl b/lib/ssh/src/ssh_dbg.erl index ce5596e0f9..dff2bae9f2 100644 --- a/lib/ssh/src/ssh_dbg.erl +++ b/lib/ssh/src/ssh_dbg.erl @@ -28,6 +28,9 @@ stop/0 ]). +-export([shrink_bin/1, + wr_record/3]). + -include("ssh.hrl"). -include("ssh_transport.hrl"). -include("ssh_connect.hrl"). diff --git a/lib/ssh/src/ssh_dbg.hrl b/lib/ssh/src/ssh_dbg.hrl new file mode 100644 index 0000000000..e94664737b --- /dev/null +++ b/lib/ssh/src/ssh_dbg.hrl @@ -0,0 +1,27 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-ifndef(SSH_DBG_HRL). +-define(SSH_DBG_HRL, 1). + +-define(formatrec(RecName,R), + ssh_dbg:wr_record(R, record_info(fields,RecName), [])). + +-endif. % SSH_DBG_HRL defined diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index bcf3b01824..e898d55b6f 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -381,13 +381,13 @@ do_interrupted_send(Config, SendSize, EchoSize) -> {password, "morot"}, {subsystems, [{"echo_n",EchoSS_spec}]}]), - ct:log("connect", []), + ct:log("~p:~p connect", [?MODULE,?LINE]), ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, {user, "foo"}, {password, "morot"}, {user_interaction, false}, {user_dir, UserDir}]), - ct:log("connected", []), + ct:log("~p:~p connected", [?MODULE,?LINE]), %% build big binary Data = << <<X:32>> || X <- lists:seq(1,SendSize div 4)>>, @@ -399,9 +399,9 @@ do_interrupted_send(Config, SendSize, EchoSize) -> Parent = self(), ResultPid = spawn( fun() -> - ct:log("open channel",[]), + ct:log("~p:~p open channel",[?MODULE,?LINE]), {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), - ct:log("start subsystem", []), + ct:log("~p:~p start subsystem", [?MODULE,?LINE]), case ssh_connection:subsystem(ConnectionRef, ChannelId, "echo_n", infinity) of success -> Parent ! {self(), channelId, ChannelId}, @@ -410,47 +410,69 @@ do_interrupted_send(Config, SendSize, EchoSize) -> try collect_data(ConnectionRef, ChannelId) of ExpectedData -> + ct:log("~p:~p got expected data",[?MODULE,?LINE]), ok; - _ -> - {fail,"unexpected result"} + Other -> + ct:log("~p:~p unexpect: ~p", [?MODULE,?LINE,Other]), + {fail,"unexpected result in listener"} catch Class:Exception -> - {fail, io_lib:format("Exception ~p:~p",[Class,Exception])} + {fail, io_lib:format("Listener exception ~p:~p",[Class,Exception])} end, - Parent ! {self(), Result}; + Parent ! {self(), result, Result}; Other -> Parent ! {self(), channelId, error, Other} end end), receive + {ResultPid, channelId, error, Other} -> + ct:log("~p:~p channelId error ~p", [?MODULE,?LINE,Other]), + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid), + {fail, "ssh_connection:subsystem"}; + {ResultPid, channelId, ChannelId} -> - %% pre-adjust receive window so the other end doesn't block - ct:log("adjust window", []), - ssh_connection:adjust_window(ConnectionRef, ChannelId, size(ExpectedData) + 1), - - ct:log("going to send ~p bytes", [size(Data)]), - case ssh_connection:send(ConnectionRef, ChannelId, Data, 30000) of - {error, closed} -> - ct:log("{error,closed} - That's what we expect :)", []), - ok; - Msg -> - ct:log("Got ~p - that's bad, very bad indeed",[Msg]), - ct:fail({expected,{error,closed}, got, Msg}) - end, - ct:log("going to check the result (if it is available)", []), + ct:log("~p:~p ~p going to send ~p bytes", [?MODULE,?LINE,self(),size(Data)]), + SenderPid = spawn(fun() -> + Parent ! {self(), ssh_connection:send(ConnectionRef, ChannelId, Data, 30000)} + end), receive - {ResultPid, Result} -> - ct:log("Got result: ~p", [Result]), + {ResultPid, result, {fail, Fail}} -> + ct:log("~p:~p Listener failed: ~p", [?MODULE,?LINE,Fail]), + {fail, Fail}; + + {ResultPid, result, Result} -> + ct:log("~p:~p Got result: ~p", [?MODULE,?LINE,Result]), ssh:close(ConnectionRef), ssh:stop_daemon(Pid), - Result - end; + ct:log("~p:~p Check sender", [?MODULE,?LINE]), + receive + {SenderPid, {error, closed}} -> + ct:log("~p:~p {error,closed} - That's what we expect :)",[?MODULE,?LINE]), + ok; + Msg -> + ct:log("~p:~p Not expected send result: ~p",[?MODULE,?LINE,Msg]), + {fail, "Not expected msg"} + end; + + {SenderPid, {error, closed}} -> + ct:log("~p:~p {error,closed} - That's what we expect, but client channel handler has not reported yet",[?MODULE,?LINE]), + receive + {ResultPid, result, Result} -> + ct:log("~p:~p Now got the result: ~p", [?MODULE,?LINE,Result]), + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid), + ok; + Msg -> + ct:log("~p:~p Got an unexpected msg ~p",[?MODULE,?LINE,Msg]), + {fail, "Un-expected msg"} + end; - {ResultPid, channelId, error, Other} -> - ssh:close(ConnectionRef), - ssh:stop_daemon(Pid), - {fail, io_lib:format("ssh_connection:subsystem: ~p",[Other])} + Msg -> + ct:log("~p:~p Got unexpected ~p",[?MODULE,?LINE,Msg]), + {fail, "Unexpected msg"} + end end. %%-------------------------------------------------------------------- @@ -910,34 +932,35 @@ big_cat_rx(ConnectionRef, ChannelId, Acc) -> end. collect_data(ConnectionRef, ChannelId) -> - ct:log("Listener ~p running! ConnectionRef=~p, ChannelId=~p",[self(),ConnectionRef,ChannelId]), + ct:log("~p:~p Listener ~p running! ConnectionRef=~p, ChannelId=~p",[?MODULE,?LINE,self(),ConnectionRef,ChannelId]), collect_data(ConnectionRef, ChannelId, [], 0). collect_data(ConnectionRef, ChannelId, Acc, Sum) -> TO = 5000, receive {ssh_cm, ConnectionRef, {data, ChannelId, 0, Data}} when is_binary(Data) -> - ct:log("collect_data: received ~p bytes. total ~p bytes",[size(Data),Sum+size(Data)]), + ct:log("~p:~p collect_data: received ~p bytes. total ~p bytes",[?MODULE,?LINE,size(Data),Sum+size(Data)]), + ssh_connection:adjust_window(ConnectionRef, ChannelId, size(Data)), collect_data(ConnectionRef, ChannelId, [Data | Acc], Sum+size(Data)); {ssh_cm, ConnectionRef, {eof, ChannelId}} -> try iolist_to_binary(lists:reverse(Acc)) of Bin -> - ct:log("collect_data: received eof.~nGot in total ~p bytes",[size(Bin)]), + ct:log("~p:~p collect_data: received eof.~nGot in total ~p bytes",[?MODULE,?LINE,size(Bin)]), Bin catch C:E -> - ct:log("collect_data: received eof.~nAcc is strange...~nException=~p:~p~nAcc=~p", - [C,E,Acc]), + ct:log("~p:~p collect_data: received eof.~nAcc is strange...~nException=~p:~p~nAcc=~p", + [?MODULE,?LINE,C,E,Acc]), {error,{C,E}} end; Msg -> - ct:log("collect_data: ***** unexpected message *****~n~p",[Msg]), + ct:log("~p:~p collect_data: ***** unexpected message *****~n~p",[?MODULE,?LINE,Msg]), collect_data(ConnectionRef, ChannelId, Acc, Sum) after TO -> - ct:log("collect_data: ----- Nothing received for ~p seconds -----~n",[]), + ct:log("~p:~p collect_data: ----- Nothing received for ~p seconds -----~n",[?MODULE,?LINE,TO]), collect_data(ConnectionRef, ChannelId, Acc, Sum) end. diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 2c7fe7898f..86c3d5de26 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -404,8 +404,6 @@ erlang_server_openssh_client_renegotiate(Config) -> {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {public_key_alg, PubKeyAlg}, {failfun, fun ssh_test_lib:failfun/2}]), - -%% catch ssh_dbg:messages(fun(String,_D) -> ct:log(String) end), ct:sleep(500), RenegLimitK = 3, @@ -431,13 +429,24 @@ erlang_server_openssh_client_renegotiate(Config) -> catch _:_ -> false end; + + ({exit_status,E}) when E=/=0 -> + ct:log("exit_status ~p",[E]), + throw({skip,"exit status"}); + (_) -> false end, - - ssh_test_lib:rcv_expected(Expect, OpenSsh, ?TIMEOUT), - %% Unfortunatly we can't check that there has been a renegotiation, just trust OpenSSH. - ssh:stop_daemon(Pid). + + try + ssh_test_lib:rcv_expected(Expect, OpenSsh, ?TIMEOUT) + of + _ -> + %% Unfortunatly we can't check that there has been a renegotiation, just trust OpenSSH. + ssh:stop_daemon(Pid) + catch + throw:{skip,R} -> {skip,R} + end. %%-------------------------------------------------------------------- erlang_client_openssh_server_renegotiate(_Config) -> @@ -447,7 +456,6 @@ erlang_client_openssh_server_renegotiate(_Config) -> Ref = make_ref(), Parent = self(), - catch ssh_dbg:messages(fun(X,_) -> ct:log(X) end), Shell = spawn_link( fun() -> diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index f8dea736ae..392da738ec 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -2193,7 +2193,7 @@ ciphers_dsa_signed_certs() -> ciphers_dsa_signed_certs(Config) when is_list(Config) -> Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:dsa_suites(), + Ciphers = ssl_test_lib:dsa_suites(tls_record:protocol_version(Version)), ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), run_suites(Ciphers, Version, Config, dsa). %%------------------------------------------------------------------- @@ -2334,7 +2334,7 @@ ciphers_ecdsa_signed_certs() -> ciphers_ecdsa_signed_certs(Config) when is_list(Config) -> Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:ecdsa_suites(), + Ciphers = ssl_test_lib:ecdsa_suites(tls_record:protocol_version(Version)), ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), run_suites(Ciphers, Version, Config, ecdsa). %%-------------------------------------------------------------------- @@ -2352,7 +2352,7 @@ ciphers_ecdh_rsa_signed_certs() -> ciphers_ecdh_rsa_signed_certs(Config) when is_list(Config) -> Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:ecdh_rsa_suites(), + Ciphers = ssl_test_lib:ecdh_rsa_suites(tls_record:protocol_version(Version)), ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), run_suites(Ciphers, Version, Config, ecdh_rsa). %%-------------------------------------------------------------------- @@ -3663,9 +3663,10 @@ no_rizzo_rc4() -> [{doc,"Test that there is no 1/n-1-split for RC4 as it is not vunrable to Rizzo/Dungon attack"}]. no_rizzo_rc4(Config) when is_list(Config) -> - Ciphers = [X || X ={_,Y,_} <- ssl:cipher_suites(),Y == rc4_128], Prop = proplists:get_value(tc_group_properties, Config), Version = proplists:get_value(name, Prop), + Ciphers = [ssl_cipher:erl_suite_definition(Suite) || + Suite <- ssl_test_lib:rc4_suites(tls_record:protocol_version(Version))], run_send_recv_rizzo(Ciphers, Config, Version, {?MODULE, send_recv_result_active_no_rizzo, []}). @@ -3673,9 +3674,10 @@ rizzo_one_n_minus_one() -> [{doc,"Test that the 1/n-1-split mitigation of Rizzo/Dungon attack can be explicitly selected"}]. rizzo_one_n_minus_one(Config) when is_list(Config) -> - Ciphers = [X || X ={_,Y,_} <- ssl:cipher_suites(), Y =/= rc4_128], Prop = proplists:get_value(tc_group_properties, Config), Version = proplists:get_value(name, Prop), + AllSuites = ssl_test_lib:available_suites(tls_record:protocol_version(Version)), + Ciphers = [X || X ={_,Y,_} <- AllSuites, Y =/= rc4_128], run_send_recv_rizzo(Ciphers, Config, Version, {?MODULE, send_recv_result_active_rizzo, []}). @@ -3683,9 +3685,10 @@ rizzo_zero_n() -> [{doc,"Test that the 0/n-split mitigation of Rizzo/Dungon attack can be explicitly selected"}]. rizzo_zero_n(Config) when is_list(Config) -> - Ciphers = [X || X ={_,Y,_} <- ssl:cipher_suites(), Y =/= rc4_128], Prop = proplists:get_value(tc_group_properties, Config), Version = proplists:get_value(name, Prop), + AllSuites = ssl_test_lib:available_suites(tls_record:protocol_version(Version)), + Ciphers = [X || X ={_,Y,_} <- AllSuites, Y =/= rc4_128], run_send_recv_rizzo(Ciphers, Config, Version, {?MODULE, send_recv_result_active_no_rizzo, []}). @@ -4436,7 +4439,7 @@ rizzo_test(Cipher, Config, Version, Mfa) -> {host, Hostname}, {from, self()}, {mfa, Mfa}, - {options, [{active, true} | ClientOpts]}]), + {options, [{active, true}, {ciphers, [Cipher]}| ClientOpts]}]), Result = ssl_test_lib:check_result(Server, ok, Client, ok), ssl_test_lib:close(Server), @@ -4727,3 +4730,4 @@ first_rsa_suite([_ | Rest]) -> wait_for_send(Socket) -> %% Make sure TLS process processed send message event _ = ssl:connection_information(Socket). + diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index 4c6f1d7c01..5265c87e29 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -1097,7 +1097,8 @@ client_with_cert_cipher_suites_handshake(Config) when is_list(Config) -> {mfa, {ssl_test_lib, send_recv_result_active, []}}, {options, [{active, true}, - {ciphers, ssl_test_lib:rsa_non_signed_suites()} + {ciphers, + ssl_test_lib:rsa_non_signed_suites(tls_record:highest_protocol_version([]))} | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index cab22a60a8..9632103696 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -462,9 +462,10 @@ cert_options(Config) -> make_dsa_cert(Config) -> - - {ServerCaCertFile, ServerCertFile, ServerKeyFile} = make_cert_files("server", Config, dsa, dsa, ""), - {ClientCaCertFile, ClientCertFile, ClientKeyFile} = make_cert_files("client", Config, dsa, dsa, ""), + {ServerCaCertFile, ServerCertFile, ServerKeyFile} = + make_cert_files("server", Config, dsa, dsa, "", []), + {ClientCaCertFile, ClientCertFile, ClientKeyFile} = + make_cert_files("client", Config, dsa, dsa, "", []), [{server_dsa_opts, [{ssl_imp, new},{reuseaddr, true}, {cacertfile, ServerCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]}, @@ -490,8 +491,10 @@ make_ecdsa_cert(Config) -> CryptoSupport = crypto:supports(), case proplists:get_bool(ecdsa, proplists:get_value(public_keys, CryptoSupport)) of true -> - {ServerCaCertFile, ServerCertFile, ServerKeyFile} = make_cert_files("server", Config, ec, ec, ""), - {ClientCaCertFile, ClientCertFile, ClientKeyFile} = make_cert_files("client", Config, ec, ec, ""), + {ServerCaCertFile, ServerCertFile, ServerKeyFile} = + make_cert_files("server", Config, ec, ec, "", [{digest, appropriate_sha(CryptoSupport)}]), + {ClientCaCertFile, ClientCertFile, ClientKeyFile} = + make_cert_files("client", Config, ec, ec, "", [{digest, appropriate_sha(CryptoSupport)}]), [{server_ecdsa_opts, [{ssl_imp, new},{reuseaddr, true}, {cacertfile, ServerCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]}, @@ -507,6 +510,14 @@ make_ecdsa_cert(Config) -> Config end. +appropriate_sha(CryptoSupport) -> + case proplists:get_bool(sha256, CryptoSupport) of + true -> + sha256; + false -> + sha1 + end. + %% RFC 4492, Sect. 2.3. ECDH_RSA %% %% This key exchange algorithm is the same as ECDH_ECDSA except that the @@ -515,8 +526,10 @@ make_ecdh_rsa_cert(Config) -> CryptoSupport = crypto:supports(), case proplists:get_bool(ecdh, proplists:get_value(public_keys, CryptoSupport)) of true -> - {ServerCaCertFile, ServerCertFile, ServerKeyFile} = make_cert_files("server", Config, rsa, ec, "rsa_"), - {ClientCaCertFile, ClientCertFile, ClientKeyFile} = make_cert_files("client", Config, rsa, ec, "rsa_"), + {ServerCaCertFile, ServerCertFile, ServerKeyFile} = + make_cert_files("server", Config, rsa, ec, "rsa_", []), + {ClientCaCertFile, ClientCertFile, ClientKeyFile} = + make_cert_files("client", Config, rsa, ec, "rsa_",[]), [{server_ecdh_rsa_opts, [{ssl_imp, new},{reuseaddr, true}, {cacertfile, ServerCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]}, @@ -534,9 +547,9 @@ make_ecdh_rsa_cert(Config) -> make_mix_cert(Config) -> {ServerCaCertFile, ServerCertFile, ServerKeyFile} = make_cert_files("server", Config, dsa, - rsa, "mix"), + rsa, "mix", []), {ClientCaCertFile, ClientCertFile, ClientKeyFile} = make_cert_files("client", Config, dsa, - rsa, "mix"), + rsa, "mix", []), [{server_mix_opts, [{ssl_imp, new},{reuseaddr, true}, {cacertfile, ServerCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]}, @@ -549,11 +562,11 @@ make_mix_cert(Config) -> {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]} | Config]. -make_cert_files(RoleStr, Config, Alg1, Alg2, Prefix) -> +make_cert_files(RoleStr, Config, Alg1, Alg2, Prefix, Opts) -> Alg1Str = atom_to_list(Alg1), Alg2Str = atom_to_list(Alg2), - CaInfo = {CaCert, _} = erl_make_certs:make_cert([{key, Alg1}]), - {Cert, CertKey} = erl_make_certs:make_cert([{key, Alg2}, {issuer, CaInfo}]), + CaInfo = {CaCert, _} = erl_make_certs:make_cert([{key, Alg1}| Opts]), + {Cert, CertKey} = erl_make_certs:make_cert([{key, Alg2}, {issuer, CaInfo} | Opts]), CaCertFile = filename:join([proplists:get_value(priv_dir, Config), RoleStr, Prefix ++ Alg1Str ++ "_cacerts.pem"]), CertFile = filename:join([proplists:get_value(priv_dir, Config), @@ -840,37 +853,42 @@ common_ciphers(openssl) -> lists:member(ssl_cipher:openssl_suite_name(S), OpenSslSuites) ]. -rsa_non_signed_suites() -> +available_suites(Version) -> + [ssl_cipher:erl_suite_definition(Suite) || + Suite <- ssl_cipher:filter_suites(ssl_cipher:suites(Version))]. + + +rsa_non_signed_suites(Version) -> lists:filter(fun({rsa, _, _}) -> true; (_) -> false end, - ssl:cipher_suites()). + available_suites(Version)). -dsa_suites() -> +dsa_suites(Version) -> lists:filter(fun({dhe_dss, _, _}) -> true; (_) -> false end, - ssl:cipher_suites()). + available_suites(Version)). -ecdsa_suites() -> +ecdsa_suites(Version) -> lists:filter(fun({ecdhe_ecdsa, _, _}) -> true; (_) -> false end, - ssl:cipher_suites()). + available_suites(Version)). -ecdh_rsa_suites() -> +ecdh_rsa_suites(Version) -> lists:filter(fun({ecdh_rsa, _, _}) -> true; (_) -> false end, - ssl:cipher_suites()). + available_suites(Version)). openssl_rsa_suites(CounterPart) -> Ciphers = ssl:cipher_suites(openssl), @@ -1174,14 +1192,15 @@ is_fips(_) -> false. cipher_restriction(Config0) -> + Version = tls_record:protocol_version(protocol_version(Config0)), case is_sane_ecc(openssl) of false -> Opts = proplists:get_value(server_opts, Config0), Config1 = proplists:delete(server_opts, Config0), VerOpts = proplists:get_value(server_verification_opts, Config1), Config = proplists:delete(server_verification_opts, Config1), - Restricted0 = ssl:cipher_suites() -- ecdsa_suites(), - Restricted = Restricted0 -- ecdh_rsa_suites(), + Restricted0 = ssl:cipher_suites() -- ecdsa_suites(Version), + Restricted = Restricted0 -- ecdh_rsa_suites(Version), [{server_opts, [{ciphers, Restricted} | Opts]}, {server_verification_opts, [{ciphers, Restricted} | VerOpts] } | Config]; true -> Config0 diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 9ecfe5b0ea..e99340822d 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -834,7 +834,7 @@ ciphers_dsa_signed_certs() -> [{doc,"Test cipher suites that uses dsa certs"}]. ciphers_dsa_signed_certs(Config) when is_list(Config) -> Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:dsa_suites(), + Ciphers = ssl_test_lib:dsa_suites(tls_record:protocol_version(Version)), run_suites(Ciphers, Version, Config, dsa). %%-------------------------------------------------------------------- diff --git a/lib/stdlib/doc/src/orddict.xml b/lib/stdlib/doc/src/orddict.xml index 076b06fc38..39b43809b6 100644 --- a/lib/stdlib/doc/src/orddict.xml +++ b/lib/stdlib/doc/src/orddict.xml @@ -38,7 +38,7 @@ <p>This module provides a <c>Key</c>-<c>Value</c> dictionary. An <c>orddict</c> is a representation of a dictionary, where a list of pairs is used to store the keys and values. The list is - ordered after the keys.</p> + ordered after the keys in the <em>Erlang term order</em>.</p> <p>This module provides the same interface as the <seealso marker="dict"><c>dict(3)</c></seealso> module diff --git a/lib/stdlib/doc/src/ordsets.xml b/lib/stdlib/doc/src/ordsets.xml index 148281fcf7..7b590932e4 100644 --- a/lib/stdlib/doc/src/ordsets.xml +++ b/lib/stdlib/doc/src/ordsets.xml @@ -39,7 +39,8 @@ <p>Sets are collections of elements with no duplicate elements. An <c>ordset</c> is a representation of a set, where an ordered list is used to store the elements of the set. An ordered list - is more efficient than an unordered list.</p> + is more efficient than an unordered list. Elements are ordered + according to the <em>Erlang term order</em>.</p> <p>This module provides the same interface as the <seealso marker="sets"><c>sets(3)</c></seealso> module diff --git a/lib/stdlib/doc/src/rand.xml b/lib/stdlib/doc/src/rand.xml index 1dcc3de000..1364a3277b 100644 --- a/lib/stdlib/doc/src/rand.xml +++ b/lib/stdlib/doc/src/rand.xml @@ -41,6 +41,11 @@ Sebastiano Vigna</url>. The normal distribution algorithm uses the <url href="http://www.jstatsoft.org/v05/i08">Ziggurat Method by Marsaglia and Tsang</url>.</p> + <p>For some algorithms, jump functions are provided for generating + non-overlapping sequences for parallel computations. + The jump functions perform calculations + equivalent to perform a large number of repeated calls + for calculating new states. </p> <p>The following algorithms are provided:</p> @@ -48,14 +53,17 @@ <tag><c>exsplus</c></tag> <item> <p>Xorshift116+, 58 bits precision and period of 2^116-1</p> + <p>Jump function: equivalent to 2^64 calls</p> </item> <tag><c>exs64</c></tag> <item> <p>Xorshift64*, 64 bits precision and a period of 2^64-1</p> + <p>Jump function: not available</p> </item> <tag><c>exs1024</c></tag> <item> <p>Xorshift1024*, 64 bits precision and a period of 2^1024-1</p> + <p>Jump function: equivalent to 2^512 calls</p> </item> </taglist> @@ -156,6 +164,33 @@ S0 = rand:seed_s(exsplus), </func> <func> + <name name="jump" arity="0"/> + <fsummary>Return the seed after performing jump calculation + to the state in the process dictionary.</fsummary> + <desc><marker id="jump-0" /> + <p>Returns the state + after performing jump calculation + to the state in the process dictionary.</p> + <p>This function generates a <c>not_implemented</c> error exception + when the jump function is not implemented for + the algorithm specified in the state + in the process dictionary.</p> + </desc> + </func> + + <func> + <name name="jump" arity="1"/> + <fsummary>Return the seed after performing jump calculation.</fsummary> + <desc><marker id="jump-1" /> + <p>Returns the state after performing jump calculation + to the given state. </p> + <p>This function generates a <c>not_implemented</c> error exception + when the jump function is not implemented for + the algorithm specified in the state.</p> + </desc> + </func> + + <func> <name name="normal" arity="0"/> <fsummary>Return a standard normal distributed random float.</fsummary> <desc> diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index 294196f746..bb06d3645e 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -133,8 +133,10 @@ sup_flags() = #{strategy => strategy(), % optional map. Assuming the values <c>MaxR</c> for <c>intensity</c> and <c>MaxT</c> for <c>period</c>, then, if more than <c>MaxR</c> restarts occur within <c>MaxT</c> seconds, the supervisor - terminates all child processes and then itself. <c>intensity</c> - defaults to <c>1</c> and <c>period</c> defaults to <c>5</c>.</p> + terminates all child processes and then itself. The termination + reason for the supervisor itself in that case will be <c>shutdown</c>. + <c>intensity</c> defaults to <c>1</c> and <c>period</c> defaults to + <c>5</c>.</p> <marker id="child_spec"/> <p>The type definition of a child specification is as follows:</p> diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index 93409d95df..1f457b9e0e 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -19,7 +19,7 @@ %% %% ===================================================================== %% Multiple PRNG module for Erlang/OTP -%% Copyright (c) 2015 Kenji Rikitake +%% Copyright (c) 2015-2016 Kenji Rikitake %% ===================================================================== -module(rand). @@ -27,11 +27,14 @@ -export([seed_s/1, seed_s/2, seed/1, seed/2, export_seed/0, export_seed_s/1, uniform/0, uniform/1, uniform_s/1, uniform_s/2, + jump/0, jump/1, normal/0, normal_s/1 ]). -compile({inline, [exs64_next/1, exsplus_next/1, + exsplus_jump/1, exs1024_next/1, exs1024_calc/2, + exs1024_jump/1, get_52/1, normal_kiwi/1]}). -define(DEFAULT_ALG_HANDLER, exsplus). @@ -48,7 +51,8 @@ max := integer(), next := fun(), uniform := fun(), - uniform_n := fun()}. + uniform_n := fun(), + jump := fun()}. %% Internal state -opaque state() :: {alg_handler(), alg_seed()}. @@ -79,9 +83,7 @@ export_seed_s({#{type:=Alg}, Seed}) -> {Alg, Seed}. -spec seed(AlgOrExpState::alg() | export_state()) -> state(). seed(Alg) -> - R = seed_s(Alg), - _ = seed_put(R), - R. + seed_put(seed_s(Alg)). -spec seed_s(AlgOrExpState::alg() | export_state()) -> state(). seed_s(Alg) when is_atom(Alg) -> @@ -97,9 +99,7 @@ seed_s({Alg0, Seed}) -> -spec seed(Alg :: alg(), {integer(), integer(), integer()}) -> state(). seed(Alg0, S0) -> - State = seed_s(Alg0, S0), - _ = seed_put(State), - State. + seed_put(seed_s(Alg0, S0)). -spec seed_s(Alg :: alg(), {integer(), integer(), integer()}) -> state(). seed_s(Alg0, S0 = {_, _, _}) -> @@ -150,6 +150,25 @@ uniform_s(N, State0 = {#{uniform:=Uniform}, _}) {F, State} = Uniform(State0), {trunc(F * N) + 1, State}. +%% jump/1: given a state, jump/1 +%% returns a new state which is equivalent to that +%% after a large number of call defined for each algorithm. +%% The large number is algorithm dependent. + +-spec jump(state()) -> NewS :: state(). +jump(State = {#{jump:=Jump}, _}) -> + Jump(State). + +%% jump/0: read the internal state and +%% apply the jump function for the state as in jump/1 +%% and write back the new value to the internal state, +%% then returns the new value. + +-spec jump() -> NewS :: state(). + +jump() -> + seed_put(jump(seed_get())). + %% normal/0: returns a random float with standard normal distribution %% updating the state in the process dictionary. @@ -192,9 +211,10 @@ normal_s(State0) -> -type uint64() :: 0..16#ffffffffffffffff. -type uint58() :: 0..16#03ffffffffffffff. --spec seed_put(state()) -> undefined | state(). +-spec seed_put(state()) -> state(). seed_put(Seed) -> - put(?SEED_DICT, Seed). + put(?SEED_DICT, Seed), + Seed. seed_get() -> case get(?SEED_DICT) of @@ -205,15 +225,18 @@ seed_get() -> %% Setup alg record mk_alg(exs64) -> {#{type=>exs64, max=>?UINT64MASK, next=>fun exs64_next/1, - uniform=>fun exs64_uniform/1, uniform_n=>fun exs64_uniform/2}, + uniform=>fun exs64_uniform/1, uniform_n=>fun exs64_uniform/2, + jump=>fun exs64_jump/1}, fun exs64_seed/1}; mk_alg(exsplus) -> {#{type=>exsplus, max=>?UINT58MASK, next=>fun exsplus_next/1, - uniform=>fun exsplus_uniform/1, uniform_n=>fun exsplus_uniform/2}, + uniform=>fun exsplus_uniform/1, uniform_n=>fun exsplus_uniform/2, + jump=>fun exsplus_jump/1}, fun exsplus_seed/1}; mk_alg(exs1024) -> {#{type=>exs1024, max=>?UINT64MASK, next=>fun exs1024_next/1, - uniform=>fun exs1024_uniform/1, uniform_n=>fun exs1024_uniform/2}, + uniform=>fun exs1024_uniform/1, uniform_n=>fun exs1024_uniform/2, + jump=>fun exs1024_jump/1}, fun exs1024_seed/1}. %% ===================================================================== @@ -246,6 +269,9 @@ exs64_uniform(Max, {Alg, R}) -> {V, R1} = exs64_next(R), {(V rem Max) + 1, {Alg, R1}}. +exs64_jump(_) -> + erlang:error(not_implemented). + %% ===================================================================== %% exsplus PRNG: Xorshift116+ %% Algorithm by Sebastiano Vigna @@ -283,6 +309,40 @@ exsplus_uniform(Max, {Alg, R}) -> {V, R1} = exsplus_next(R), {(V rem Max) + 1, {Alg, R1}}. +%% This is the jump function for the exsplus generator, equivalent +%% to 2^64 calls to next/1; it can be used to generate 2^52 +%% non-overlapping subsequences for parallel computations. +%% Note: the jump function takes 116 times of the execution time of +%% next/1. + +%% -define(JUMPCONST, 16#000d174a83e17de2302f8ea6bc32c797). +%% split into 58-bit chunks +%% and two iterative executions + +-define(JUMPCONST1, 16#02f8ea6bc32c797). +-define(JUMPCONST2, 16#345d2a0f85f788c). +-define(JUMPELEMLEN, 58). + +-dialyzer({no_improper_lists, exsplus_jump/1}). +-spec exsplus_jump(state()) -> state(). +exsplus_jump({Alg, S}) -> + {S1, AS1} = exsplus_jump(S, [0|0], ?JUMPCONST1, ?JUMPELEMLEN), + {_, AS2} = exsplus_jump(S1, AS1, ?JUMPCONST2, ?JUMPELEMLEN), + {Alg, AS2}. + +-dialyzer({no_improper_lists, exsplus_jump/4}). +exsplus_jump(S, AS, _, 0) -> + {S, AS}; +exsplus_jump(S, [AS0|AS1], J, N) -> + {_, NS} = exsplus_next(S), + case (J band 1) of + 1 -> + [S0|S1] = S, + exsplus_jump(NS, [(AS0 bxor S0)|(AS1 bxor S1)], J bsr 1, N-1); + 0 -> + exsplus_jump(NS, [AS0|AS1], J bsr 1, N-1) + end. + %% ===================================================================== %% exs1024 PRNG: Xorshift1024* %% Algorithm by Sebastiano Vigna @@ -340,6 +400,60 @@ exs1024_uniform(Max, {Alg, R}) -> {V, R1} = exs1024_next(R), {(V rem Max) + 1, {Alg, R1}}. +%% This is the jump function for the exs1024 generator, equivalent +%% to 2^512 calls to next(); it can be used to generate 2^512 +%% non-overlapping subsequences for parallel computations. +%% Note: the jump function takes ~2000 times of the execution time of +%% next/1. + +%% Jump constant here split into 58 bits for speed +-define(JUMPCONSTHEAD, 16#00242f96eca9c41d). +-define(JUMPCONSTTAIL, + [16#0196e1ddbe5a1561, + 16#0239f070b5837a3c, + 16#03f393cc68796cd2, + 16#0248316f404489af, + 16#039a30088bffbac2, + 16#02fea70dc2d9891f, + 16#032ae0d9644caec4, + 16#0313aac17d8efa43, + 16#02f132e055642626, + 16#01ee975283d71c93, + 16#00552321b06f5501, + 16#00c41d10a1e6a569, + 16#019158ecf8aa1e44, + 16#004e9fc949d0b5fc, + 16#0363da172811fdda, + 16#030e38c3b99181f2, + 16#0000000a118038fc]). +-define(JUMPTOTALLEN, 1024). +-define(RINGLEN, 16). + +-spec exs1024_jump(state()) -> state(). + +exs1024_jump({Alg, {L, RL}}) -> + P = length(RL), + AS = exs1024_jump({L, RL}, + [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0], + ?JUMPCONSTTAIL, ?JUMPCONSTHEAD, ?JUMPELEMLEN, ?JUMPTOTALLEN), + {ASL, ASR} = lists:split(?RINGLEN - P, AS), + {Alg, {ASL, lists:reverse(ASR)}}. + +exs1024_jump(_, AS, _, _, _, 0) -> + AS; +exs1024_jump(S, AS, [H|T], _, 0, TN) -> + exs1024_jump(S, AS, T, H, ?JUMPELEMLEN, TN); +exs1024_jump({L, RL}, AS, JL, J, N, TN) -> + {_, NS} = exs1024_next({L, RL}), + case (J band 1) of + 1 -> + AS2 = lists:zipwith(fun(X, Y) -> X bxor Y end, + AS, L ++ lists:reverse(RL)), + exs1024_jump(NS, AS2, JL, J bsr 1, N-1, TN-1); + 0 -> + exs1024_jump(NS, AS, JL, J bsr 1, N-1, TN-1) + end. + %% ===================================================================== %% Ziggurat cont %% ===================================================================== diff --git a/lib/stdlib/src/sets.erl b/lib/stdlib/src/sets.erl index 3e70450320..c65a13b22e 100644 --- a/lib/stdlib/src/sets.erl +++ b/lib/stdlib/src/sets.erl @@ -128,14 +128,14 @@ is_element(E, S) -> Set2 :: set(Element). add_element(E, S0) -> Slot = get_slot(S0, E), - {S1,Ic} = on_bucket(fun (B0) -> add_bkt_el(E, B0, B0) end, S0, Slot), - maybe_expand(S1, Ic). - --spec add_bkt_el(T, [T], [T]) -> {[T], 0 | 1}. -add_bkt_el(E, [E|_], Bkt) -> {Bkt,0}; -add_bkt_el(E, [_|B], Bkt) -> - add_bkt_el(E, B, Bkt); -add_bkt_el(E, [], Bkt) -> {[E|Bkt],1}. + Bkt = get_bucket(S0, Slot), + case lists:member(E, Bkt) of + true -> + S0; + false -> + S1 = update_bucket(S0, Slot, [E | Bkt]), + maybe_expand(S1) + end. %% del_element(Element, Set) -> Set. %% Return Set but with Element removed. @@ -144,15 +144,28 @@ add_bkt_el(E, [], Bkt) -> {[E|Bkt],1}. Set2 :: set(Element). del_element(E, S0) -> Slot = get_slot(S0, E), - {S1,Dc} = on_bucket(fun (B0) -> del_bkt_el(E, B0) end, S0, Slot), - maybe_contract(S1, Dc). + Bkt = get_bucket(S0, Slot), + case lists:member(E, Bkt) of + false -> + S0; + true -> + S1 = update_bucket(S0, Slot, lists:delete(E, Bkt)), + maybe_contract(S1, 1) + end. --spec del_bkt_el(T, [T]) -> {[T], 0 | 1}. -del_bkt_el(E, [E|Bkt]) -> {Bkt,1}; -del_bkt_el(E, [Other|Bkt0]) -> - {Bkt1,Dc} = del_bkt_el(E, Bkt0), - {[Other|Bkt1],Dc}; -del_bkt_el(_, []) -> {[],0}. +%% update_bucket(Set, Slot, NewBucket) -> UpdatedSet. +%% Replace bucket in Slot by NewBucket +-spec update_bucket(Set1, Slot, Bkt) -> Set2 when + Set1 :: set(Element), + Set2 :: set(Element), + Slot :: non_neg_integer(), + Bkt :: [Element]. +update_bucket(Set, Slot, NewBucket) -> + SegI = ((Slot-1) div ?seg_size) + 1, + BktI = ((Slot-1) rem ?seg_size) + 1, + Segs = Set#set.segs, + Seg = element(SegI, Segs), + Set#set{segs = setelement(SegI, Segs, setelement(BktI, Seg, NewBucket))}. %% union(Set1, Set2) -> Set %% Return the union of Set1 and Set2. @@ -272,19 +285,6 @@ get_slot(T, Key) -> -spec get_bucket(set(), non_neg_integer()) -> term(). get_bucket(T, Slot) -> get_bucket_s(T#set.segs, Slot). -%% on_bucket(Fun, Hashdb, Slot) -> {NewHashDb,Result}. -%% Apply Fun to the bucket in Slot and replace the returned bucket. --spec on_bucket(fun((_) -> {[_], 0 | 1}), set(E), non_neg_integer()) -> - {set(E), 0 | 1}. -on_bucket(F, T, Slot) -> - SegI = ((Slot-1) div ?seg_size) + 1, - BktI = ((Slot-1) rem ?seg_size) + 1, - Segs = T#set.segs, - Seg = element(SegI, Segs), - B0 = element(BktI, Seg), - {B1, Res} = F(B0), %Op on the bucket. - {T#set{segs = setelement(SegI, Segs, setelement(BktI, Seg, B1))},Res}. - %% fold_set(Fun, Acc, Dictionary) -> Dictionary. %% filter_set(Fun, Dictionary) -> Dictionary. @@ -349,8 +349,8 @@ put_bucket_s(Segs, Slot, Bkt) -> Seg = setelement(BktI, element(SegI, Segs), Bkt), setelement(SegI, Segs, Seg). --spec maybe_expand(set(E), 0 | 1) -> set(E). -maybe_expand(T0, Ic) when T0#set.size + Ic > T0#set.exp_size -> +-spec maybe_expand(set(E)) -> set(E). +maybe_expand(T0) when T0#set.size + 1 > T0#set.exp_size -> T = maybe_expand_segs(T0), %Do we need more segments. N = T#set.n + 1, %Next slot to expand into Segs0 = T#set.segs, @@ -360,12 +360,12 @@ maybe_expand(T0, Ic) when T0#set.size + Ic > T0#set.exp_size -> {B1,B2} = rehash(B, Slot1, Slot2, T#set.maxn), Segs1 = put_bucket_s(Segs0, Slot1, B1), Segs2 = put_bucket_s(Segs1, Slot2, B2), - T#set{size = T#set.size + Ic, + T#set{size = T#set.size + 1, n = N, exp_size = N * ?expand_load, con_size = N * ?contract_load, segs = Segs2}; -maybe_expand(T, Ic) -> T#set{size = T#set.size + Ic}. +maybe_expand(T) -> T#set{size = T#set.size + 1}. -spec maybe_expand_segs(set(E)) -> set(E). maybe_expand_segs(T) when T#set.n =:= T#set.maxn -> diff --git a/lib/stdlib/src/stdlib.appup.src b/lib/stdlib/src/stdlib.appup.src index e917b7ea1f..979161fef7 100644 --- a/lib/stdlib/src/stdlib.appup.src +++ b/lib/stdlib/src/stdlib.appup.src @@ -18,9 +18,7 @@ %% %CopyrightEnd% {"%VSN%", %% Up from - max one major revision back - [{<<"3\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* - {<<"2\\.[5-8](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-18.* + [{<<"3\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-19.* %% Down to - max one major revision back - [{<<"3\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* - {<<"2\\.[5-8](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-18.* + [{<<"3\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-19.* }. diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl index 02b7cb10c2..8e7ac223a7 100644 --- a/lib/stdlib/test/rand_SUITE.erl +++ b/lib/stdlib/test/rand_SUITE.erl @@ -28,7 +28,8 @@ api_eq/1, reference/1, basic_stats_uniform_1/1, basic_stats_uniform_2/1, basic_stats_normal/1, - plugin/1, measure/1]). + plugin/1, measure/1, + reference_jump_state/1, reference_jump_procdict/1]). -export([test/0, gen/1]). @@ -45,14 +46,21 @@ all() -> api_eq, reference, {group, basic_stats}, - plugin, measure]. + plugin, measure, + {group, reference_jump} + ]. groups() -> [{basic_stats, [parallel], - [basic_stats_uniform_1, basic_stats_uniform_2, basic_stats_normal]}]. + [basic_stats_uniform_1, basic_stats_uniform_2, basic_stats_normal]}, + {reference_jump, [parallel], + [reference_jump_state, reference_jump_procdict]}]. group(basic_stats) -> %% valgrind needs a lot of time + [{timetrap,{minutes,10}}]; +group(reference_jump) -> + %% valgrind needs a lot of time [{timetrap,{minutes,10}}]. %% A simple helper to test without test_server during dev @@ -228,7 +236,7 @@ interval_float_1(N) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Check if exs64 algorithm generates the proper sequence. +%% Check if each algorithm generates the proper sequence. reference(Config) when is_list(Config) -> [reference_1(Alg) || Alg <- algs()], ok. @@ -242,7 +250,7 @@ reference_1(Alg) -> io:format("Failed: ~p~n",[Alg]), io:format("Length ~p ~p~n",[length(Refval), length(Testval)]), io:format("Head ~p ~p~n",[hd(Refval), hd(Testval)]), - ok + exit(wrong_value) end. gen(Algo) -> @@ -434,6 +442,112 @@ measure_2(N, State0, Fun) when N > 0 -> measure_2(0, _, _) -> ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% The jump sequence tests has two parts +%% for those with the functional API (jump/1) +%% and for those with the internal state +%% in process dictionary (jump/0). + +-define(LOOP_JUMP, (?LOOP div 1000)). + +%% Check if each algorithm generates the proper jump sequence +%% with the functional API. +reference_jump_state(Config) when is_list(Config) -> + [reference_jump_1(Alg) || Alg <- algs()], + ok. + +reference_jump_1(Alg) -> + Refval = reference_jump_val(Alg), + Testval = gen_jump_1(Alg), + case Refval =:= Testval of + true -> ok; + false -> + io:format("Failed: ~p~n",[Alg]), + io:format("Length ~p ~p~n",[length(Refval), length(Testval)]), + io:format("Head ~p ~p~n",[hd(Refval), hd(Testval)]), + exit(wrong_value) + end. + +gen_jump_1(Algo) -> + Seed = case Algo of + exsplus -> %% Printed with orig 'C' code and this seed + rand:seed_s({exsplus, [12345678|12345678]}); + exs1024 -> %% Printed with orig 'C' code and this seed + rand:seed_s({exs1024, {lists:duplicate(16, 12345678), []}}); + exs64 -> %% Test exception of not_implemented notice + try rand:jump(rand:seed_s(exs64)) + catch + error:not_implemented -> not_implemented + end; + _ -> % unimplemented + not_implemented + end, + case Seed of + not_implemented -> [not_implemented]; + S -> gen_jump_1(?LOOP_JUMP, S, []) + end. + +gen_jump_1(N, State0 = {#{max:=Max}, _}, Acc) when N > 0 -> + {_, State1} = rand:uniform_s(Max, State0), + {Random, State2} = rand:uniform_s(Max, rand:jump(State1)), + case N rem (?LOOP_JUMP div 100) of + 0 -> gen_jump_1(N-1, State2, [Random|Acc]); + _ -> gen_jump_1(N-1, State2, Acc) + end; +gen_jump_1(_, _, Acc) -> lists:reverse(Acc). + +%% Check if each algorithm generates the proper jump sequence +%% with the internal state in the process dictionary. +reference_jump_procdict(Config) when is_list(Config) -> + [reference_jump_0(Alg) || Alg <- algs()], + ok. + +reference_jump_0(Alg) -> + Refval = reference_jump_val(Alg), + Testval = gen_jump_0(Alg), + case Refval =:= Testval of + true -> ok; + false -> + io:format("Failed: ~p~n",[Alg]), + io:format("Length ~p ~p~n",[length(Refval), length(Testval)]), + io:format("Head ~p ~p~n",[hd(Refval), hd(Testval)]), + exit(wrong_value) + end. + +gen_jump_0(Algo) -> + Seed = case Algo of + exsplus -> %% Printed with orig 'C' code and this seed + rand:seed({exsplus, [12345678|12345678]}); + exs1024 -> %% Printed with orig 'C' code and this seed + rand:seed({exs1024, {lists:duplicate(16, 12345678), []}}); + exs64 -> %% Test exception of not_implemented notice + try + _ = rand:seed(exs64), + rand:jump() + catch + error:not_implemented -> not_implemented + end; + _ -> % unimplemented + not_implemented + end, + case Seed of + not_implemented -> [not_implemented]; + S -> + {Seedmap=#{}, _} = S, + Max = maps:get(max, Seedmap), + gen_jump_0(?LOOP_JUMP, Max, []) + end. + +gen_jump_0(N, Max, Acc) when N > 0 -> + _ = rand:uniform(Max), + _ = rand:jump(), + Random = rand:uniform(Max), + case N rem (?LOOP_JUMP div 100) of + 0 -> gen_jump_0(N-1, Max, [Random|Acc]); + _ -> gen_jump_0(N-1, Max, Acc) + end; +gen_jump_0(_, _, Acc) -> lists:reverse(Acc). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Data reference_val(exs64) -> [16#3737ad0c703ff6c3,16#3868a78fe71adbbd,16#1f01b62b4338b605,16#50876a917437965f, @@ -515,3 +629,61 @@ reference_val(exsplus) -> 16#36f715a249f4ec2,16#1c27629826c50d3,16#914d9a6648726a,16#27f5bf5ce2301e8, 16#3dd493b8012970f,16#be13bed1e00e5c,16#ceef033b74ae10,16#3da38c6a50abe03, 16#15cbd1a421c7a8c,16#22794e3ec6ef3b1,16#26154d26e7ea99f,16#3a66681359a6ab6]. + +%%% + +reference_jump_val(exsplus) -> + [82445318862816932, 145810727464480743, 16514517716894509, 247642377064868650, + 162385642339156908, 251810707075252101, 82288275771998924, 234412731596926322, + 49960883129071044, 200690077681656596, 213743196668671647, 131182800982967108, + 144200072021941728, 263557425008503277, 194858522616874272, 185869394820993172, + 80384502675241453, 262654144824057588, 90033295011291362, 4494510449302659, + 226005372746479588, 116780561309220553, 47048528594475843, 39168929349768743, + 139615163424415552, 55330632656603925, 237575574720486569, 102381140288455025, + 18452933910354323, 150248612130579752, 269358096791922740, 61313433522002187, + 160327361842676597, 185187983548528938, 57378981505594193, 167510799293984067, + 105117045862954303, 176126685946302943, 123590876906828803, 69185336947273487, + 9098689247665808, 49906154674145057, 131575138412788650, 161843880211677185, + 30743946051071186, 187578920583823612, 45008401528636978, 122454158686456658, + 111195992644229524, 17962783958752862, 13579507636941108, 130137843317798663, + 144202635170576832, 132539563255093922, 159785575703967124, 187241848364816640, + 183044737781926478, 12921559769912263, 83553932242922001, 96698298841984688, + 281664320227537824, 224233030818578263, 77812932110318774, 169729351013291728, + 164475402723178734, 242780633011249051, 51095111179609125, 19249189591963554, + 221412426221439180, 265700202856282653, 265342254311932308, 241218503498385511, + 255400887248486575, 212083616929812076, 227947034485840579, 268261881651571692, + 104846262373404908, 49690734329496661, 213259196633566308, 186966479726202436, + 282157378232384574, 11272948584603747, 166540426999573480, 50628164001018755, + 65235580992800860, 230664399047956956, 64575592354687978, 40519393736078511, + 108341851194332747, 115426411532008961, 120656817002338193, 234537867870809797, + 12504080415362731, 45083100453836317, 270968267812126657, 93505647407734103, + 252852934678537969, 258758309277167202, 74250882143432077, 141629095984552833]; + +reference_jump_val(exs1024) -> + [2655961906500790629, 17003395417078685063, 10466831598958356428, 7603399148503548021, + 1650550950190587188, 12294992315080723704, 15743995773860389219, 5492181000145247327, + 14118165228742583601, 1024386975263610703, 10124872895886669513, 6445624517813169301, + 6238575554686562601, 14108646153524288915, 11804141635807832816, 8421575378006186238, + 6354993374304550369, 838493020029548163, 14759355804308819469, 12212491527912522022, + 16943204735100571602, 198964074252287588, 7325922870779721649, 15853102065526570574, + 16294058349151823341, 6153379962047409781, 15874031679495957261, 17299265255608442340, + 984658421210027171, 17408042033939375278, 3326465916992232353, 5222817718770538733, + 13262385796795170510, 15648751121811336061, 6718721549566546451, 7353765235619801875, + 16110995049882478788, 14559143407227563441, 4189805181268804683, 10938587948346538224, + 1635025506014383478, 12619562911869525411, 17469465615861488695, 125252234176411528, + 2004192558503448853, 13175467866790974840, 17712272336167363518, 1710549840100880318, + 17486892343528340916, 5337910082227550967, 8333082060923612691, 6284787745504163856, + 8072221024586708290, 6077032673910717705, 11495200863352251610, 11722792537523099594, + 14642059504258647996, 8595733246938141113, 17223366528010341891, 17447739753327015776, + 6149800490736735996, 11155866914574313276, 7123864553063709909, 15982886296520662323, + 5775920250955521517, 8624640108274906072, 8652974210855988961, 8715770416136907275, + 11841689528820039868, 10991309078149220415, 11758038663970841716, 7308750055935299261, + 15939068400245256963, 6920341533033919644, 8017706063646646166, 15814376391419160498, + 13529376573221932937, 16749061963269842448, 14639730709921425830, 3265850480169354066, + 4569394597532719321, 16594515239012200038, 13372824240764466517, 16892840440503406128, + 11260004846380394643, 2441660009097834955, 10566922722880085440, 11463315545387550692, + 5252492021914937692, 10404636333478845345, 11109538423683960387, 5525267334484537655, + 17936751184378118743, 4224632875737239207, 15888641556987476199, 9586888813112229805, + 9476861567287505094, 14909536929239540332, 17996844556292992842, 2699310519182298856]; + +reference_jump_val(exs64) -> [not_implemented]. diff --git a/lib/stdlib/test/tar_SUITE.erl b/lib/stdlib/test/tar_SUITE.erl index 64dd41e75a..6f3979bb77 100644 --- a/lib/stdlib/test/tar_SUITE.erl +++ b/lib/stdlib/test/tar_SUITE.erl @@ -720,20 +720,25 @@ memory(Config) when is_list(Config) -> %% Test filenames with characters outside the US ASCII range. unicode(Config) when is_list(Config) -> - PrivDir = proplists:get_value(priv_dir, Config), - do_unicode(PrivDir), + run_unicode_node(Config, "+fnu"), case has_transparent_naming() of true -> - Pa = filename:dirname(code:which(?MODULE)), - Node = start_node(unicode, "+fnl -pa "++Pa), - ok = rpc:call(Node, erlang, apply, - [fun() -> do_unicode(PrivDir) end,[]]), - true = test_server:stop_node(Node), - ok; + run_unicode_node(Config, "+fnl"); false -> ok end. +run_unicode_node(Config, Option) -> + PrivDir = proplists:get_value(priv_dir, Config), + Pa = filename:dirname(code:which(?MODULE)), + Args = Option ++ " -pa "++Pa, + io:format("~s\n", [Args]), + Node = start_node(unicode, Args), + ok = rpc:call(Node, erlang, apply, + [fun() -> do_unicode(PrivDir) end,[]]), + true = test_server:stop_node(Node), + ok. + has_transparent_naming() -> case os:type() of {unix,darwin} -> false; @@ -745,10 +750,11 @@ do_unicode(PrivDir) -> ok = file:set_cwd(PrivDir), ok = file:make_dir("unicöde"), - Names = unicode_create_files(), + Names = lists:sort(unicode_create_files()), Tar = "unicöde.tar", ok = erl_tar:create(Tar, ["unicöde"], []), - {ok,Names} = erl_tar:table(Tar, []), + {ok,Names0} = erl_tar:table(Tar, []), + Names = lists:sort(Names0), _ = [ok = file:delete(Name) || Name <- Names], ok = erl_tar:extract(Tar), _ = [{ok,_} = file:read_file(Name) || Name <- Names], |